OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c7/] [c74305a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.