Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cc/cc3106b.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- CC3106B.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 THE FORMAL PARAMETER DENOTES THE ACTUAL
26 -- IN AN INSTANTIATION.
27
28 -- HISTORY:
29 -- LDC 06/20/88 CREATED ORIGINAL TEST
30 -- EDWARD V. BERARD, 10 AUGUST 1990 ADDED CHECKS FOR MULTI-
31 -- DIMENSIONAL ARRAYS
32
33 WITH REPORT ;
34
35 PROCEDURE CC3106B IS
36
37 BEGIN -- CC3106B
38
39 REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &
40 "THE ACTUAL IN AN INSTANTIATION");
41
42 LOCAL_BLOCK:
43
44 DECLARE
45
46 SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;
47 TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;
48 PRAGMA PACK(PCK_BOL) ;
49
50 SHORT_START : CONSTANT := -100 ;
51 SHORT_END : CONSTANT := 100 ;
52 TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
53
54 SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
55
56 TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
57 SEP, OCT, NOV, DEC) ;
58
59 SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
60
61 TYPE DAY_TYPE IS RANGE 1 .. 31 ;
62 TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
63 TYPE DATE IS RECORD
64 MONTH : MONTH_TYPE ;
65 DAY : DAY_TYPE ;
66 YEAR : YEAR_TYPE ;
67 END RECORD ;
68
69 TODAY : DATE := (MONTH => AUG,
70 DAY => 8,
71 YEAR => 1990) ;
72
73 FIRST_DATE : DATE := (DAY => 6,
74 MONTH => JUN,
75 YEAR => 1967) ;
76
77 WALL_DATE : DATE := (MONTH => NOV,
78 DAY => 9,
79 YEAR => 1989) ;
80
81 SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
82
83 TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
84 FIRST_HALF,
85 FIRST_FIVE) OF DATE ;
86
87 TD_ARRAY : THREE_DIMENSIONAL := (THREE_DIMENSIONAL'RANGE =>
88 (THREE_DIMENSIONAL'RANGE (2) =>
89 (THREE_DIMENSIONAL'RANGE (3) =>
90 TODAY))) ;
91
92 TASK TYPE TSK IS
93 ENTRY ENT_1;
94 ENTRY ENT_2;
95 ENTRY ENT_3;
96 END TSK;
97
98 GENERIC
99
100 TYPE GEN_TYPE IS (<>);
101 GEN_BOLARR : IN OUT PCK_BOL;
102 GEN_TYP : IN OUT GEN_TYPE;
103 GEN_TSK : IN OUT TSK;
104 TEST_VALUE : IN DATE ;
105 TEST_CUBE : IN OUT THREE_DIMENSIONAL ;
106
107 PACKAGE P IS
108 PROCEDURE GEN_PROC1 ;
109 PROCEDURE GEN_PROC2 ;
110 PROCEDURE GEN_PROC3 ;
111 PROCEDURE ARRAY_TEST ;
112 END P;
113
114 ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);
115 SI : SM_INT := 0 ;
116 T : TSK;
117
118 PACKAGE BODY P IS
119
120 PROCEDURE GEN_PROC1 IS
121 BEGIN -- GEN_PROC1
122 GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);
123 GEN_TYP := GEN_TYPE'VAL(4);
124 IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)
125 THEN
126 REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
127 "INSTANTIATED VALUES");
128 END IF;
129 END GEN_PROC1;
130
131 PROCEDURE GEN_PROC2 IS
132 BEGIN -- GEN_PROC2
133 IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR
134 GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN
135 REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
136 "VALUES ASSIGNED IN THE MAIN " &
137 "PROCEDURE");
138 END IF;
139 GEN_BOLARR(18) := TRUE;
140 GEN_TYP := GEN_TYPE'VAL(9);
141 END GEN_PROC2;
142
143 PROCEDURE GEN_PROC3 IS
144 BEGIN -- GEN_PROC3
145 GEN_TSK.ENT_2;
146 END GEN_PROC3 ;
147
148 PROCEDURE ARRAY_TEST IS
149 BEGIN -- ARRAY_TEST
150
151 TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;
152
153 IF (TD_ARRAY (0, JUN, 'C') /= TEST_VALUE) OR
154 (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN
155 REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &
156 "DIFFERENT THAN THE VALUES ASSIGNED " &
157 "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;
158 END IF ;
159
160 END ARRAY_TEST ;
161
162 END P ;
163
164 TASK BODY TSK IS
165 BEGIN -- TSK
166 ACCEPT ENT_1 DO
167 REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");
168 END;
169 ACCEPT ENT_2 DO
170 REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");
171 END;
172 ACCEPT ENT_3 DO
173 REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");
174 END;
175 END TSK;
176
177 PACKAGE INSTA1 IS NEW P (GEN_TYPE => SM_INT,
178 GEN_BOLARR => ACT_BOLARR,
179 GEN_TYP => SI,
180 GEN_TSK => T,
181 TEST_VALUE => FIRST_DATE,
182 TEST_CUBE => TD_ARRAY) ;
183
184 BEGIN -- LOCAL_BLOCK
185
186 INSTA1.GEN_PROC1;
187 ACT_BOLARR(9) := TRUE;
188 SI := 2;
189 INSTA1.GEN_PROC2;
190 IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR
191 SI /= REPORT.IDENT_INT(9) THEN
192 REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &
193 "ASSIGNED IN THE GENERIC PROCEDURE");
194 END IF;
195
196 T.ENT_1;
197 INSTA1.GEN_PROC3;
198 T.ENT_3;
199
200 TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;
201 INSTA1.ARRAY_TEST ;
202
203 END LOCAL_BLOCK;
204
205 REPORT.RESULT;
206
207 END CC3106B ;