OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c8/] [c87b39a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C87B39A.ADA
2
 
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
7
--     unlimited rights in the software and documentation contained herein.
8
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
9
--     this public release, the Government intends to confer upon all 
10
--     recipients unlimited rights  equal to those held by the Government.  
11
--     These rights include rights to use, duplicate, release or disclose the 
12
--     released technical data and computer software in whole or in part, in 
13
--     any manner and for any purpose whatsoever, and to have or permit others 
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
18
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
20
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
22
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23
--     PARTICULAR PURPOSE OF SAID MATERIAL.
24
--*
25
-- CHECK THAT:
26
 
27
--   A) AN OVERLOADED CALL CAN BE RESOLVED BECAUSE AN ALLOCATOR RETURNS
28
--      AN ACCESS TYPE WHOSE DESIGNATED TYPE IS THE TYPE REFERRED TO IN
29
--      THE ALLOCATOR.
30
--
31
--   B) IF THE NAME OF THE DESIGNATED TYPE IN AN ALLOCATOR DOES NOT
32
--      UNIQUELY DETERMINE THE ACCESS TYPE OF AN ALLOCATOR, THE CONTEXT
33
--      MUST DETERMINE THE TYPE.
34
 
35
-- JBG 1/30/84
36
 
37
WITH REPORT; USE REPORT;
38
PROCEDURE C87B39A IS
39
 
40
     TYPE S IS (M, F);
41
     TYPE R (D : S) IS
42
          RECORD NULL; END RECORD;
43
     SUBTYPE M1 IS R(M);
44
     SUBTYPE M2 IS R(M);
45
 
46
     TYPE ACC_M1 IS ACCESS M1;
47
     TYPE ACC_M2 IS ACCESS M2;
48
     TYPE ACC_BOOL IS ACCESS BOOLEAN;
49
     TYPE ACC_ACC_M1 IS ACCESS ACC_M1;
50
 
51
     TYPE WHICH IS (IS_M1, IS_M2, IS_BOOL);
52
 
53
     PROCEDURE P (X : ACC_M1; RESOLUTION : WHICH) IS
54
     BEGIN
55
          IF RESOLUTION /= IS_M1 THEN
56
               FAILED ("INCORRECT RESOLUTION -- ACC_M1");
57
          END IF;
58
     END P;    -- ACC_M1
59
 
60
     PROCEDURE P (X : ACC_M2; RESOLUTION : WHICH) IS
61
     BEGIN
62
          IF RESOLUTION /= IS_M2 THEN
63
               FAILED ("INCORRECT RESOLUTION -- ACC_M2");
64
          END IF;
65
     END P;    -- ACC_M2
66
 
67
     PROCEDURE P (X : ACC_BOOL; RESOLUTION : WHICH) IS
68
     BEGIN
69
          IF RESOLUTION /= IS_BOOL THEN
70
               FAILED ("INCORRECT RESOLUTION -- ACC_BOOL");
71
          END IF;
72
     END P;    -- ACC_BOOL
73
 
74
     PROCEDURE P (X : ACC_ACC_M1; RESOLUTION : WHICH) IS
75
     BEGIN
76
          FAILED ("INCORRECT RESOLUTION -- ACC_ACC_M1");
77
     END P;    -- ACC_ACC_M1
78
 
79
     PROCEDURE Q (X : ACC_M1) IS
80
     BEGIN
81
          NULL;
82
     END Q;    -- ACC_M1
83
 
84
     PROCEDURE Q (X : ACC_BOOL) IS
85
     BEGIN
86
          FAILED ("INCORRECT RESOLUTION -- ACC_BOOL: Q");
87
     END Q;    -- ACC_BOOL
88
 
89
BEGIN
90
 
91
     TEST ("C87B39A", "OVERLOADING RESOLUTION FOR ALLOCATORS");
92
 
93
     P (ACC_M1'(NEW R(M)), IS_M1);    -- B
94
 
95
     P (ACC_M2'(NEW M1), IS_M2);      -- B
96
 
97
     P (NEW BOOLEAN'(TRUE), IS_BOOL); -- A
98
 
99
     Q (NEW M2);              -- A
100
     Q (NEW M1);              -- A
101
     Q (NEW R(M));            -- A
102
     Q (NEW R'(D => M));      -- A
103
 
104
     RESULT;
105
 
106
END C87B39A;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.