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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c7/] [c74209a.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C74209A.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 OUTSIDE A PACKAGE WHICH DEFINES PRIVATE TYPES AND LIMITED
26
--    PRIVATE TYPES  IT IS POSSIBLE TO DECLARE SUBPROGRAMS WHICH USE
27
--    THOSE TYPES AS TYPES FOR PARAMETERS (OF ANY MODE EXCEPT OUT FOR A
28
--    LIMITED TYPE) OR AS THE TYPE FOR THE RESULT (FOR FUNCTION
29
--    SUBPROGRAMS). 
30
 
31
-- RM 07/14/81
32
 
33
 
34
WITH REPORT;
35
PROCEDURE  C74209A  IS
36
 
37
     USE  REPORT;
38
 
39
BEGIN
40
 
41
     TEST( "C74209A" , "CHECK THAT PROCEDURE SIGNATURES CAN USE " &
42
                       "PRIVATE TYPES" );
43
 
44
     DECLARE
45
 
46
          PACKAGE  PACK  IS
47
 
48
               TYPE  LIM_PRIV  IS LIMITED PRIVATE;
49
               TYPE  PRIV      IS         PRIVATE;
50
               PRIV_CONST_IN   :  CONSTANT  PRIV;
51
               PRIV_CONST_OUT  :  CONSTANT  PRIV;
52
               FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV;
53
               FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN ;
54
               PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV );
55
 
56
          PRIVATE
57
 
58
               TYPE  LIM_PRIV  IS NEW INTEGER;
59
               TYPE  PRIV      IS NEW STRING( 1..5 );
60
               PRIV_CONST_IN   :  CONSTANT  PRIV :=  "ABCDE";
61
               PRIV_CONST_OUT  :  CONSTANT  PRIV :=  "FGHIJ";
62
 
63
          END  PACK;
64
 
65
 
66
          PRIV_VAR_1 ,     PRIV_VAR_2      :  PACK.PRIV;
67
          LIM_PRIV_VAR_1 , LIM_PRIV_VAR_2  :  PACK.LIM_PRIV;
68
 
69
 
70
          USE  PACK;
71
 
72
 
73
          PACKAGE BODY  PACK  IS
74
 
75
               FUNCTION  PACKAGED( X: IN INTEGER )  RETURN LIM_PRIV  IS
76
               BEGIN
77
                    RETURN  LIM_PRIV(X);
78
               END  PACKAGED;
79
 
80
               FUNCTION  EQUALS( X , Y : LIM_PRIV ) RETURN BOOLEAN  IS
81
               BEGIN
82
                    RETURN  X = Y ;
83
               END  EQUALS;
84
 
85
               PROCEDURE ASSIGN( X : IN  LIM_PRIV; Y : OUT LIM_PRIV) IS
86
               BEGIN
87
                    Y := X;
88
               END  ASSIGN;
89
 
90
          END  PACK;
91
 
92
 
93
          PROCEDURE  PROC1( X : IN OUT PACK.PRIV;
94
                            Y : IN     PACK.PRIV := PACK.PRIV_CONST_IN;
95
                            Z : OUT    PACK.PRIV;
96
                            U :        PACK.PRIV )  IS
97
          BEGIN
98
 
99
               IF  X /= PACK.PRIV_CONST_IN  OR
100
                   Y /= PACK.PRIV_CONST_IN  OR
101
                   U /= PACK.PRIV_CONST_IN
102
               THEN
103
                    FAILED( "WRONG INPUT VALUES  -  PROC1" );
104
               END IF;
105
 
106
               X := PACK.PRIV_CONST_OUT;
107
               Z := PACK.PRIV_CONST_OUT;
108
 
109
          END  PROC1;
110
 
111
 
112
          PROCEDURE  PROC2( X : IN OUT LIM_PRIV;
113
                            Y : IN     LIM_PRIV;
114
                            Z : IN OUT LIM_PRIV;
115
                            U :        LIM_PRIV )  IS
116
          BEGIN
117
 
118
               IF  NOT(EQUALS( X , PACKAGED(17) ))  OR
119
                   NOT(EQUALS( Y , PACKAGED(17) ))  OR
120
                   NOT(EQUALS( U , PACKAGED(17) ))
121
               THEN
122
                    FAILED( "WRONG INPUT VALUES  -  PROC2" );
123
               END IF;
124
 
125
               ASSIGN( PACKAGED(13) , X );
126
               ASSIGN( PACKAGED(13) , Z );
127
 
128
          END  PROC2;
129
 
130
 
131
          FUNCTION  FUNC1( Y : IN  PRIV  :=  PRIV_CONST_IN;
132
                           U :     PRIV  )   RETURN  PRIV  IS
133
          BEGIN
134
 
135
               IF  Y /= PRIV_CONST_IN  OR
136
                   U /= PRIV_CONST_IN
137
               THEN
138
                    FAILED( "WRONG INPUT VALUES  -  FUNC1" );
139
               END IF;
140
 
141
               RETURN  PRIV_CONST_OUT;
142
 
143
          END  FUNC1;
144
 
145
 
146
          FUNCTION  FUNC2( Y : IN  LIM_PRIV;
147
                           U :     LIM_PRIV )  RETURN  LIM_PRIV  IS
148
          BEGIN
149
 
150
               IF  NOT(EQUALS( Y , PACKAGED(17) ))  OR
151
                   NOT(EQUALS( U , PACKAGED(17) ))
152
               THEN
153
                    FAILED( "WRONG INPUT VALUES  -  FUNC2" );
154
               END IF;
155
 
156
               RETURN  PACKAGED(13);
157
 
158
          END  FUNC2;
159
 
160
 
161
     BEGIN
162
 
163
          --------------------------------------------------------------
164
 
165
          PRIV_VAR_1 := PRIV_CONST_IN;
166
          PRIV_VAR_2 := PRIV_CONST_IN;
167
 
168
          PROC1( PRIV_VAR_1 , Z => PRIV_VAR_2 , U => PRIV_CONST_IN );
169
 
170
          IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT  OR
171
              PRIV_VAR_2 /= PACK.PRIV_CONST_OUT
172
          THEN
173
               FAILED( "WRONG OUTPUT VALUES  -  PROC1" );
174
          END IF;
175
 
176
          --------------------------------------------------------------
177
 
178
          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
179
          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
180
 
181
          PROC2( LIM_PRIV_VAR_1 , PACKAGED(17) ,
182
                 LIM_PRIV_VAR_2 , PACKAGED(17) );
183
 
184
          IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))  OR
185
              NOT(EQUALS( LIM_PRIV_VAR_2 , PACKAGED(13) ))
186
          THEN
187
               FAILED( "WRONG OUTPUT VALUES  -  PROC2" );
188
          END IF;
189
 
190
          --------------------------------------------------------------
191
 
192
          PRIV_VAR_1 := PRIV_CONST_IN;
193
          PRIV_VAR_2 := PRIV_CONST_IN;
194
 
195
          PRIV_VAR_1 :=
196
              FUNC1( PRIV_VAR_1 , U => PRIV_CONST_IN );
197
 
198
          IF  PRIV_VAR_1 /= PACK.PRIV_CONST_OUT
199
          THEN
200
               FAILED( "WRONG OUTPUT VALUES  -  FUNC1" );
201
          END IF;
202
 
203
          --------------------------------------------------------------
204
 
205
          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_1 );
206
          ASSIGN( PACKAGED(17) , LIM_PRIV_VAR_2 );
207
 
208
          ASSIGN( FUNC2( LIM_PRIV_VAR_1 , PACKAGED(17)) ,
209
                  LIM_PRIV_VAR_1 );
210
 
211
          IF  NOT(EQUALS( LIM_PRIV_VAR_1 , PACKAGED(13) ))
212
          THEN
213
               FAILED( "WRONG OUTPUT VALUES  -  FUNC2" );
214
          END IF;
215
 
216
          --------------------------------------------------------------
217
 
218
     END;
219
 
220
 
221
     RESULT;
222
 
223
 
224
END C74209A;

powered by: WebSVN 2.1.0

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