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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3225a.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC3225A.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
-- OBJECTIVE:
26
--     CHECK THAT A FORMAL ACCESS TYPE DENOTES ITS ACTUAL
27
--     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE
28
--     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.
29
 
30
-- HISTORY:
31
--     DHH 10/21/88  CREATED ORIGINAL TEST.
32
--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
33
 
34
WITH REPORT; USE REPORT;
35
PROCEDURE CC3225A IS
36
 
37
     GENERIC
38
          TYPE NODE IS PRIVATE;
39
          TYPE T IS ACCESS NODE;
40
     PACKAGE P IS
41
          SUBTYPE SUB_T IS T;
42
          PAC_VAR : SUB_T;
43
     END P;
44
 
45
BEGIN
46
     TEST ("CC3225A", "CHECK THAT A FORMAL ACCESS TYPE DENOTES ITS " &
47
                      "ACTUAL PARAMETER, AND THAT OPERATIONS OF THE " &
48
                      "FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &
49
                      "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");
50
 
51
     DECLARE
52
          SUBTYPE INT IS INTEGER RANGE 1 .. 3;
53
          TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
54
          TYPE ACC_ARR IS ACCESS ARR;
55
 
56
          Q : ACC_ARR := NEW ARR;
57
 
58
          PACKAGE P1 IS NEW P (ARR, ACC_ARR);
59
          USE P1;
60
 
61
     BEGIN
62
          PAC_VAR := NEW ARR'(1, 2, 3);
63
          IF PAC_VAR'FIRST /= Q'FIRST THEN
64
               FAILED("'FIRST ATTRIBUTE FAILED");
65
          END IF;
66
          IF PAC_VAR'LAST /= Q'LAST THEN
67
               FAILED("'LAST ATTRIBUTE FAILED");
68
          END IF;
69
          IF PAC_VAR'FIRST(1) /= Q'FIRST(1) THEN
70
               FAILED("'FIRST(N) ATTRIBUTE FAILED");
71
          END IF;
72
          IF NOT (PAC_VAR'LAST(1) = Q'LAST(1)) THEN
73
               FAILED("'LAST(N) ATTRIBUTE FAILED");
74
          END IF;
75
          IF 2 NOT IN PAC_VAR'RANGE THEN
76
               FAILED("'RANGE ATTRIBUTE FAILED");
77
          END IF;
78
          IF 3 NOT IN PAC_VAR'RANGE(1) THEN
79
               FAILED("'RANGE(N) ATTRIBUTE FAILED");
80
          END IF;
81
          IF PAC_VAR'LENGTH /= Q'LENGTH THEN
82
               FAILED("'LENGTH ATTRIBUTE FAILED");
83
          END IF;
84
          IF PAC_VAR'LENGTH(1) /= Q'LENGTH(1) THEN
85
               FAILED("'LENGTH(N) ATTRIBUTE FAILED");
86
           END IF;
87
 
88
          PAC_VAR.ALL := (1, 2, 3);
89
          IF IDENT_INT(3) /= PAC_VAR(3) THEN
90
               FAILED("ASSIGNMENT FAILED");
91
          END IF;
92
 
93
          IF SUB_T'(PAC_VAR) NOT IN SUB_T THEN
94
               FAILED("QUALIFIED EXPRESSION FAILED");
95
          END IF;
96
 
97
          Q.ALL := PAC_VAR.ALL;
98
          IF SUB_T(Q) = PAC_VAR THEN
99
               FAILED("EXPLICIT CONVERSION FAILED");
100
          END IF;
101
          IF Q(1) /= PAC_VAR(1) THEN
102
               FAILED("INDEXING FAILED");
103
          END IF;
104
          IF (1, 2) /= PAC_VAR(1 .. 2) THEN
105
               FAILED("SLICE FAILED");
106
          END IF;
107
          IF (1, 2) & PAC_VAR(3) /= PAC_VAR.ALL THEN
108
               FAILED("CATENATION FAILED");
109
          END IF;
110
     END;
111
 
112
     DECLARE
113
          TASK TYPE TSK IS
114
               ENTRY ONE;
115
          END TSK;
116
 
117
          GENERIC
118
               TYPE T IS ACCESS TSK;
119
          PACKAGE P IS
120
               SUBTYPE SUB_T IS T;
121
               PAC_VAR : SUB_T;
122
          END P;
123
 
124
          TYPE ACC_TSK IS ACCESS TSK;
125
 
126
          PACKAGE P1 IS NEW P(ACC_TSK);
127
          USE P1;
128
 
129
          GLOBAL : INTEGER := 5;
130
 
131
          TASK BODY TSK IS
132
          BEGIN
133
               ACCEPT ONE DO
134
                    GLOBAL := 1;
135
               END ONE;
136
          END;
137
     BEGIN
138
          PAC_VAR := NEW TSK;
139
          PAC_VAR.ONE;
140
          IF GLOBAL /= 1 THEN
141
               FAILED("TASK ENTRY SELECTION FAILED");
142
          END IF;
143
     END;
144
 
145
     DECLARE
146
          TYPE REC IS
147
               RECORD
148
                    I : INTEGER;
149
                    B : BOOLEAN;
150
               END RECORD;
151
 
152
          TYPE ACC_REC IS ACCESS REC;
153
 
154
          PACKAGE P1 IS NEW P (REC, ACC_REC);
155
          USE P1;
156
 
157
     BEGIN
158
          PAC_VAR := NEW REC'(4, (PAC_VAR IN ACC_REC));
159
          IF PAC_VAR.I /= IDENT_INT(4) AND NOT PAC_VAR.B THEN
160
               FAILED("RECORD COMPONENT SELECTION FAILED");
161
          END IF;
162
     END;
163
 
164
     DECLARE
165
          TYPE REC(B : BOOLEAN := FALSE) IS
166
               RECORD
167
                    NULL;
168
               END RECORD;
169
 
170
          TYPE ACC_REC IS ACCESS REC;
171
 
172
          PACKAGE P1 IS NEW P (REC, ACC_REC);
173
          USE P1;
174
 
175
     BEGIN
176
          PAC_VAR := NEW REC'(B => PAC_VAR IN ACC_REC);
177
          IF NOT PAC_VAR.B THEN
178
               FAILED("DISCRIMINANT SELECTION FAILED");
179
          END IF;
180
     END;
181
 
182
     RESULT;
183
END CC3225A;

powered by: WebSVN 2.1.0

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