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/] [c4/] [c48006b.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C48006B.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 AN ALLOCATOR OF THE FORM "NEW T'(X)" ALLOCATES A NEW
26
-- OBJECT EACH TIME IT IS EXECUTED AND THAT IF T IS A RECORD, ARRAY, OR
27
-- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED), THE ALLOCATED OBJECT HAS
28
-- THE VALUE OF (X).
29
 
30
-- RM  01/14/80
31
-- RM  01/O1/82
32
-- SPS 10/27/82
33
-- EG  07/05/84
34
-- JBG 11/08/85 AVOID CONFLICT WITH AI-7 OR AI-275
35
 
36
WITH REPORT;
37
 
38
PROCEDURE C48006B IS
39
 
40
     USE REPORT ;
41
 
42
BEGIN
43
 
44
     TEST("C48006B","CHECK THAT THE FORM 'NEW T'(X)' " &
45
                    "ALLOCATES A NEW OBJECT " &
46
                    "AND THAT IF T IS A RECORD, ARRAY, OR PRIVATE "    &
47
                    "TYPE, THE ALLOCATED OBJECT HAS THE VALUE (X)");
48
 
49
     -- RECORD OR ARRAY TYPE (CONSTRAINED OR UNCONSTRAINED)
50
 
51
     DECLARE
52
 
53
          TYPE  TB0(  A , B : INTEGER )  IS
54
               RECORD
55
                    C : INTEGER := 7 ;
56
               END RECORD;
57
          SUBTYPE  TB  IS  TB0( 2 , 3 );
58
          TYPE ATB  IS  ACCESS TB  ;
59
          TYPE ATB0 IS  ACCESS TB0 ;
60
          VB1  ,  VB2  : ATB  ;
61
          VB01 , VB02  : ATB0 ;
62
 
63
          TYPE  ARR0  IS  ARRAY( INTEGER RANGE <> ) OF INTEGER ;
64
          SUBTYPE  ARR  IS ARR0( 1..4 );
65
          TYPE  A_ARR   IS  ACCESS ARR  ;
66
          TYPE  A_ARR0  IS  ACCESS ARR0 ;
67
          VARR1  , VARR2  : A_ARR  ;
68
          VARR01 , VARR02 : A_ARR0 ;
69
 
70
     BEGIN
71
 
72
          VB1  :=  NEW TB'( 2 , 3 , 5 );
73
          IF ( VB1.A /=IDENT_INT( 2)  OR
74
               VB1.B /=IDENT_INT( 3)  OR
75
               VB1.C /=IDENT_INT( 5) )
76
          THEN FAILED( "WRONG VALUES  -  B1 1" );
77
          END IF;
78
 
79
          VB2  :=  NEW TB'( IDENT_INT(2), IDENT_INT(3), IDENT_INT(6));
80
          IF ( VB2.A /= 2  OR
81
               VB2.B /= 3  OR
82
               VB2.C /= 6  OR
83
               VB1.A /= 2  OR
84
               VB1.B /= 3  OR
85
               VB1.C /= 5 )
86
          THEN FAILED( "WRONG VALUES  -  B1 2" );
87
          END IF;
88
 
89
          VB01  :=  NEW TB0'( 1 , 2 , 3 );
90
          IF ( VB01.A /=IDENT_INT( 1)  OR
91
               VB01.B /=IDENT_INT( 2)  OR
92
               VB01.C /=IDENT_INT( 3) )
93
          THEN FAILED( "WRONG VALUES  -  B2 1" );
94
          END IF;
95
 
96
          VB02  :=  NEW TB0'( IDENT_INT(4) , IDENT_INT(5) ,
97
                                                      IDENT_INT(6) );
98
          IF ( VB02.A /=IDENT_INT( 4)  OR
99
               VB02.B /=IDENT_INT( 5)  OR
100
               VB02.C /=IDENT_INT( 6)  OR
101
               VB01.A /=IDENT_INT( 1)  OR
102
               VB01.B /=IDENT_INT( 2)  OR
103
               VB01.C /=IDENT_INT( 3) )
104
          THEN FAILED( "WRONG VALUES  -  B2 2" );
105
          END IF;
106
 
107
          VARR1 := NEW ARR'( 5 , 6 , 7 , 8 );
108
          IF  ( VARR1(1) /=IDENT_INT( 5)  OR
109
                VARR1(2) /=IDENT_INT( 6)  OR
110
                VARR1(3) /=IDENT_INT( 7)  OR
111
                VARR1(4) /=IDENT_INT( 8) )
112
          THEN FAILED( "WRONG VALUES  -  B3 1" );
113
          END IF ;
114
 
115
          VARR2 := NEW ARR'( IDENT_INT(1) , IDENT_INT(2) , IDENT_INT(3),
116
                                                         IDENT_INT(4) );
117
          IF  ( VARR2(1) /= 1  OR
118
                VARR2(2) /= 2  OR
119
                VARR2(3) /= 3  OR
120
                VARR2(4) /= 4  OR
121
                VARR1(1) /= 5  OR
122
                VARR1(2) /= 6  OR
123
                VARR1(3) /= 7  OR
124
                VARR1(4) /= 8 )
125
          THEN FAILED( "WRONG VALUES  -  B3 2" );
126
          END IF ;
127
 
128
          VARR01 := NEW ARR0'( 11 , 12 , 13 );
129
          IF  ( VARR01(INTEGER'FIRST) /= IDENT_INT(11)  OR
130
                VARR01(INTEGER'FIRST + 1) /= IDENT_INT(12)  OR
131
                VARR01(INTEGER'FIRST + 2) /= IDENT_INT(13) )
132
          THEN FAILED( "WRONG VALUES -  B4 1" );
133
          END IF ;
134
          IF  ( VARR01.ALL'FIRST /= IDENT_INT( INTEGER'FIRST )  OR
135
                VARR01.ALL'LAST  /= IDENT_INT( INTEGER'FIRST + 2 ) )
136
          THEN FAILED( "WRONG VALUES -  B4 2" );
137
          END IF ;
138
 
139
          VARR02 := NEW ARR0'( 1 => IDENT_INT(14) , 2 => IDENT_INT(15));
140
          IF  ( VARR02(1) /= 14  OR
141
                VARR02(2) /= 15  OR
142
                VARR01(INTEGER'FIRST) /= 11  OR
143
                VARR01(INTEGER'FIRST + 1) /= 12  OR
144
                VARR01(INTEGER'FIRST + 2) /= 13 )
145
          THEN FAILED( "WRONG VALUES -  B4 3" );
146
          END IF ;
147
 
148
     END ;
149
 
150
     -- PRIVATE TYPE (CONSTRAINED OR UNCONSTRAINED)
151
 
152
     DECLARE
153
 
154
          PACKAGE P IS
155
               TYPE UP(A, B : INTEGER) IS PRIVATE;
156
--             SUBTYPE CP IS UP(1, 2);
157
--             TYPE A_CP IS ACCESS CP;
158
               TYPE A_UP IS ACCESS UP;
159
               CONS1_UP : CONSTANT UP;
160
               CONS2_UP : CONSTANT UP;
161
               CONS3_UP : CONSTANT UP;
162
               CONS4_UP : CONSTANT UP;
163
--             PROCEDURE CHECK1 (X : A_CP);
164
--             PROCEDURE CHECK2 (X, Y : A_CP);
165
               PROCEDURE CHECK3 (X : A_UP);
166
               PROCEDURE CHECK4 (X, Y : A_UP);
167
          PRIVATE
168
               TYPE UP(A, B : INTEGER) IS
169
                    RECORD
170
                         C : INTEGER;
171
                    END RECORD;
172
               CONS1_UP : CONSTANT UP := (1, 2, 3);
173
               CONS2_UP : CONSTANT UP := (IDENT_INT(1), IDENT_INT(2),
174
                                          IDENT_INT(4));
175
               CONS3_UP : CONSTANT UP := (7, 8, 9);
176
               CONS4_UP : CONSTANT UP := (IDENT_INT(10), IDENT_INT(11),
177
                                          IDENT_INT(12));
178
          END P;
179
 
180
          USE P;
181
 
182
--        V_A_CP1, V_A_CP2 : A_CP;
183
          V_A_UP1, V_A_UP2 : A_UP;
184
 
185
          PACKAGE BODY P IS
186
--             PROCEDURE CHECK1 (X : A_CP) IS
187
--             BEGIN
188
--                  IF (X.A /= IDENT_INT(1) OR
189
--                      X.B /= IDENT_INT(2) OR
190
--                      X.C /= IDENT_INT(3)) THEN
191
--                       FAILED ("WRONG VALUES - CP1");
192
--                  END IF;
193
--             END CHECK1;
194
--             PROCEDURE CHECK2 (X, Y : A_CP) IS
195
--             BEGIN
196
--                  IF (X.A /= 1 OR X.B /= 2 OR X.C /= 3 OR
197
--                      Y.A /= 1 OR Y.B /= 2 OR Y.C /= 4) THEN
198
--                       FAILED ("WRONG VALUES - CP2");
199
--                  END IF;
200
--             END CHECK2;
201
               PROCEDURE CHECK3 (X : A_UP) IS
202
               BEGIN
203
                    IF (X.A /= IDENT_INT(7) OR
204
                        X.B /= IDENT_INT(8) OR
205
                        X.C /= IDENT_INT(9)) THEN
206
                         FAILED ("WRONG VALUES - UP1");
207
                    END IF;
208
               END CHECK3;
209
               PROCEDURE CHECK4 (X, Y : A_UP) IS
210
               BEGIN
211
                    IF (X.A /=  7 OR X.B /=  8 OR X.C /=  9 OR
212
                        Y.A /= 10 OR Y.B /= 11 OR Y.C /= 12) THEN
213
                         FAILED ("WRONG VALUES - UP2");
214
                    END IF;
215
               END CHECK4;
216
          END P;
217
 
218
     BEGIN
219
 
220
--        V_A_CP1 := NEW CP'(CONS1_UP);
221
--        CHECK1(V_A_CP1);
222
 
223
--        V_A_CP2 := NEW CP'(CONS2_UP);
224
--        CHECK2(V_A_CP1, V_A_CP2);
225
 
226
          V_A_UP1 := NEW P.UP'(CONS3_UP);
227
          CHECK3(V_A_UP1);
228
 
229
          V_A_UP2 := NEW P.UP'(CONS4_UP);
230
          CHECK4(V_A_UP1, V_A_UP2);
231
 
232
     END;
233
 
234
     RESULT;
235
 
236
END C48006B;

powered by: WebSVN 2.1.0

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