Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c4/c45251a.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 -- C45251A.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 THAT FOR RELATIONAL OPERATIONS ON FIXED POINT TYPES THE
26 -- FOLLOWING HOLD:
27 -- (A) A /= B IS THE SAME AS NOT (A = B).
28 -- (B) A < B IS THE SAME AS NOT (A >= B).
29 -- (C) A > B IS THE SAME AS NOT (A <= B).
30 -- (D) ADJACENT MODEL NUMBERS GIVE CORRECT RESULTS.
31 -- (E) NON-MODEL NUMBERS WITH DISTINCT MODEL INTERVALS GIVE
32 -- CORRECT RESULTS.
33 -- (F) CASE WHERE MODEL INTERVALS INTERSECT IN A SINGLE MODEL
34 -- NUMBER GIVES CORRECT RESULT.
35
36 -- CASE A: BASIC TYPES THAT FIT THE CHARACTERISTICS OF DURATION'BASE.
37
38 -- WRG 8/26/86
39
40 WITH REPORT; USE REPORT;
41 PROCEDURE C45251A IS
42
43 -- THE NAME OF EACH TYPE OR SUBTYPE ENDS WITH THAT TYPE'S
44 -- 'MANTISSA VALUE.
45
46 TYPE LIKE_DURATION_M23 IS DELTA 0.020 RANGE -86_400.0 .. 86_400.0;
47 TYPE DECIMAL_M4 IS DELTA 100.0 RANGE -1000.0 .. 1000.0;
48
49 BEGIN
50
51 TEST ("C45251A", "CHECK RELATIONAL OPERATIONS FOR FIXED POINT " &
52 "TYPES - BASIC TYPES");
53
54 -------------------------------------------------------------------
55
56 DECLARE
57 A, B : LIKE_DURATION_M23 := 0.0;
58 C, D : DECIMAL_M4 := 0.0;
59 BEGIN
60 IF EQUAL (3, 3) THEN
61 A := 2#0.0000_0011#; -- JUST BELOW LIKE_DURATION'SMALL.
62 B := 2#0.0000_0101#; -- JUST ABOVE LIKE_DURATION'SMALL.
63 END IF;
64
65 -- (A)
66 IF A /= B XOR NOT (A = B) THEN
67 FAILED ("A /= B IS NOT THE SAME AS NOT (A = B)");
68 END IF;
69
70 -- (B)
71 IF A < B XOR NOT (A >= B) THEN
72 FAILED ("A < B IS NOT THE SAME AS NOT (A >= B)");
73 END IF;
74
75 -- (C)
76 IF A > B XOR NOT (A <= B) THEN
77 FAILED ("A > B IS NOT THE SAME AS NOT (A <= B)");
78 END IF;
79
80 -- (D)
81 IF EQUAL (3, 3) THEN
82 A := -(16#1_5180.00#); -- (-86_400.0)
83 B := -(16#1_517F.FC#); -- (-86_400.0 + 1.0/64)
84
85 C := 64.0; -- DECIMAL_M4'SMALL.
86 D := 128.0; -- 2 * DECIMAL_M4'SMALL.
87 END IF;
88 IF "=" (LEFT => A, RIGHT => B) THEN
89 FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
90 "- (A = B)");
91 END IF;
92 IF NOT "/=" (LEFT => C, RIGHT => D) THEN
93 FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
94 "- (C /= D)");
95 END IF;
96 IF "<" (LEFT => B, RIGHT => A) THEN
97 FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
98 "- (B < A)");
99 END IF;
100 IF ">" (LEFT => C, RIGHT => D) THEN
101 FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
102 "- (C > D)");
103 END IF;
104 IF ">=" (LEFT => A, RIGHT => B) THEN
105 FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
106 "- (A >= B)");
107 END IF;
108 IF "<=" (LEFT => D, RIGHT => C) THEN
109 FAILED ("ADJACENT MODEL NUMBERS GIVE INCORRECT RESULT " &
110 "- (D <= C)");
111 END IF;
112
113 -- (E)
114 IF EQUAL (3, 3) THEN
115 A := 0.02; -- INTERVAL IS 1.0/64 .. 2.0/64.
116 B := -0.02; -- INTERVAL IS -2.0/64 .. -1.0/64.
117
118 C := 800.0; -- INTERVAL IS 768.0 .. 832.0.
119 D := 900.0; -- INTERVAL IS 896.0 .. 960.0.
120 END IF;
121 IF A = B THEN
122 FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
123 "INTERVALS GIVE INCORRECT RESULT - (A = B)");
124 END IF;
125 IF NOT (C /= D) THEN
126 FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
127 "INTERVALS GIVE INCORRECT RESULT - (C /= D)");
128 END IF;
129 IF A < B THEN
130 FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
131 "INTERVALS GIVE INCORRECT RESULT - (A < B)");
132 END IF;
133 IF C > D THEN
134 FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
135 "INTERVALS GIVE INCORRECT RESULT - (C > D)");
136 END IF;
137 IF B >= A THEN
138 FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
139 "INTERVALS GIVE INCORRECT RESULT - (B >= A)");
140 END IF;
141 IF D <= C THEN
142 FAILED ("NON-MODEL NUMBERS WITH DISTINCT MODEL " &
143 "INTERVALS GIVE INCORRECT RESULT - (D <= C)");
144 END IF;
145
146 -- (F)
147 IF EQUAL (3, 3) THEN
148 B := 0.035; -- INTERVAL IS 2.0/64 .. 3.0/64.
149
150 C := 850.0; -- INTERVAL IS 832.0 .. 896.0.
151 END IF;
152 IF NOT (A <= B) THEN
153 FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
154 "COMMON MODEL INTERVAL END-POINT GIVES " &
155 "INCORRECT RESULT - (A <= B)");
156 END IF;
157 IF A > B THEN
158 FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
159 "COMMON MODEL INTERVAL END-POINT GIVES " &
160 "INCORRECT RESULT - (A > B)");
161 END IF;
162 IF NOT (D >= C) THEN
163 FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
164 "COMMON MODEL INTERVAL END-POINT GIVES " &
165 "INCORRECT RESULT - (D >= C)");
166 END IF;
167 IF D < C THEN
168 FAILED ("COMPARISON OF NON-MODEL NUMBERS WITH ONE " &
169 "COMMON MODEL INTERVAL END-POINT GIVES " &
170 "INCORRECT RESULT - (D < C)");
171 END IF;
172 END;
173
174 -------------------------------------------------------------------
175
176 RESULT;
177
178 END C45251A;