Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c7/c74305a.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 -- C74305A.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 DEFERRED CONSTANT CAN BE USED AS A DEFAULT
26 -- INITIALIZATION FOR A PARAMETER OR AS A DEFAULT INITIA-
27 -- LIZATION FOR A COMPONENT (NON GENERIC CASE).
28
29 -- DAT 4/06/81
30 -- RM 5/21/81
31 -- SPS 8/23/82
32 -- SPS 2/10/83
33 -- SPS 10/20/83
34 -- EG 12/20/83
35 -- GJD 11/15/95 REMOVED ADA 95 INCOMPATIBILITY.
36
37 WITH REPORT;
38
39 PROCEDURE C74305A IS
40
41 USE REPORT;
42
43 PACKAGE PK IS
44 TYPE T1 IS PRIVATE;
45 TYPE T2 IS PRIVATE;
46 C1 : CONSTANT T1; -- OK.
47
48 PROCEDURE P1 (P : T1 := C1); -- OK.
49
50 TYPE R1 IS RECORD
51 C : T1 := C1; -- OK.
52 END RECORD;
53 PRIVATE
54 PROCEDURE PROC2 (P : T1 := C1); -- OK.
55
56 TYPE R2 IS RECORD
57 C : T1 := C1; -- OK.
58 D : INTEGER := C1'SIZE; -- OK.
59 END RECORD;
60
61 FUNCTION F1 (P : T1) RETURN T1;
62
63 TYPE T1 IS NEW INTEGER;
64 TYPE T2 IS ARRAY (1..2) OF INTEGER; -- OK.
65
66 FUNCTION F2 (P : T1) RETURN T1;
67
68 PROCEDURE P3 (P : T1 := C1+1); -- OK.
69
70 PROCEDURE P4 (P : T1 := F1(C1));
71
72 TYPE R5 IS RECORD
73 C : T1 := F2(C1);
74 END RECORD;
75
76 PROCEDURE P5 (P : T1 := C1+2) RENAMES P3;
77
78 TYPE R3 IS RECORD
79 C : T1 := C1; -- OK.
80 END RECORD;
81
82 C1 : CONSTANT T1 := 1; -- OK.
83 C2 : CONSTANT T2 := (1,1); -- OK.
84 END PK;
85
86 USE PK;
87
88 PACKAGE BODY PK IS
89
90 R11 : R1;
91
92 PROCEDURE P1 (P : T1 := C1) IS
93 BEGIN
94 IF ( P /= 1 ) THEN
95 FAILED ("PARAMETER DEFAULT OF P1 NOT PROPERLY " &
96 "INITIALIZED");
97 END IF;
98 END P1;
99
100 PROCEDURE PROC2 (P : T1 := C1) IS
101 BEGIN NULL; END PROC2;
102
103 PROCEDURE P3 (P : T1 := C1+1) IS
104 BEGIN
105 IF ( P /= 3 ) THEN
106 FAILED ("PARAMETER DEFAULT OF P5 NOT PROPERLY " &
107 "INITIALIZED");
108 END IF;
109 END P3;
110
111 FUNCTION F1 (P : T1) RETURN T1 IS
112 BEGIN
113 RETURN P+10;
114 END F1;
115
116 PROCEDURE P4 (P : T1 := F1(C1)) IS
117 BEGIN
118 IF ( P /= 11 ) THEN
119 FAILED ("WRONG ACTUAL PARAMETER RECEIVED");
120 END IF;
121 END P4;
122
123 FUNCTION F2 (P : T1) RETURN T1 IS
124 BEGIN
125 RETURN P+20;
126 END F2;
127
128 BEGIN -- PK BODY.
129
130 DECLARE
131
132 R55 : R5;
133
134 BEGIN
135 TEST ("C74305A","CHECK THAT A DEFERRED CONSTANT CAN " &
136 "BE USED AS A DEFAULT INITIALIZATION " &
137 "FOR A PARAMETER OR AS A DEFAULT " &
138 "INITIALIZATION FOR A COMPONENT (NON " &
139 "GENERIC CASE)");
140
141 IF ( R11.C /= 1 ) THEN
142 FAILED ("RECORD R11 NOT PROPERLY INITIALIZED");
143 END IF;
144
145 P4;
146
147 IF ( R55.C /= 21 ) THEN
148 FAILED ("RECORD R55 NOT PROPERLY INITIALIZED");
149 END IF;
150
151 P5;
152 END;
153 END PK;
154
155 BEGIN
156
157 P1;
158
159 RESULT;
160 END C74305A;