Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c7/c74407b.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 -- C74407B.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, FOR A LIMITED PRIVATE TYPE, THAT PRE-DEFINED EQUALITY AND
27 -- ASSIGNMENT ARE DEFINED AND AVAILABLE WITHIN THE PRIVATE PART AND
28 -- THE BODY OF A PACKAGE, AFTER THE FULL DECLARATION, IF THE FULL
29 -- DECLARATION IS NOT LIMITED.
30
31 -- HISTORY:
32 -- BCB 07/15/88 CREATED ORIGINAL TEST.
33
34 WITH REPORT; USE REPORT;
35
36 PROCEDURE C74407B IS
37
38 PACKAGE PP IS
39 TYPE PRIV IS PRIVATE;
40 C1 : CONSTANT PRIV;
41 C2 : CONSTANT PRIV;
42 PRIVATE
43 TYPE PRIV IS (ONE, TWO, THREE, FOUR, FIVE, SIX);
44 C1 : CONSTANT PRIV := ONE;
45 C2 : CONSTANT PRIV := TWO;
46 END PP;
47
48 USE PP;
49
50 PACKAGE P IS
51 TYPE INT IS LIMITED PRIVATE;
52 TYPE COMP IS LIMITED PRIVATE;
53 TYPE DER IS LIMITED PRIVATE;
54 PRIVATE
55 TYPE INT IS RANGE 1 .. 100;
56 TYPE COMP IS ARRAY(1..5) OF INTEGER;
57 TYPE DER IS NEW PRIV;
58 D, E : INT := 10;
59 F : INT := 20;
60 CONS_INT1 : CONSTANT INT := 30;
61 G : BOOLEAN := D = E;
62 H : BOOLEAN := D /= F;
63 CONS_BOOL1 : CONSTANT BOOLEAN := D = E;
64 CONS_BOOL2 : CONSTANT BOOLEAN := D /= F;
65 I : COMP := (1,2,3,4,5);
66 CONS_COMP1 : CONSTANT COMP := (6,7,8,9,10);
67 J : DER := DER(C1);
68 CONS_DER1 : CONSTANT DER := DER(C2);
69 END P;
70
71 PACKAGE BODY P IS
72 A, B, C : INT;
73 X, Y, Z : COMP;
74 L, M, N : DER;
75 CONS_INT2 : CONSTANT INT := 10;
76 CONS_COMP2 : CONSTANT COMP := (1,2,3,4,5);
77 CONS_DER2 : CONSTANT DER := DER(C1);
78 BEGIN
79 TEST ("C74407B", "CHECK, FOR A LIMITED PRIVATE TYPE, THAT " &
80 "PRE-DEFINED EQUALITY AND ASSIGNMENT ARE " &
81 "DEFINED AND AVAILABLE WITHIN THE PRIVATE " &
82 "PART AND THE BODY OF A PACKAGE, AFTER " &
83 "THE FULL DECLARATION, IF THE FULL " &
84 "DECLARATION IS NOT LIMITED");
85
86 A := 10;
87
88 B := 10;
89
90 C := 20;
91
92 IF A = C THEN
93 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
94 "OPERATION WITHIN THE PACKAGE BODY - 1");
95 END IF;
96
97 IF A /= B THEN
98 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
99 "OPERATION WITHIN THE PACKAGE BODY - 1");
100 END IF;
101
102 IF CONS_INT2 = C THEN
103 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
104 "OPERATION WITHIN THE PACKAGE BODY - 2");
105 END IF;
106
107 IF CONS_INT2 /= B THEN
108 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
109 "OPERATION WITHIN THE PACKAGE BODY - 2");
110 END IF;
111
112 IF NOT G THEN
113 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
114 "OPERATION WITHIN THE PRIVATE PART OF THE " &
115 "PACKAGE - 1");
116 END IF;
117
118 IF NOT H THEN
119 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
120 "OPERATION WITHIN THE PRIVATE PART OF THE " &
121 "PACKAGE - 1");
122 END IF;
123
124 IF NOT CONS_BOOL1 THEN
125 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
126 "OPERATION WITHIN THE PRIVATE PART OF THE " &
127 "PACKAGE - 2");
128 END IF;
129
130 IF NOT CONS_BOOL2 THEN
131 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
132 "OPERATION WITHIN THE PRIVATE PART OF THE " &
133 "PACKAGE - 2");
134 END IF;
135
136 X := (1,2,3,4,5);
137
138 Y := (1,2,3,4,5);
139
140 Z := (5,4,3,2,1);
141
142 IF X = Z THEN
143 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
144 "OPERATION WITHIN THE PACKAGE BODY - 3");
145 END IF;
146
147 IF X /= Y THEN
148 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
149 "OPERATION WITHIN THE PACKAGE BODY - 3");
150 END IF;
151
152 IF CONS_COMP2 = Z THEN
153 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
154 "OPERATION WITHIN THE PACKAGE BODY - 4");
155 END IF;
156
157 IF CONS_COMP2 /= Y THEN
158 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
159 "OPERATION WITHIN THE PACKAGE BODY - 4");
160 END IF;
161
162 L := DER(C1);
163
164 M := DER(C1);
165
166 N := DER(C2);
167
168 IF L = N THEN
169 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
170 "OPERATION WITHIN THE PACKAGE BODY - 5");
171 END IF;
172
173 IF L /= M THEN
174 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
175 "OPERATION WITHIN THE PACKAGE BODY - 5");
176 END IF;
177
178 IF CONS_DER2 = N THEN
179 FAILED ("IMPROPER RESULT FROM PRE-DEFINED EQUALITY " &
180 "OPERATION WITHIN THE PACKAGE BODY - 6");
181 END IF;
182
183 IF CONS_DER2 /= M THEN
184 FAILED ("IMPROPER RESULT FROM PRE-DEFINED INEQUALITY " &
185 "OPERATION WITHIN THE PACKAGE BODY - 6");
186 END IF;
187
188 RESULT;
189 END P;
190
191 USE P;
192
193 BEGIN
194 NULL;
195 END C74407B;