Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c7/c74402a.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 -- C74402A.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 A SUBPROGRAM PARAMETER OF A LIMITED TYPE MAY HAVE A
26 -- DEFAULT EXPRESSION, EVEN IF THE SUBPROGRAM IS DECLARED OUTSIDE
27 -- THE PACKAGE THAT DECLARES THE LIMITED TYPE.
28 -- (SEE ALSO 6.4.2/T1 FOR TESTS OF OTHER LIMITED TYPES.)
29
30 -- DSJ 5/6/83
31 -- SPS 10/24/83
32
33 WITH REPORT;
34 PROCEDURE C74402A IS
35
36 USE REPORT;
37
38 BEGIN
39
40 TEST("C74402A", "CHECK THAT A SUBPROGRAM PARAMETER OF A LIMITED " &
41 "TYPE MAY HAVE A DEFAULT EXPRESSION, EVEN IF " &
42 "THE SUBPROGRAM IS DECLARED OUTSIDE THE PACKAGE " &
43 "THAT DECLARES THE LIMITED TYPE");
44
45 DECLARE
46
47 PACKAGE PACK1 IS
48
49 TYPE LP1 IS LIMITED PRIVATE;
50 TYPE LP2 IS ARRAY (1 .. 2) OF LP1;
51 TYPE LP3 IS
52 RECORD
53 C1, C2 : LP2;
54 END RECORD;
55
56 FUNCTION F1 RETURN LP1;
57 FUNCTION F2 RETURN LP2;
58 FUNCTION F3 RETURN LP3;
59
60 PROCEDURE G1 (X : LP1 := F1); -- LEGAL
61 PROCEDURE G2 (X : LP2 := F2); -- LEGAL
62 PROCEDURE G3 (X : LP3 := F3); -- LEGAL
63
64 PRIVATE
65
66 TYPE LP1 IS NEW INTEGER;
67
68 END PACK1;
69
70 PACKAGE BODY PACK1 IS
71
72 FUNCTION F1 RETURN LP1 IS
73 BEGIN
74 RETURN LP1'(1);
75 END F1;
76
77 FUNCTION F2 RETURN LP2 IS
78 BEGIN
79 RETURN LP2'(2,3);
80 END F2;
81
82 FUNCTION F3 RETURN LP3 IS
83 BEGIN
84 RETURN LP3'((4,5),(6,7));
85 END F3;
86
87 PROCEDURE G1 (X : LP1 := F1) IS
88 BEGIN
89 IF X /= LP1'(1) THEN
90 FAILED("WRONG DEFAULT VALUE - LP1");
91 END IF;
92 END G1;
93
94 PROCEDURE G2 (X : LP2 := F2) IS
95 BEGIN
96 IF X /= LP2'(2,3) THEN
97 FAILED("WRONG DEFAULT VALUE - LP2");
98 END IF;
99 END G2;
100
101 PROCEDURE G3 (X : LP3 := F3) IS
102 BEGIN
103 IF X /= LP3'((4,5),(6,7)) THEN
104 FAILED("WRONG DEFAULT VALUE - LP3");
105 END IF;
106 END G3;
107
108 BEGIN
109
110 G1; -- LEGAL, DEFAULT USED
111 G2; -- LEGAL, DEFAULT USED
112 G3; -- LEGAL, DEFAULT USED
113
114 G1(F1); -- LEGAL
115 G2(F2); -- LEGAL
116 G3(F3); -- LEGAL
117
118 END PACK1;
119
120 USE PACK1;
121
122 PROCEDURE G4 (X : LP1 := F1) IS
123 BEGIN
124 G1; -- LEGAL, DEFAULT USED
125 G1(X);
126 END G4;
127
128 PROCEDURE G5 (X : LP2 := F2) IS
129 BEGIN
130 G2; -- LEGAL, DEFAULT USED
131 G2(X);
132 END G5;
133
134 PROCEDURE G6 (X : LP3 := F3) IS
135 BEGIN
136 G3; -- DEFAULT USED
137 G3(X);
138 END G6;
139
140 BEGIN
141
142 G4; -- LEGAL, DEFAULT USED
143 G5; -- LEGAL, DEFAULT USED
144 G6; -- LEGAL, DEFAULT USED
145
146 G4(F1); -- LEGAL
147 G5(F2); -- LEGAL
148 G6(F3); -- LEGAL
149
150 END;
151
152 RESULT;
153
154 END C74402A;