Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c3/c35507k.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 -- C35507K.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 'POS' AND 'VAL' YIELD THE CORRECT
27 -- RESULTS WHEN THE PREFIX IS A CHARACTER TYPE.
28
29 -- HISTORY:
30 -- RJW 06/03/86
31 -- JLH 07/28/87 MODIFIED FUNCTION IDENT.
32 -- PWN 11/30/94 REMOVED PART OF TEST INVALID FOR ADA 9X.
33
34 WITH REPORT; USE REPORT;
35
36 PROCEDURE C35507K IS
37
38 TYPE CHAR IS ('A', B);
39
40 TYPE NEWCHAR IS NEW CHAR;
41
42 SUBTYPE SCHAR IS CHARACTER
43 RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127);
44
45 BLANK : CONSTANT CHARACTER := ' ';
46
47 POSITION : INTEGER;
48
49 NONGRAPH : ARRAY (0 .. 31) OF CHARACTER :=
50 (ASCII.NUL, ASCII.SOH, ASCII.STX, ASCII.ETX,
51 ASCII.EOT, ASCII.ENQ, ASCII.ACK, ASCII.BEL,
52 ASCII.BS, ASCII.HT, ASCII.LF, ASCII.VT,
53 ASCII.FF, ASCII.CR, ASCII.SO, ASCII.SI,
54 ASCII.DLE, ASCII.DC1, ASCII.DC2, ASCII.DC3,
55 ASCII.DC4, ASCII.NAK, ASCII.SYN, ASCII.ETB,
56 ASCII.CAN, ASCII.EM, ASCII.SUB, ASCII.ESC,
57 ASCII.FS, ASCII.GS, ASCII.RS, ASCII.US);
58
59 FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
60 BEGIN
61 IF EQUAL (CHAR'POS (CH), CHAR'POS (CH)) THEN
62 RETURN CH;
63 END IF;
64 RETURN CHAR'FIRST;
65 END IDENT;
66
67 FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
68 BEGIN
69 IF EQUAL (NEWCHAR'POS (CH), NEWCHAR'POS (CH)) THEN
70 RETURN CH;
71 END IF;
72 RETURN NEWCHAR'FIRST;
73 END IDENT;
74
75 BEGIN
76
77 TEST( "C35507K" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
78 "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
79 "PREFIX IS A CHARACTER TYPE" );
80
81 BEGIN
82 IF CHAR'POS ('A') /= 0 THEN
83 FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') - 1" );
84 END IF;
85
86 IF CHAR'POS (B) /= 1 THEN
87 FAILED ( "INCORRECT VALUE FOR CHAR'POS(B) - 1" );
88 END IF;
89
90 IF CHAR'VAL (0) /= 'A' THEN
91 FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
92 END IF;
93
94 IF CHAR'VAL (1) /= B THEN
95 FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
96 END IF;
97
98 IF CHAR'POS (IDENT ('A')) /= 0 THEN
99 FAILED ( "INCORRECT VALUE " &
100 "FOR CHAR'POS (IDENT ('A')) - 2" );
101 END IF;
102
103 IF CHAR'POS (IDENT (B)) /= 1 THEN
104 FAILED ( "INCORRECT VALUE " &
105 "FOR CHAR'POS (IDENT (B)) - 2" );
106 END IF;
107
108 END;
109
110 BEGIN
111 IF NEWCHAR'POS ('A') /= 0 THEN
112 FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
113 END IF;
114
115 IF NEWCHAR'POS (B) /= 1 THEN
116 FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) - 1" );
117 END IF;
118
119 IF NEWCHAR'VAL (0) /= 'A' THEN
120 FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) - 1" );
121 END IF;
122
123 IF NEWCHAR'VAL (1) /= B THEN
124 FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
125 END IF;
126
127 IF NEWCHAR'VAL (IDENT_INT (1)) /= B THEN
128 FAILED ( "INCORRECT VALUE " &
129 "FOR NEWCHAR'POS (IDENT (B)) - 2" );
130 END IF;
131
132 IF (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
133 FAILED ( "INCORRECT VALUE " &
134 "FOR IDENT (NEWCHAR'VAL (0)) - 2" );
135 END IF;
136
137 END;
138
139 BEGIN
140 IF CHAR'VAL (IDENT_INT (2)) = B THEN
141 FAILED ( "NO EXCEPTION RAISED " &
142 "FOR CHAR'VAL (IDENT_INT (2)) - 1" );
143 ELSE
144 FAILED ( "NO EXCEPTION RAISED " &
145 "FOR CHAR'VAL (IDENT_INT (2)) - 2" );
146 END IF;
147 EXCEPTION
148 WHEN CONSTRAINT_ERROR =>
149 NULL;
150 WHEN OTHERS =>
151 FAILED ( "WRONG EXCEPTION RAISED " &
152 "FOR CHAR'VAL (IDENT_INT (2))" );
153 END;
154
155 BEGIN
156 IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
157 FAILED ( "NO EXCEPTION RAISED " &
158 "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
159 ELSE
160 FAILED ( "NO EXCEPTION RAISED " &
161 "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
162 END IF;
163 EXCEPTION
164 WHEN CONSTRAINT_ERROR =>
165 NULL;
166 WHEN OTHERS =>
167 FAILED ( "WRONG EXCEPTION RAISED " &
168 "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
169 END;
170
171 POSITION := 0;
172
173 FOR CH IN CHARACTER LOOP
174 IF SCHAR'POS (CH) /= POSITION THEN
175 FAILED ( "INCORRECT VALUE FOR SCHAR'POS OF " &
176 CHARACTER'IMAGE (CH) );
177 END IF;
178
179 POSITION := POSITION + 1;
180 END LOOP;
181
182 FOR POSITION IN 0 .. 31 LOOP
183 IF CHARACTER'VAL (POSITION) /= NONGRAPH (POSITION) THEN
184 FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
185 "NONGRAPHIC CHARACTER IN POSITION - " &
186 INTEGER'IMAGE (POSITION) );
187 END IF;
188 END LOOP;
189
190 POSITION := 32;
191
192 FOR CH IN BLANK .. ASCII.TILDE LOOP
193 IF SCHAR'VAL (POSITION) /= CH THEN
194 FAILED ( "INCORRECT VALUE FOR SCHAR'VAL OF " &
195 "GRAPHIC CHARACTER IN POSITION - " &
196 INTEGER'IMAGE (POSITION) );
197 END IF;
198
199 POSITION := POSITION + 1;
200 END LOOP;
201
202 IF CHARACTER'VAL (127) /= ASCII.DEL THEN
203 FAILED ( "INCORRECT VALUE FOR CHARACTER'VAL OF " &
204 "NONGRAPHIC CHARACTER IN POSITION - 127" );
205 END IF;
206
207 BEGIN
208 IF CHARACTER'VAL (IDENT_INT (-1)) = ASCII.NUL THEN
209 FAILED ( "NO EXCEPTION RAISED " &
210 "FOR CHARACTER'VAL (IDENT_INT (-1)) - 1" );
211 ELSE
212 FAILED ( "NO EXCEPTION RAISED " &
213 "FOR CHARACTER'VAL (IDENT_INT (-1)) - 2" );
214 END IF;
215 EXCEPTION
216 WHEN CONSTRAINT_ERROR =>
217 NULL;
218 WHEN OTHERS =>
219 FAILED ( "WRONG EXCEPTION RAISED " &
220 "FOR CHARACTER'VAL (IDENT_INT (-1))" );
221 END;
222
223 RESULT;
224 END C35507K;