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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C43004C.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 CONSTRAINT_ERROR IS RAISED IF THE VALUE OF A
27 
--     DISCRIMINANT OF A CONSTRAINED COMPONENT OF AN AGGREGATE DOES
28 
--     NOT EQUAL THE CORRESPONDING DISCRIMINANT VALUE FOR THE
29 
--     COMPONENT'S SUBTYPE.
30 
 
31 
-- HISTORY:
32 
--     BCB 07/19/88  CREATED ORIGINAL TEST.
33 
 
34 
WITH REPORT; USE REPORT;
35 
 
36 
PROCEDURE C43004C IS
37 
 
38 
     ZERO : INTEGER := 0;
39 
 
40 
     TYPE REC (D : INTEGER := 0) IS RECORD
41 
          COMP1 : INTEGER;
42 
     END RECORD;
43 
 
44 
     TYPE DREC (DD : INTEGER := ZERO) IS RECORD
45 
          DCOMP1 : INTEGER;
46 
     END RECORD;
47 
 
48 
     TYPE REC1 IS RECORD
49 
          A : REC(0);
50 
     END RECORD;
51 
 
52 
     TYPE REC2 IS RECORD
53 
          B : DREC(ZERO);
54 
     END RECORD;
55 
 
56 
     TYPE REC3 (D3 : INTEGER := 0) IS RECORD
57 
          C : REC(D3);
58 
     END RECORD;
59 
 
60 
     V : REC1;
61 
     W : REC2;
62 
     X : REC3;
63 
 
64 
     PACKAGE P IS
65 
          TYPE PRIV1 (D : INTEGER := 0) IS PRIVATE;
66 
          TYPE PRIV2 (DD : INTEGER := ZERO) IS PRIVATE;
67 
          FUNCTION INIT (I : INTEGER) RETURN PRIV1;
68 
     PRIVATE
69 
          TYPE PRIV1 (D : INTEGER := 0) IS RECORD
70 
               NULL;
71 
          END RECORD;
72 
 
73 
          TYPE PRIV2 (DD : INTEGER := ZERO) IS RECORD
74 
               NULL;
75 
          END RECORD;
76 
     END P;
77 
 
78 
     TYPE REC7 IS RECORD
79 
          H : P.PRIV1 (0);
80 
     END RECORD;
81 
 
82 
     Y : REC7;
83 
 
84 
     GENERIC
85 
          TYPE GP IS PRIVATE;
86 
     FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN;
87 
 
88 
     FUNCTION GEN_EQUAL (X, Y : GP) RETURN BOOLEAN IS
89 
     BEGIN
90 
          RETURN X = Y;
91 
     END GEN_EQUAL;
92 
 
93 
     PACKAGE BODY P IS
94 
          TYPE REC4 IS RECORD
95 
               E : PRIV1(0);
96 
          END RECORD;
97 
 
98 
          TYPE REC5 IS RECORD
99 
               F : PRIV2(ZERO);
100 
          END RECORD;
101 
 
102 
          TYPE REC6 (D6 : INTEGER := 0) IS RECORD
103 
               G : PRIV1(D6);
104 
          END RECORD;
105 
 
106 
          VV : REC4;
107 
          WW : REC5;
108 
          XX : REC6;
109 
 
110 
          FUNCTION REC4_EQUAL IS NEW GEN_EQUAL (REC4);
111 
          FUNCTION REC5_EQUAL IS NEW GEN_EQUAL (REC5);
112 
          FUNCTION REC6_EQUAL IS NEW GEN_EQUAL (REC6);
113 
 
114 
          FUNCTION INIT (I : INTEGER) RETURN PRIV1 IS
115 
               VAR : PRIV1;
116 
          BEGIN
117 
               VAR := (D => I);
118 
               RETURN VAR;
119 
          END INIT;
120 
     BEGIN
121 
          TEST ("C43004C", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
122 
                           "IF THE VALUE OF A DISCRIMINANT OF A " &
123 
                           "CONSTRAINED COMPONENT OF AN AGGREGATE " &
124 
                           "DOES NOT EQUAL THE CORRESPONDING " &
125 
                            "DISCRIMINANT VALUE FOR THECOMPONENT'S " &
126 
                           "SUBTYPE");
127 
 
128 
          BEGIN
129 
               VV := (E => (D => 1));
130 
               FAILED ("CONSTRAINT_ERROR NOT RAISED - 1");
131 
               IF REC4_EQUAL (VV,VV) THEN
132 
                    COMMENT ("DON'T OPTIMIZE VV");
133 
               END IF;
134 
          EXCEPTION
135 
               WHEN CONSTRAINT_ERROR =>
136 
                    NULL;
137 
               WHEN OTHERS =>
138 
                    FAILED ("OTHER EXCEPTION RAISED - 1");
139 
          END;
140 
 
141 
          BEGIN
142 
               WW := (F => (DD => 1));
143 
               FAILED ("CONSTRAINT_ERROR NOT RAISED - 2");
144 
               IF REC5_EQUAL (WW,WW) THEN
145 
                    COMMENT ("DON'T OPTIMIZE WW");
146 
               END IF;
147 
          EXCEPTION
148 
               WHEN CONSTRAINT_ERROR =>
149 
                    NULL;
150 
               WHEN OTHERS =>
151 
                    FAILED ("OTHER EXCEPTION RAISED - 2");
152 
          END;
153 
 
154 
          BEGIN
155 
               XX := (D6 => 1, G => (D => 5));
156 
               FAILED ("CONSTRAINT_ERROR NOT RAISED - 3");
157 
               IF REC6_EQUAL (XX,XX) THEN
158 
                    COMMENT ("DON'T OPTIMIZE XX");
159 
               END IF;
160 
          EXCEPTION
161 
               WHEN CONSTRAINT_ERROR =>
162 
                    NULL;
163 
               WHEN OTHERS =>
164 
                    FAILED ("OTHER EXCEPTION RAISED - 3");
165 
          END;
166 
     END P;
167 
 
168 
     USE P;
169 
 
170 
     FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
171 
     FUNCTION REC2_EQUAL IS NEW GEN_EQUAL (REC2);
172 
     FUNCTION REC3_EQUAL IS NEW GEN_EQUAL (REC3);
173 
     FUNCTION REC7_EQUAL IS NEW GEN_EQUAL (REC7);
174 
 
175 
BEGIN
176 
 
177 
     BEGIN
178 
          V := (A => (D => 1, COMP1 => 2));
179 
          FAILED ("CONSTRAINT_ERROR NOT RAISED - 4");
180 
          IF REC1_EQUAL (V,V) THEN
181 
               COMMENT ("DON'T OPTIMIZE V");
182 
          END IF;
183 
     EXCEPTION
184 
          WHEN CONSTRAINT_ERROR =>
185 
               NULL;
186 
          WHEN OTHERS =>
187 
               FAILED ("OTHER EXCEPTION RAISED - 4");
188 
     END;
189 
 
190 
     BEGIN
191 
          W := (B => (DD => 1, DCOMP1 => 2));
192 
          FAILED ("CONSTRAINT_ERROR NOT RAISED - 5");
193 
          IF REC2_EQUAL (W,W) THEN
194 
               COMMENT ("DON'T OPTIMIZE W");
195 
          END IF;
196 
     EXCEPTION
197 
          WHEN CONSTRAINT_ERROR =>
198 
               NULL;
199 
          WHEN OTHERS =>
200 
               FAILED ("OTHER EXCEPTION RAISED - 5");
201 
     END;
202 
 
203 
     BEGIN
204 
          X := (D3 => 1, C => (D => 5, COMP1 => 2));
205 
          FAILED ("CONSTRAINT_ERROR NOT RAISED - 6");
206 
          IF REC3_EQUAL (X,X) THEN
207 
               COMMENT ("DON'T OPTIMIZE X");
208 
          END IF;
209 
     EXCEPTION
210 
          WHEN CONSTRAINT_ERROR =>
211 
               NULL;
212 
          WHEN OTHERS =>
213 
               FAILED ("OTHER EXCEPTION RAISED - 6");
214 
     END;
215 
 
216 
     BEGIN
217 
          Y := (H => INIT (1));
218 
          FAILED ("CONSTRAINT_ERROR NOT RAISED - 7");
219 
          IF REC7_EQUAL (Y,Y) THEN
220 
               COMMENT ("DON'T OPTIMIZE Y");
221 
          END IF;
222 
     EXCEPTION
223 
          WHEN CONSTRAINT_ERROR =>
224 
               NULL;
225 
          WHEN OTHERS =>
226 
               FAILED ("OTHER EXCEPTION RAISED - 7");
227 
     END;
228 
 
229 
     RESULT;
230 
END C43004C;

powered by: WebSVN 2.1.0

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