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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CD2B11A.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
-- OBJECTIVE:
26
--     CHECK THAT IF A COLLECTION SIZE SPECIFICATION CAN BE GIVEN FOR AN
27
--     ACCESS TYPE, THEN OPERATIONS ON VALUES OF THE ACCESS TYPE ARE NOT
28
--     AFFECTED.
29
 
30
-- HISTORY:
31
--     BCB 11/01/88  CREATED ORIGINAL TEST.
32
--     RJW 05/17/89  CHANGED FROM '.DEP' TEST TO '.ADA' TEST.
33
--                   ADDED CHECK FOR UNCHECKED_DEALLOCATION.
34
 
35
WITH REPORT;  USE REPORT;
36
WITH SYSTEM;
37
WITH UNCHECKED_DEALLOCATION;
38
PROCEDURE CD2B11A IS
39
 
40
     BASIC_SIZE : CONSTANT := 1024;
41
 
42
     TYPE MAINTYPE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
43
     TYPE ACC_TYPE IS ACCESS MAINTYPE;
44
     SUBTYPE ACC_RANGE IS ACC_TYPE (1 .. 3);
45
 
46
     FOR ACC_TYPE'STORAGE_SIZE USE BASIC_SIZE;
47
 
48
     TYPE RECORD_TYPE IS RECORD
49
          COMP : ACC_TYPE;
50
     END RECORD;
51
 
52
     CHECK_TYPE1 : ACC_TYPE;
53
     CHECK_TYPE2 : ACC_TYPE;
54
     CHECK_TYPE3 : ACC_TYPE(1..3);
55
 
56
     CHECK_ARRAY : ARRAY (1..2) OF ACC_TYPE;
57
 
58
     CHECK_RECORD1 : RECORD_TYPE;
59
     CHECK_RECORD2 : RECORD_TYPE;
60
 
61
     CHECK_PARAM1 : ACC_TYPE;
62
     CHECK_PARAM2 : ACC_TYPE;
63
 
64
     CHECK_NULL : ACC_TYPE := NULL;
65
 
66
     PROCEDURE PROC (ACC1,ACC2 : IN OUT ACC_TYPE) IS
67
 
68
     BEGIN
69
 
70
          IF (ACC1.ALL /= ACC2.ALL) THEN
71
               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS " &
72
                       "- 1");
73
          END IF;
74
 
75
          IF EQUAL (3,3) THEN
76
               ACC2 := ACC1;
77
          END IF;
78
 
79
          IF ACC2 /= ACC1 THEN
80
               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
81
                       "-1");
82
          END IF;
83
 
84
          IF (ACC1 IN ACC_RANGE) THEN
85
               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 1");
86
          END IF;
87
 
88
     END PROC;
89
 
90
BEGIN
91
 
92
     TEST ("CD2B11A", "CHECK THAT IF A COLLECTION SIZE SPECIFICATION " &
93
                      "CAN BE GIVEN FOR AN ACCESS TYPE, THEN " &
94
                      "OPERATIONS ON VALUES OF THE ACCESS TYPE ARE " &
95
                      "NOT AFFECTED");
96
 
97
     CHECK_PARAM1 := NEW MAINTYPE'(25,35,45);
98
     CHECK_PARAM2 := NEW MAINTYPE'(25,35,45);
99
 
100
     PROC (CHECK_PARAM1,CHECK_PARAM2);
101
 
102
     IF ACC_TYPE'STORAGE_SIZE < BASIC_SIZE THEN
103
          FAILED ("INCORRECT VALUE FOR ACCESS TYPE STORAGE_SIZE");
104
     END IF;
105
 
106
     CHECK_TYPE1 := NEW MAINTYPE'(25,35,45);
107
     CHECK_TYPE2 := NEW MAINTYPE'(25,35,45);
108
     CHECK_TYPE3 := NEW MAINTYPE'(1 => 1,2 => 2,3 => 3);
109
 
110
     CHECK_ARRAY (1) := NEW MAINTYPE'(25,35,45);
111
     CHECK_ARRAY (2) := NEW MAINTYPE'(25,35,45);
112
 
113
     CHECK_RECORD1.COMP := NEW MAINTYPE'(25,35,45);
114
     CHECK_RECORD2.COMP := NEW MAINTYPE'(25,35,45);
115
 
116
     IF (CHECK_TYPE1.ALL /= CHECK_TYPE2.ALL) THEN
117
          FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 2");
118
     END IF;
119
 
120
     IF EQUAL (3,3) THEN
121
          CHECK_TYPE2 := CHECK_TYPE1;
122
     END IF;
123
 
124
     IF CHECK_TYPE2 /= CHECK_TYPE1 THEN
125
          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 2");
126
     END IF;
127
 
128
     IF (CHECK_TYPE1 IN ACC_RANGE) THEN
129
          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 2");
130
     END IF;
131
 
132
     IF (CHECK_ARRAY (1).ALL /= CHECK_ARRAY (2).ALL) THEN
133
          FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 3");
134
     END IF;
135
 
136
     IF EQUAL (3,3) THEN
137
          CHECK_ARRAY (2) := CHECK_ARRAY (1);
138
     END IF;
139
 
140
     IF CHECK_ARRAY (2) /= CHECK_ARRAY (1) THEN
141
          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 3");
142
     END IF;
143
 
144
     IF (CHECK_ARRAY (1) IN ACC_RANGE) THEN
145
          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 3");
146
     END IF;
147
 
148
     IF (CHECK_RECORD1.COMP.ALL /= CHECK_RECORD2.COMP.ALL) THEN
149
          FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 4");
150
     END IF;
151
 
152
     IF EQUAL (3,3) THEN
153
          CHECK_RECORD2 := CHECK_RECORD1;
154
     END IF;
155
 
156
     IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
157
          FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS - 4");
158
     END IF;
159
 
160
     IF (CHECK_RECORD1.COMP IN ACC_RANGE) THEN
161
          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 4");
162
     END IF;
163
 
164
     IF CHECK_TYPE3'FIRST /= IDENT_INT (1) THEN
165
          FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'FIRST");
166
     END IF;
167
 
168
     IF CHECK_TYPE3'LAST /= IDENT_INT (3) THEN
169
          FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'LAST");
170
     END IF;
171
 
172
     DECLARE
173
          TYPE ACC_CHAR IS ACCESS CHARACTER;
174
          FOR ACC_CHAR'STORAGE_SIZE USE 128;
175
 
176
          LIMIT : INTEGER :=
177
           (ACC_CHAR'STORAGE_SIZE * SYSTEM.STORAGE_UNIT)/CHARACTER'SIZE;
178
 
179
          ACC_ARRAY : ARRAY (1 .. LIMIT + 1) OF ACC_CHAR;
180
          PLACE : INTEGER;
181
 
182
          PROCEDURE FREE IS
183
               NEW UNCHECKED_DEALLOCATION (CHARACTER, ACC_CHAR);
184
     BEGIN
185
          FOR I IN ACC_ARRAY'RANGE LOOP
186
               ACC_ARRAY (IDENT_INT (I)) :=
187
                    NEW CHARACTER'
188
                         (IDENT_CHAR ((CHARACTER'VAL (I MOD 128))));
189
               PLACE := I;
190
          END LOOP;
191
          FAILED ("NO EXCEPTION RAISED WHEN COLLECTION SIZE EXCEEDED");
192
     EXCEPTION
193
          WHEN STORAGE_ERROR =>
194
               BEGIN
195
                    FOR I IN 1 .. PLACE LOOP
196
                         IF I MOD 2 = 0 THEN
197
                              FREE (ACC_ARRAY (IDENT_INT (I)));
198
                         END IF;
199
                    END LOOP;
200
 
201
                    FOR I IN 1 .. PLACE LOOP
202
                         IF I MOD 2 = 1 AND THEN
203
                            IDENT_CHAR (ACC_ARRAY (I).ALL) /=
204
                            CHARACTER'VAL (I MOD IDENT_INT (128)) THEN
205
                              FAILED ("INCORRECT VALUE IN ARRAY");
206
                         END IF;
207
                    END LOOP;
208
               END;
209
          WHEN OTHERS =>
210
               FAILED ("WRONG EXCEPTION RAISED");
211
     END;
212
 
213
     RESULT;
214
END CD2B11A;

powered by: WebSVN 2.1.0

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