Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c3/c35507m.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 -- C35507M.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 WITH AN ENUMERATION
28 -- REPRESENTATION CLAUSE.
29
30 -- HISTORY:
31 -- RJW 06/03/86 CREATED ORIGINAL TEST
32 -- JLH 07/28/87 MODIFIED FUNCTION IDENT.
33 -- PWB 05/11/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
34
35 WITH REPORT; USE REPORT;
36
37 PROCEDURE C35507M IS
38
39 TYPE CHAR IS ('A', B);
40 FOR CHAR USE ('A' => 4, B => 5);
41
42 TYPE NEWCHAR IS NEW CHAR;
43
44 FUNCTION IDENT (CH : CHAR) RETURN CHAR IS
45 BEGIN
46 IF EQUAL (3,3) THEN
47 RETURN CH;
48 ELSE
49 RETURN 'A';
50 END IF;
51 END IDENT;
52
53 FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS
54 BEGIN
55 IF EQUAL (3,3) THEN
56 RETURN CH;
57 ELSE
58 RETURN 'A';
59 END IF;
60 END IDENT;
61
62 BEGIN
63
64 TEST( "C35507M" , "CHECK THAT THE ATTRIBUTES 'POS' AND " &
65 "'VAL' YIELD THE CORRECT RESULTS WHEN THE " &
66 "PREFIX IS A CHARACTER TYPE WITH AN " &
67 "ENUMERATION REPESENTATION CLAUSE" );
68
69 BEGIN
70 IF CHAR'POS ('A') /= 0 THEN
71 FAILED ( "INCORRECT VALUE FOR CHAR'POS('A')" );
72 END IF;
73
74 IF CHAR'POS (B) /= 1 THEN
75 FAILED ( "INCORRECT VALUE FOR CHAR'POS(B)" );
76 END IF;
77
78 IF CHAR'VAL (0) /= 'A' THEN
79 FAILED ( "INCORRECT VALUE FOR CHAR'VAL(0)" );
80 END IF;
81
82 IF CHAR'VAL (1) /= B THEN
83 FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1)" );
84 END IF;
85 END;
86
87 BEGIN
88 IF NEWCHAR'POS ('A') /= 0 THEN
89 FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS('A')" );
90 END IF;
91
92 IF NEWCHAR'POS (B) /= 1 THEN
93 FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B)" );
94 END IF;
95
96 IF NEWCHAR'VAL (0) /= 'A' THEN
97 FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0)" );
98 END IF;
99
100 IF NEWCHAR'VAL (1) /= B THEN
101 FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(1)" );
102 END IF;
103 END;
104
105 BEGIN
106 IF CHAR'POS (IDENT ('A')) /= 0 THEN
107 FAILED ( "INCORRECT VALUE FOR CHAR'POS('A') WITH " &
108 "IDENT" );
109 END IF;
110
111 IF NEWCHAR'POS (IDENT (B)) /= 1 THEN
112 FAILED ( "INCORRECT VALUE FOR NEWCHAR'POS(B) WITH " &
113 "IDENT" );
114 END IF;
115
116 IF IDENT (NEWCHAR'VAL (IDENT_INT(0))) /= 'A' THEN
117 FAILED ( "INCORRECT VALUE FOR NEWCHAR'VAL(0) WITH " &
118 "IDENT" );
119 END IF;
120
121 IF IDENT (CHAR'VAL (IDENT_INT(1))) /= B THEN
122 FAILED ( "INCORRECT VALUE FOR CHAR'VAL(1) WITH IDENT" );
123 END IF;
124 END;
125
126 BEGIN
127 IF CHAR'VAL (IDENT_INT(2)) = B THEN
128 FAILED ( "NO EXCEPTION RAISED FOR " &
129 "CHAR'VAL (IDENT_INT(2)) - 1" );
130 ELSE
131 FAILED ( "NO EXCEPTION RAISED FOR " &
132 "CHAR'VAL (IDENT_INT(2)) - 2" );
133 END IF;
134 EXCEPTION
135 WHEN CONSTRAINT_ERROR =>
136 NULL;
137 WHEN OTHERS =>
138 FAILED ( "WRONG EXCEPTION RAISED FOR " &
139 "CHAR'VAL (IDENT_INT(2))" );
140 END;
141
142 BEGIN
143 IF NEWCHAR'VAL (IDENT_INT (-1)) = 'A' THEN
144 FAILED ( "NO EXCEPTION RAISED " &
145 "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 1" );
146 ELSE
147 FAILED ( "NO EXCEPTION RAISED " &
148 "FOR NEWCHAR'VAL (IDENT_INT (-1)) - 2" );
149 END IF;
150 EXCEPTION
151 WHEN CONSTRAINT_ERROR =>
152 NULL;
153 WHEN OTHERS =>
154 FAILED ( "WRONG EXCEPTION RAISED " &
155 "FOR NEWCHAR'VAL (IDENT_INT (-1))" );
156 END;
157
158 RESULT;
159 END C35507M;