Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c5/c52011a.ada @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 -- C52011A.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 INDEX CONSTRAINTS FOR ASSIGNMENT OF ACCESS SUBTYPES. | |
26 -- SPECIFICALLY, CHECK THAT: | |
27 | |
28 -- A) ANY ACCESS TYPE VARIABLE AND CONSTRAINED SUBTYPE VARIABLES OF THAT | |
29 -- TYPE MAY BE ASSIGNED TO ONE ANOTHER IF THE VALUE BEING ASSIGNED | |
30 -- IS NULL. | |
31 | |
32 -- B) VARIABLES OF THE SAME CONSTRAINED ACCESS SUBTYPE MAY BE ASSIGNED | |
33 -- TO ONE ANOTHER OR TO VARIABLES OF THE BASE ACCESS TYPE. | |
34 | |
35 -- C) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF NON-NULL OBJECTS | |
36 -- BETWEEN DIFFERENTLY CONSTRAINED ACCESS SUBTYPES. | |
37 | |
38 -- D) CONSTRAINT_ERROR IS RAISED UPON ASSIGNMENT OF A NON-NULL OBJECT | |
39 -- OF A BASE ACCESS TYPE VARIABLE TO A VARIABLE OF ONE OF ITS | |
40 -- CONSTRAINED SUBTYPES IF THE CONSTRAINTS ON THE OBJECT DIFFER | |
41 -- FROM THOSE ON THE SUBTYPE. | |
42 | |
43 -- E) NULL CAN BE ASSIGNED TO BASE ACCESS TYPES AND ANY CONSTRAINED | |
44 -- SUBTYPES OF THIS TYPE. | |
45 | |
46 -- ASL 6/29/81 | |
47 -- RM 6/17/82 | |
48 -- SPS 10/26/82 | |
49 -- RLB 6/29/01 - FIXED TO ALLOW AGGRESIVE OPTIMIZATION. | |
50 | |
51 WITH REPORT; | |
52 PROCEDURE C52011A IS | |
53 | |
54 USE REPORT; | |
55 | |
56 TYPE ARR IS ARRAY(INTEGER RANGE <>) OF INTEGER; | |
57 TYPE ARR_NAME IS ACCESS ARR; | |
58 SUBTYPE S1 IS ARR_NAME(IDENT_INT(1)..IDENT_INT(10)); | |
59 SUBTYPE S2 IS ARR_NAME(IDENT_INT(3)..IDENT_INT(6)); | |
60 | |
61 W : ARR_NAME := NULL; -- E. | |
62 X1,X2 : S1 := NULL; -- E. | |
63 Y1,Y2 : S2 := NULL; -- E. | |
64 | |
65 W_NONNULL : ARR_NAME := NEW ARR'(3..5=>7) ; | |
66 X1_NONNULL : S1 := NEW ARR'(IDENT_INT(1)..IDENT_INT(10)=>7); | |
67 Y1_NONNULL : S2 := NEW ARR'(IDENT_INT(3)..IDENT_INT( 6)=>7); | |
68 | |
69 TOO_EARLY : BOOLEAN := TRUE; | |
70 | |
71 BEGIN | |
72 | |
73 TEST ("C52011A", "INDEX CONSTRAINTS ON ACCESS SUBTYPE OBJECTS " & | |
74 "MUST BE SATISFIED FOR ASSIGNMENT"); | |
75 | |
76 BEGIN | |
77 | |
78 IF EQUAL(3,3) THEN | |
79 W_NONNULL := X1; -- A. | |
80 END IF; | |
81 IF W_NONNULL /= X1 THEN | |
82 FAILED ("ASSIGNMENT FAILED - 1"); | |
83 END IF; | |
84 | |
85 IF EQUAL(3,3) THEN | |
86 X1_NONNULL := X2; -- A. | |
87 END IF; | |
88 IF X1_NONNULL /= X2 THEN | |
89 FAILED ("ASSIGNMENT FAILED - 2"); | |
90 END IF; | |
91 | |
92 IF EQUAL(3,3) THEN | |
93 X1_NONNULL := Y1; -- A. | |
94 END IF; | |
95 IF X1 /= Y1 THEN | |
96 FAILED ("ASSIGNMENT FAILED - 3"); | |
97 END IF; | |
98 | |
99 X1 := NEW ARR'(1..IDENT_INT(10) => 5); | |
100 IF EQUAL(3,3) THEN | |
101 X2 := X1; -- B. | |
102 END IF; | |
103 IF X2 /= X1 THEN | |
104 FAILED ("ASSIGNMENT FAILED - 4"); | |
105 END IF; | |
106 | |
107 IF EQUAL(3,3) THEN | |
108 W := X1; -- B. | |
109 END IF; | |
110 IF W /= X1 THEN | |
111 FAILED ("ASSIGNMENT FAILED - 5"); | |
112 END IF; | |
113 | |
114 BEGIN | |
115 Y1 := X1; -- C. | |
116 IF Y1'FIRST /= REPORT.IDENT_INT(3) THEN | |
117 FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " & | |
118 "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " & | |
119 "AND CONSTRAINT IS CHANGED"); | |
120 ELSE | |
121 FAILED ("NON-NULL ASSIGNMENT MADE BETWEEN TWO " & | |
122 "VARIABLES OF DIFFERENT CONSTRAINED ACCESS SUBTYPES " & | |
123 "AND CONSTRAINT IS NOT CHANGED"); | |
124 END IF; | |
125 EXCEPTION | |
126 | |
127 WHEN CONSTRAINT_ERROR => NULL; | |
128 | |
129 WHEN OTHERS => | |
130 FAILED ("WRONG EXCEPTION - 1"); | |
131 | |
132 END; | |
133 | |
134 W := NEW ARR'(IDENT_INT(3)..IDENT_INT(6) => 3); | |
135 | |
136 BEGIN | |
137 X1 := W; -- D. | |
138 IF X1'FIRST /= REPORT.IDENT_INT(1) THEN | |
139 FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " & | |
140 "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "& | |
141 "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " & | |
142 "AND CONSTRAINT IS CHANGED"); | |
143 ELSE | |
144 FAILED ("NON-NULL ASSIGNMENT MADE FROM UNCONSTRAINED " & | |
145 "ACCESS TYPE DESIGNATING CONSTRAINED OBJECT TO "& | |
146 "ACCESS SUBTYPE WITH DIFFERENT CONSTRAINT " & | |
147 "AND CONSTRAINT IS NOT CHANGED"); | |
148 END IF; | |
149 EXCEPTION | |
150 | |
151 WHEN CONSTRAINT_ERROR => | |
152 NULL ; | |
153 | |
154 WHEN OTHERS => | |
155 FAILED ("WRONG EXCEPTION - 2"); | |
156 | |
157 END; | |
158 | |
159 EXCEPTION | |
160 | |
161 WHEN OTHERS => | |
162 FAILED ("EXCEPTION RAISED"); | |
163 | |
164 END; | |
165 | |
166 | |
167 RESULT; | |
168 | |
169 | |
170 END C52011A; |