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/] [cd/] [cd2b11b.ada] - Blame information for rev 154

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CD2B11B.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 IS SPECIFIED FOR AN
27
--     ACCESS TYPE IN A GENERIC UNIT, THEN OPERATIONS ON VALUES OF THE
28
--     ACCESS TYPE ARE NOT AFFECTED.
29
 
30
-- HISTORY:
31
--     BCB 09/23/87  CREATED ORIGINAL TEST.
32
--     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
33
 
34
WITH REPORT;  USE REPORT;
35
 
36
PROCEDURE CD2B11B IS
37
 
38
     BASIC_SIZE : CONSTANT := 1024;
39
     B : BOOLEAN;
40
 
41
BEGIN
42
 
43
     TEST ("CD2B11B", "CHECK THAT IF A COLLECTION SIZE IS SPECIFIED " &
44
                      "FOR AN ACCESS TYPE, THEN " &
45
                      "OPERATIONS ON VALUES OF THE ACCESS TYPE ARE " &
46
                      "NOT AFFECTED");
47
 
48
     DECLARE
49
 
50
          GENERIC
51
          FUNCTION FUNC RETURN BOOLEAN;
52
 
53
          FUNCTION FUNC RETURN BOOLEAN IS
54
 
55
               TYPE MAINTYPE IS ARRAY (INTEGER RANGE <>) OF INTEGER;
56
               TYPE ACC_TYPE IS ACCESS MAINTYPE;
57
               SUBTYPE ACC_RANGE IS ACC_TYPE (1 .. 3);
58
 
59
               FOR ACC_TYPE'STORAGE_SIZE
60
                    USE BASIC_SIZE;
61
 
62
               TYPE RECORD_TYPE IS RECORD
63
                    COMP : ACC_TYPE;
64
               END RECORD;
65
 
66
               CHECK_TYPE1 : ACC_TYPE;
67
               CHECK_TYPE2 : ACC_TYPE;
68
               CHECK_TYPE3 : ACC_TYPE(1..3);
69
 
70
               CHECK_ARRAY : ARRAY (1..3) OF ACC_TYPE;
71
 
72
               CHECK_RECORD1 : RECORD_TYPE;
73
               CHECK_RECORD2 : RECORD_TYPE;
74
 
75
               CHECK_PARAM1 : ACC_TYPE;
76
               CHECK_PARAM2 : ACC_TYPE;
77
 
78
               CHECK_NULL : ACC_TYPE := NULL;
79
 
80
               PROCEDURE PROC (ACC1,ACC2 : IN OUT ACC_TYPE) IS
81
 
82
               BEGIN
83
 
84
                    IF (ACC1.ALL /= ACC2.ALL) THEN
85
                         FAILED ("INCORRECT VALUES FOR DESIGNATED " &
86
                                 "OBJECTS - 1");
87
                    END IF;
88
 
89
                    IF EQUAL (3,3) THEN
90
                         ACC2 := ACC1;
91
                    END IF;
92
 
93
                    IF ACC2 /= ACC1 THEN
94
                         FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
95
                                 "OPERATORS - 1");
96
                    END IF;
97
 
98
                    IF (ACC1 IN ACC_RANGE) THEN
99
                         FAILED ("INCORRECT RESULTS FOR " &
100
                                 "MEMBERSHIP TEST - 1");
101
                    END IF;
102
 
103
               END PROC;
104
 
105
     BEGIN -- FUNC.
106
 
107
          CHECK_PARAM1 := NEW MAINTYPE'(25,35,45);
108
          CHECK_PARAM2 := NEW MAINTYPE'(25,35,45);
109
 
110
          PROC (CHECK_PARAM1,CHECK_PARAM2);
111
 
112
          IF ACC_TYPE'STORAGE_SIZE < BASIC_SIZE THEN
113
               FAILED ("INCORRECT VALUE FOR ACCESS TYPE STORAGE_SIZE");
114
          END IF;
115
 
116
          CHECK_TYPE1 := NEW MAINTYPE'(25,35,45);
117
          CHECK_TYPE2 := NEW MAINTYPE'(25,35,45);
118
          CHECK_TYPE3 := NEW MAINTYPE'(1 => 1,2 => 2,3 => 3);
119
 
120
          CHECK_ARRAY (1) := NEW MAINTYPE'(25,35,45);
121
          CHECK_ARRAY (2) := NEW MAINTYPE'(25,35,45);
122
 
123
          CHECK_RECORD1.COMP := NEW MAINTYPE'(25,35,45);
124
          CHECK_RECORD2.COMP := NEW MAINTYPE'(25,35,45);
125
 
126
          IF (CHECK_TYPE1.ALL /= CHECK_TYPE2.ALL) THEN
127
               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 2");
128
          END IF;
129
 
130
          IF EQUAL (3,3) THEN
131
               CHECK_TYPE2 := CHECK_TYPE1;
132
          END IF;
133
 
134
          IF CHECK_TYPE2 /= CHECK_TYPE1 THEN
135
               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
136
                       "- 2");
137
          END IF;
138
 
139
          IF (CHECK_TYPE1 IN ACC_RANGE) THEN
140
               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 2");
141
          END IF;
142
 
143
          IF (CHECK_ARRAY (1).ALL /= CHECK_ARRAY (2).ALL) THEN
144
               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 3");
145
          END IF;
146
 
147
          IF EQUAL (3,3) THEN
148
               CHECK_ARRAY (2) := CHECK_ARRAY (1);
149
          END IF;
150
 
151
          IF CHECK_ARRAY (2) /= CHECK_ARRAY (1) THEN
152
               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
153
                       "- 3");
154
          END IF;
155
 
156
          IF (CHECK_ARRAY (1) IN ACC_RANGE) THEN
157
               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 3");
158
          END IF;
159
 
160
          IF (CHECK_RECORD1.COMP.ALL /= CHECK_RECORD2.COMP.ALL) THEN
161
               FAILED ("INCORRECT VALUES FOR DESIGNATED OBJECTS - 4");
162
          END IF;
163
 
164
          IF EQUAL (3,3) THEN
165
               CHECK_RECORD2 := CHECK_RECORD1;
166
          END IF;
167
 
168
          IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
169
               FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATORS " &
170
                       "- 4");
171
          END IF;
172
 
173
          IF (CHECK_RECORD1.COMP IN ACC_RANGE) THEN
174
               FAILED ("INCORRECT RESULTS FOR MEMBERSHIP TEST - 4");
175
          END IF;
176
 
177
          IF CHECK_TYPE3'FIRST /= IDENT_INT (1) THEN
178
               FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'FIRST");
179
          END IF;
180
 
181
          IF CHECK_TYPE3'LAST /= IDENT_INT (3) THEN
182
               FAILED ("INCORRECT VALUE FOR CHECK_TYPE3'LAST");
183
          END IF;
184
 
185
          RETURN TRUE;
186
 
187
     END FUNC;
188
 
189
     FUNCTION NEWFUNC IS NEW FUNC;
190
 
191
     BEGIN
192
          B := NEWFUNC;
193
     END;
194
 
195
     RESULT;
196
END CD2B11B;

powered by: WebSVN 2.1.0

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