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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c36204c.ada] - Blame information for rev 309

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

Line No. Rev Author Line
1 294 jeremybenn 
-- C36204C.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 THE 'RANGE ATTRIBUTE CAN BE USED TO DECLARE OBJECTS
27 
--     AND IN A SUBTYPE AND TYPE DECLARATION.
28 
 
29 
-- HISTORY:
30 
--     LB  08/13/86  CREATED ORIGINAL TEST.
31 
--     BCB 08/18/87  CHANGED HEADER TO STANDARD HEADER FORMAT.
32 
--                   REARRANGED STATEMENTS SO TEST IS CALLED FIRST.
33 
--                   ELIMINATED DEAD VARIABLE OPTIMIZATION.  CHECKED
34 
--                   RANGE VALUES FOR A SMALL INTEGER.
35 
 
36 
WITH REPORT; USE REPORT;
37 
PROCEDURE  C36204C  IS
38 
 
39 
BEGIN
40 
     TEST("C36204C","USING 'RANGE TO DECLARE OBJECTS AND " &
41 
                    "IN A SUBTYPE AND TYPE DECLARATION " &
42 
                    "RETURNS THE CORRECT VALUES.");
43 
 
44 
     DECLARE
45 
 
46 
          ARR : ARRAY(IDENT_INT(4) .. IDENT_INT(10)) OF INTEGER;
47 
          OBJ1 : ARRAY(ARR'RANGE) OF BOOLEAN;
48 
 
49 
          SUBTYPE SMALL_INT IS INTEGER RANGE ARR'RANGE ;
50 
          SML : SMALL_INT;
51 
 
52 
          TYPE OTHER_ARR IS ARRAY(ARR'RANGE) OF CHARACTER;
53 
          OBJ2 : OTHER_ARR;
54 
 
55 
          TYPE ARR_TYPE IS ARRAY(INTEGER RANGE IDENT_INT(1) ..
56 
                                 IDENT_INT(10)) OF INTEGER;
57 
          TYPE ARR_PTR IS ACCESS ARR_TYPE;
58 
          PTR : ARR_PTR := NEW ARR_TYPE'(ARR_TYPE'RANGE => 0);
59 
 
60 
          FUNCTION F RETURN ARR_TYPE IS
61 
               AR : ARR_TYPE := (ARR_TYPE'RANGE => 0);
62 
               BEGIN
63 
                    RETURN AR;
64 
               END F;
65 
 
66 
          BEGIN
67 
               BEGIN
68 
                    IF OBJ1'FIRST /= IDENT_INT(4)  THEN
69 
                         FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
70 
                                "DECLARATION 1");
71 
                    END IF;
72 
               EXCEPTION
73 
                    WHEN OTHERS =>
74 
                         FAILED("EXCEPTION RAISED WHEN CHECKING " &
75 
                                "OBJECT DECLARATION 1");
76 
               END;
77 
 
78 
               BEGIN
79 
                    IF OBJ1'LAST /= IDENT_INT(10)  THEN
80 
                         FAILED("INCORRECT RANGE VALUE FOR AN OBJECT " &
81 
                                "DECLARATION 2");
82 
                    END IF;
83 
               EXCEPTION
84 
                    WHEN OTHERS =>
85 
                         FAILED("EXCEPTION RAISED WHEN CHECKING " &
86 
                                "OBJECT DECLARATION 2");
87 
               END;
88 
 
89 
               BEGIN
90 
                    IF SMALL_INT'FIRST /= 4 THEN
91 
                         FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
92 
                                "INTEGER DECLARATION 1");
93 
                    END IF;
94 
               EXCEPTION
95 
                    WHEN OTHERS =>
96 
                         FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
97 
                                " INTEGER DECLARATION 1");
98 
               END;
99 
 
100 
               BEGIN
101 
                    IF SMALL_INT'LAST /= 10 THEN
102 
                         FAILED("INCORRECT RANGE VALUE FOR A SMALL " &
103 
                                "INTEGER DECLARATION 2");
104 
                    END IF;
105 
               EXCEPTION
106 
                    WHEN OTHERS =>
107 
                         FAILED("EXCEPTION RAISED WHEN CHECKING SMALL" &
108 
                                " INTEGER DECLARATION 2");
109 
               END;
110 
 
111 
               BEGIN
112 
                    SML := IDENT_INT(3) ;
113 
                    IF SML = 3 THEN
114 
                         COMMENT("VARIABLE SML OPTIMIZED VALUE 1");
115 
                    END IF;
116 
                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
117 
                           "VALUE 1");
118 
               EXCEPTION
119 
                    WHEN CONSTRAINT_ERROR =>
120 
                         NULL;
121 
                    WHEN OTHERS =>
122 
                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
123 
                                "RANGE VALUE 1");
124 
               END;
125 
 
126 
               BEGIN
127 
                    SML := IDENT_INT(11) ;
128 
                    IF SML = 11 THEN
129 
                         COMMENT("VARIABLE SML OPTIMIZED VALUE 2");
130 
                    END IF;
131 
                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
132 
                           "VALUE 2");
133 
               EXCEPTION
134 
                    WHEN CONSTRAINT_ERROR =>
135 
                         NULL;
136 
                    WHEN OTHERS =>
137 
                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
138 
                                "RANGE VALUE 2");
139 
               END;
140 
 
141 
               BEGIN
142 
                    IF OBJ2'FIRST /= IDENT_INT(4)  THEN
143 
                         FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
144 
                                "DECLARATION 1");
145 
                    END IF;
146 
               EXCEPTION
147 
                    WHEN OTHERS =>
148 
                         FAILED("EXCEPTION RAISED WHEN CHECKING A " &
149 
                                "TYPE DECLARATION 1");
150 
               END;
151 
 
152 
               BEGIN
153 
                    IF OBJ2'LAST /= IDENT_INT(10)  THEN
154 
                         FAILED("INCORRECT RANGE VALUE FOR A TYPE " &
155 
                                "DECLARATION 2");
156 
                    END IF;
157 
               EXCEPTION
158 
                    WHEN OTHERS =>
159 
                         FAILED("EXCEPTION RAISED WHEN CHECKING A " &
160 
                                "TYPE DECLARATION 2");
161 
               END;
162 
 
163 
               BEGIN
164 
                    IF PTR'FIRST /= IDENT_INT(1)  THEN
165 
                         FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
166 
                                "TYPE DECLARATION 1");
167 
                    END IF;
168 
               EXCEPTION
169 
                    WHEN OTHERS =>
170 
                         FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
171 
                                "ACCESS TYPE DECLARATION 1");
172 
               END;
173 
 
174 
               BEGIN
175 
                    IF PTR'LAST /= IDENT_INT(10)  THEN
176 
                         FAILED("INCORRECT RANGE VALUE FOR AN ACCESS " &
177 
                                "TYPE DECLARATION 2");
178 
                    END IF;
179 
               EXCEPTION
180 
                    WHEN OTHERS =>
181 
                         FAILED("EXCEPTION RAISED WHEN CHECKING AN " &
182 
                                "ACCESS TYPE DECLARATION 2");
183 
               END;
184 
 
185 
               DECLARE
186 
                    OBJ_F1 : INTEGER RANGE F'RANGE ;
187 
               BEGIN
188 
                    OBJ_F1 := IDENT_INT(0) ;
189 
                    IF OBJ_F1 = 0 THEN
190 
                         COMMENT("VARIABLE OBJ_F1 OPTIMIZED VALUE 1");
191 
                    END IF;
192 
                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
193 
                           "VALUE 3");
194 
               EXCEPTION
195 
                    WHEN CONSTRAINT_ERROR =>
196 
                         NULL;
197 
                    WHEN OTHERS =>
198 
                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
199 
                                "RANGE VALUE 3");
200 
               END;
201 
 
202 
               DECLARE
203 
                    OBJ_F2 : INTEGER RANGE F'RANGE ;
204 
               BEGIN
205 
                    OBJ_F2 := IDENT_INT(11) ;
206 
                    IF OBJ_F2 = 11 THEN
207 
                         COMMENT("VARIABLE OBJ_F2 OPTIMIZED VALUE 1");
208 
                    END IF;
209 
                    FAILED("NO EXCEPTION RAISED FOR OUT-OF RANGE " &
210 
                           "VALUE 4");
211 
               EXCEPTION
212 
                    WHEN CONSTRAINT_ERROR =>
213 
                         NULL;
214 
                    WHEN OTHERS =>
215 
                         FAILED("WRONG EXCEPTION RAISED FOR OUT-OF " &
216 
                                "RANGE VALUE 4");
217 
               END;
218 
          END;
219 
     RESULT;
220 
 
221 
END C36204C;

powered by: WebSVN 2.1.0

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