Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c4/c46042a.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 -- C46042A.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 ARRAY CONVERSIONS WHEN THE TARGET TYPE IS A CONSTRAINED | |
26 -- ARRAY TYPE AND THE OPERAND TYPE HAS BOUNDS THAT DO NOT BELONG TO | |
27 -- THE BASE TYPE OF THE TARGET TYPE'S INDEX SUBTYPE. | |
28 | |
29 -- R.WILLIAMS 9/8/86 | |
30 | |
31 WITH REPORT; USE REPORT; | |
32 PROCEDURE C46042A IS | |
33 | |
34 TYPE INT IS RANGE -100 .. 100; | |
35 | |
36 TYPE NEWINTEGER IS NEW INTEGER; | |
37 | |
38 TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT); | |
39 | |
40 TYPE NDAY1 IS NEW DAY RANGE MON .. FRI; | |
41 TYPE NDAY2 IS NEW DAY RANGE MON .. FRI; | |
42 | |
43 TYPE NNDAY1 IS NEW NDAY1; | |
44 | |
45 FUNCTION IDENT (X : INT) RETURN INT IS | |
46 BEGIN | |
47 RETURN INT'VAL (IDENT_INT (INT'POS (X))); | |
48 END IDENT; | |
49 | |
50 FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS | |
51 BEGIN | |
52 RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X))); | |
53 END IDENT; | |
54 | |
55 FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS | |
56 BEGIN | |
57 RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X))); | |
58 END IDENT; | |
59 | |
60 FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS | |
61 BEGIN | |
62 RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X))); | |
63 END IDENT; | |
64 | |
65 FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS | |
66 BEGIN | |
67 RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X))); | |
68 END IDENT; | |
69 | |
70 BEGIN | |
71 TEST ( "C46042A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " & | |
72 "TYPE IS A CONSTRAINED ARRAY TYPE AND THE " & | |
73 "OPERAND TYPE HAS BOUNDS THAT DO NOT " & | |
74 "BELONG TO THE BASE TYPE OF THE TARGET " & | |
75 "TYPE'S INDEX SUBTYPE" ); | |
76 | |
77 DECLARE | |
78 | |
79 TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER; | |
80 SUBTYPE CONARR1 IS UNARR1 (IDENT_INT (1) .. IDENT_INT (10)); | |
81 | |
82 TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>) | |
83 OF INTEGER; | |
84 SUBTYPE CONARR2 IS UNARR2 (IDENT_INT (1) .. IDENT_INT (10), | |
85 IDENT (MON) .. IDENT (TUE)); | |
86 | |
87 TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER; | |
88 A1 : ARR1 (IDENT (11) .. IDENT (20)) := | |
89 (IDENT (11) .. IDENT (20) => 0); | |
90 | |
91 TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>) | |
92 OF INTEGER; | |
93 A2 : ARR2 (IDENT (11) .. IDENT (20), | |
94 IDENT (WED) .. IDENT (THU)) := | |
95 (IDENT (11) .. IDENT (20) => | |
96 (IDENT (WED) .. IDENT (THU) => 0)); | |
97 | |
98 TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>) | |
99 OF INTEGER; | |
100 A3 : ARR3 (IDENT (11) .. IDENT (20), | |
101 IDENT (WED) .. IDENT (THU)) := | |
102 (IDENT (11) .. IDENT (20) => | |
103 (IDENT (WED) .. IDENT (THU) => 0)); | |
104 | |
105 PROCEDURE CHECK (A : UNARR1) IS | |
106 BEGIN | |
107 IF A'FIRST /= 1 OR A'LAST /= 10 THEN | |
108 FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" ); | |
109 END IF; | |
110 END CHECK; | |
111 | |
112 PROCEDURE CHECK (A : UNARR2; STR : STRING) IS | |
113 BEGIN | |
114 IF A'FIRST (1) /= 1 OR A'LAST /= 10 OR | |
115 A'FIRST (2) /= MON OR A'LAST (2) /= TUE THEN | |
116 FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" & | |
117 STR & ")" ); | |
118 END IF; | |
119 END CHECK; | |
120 | |
121 BEGIN | |
122 BEGIN | |
123 CHECK (CONARR1 (A1)); | |
124 EXCEPTION | |
125 WHEN OTHERS => | |
126 FAILED ( "EXCEPTION RAISED BY 'CONARR1 (A1)'" ); | |
127 END; | |
128 | |
129 BEGIN | |
130 CHECK (CONARR2 (A2), "2"); | |
131 EXCEPTION | |
132 WHEN OTHERS => | |
133 FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A2)'" ); | |
134 END; | |
135 | |
136 BEGIN | |
137 CHECK (CONARR2 (A3), "3"); | |
138 EXCEPTION | |
139 WHEN OTHERS => | |
140 FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A3)'" ); | |
141 END; | |
142 | |
143 END; | |
144 | |
145 RESULT; | |
146 END C46042A; |