Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c3/c35507e.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 -- C35507E.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 THE ATTRIBUTES 'IMAGE' AND 'VALUE YIELD THE CORRECT | |
27 -- RESULTS WHEN THE PREFIX IS A FORMAL DISCRETE TYPE WHOSE ACTUAL | |
28 -- PARAMETER IS A CHARACTER TYPE. | |
29 -- SUBTESTS ARE: | |
30 -- (A). TESTS FOR IMAGE. | |
31 -- (B). TESTS FOR VALUE. | |
32 | |
33 -- HISTORY: | |
34 -- RJW 05/29/86 CREATED ORIGINAL TEST. | |
35 -- VCL 10/23/87 MODIFIED THIS HEADER, CHANGED THE CALLS TO | |
36 -- PROCEDURE 'PCH', IN THE SECOND PART OF SUBTEST B, | |
37 -- TO INCLUDE ANOTHER CALL TO PROCEDURE 'PCHAR' AND | |
38 -- CALLS TO PROCEDURE 'PNCHAR'. | |
39 | |
40 WITH REPORT; USE REPORT; | |
41 PROCEDURE C35507E IS | |
42 | |
43 TYPE CHAR IS ('A', 'a'); | |
44 | |
45 TYPE NEWCHAR IS NEW CHAR; | |
46 | |
47 PROCEDURE CHECK_LOWER_BOUND (STR1, STR2 : STRING) IS | |
48 BEGIN | |
49 IF STR1'FIRST /= 1 THEN | |
50 FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 & "'(" & | |
51 STR1 & ")" ); | |
52 END IF; | |
53 END CHECK_LOWER_BOUND; | |
54 | |
55 BEGIN | |
56 | |
57 TEST( "C35507E" , "THE ATTRIBUTES 'IMAGE' AND " & | |
58 "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " & | |
59 "PREFIX IS A FORMAL DISCRETE TYPE WHOSE " & | |
60 "ACTUAL PARAMETER IS A CHARACTER TYPE" ); | |
61 | |
62 DECLARE -- (A). | |
63 GENERIC | |
64 TYPE CHTYPE IS (<>); | |
65 STR1 : STRING; | |
66 PROCEDURE P (CH : CHTYPE; STR2 : STRING); | |
67 | |
68 PROCEDURE P (CH : CHTYPE; STR2 : STRING) IS | |
69 SUBTYPE SUBCH IS CHTYPE; | |
70 BEGIN | |
71 IF SUBCH'IMAGE (CH) /= STR2 THEN | |
72 FAILED ( "INCORRECT IMAGE FOR " & STR1 & "'(" & | |
73 STR2 & ")" ); | |
74 END IF; | |
75 | |
76 CHECK_LOWER_BOUND (SUBCH'IMAGE (CH), STR1); | |
77 END P; | |
78 | |
79 PROCEDURE PCHAR IS NEW P (CHAR, "CHAR"); | |
80 PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR"); | |
81 PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER"); | |
82 | |
83 BEGIN | |
84 PCHAR ('A', "'A'"); | |
85 PCHAR ('a', "'a'"); | |
86 PNCHAR ('A', "'A'"); | |
87 PNCHAR ('a', "'a'"); | |
88 | |
89 FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP | |
90 PCH (CH, ("'" & CH) & "'" ); | |
91 END LOOP; | |
92 END; | |
93 | |
94 DECLARE | |
95 | |
96 GENERIC | |
97 TYPE CHTYPE IS (<>); | |
98 PROCEDURE P (CH : CHTYPE; STR : STRING); | |
99 | |
100 PROCEDURE P (CH : CHTYPE; STR : STRING) IS | |
101 SUBTYPE SUBCH IS CHTYPE; | |
102 BEGIN | |
103 CHECK_LOWER_BOUND (CHTYPE'IMAGE (CH), "CHARACTER"); | |
104 END P; | |
105 | |
106 PROCEDURE PN IS NEW P (CHARACTER); | |
107 | |
108 BEGIN | |
109 | |
110 FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP | |
111 PN (CH, CHARACTER'IMAGE (CH)); | |
112 END LOOP; | |
113 | |
114 PN (ASCII.DEL, CHARACTER'IMAGE (ASCII.DEL)); | |
115 END; | |
116 | |
117 --------------------------------------------------------------- | |
118 | |
119 DECLARE -- (B). | |
120 | |
121 GENERIC | |
122 TYPE CHTYPE IS (<>); | |
123 STR1 : STRING; | |
124 PROCEDURE P (STR2 : STRING; CH : CHTYPE); | |
125 | |
126 PROCEDURE P (STR2 : STRING; CH : CHTYPE) IS | |
127 SUBTYPE SUBCH IS CHTYPE; | |
128 BEGIN | |
129 IF SUBCH'VALUE (STR2) /= CH THEN | |
130 FAILED ( "INCORRECT " & STR1 & "'VALUE FOR " & | |
131 STR2 ); | |
132 END IF; | |
133 END P; | |
134 | |
135 PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER"); | |
136 PROCEDURE PCHAR IS NEW P (CHAR, "CHAR"); | |
137 PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR"); | |
138 | |
139 BEGIN | |
140 FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP | |
141 PCH (CHARACTER'IMAGE (CH), CH ); | |
142 END LOOP; | |
143 | |
144 PCH (CHARACTER'IMAGE (CHARACTER'VAL (127)), | |
145 CHARACTER'VAL (127)); | |
146 | |
147 PCHAR ("'A'", 'A'); | |
148 PCHAR ("'a'", 'a' ); | |
149 PNCHAR ("'A'", 'A'); | |
150 PNCHAR ("'a'", 'a'); | |
151 END; | |
152 | |
153 DECLARE | |
154 GENERIC | |
155 TYPE CHTYPE IS (<>); | |
156 STR1 : STRING; | |
157 PROCEDURE P (STR2 : STRING); | |
158 | |
159 PROCEDURE P (STR2 : STRING) IS | |
160 SUBTYPE SUBCH IS CHTYPE; | |
161 BEGIN | |
162 IF SUBCH'VALUE (STR2) = SUBCH'VAL (0) THEN | |
163 FAILED ( "NO EXCEPTION RAISED FOR " & | |
164 STR1 & "'VALUE (" & STR2 & ") - 1" ); | |
165 ELSE | |
166 FAILED ( "NO EXCEPTION RAISED FOR " & | |
167 STR1 & "'VALUE (" & STR2 & ") - 2" ); | |
168 END IF; | |
169 EXCEPTION | |
170 WHEN CONSTRAINT_ERROR => | |
171 NULL; | |
172 WHEN OTHERS => | |
173 FAILED ( "WRONG EXCEPTION RAISED " & | |
174 "FOR " & STR1 & "'VALUE (" & STR2 & ")" ); | |
175 END P; | |
176 | |
177 PROCEDURE PCH IS NEW P (CHARACTER, "CHARACTER"); | |
178 PROCEDURE PCHAR IS NEW P (CHAR, "CHAR"); | |
179 PROCEDURE PNCHAR IS NEW P (NEWCHAR, "NEWCHAR"); | |
180 | |
181 BEGIN | |
182 PCHAR ("'B'"); | |
183 PCH (ASCII.HT & "'A'"); | |
184 PCH ("'B'" & ASCII.HT); | |
185 PCH ("'C'" & ASCII.BEL); | |
186 PCH ("'"); | |
187 PNCHAR ("''"); | |
188 PCHAR ("'A"); | |
189 PNCHAR ("A'"); | |
190 PCH ("'AB'"); | |
191 END; | |
192 | |
193 RESULT; | |
194 END C35507E; |