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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C35003B.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 FOR A SUBTYPE INDICATION
27 
--     OF A DISCRETE GENERIC FORMAL TYPE WHEN THE LOWER OR UPPER BOUND
28 
--     OF A NON-NULL RANGE LIES OUTSIDE THE RANGE OF THE TYPE MARK.
29 
 
30 
-- HISTORY:
31 
--     JET 07/08/88  CREATED ORIGINAL TEST.
32 
 
33 
WITH REPORT; USE REPORT;
34 
 
35 
PROCEDURE C35003B IS
36 
 
37 
     TYPE ENUM IS (WE, LOVE, WRITING, TESTS);
38 
     TYPE INT IS RANGE -10..10;
39 
 
40 
     GENERIC
41 
          TYPE GEN_ENUM IS (<>);
42 
          TYPE GEN_INT IS RANGE <>;
43 
     PACKAGE GEN_PACK IS
44 
          SUBTYPE SUBENUM IS GEN_ENUM RANGE
45 
               GEN_ENUM'SUCC(GEN_ENUM'FIRST) ..
46 
               GEN_ENUM'PRED(GEN_ENUM'LAST);
47 
          SUBTYPE SUBINT IS GEN_INT RANGE
48 
               GEN_INT'SUCC(GEN_INT'FIRST) ..
49 
               GEN_INT'PRED(GEN_INT'LAST);
50 
          TYPE A1 IS ARRAY (0..GEN_INT'LAST) OF INTEGER;
51 
          TYPE A2 IS ARRAY (GEN_INT RANGE GEN_INT'FIRST..0) OF INTEGER;
52 
     END GEN_PACK;
53 
 
54 
     PACKAGE BODY GEN_PACK IS
55 
     BEGIN
56 
          TEST ("C35003B", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
57 
                           "FOR A SUBTYPE INDICATION OF A DISCRETE " &
58 
                           "GENERIC FORMAL TYPE WHEN THE LOWER OR " &
59 
                           "UPPER BOUND OF A NON-NULL RANGE LIES " &
60 
                           "OUTSIDE THE RANGE OF THE TYPE MARK");
61 
          BEGIN
62 
               DECLARE
63 
                    SUBTYPE SUBSUBENUM IS SUBENUM RANGE
64 
                         GEN_ENUM'FIRST..SUBENUM'LAST;
65 
               BEGIN
66 
                    FAILED ("NO EXCEPTION RAISED (E1)");
67 
                    DECLARE
68 
                         Z : SUBSUBENUM := SUBENUM'FIRST;
69 
                    BEGIN
70 
                         IF NOT EQUAL(SUBSUBENUM'POS(Z),
71 
                                      SUBSUBENUM'POS(Z)) THEN
72 
                              COMMENT ("DON'T OPTIMIZE Z");
73 
                         END IF;
74 
                    END;
75 
               EXCEPTION
76 
                    WHEN OTHERS =>
77 
                         FAILED ("EXCEPTION RAISED IN WRONG " &
78 
                                 "PLACE (E1)");
79 
               END;
80 
          EXCEPTION
81 
               WHEN CONSTRAINT_ERROR =>
82 
                    NULL;
83 
               WHEN OTHERS =>
84 
                    FAILED ("WRONG EXCEPTION RAISED (E1)");
85 
          END;
86 
 
87 
          BEGIN
88 
               DECLARE
89 
                    TYPE A IS ARRAY (SUBENUM RANGE SUBENUM'FIRST ..
90 
                         GEN_ENUM'LAST) OF INTEGER;
91 
               BEGIN
92 
                    FAILED ("NO EXCEPTION RAISED (E2)");
93 
                    DECLARE
94 
                         Z : A := (OTHERS => 0);
95 
                    BEGIN
96 
                         IF NOT EQUAL(Z(SUBENUM'FIRST),
97 
                                      Z(SUBENUM'FIRST)) THEN
98 
                              COMMENT ("DON'T OPTIMIZE Z");
99 
                         END IF;
100 
                    END;
101 
               EXCEPTION
102 
                    WHEN OTHERS =>
103 
                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
104 
                                 "(E2)");
105 
               END;
106 
          EXCEPTION
107 
               WHEN CONSTRAINT_ERROR =>
108 
                    NULL;
109 
               WHEN OTHERS =>
110 
                    FAILED ("WRONG EXCEPTION RAISED (E2)");
111 
          END;
112 
 
113 
          BEGIN
114 
               DECLARE
115 
                    TYPE I IS ACCESS SUBINT RANGE
116 
                         GEN_INT'FIRST..SUBINT'LAST;
117 
               BEGIN
118 
                    FAILED ("NO EXCEPTION RAISED (I1)");
119 
                    DECLARE
120 
                         Z : I := NEW SUBINT'(SUBINT'FIRST);
121 
                    BEGIN
122 
                         IF NOT EQUAL(INTEGER(Z.ALL),INTEGER(Z.ALL))
123 
                         THEN
124 
                              COMMENT ("DON'T OPTIMIZE Z");
125 
                         END IF;
126 
                    END;
127 
               EXCEPTION
128 
                    WHEN OTHERS =>
129 
                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
130 
                                 "(I1)");
131 
               END;
132 
          EXCEPTION
133 
               WHEN CONSTRAINT_ERROR =>
134 
                    NULL;
135 
               WHEN OTHERS =>
136 
                    FAILED ("WRONG EXCEPTION RAISED (I1)");
137 
          END;
138 
 
139 
          BEGIN
140 
               DECLARE
141 
                    TYPE I IS NEW
142 
                         SUBINT RANGE SUBINT'FIRST..GEN_INT'LAST;
143 
               BEGIN
144 
                    FAILED ("NO EXCEPTION RAISED (I2)");
145 
                    DECLARE
146 
                         Z : I := I'FIRST;
147 
                    BEGIN
148 
                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
149 
                              COMMENT ("DON'T OPTIMIZE Z");
150 
                         END IF;
151 
                    END;
152 
               EXCEPTION
153 
                    WHEN OTHERS =>
154 
                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
155 
                                 "(I2)");
156 
               END;
157 
          EXCEPTION
158 
               WHEN CONSTRAINT_ERROR =>
159 
                    NULL;
160 
               WHEN OTHERS =>
161 
                    FAILED ("WRONG EXCEPTION RAISED (I2)");
162 
          END;
163 
 
164 
          BEGIN
165 
               DECLARE
166 
                    SUBTYPE I IS SUBINT RANGE A1'RANGE;
167 
               BEGIN
168 
                    FAILED ("NO EXCEPTION RAISED (R1)");
169 
                    DECLARE
170 
                         Z : I := SUBINT'FIRST;
171 
                    BEGIN
172 
                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
173 
                              COMMENT ("DON'T OPTIMIZE Z");
174 
                         END IF;
175 
                    END;
176 
               EXCEPTION
177 
                    WHEN OTHERS =>
178 
                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
179 
                                 "(R1)");
180 
               END;
181 
          EXCEPTION
182 
               WHEN CONSTRAINT_ERROR =>
183 
                    NULL;
184 
               WHEN OTHERS =>
185 
                    FAILED ("WRONG EXCEPTION RAISED (R1)");
186 
          END;
187 
 
188 
          BEGIN
189 
               DECLARE
190 
                    SUBTYPE I IS SUBINT RANGE A2'RANGE;
191 
               BEGIN
192 
                    FAILED ("NO EXCEPTION RAISED (R2)");
193 
                    DECLARE
194 
                         Z : I := 1;
195 
                    BEGIN
196 
                         IF NOT EQUAL(INTEGER(Z),INTEGER(Z)) THEN
197 
                              COMMENT ("DON'T OPTIMIZE Z");
198 
                         END IF;
199 
                    END;
200 
               EXCEPTION
201 
                    WHEN OTHERS =>
202 
                         FAILED ("EXCEPTION RAISED IN WRONG PLACE " &
203 
                                 "(R2)");
204 
               END;
205 
          EXCEPTION
206 
               WHEN CONSTRAINT_ERROR =>
207 
                    NULL;
208 
               WHEN OTHERS =>
209 
                    FAILED ("WRONG EXCEPTION RAISED (R2)");
210 
          END;
211 
     END GEN_PACK;
212 
 
213 
     PACKAGE ENUM_PACK IS NEW GEN_PACK(ENUM, INT);
214 
 
215 
BEGIN
216 
     RESULT;
217 
END C35003B;

powered by: WebSVN 2.1.0

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