Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cd/cd2a51a.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 -- CD2A51A.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 WHEN A SIZE SPECIFICATION IS GIVEN FOR A
27 -- FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
28 -- ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
29
30 -- HISTORY:
31 -- RJW 08/12/87 CREATED ORIGINAL TEST.
32 -- DHH 04/12/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
33 -- OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
34 -- SO THAT IT IS NOT A POWER OF TWO.
35 -- WMC 03/31/92 ELIMINATED TEST REDUNDANCIES.
36 -- PWN 02/02/95 REMOVED INCONSISTENCIES WITH ADA 9X.
37
38 WITH REPORT; USE REPORT;
39 PROCEDURE CD2A51A IS
40
41 BASIC_SIZE : CONSTANT := 9;
42
43 TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
44
45 TYPE CHECK_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
46
47 FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
48
49 CNEG1 : CHECK_TYPE := -3.5;
50 CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
51 CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
52 CPOS2 : CHECK_TYPE := 3.5;
53 CZERO : CHECK_TYPE;
54
55 TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
56 CHARRAY : ARRAY_TYPE :=
57 (-3.5, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 3.5);
58
59 TYPE REC_TYPE IS RECORD
60 COMPN1 : CHECK_TYPE := -3.5;
61 COMPN2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
62 COMPP1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
63 COMPP2 : CHECK_TYPE := 3.5;
64 END RECORD;
65
66 CHREC : REC_TYPE;
67
68 FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
69 BEGIN
70 IF EQUAL (3, 3) THEN
71 RETURN FX;
72 ELSE
73 RETURN 0.0;
74 END IF;
75 END IDENT;
76
77 PROCEDURE PROC (N1_IN, P1_IN : CHECK_TYPE;
78 N2_INOUT,P2_INOUT : IN OUT CHECK_TYPE;
79 CZOUT : OUT CHECK_TYPE) IS
80 BEGIN
81
82 IF +IDENT (N2_INOUT) NOT IN -0.375 .. -0.3125 OR
83 IDENT (-P1_IN) NOT IN -0.6875 .. -0.625 THEN
84 FAILED ("INCORRECT RESULTS FOR " &
85 "UNARY ADDING OPERATORS - 1");
86 END IF;
87
88 IF ABS IDENT (N2_INOUT) NOT IN 0.3125 .. 0.375 OR
89 IDENT (ABS P1_IN) NOT IN 0.625 .. 0.6875 THEN
90 FAILED ("INCORRECT RESULTS FOR " &
91 "ABSOLUTE VALUE OPERATORS - 1");
92 END IF;
93
94 CZOUT := 0.0;
95
96 END PROC;
97
98 BEGIN
99 TEST ("CD2A51A", "CHECK THAT WHEN A SIZE SPECICFICATION IS " &
100 "GIVEN FOR A FIXED POINT TYPE, THEN " &
101 "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
102 "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
103
104 PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
105
106 IF IDENT (CZERO) /= 0.0 THEN
107 FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
108 END IF;
109
110 IF CHECK_TYPE'LAST < IDENT (3.9375) THEN
111 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
112 END IF;
113
114 IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
115 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
116 END IF;
117
118 IF CHECK_TYPE'AFT /= BASIC_TYPE'AFT THEN
119 FAILED ("INCORRECT VALUE FOR CHECK_TYPE'AFT");
120 END IF;
121
122 IF CNEG1'SIZE < IDENT_INT (BASIC_SIZE) THEN
123 FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
124 END IF;
125
126 IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
127 CPOS2 - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
128 FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 2");
129 END IF;
130
131 IF CHECK_TYPE (CNEG1 * IDENT (CPOS1)) NOT IN -2.4375 .. -2.1875 OR
132 CHECK_TYPE (IDENT (CNEG2) / CPOS2) NOT IN
133 -0.125 .. -0.0625 THEN
134 FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 2");
135 END IF;
136
137 IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
138 CNEG2 IN -0.25 .. 0.0 OR
139 IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
140 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
141 "OPERATORS - 2");
142 END IF;
143
144 IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
145 FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
146 END IF;
147
148 IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
149 IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
150 FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 3");
151 END IF;
152
153 IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
154 IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
155 FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
156 "OPERATORS - 3");
157 END IF;
158
159 IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
160 CHARRAY (1) IN -0.25 .. 0.0 OR
161 IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
162 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
163 "OPERATORS - 3");
164 END IF;
165
166 IF CHREC.COMPP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
167 FAILED ("INCORRECT VALUE FOR CHREC.COMPP1'SIZE");
168 END IF;
169
170 IF IDENT (CHREC.COMPN1) + CHREC.COMPP1 NOT IN
171 -2.875 .. -2.8125 OR
172 CHREC.COMPP2 - IDENT (CHREC.COMPP1) NOT IN
173 2.8125 .. 2.875 THEN
174 FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 4");
175 END IF;
176
177 IF CHECK_TYPE (CHREC.COMPN1 * IDENT (CHREC.COMPP1)) NOT IN
178 -2.4375 .. -2.1875 OR
179 CHECK_TYPE (IDENT (CHREC.COMPN2) / CHREC.COMPP2) NOT IN
180 -0.125 .. -0.0625 THEN
181 FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 4");
182 END IF;
183
184 IF IDENT (CHREC.COMPP1) NOT IN 0.625 .. 0.6875 OR
185 CHREC.COMPN2 IN -0.25 .. 0.0 OR
186 IDENT (CHREC.COMPN2) IN -1.0 .. -0.4375 THEN
187 FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
188 "OPERATORS - 4");
189 END IF;
190
191 RESULT;
192
193 END CD2A51A;