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/] [c6/] [c64103d.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C64103D.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
-- CHECK THAT THE APPROPRIATE EXCEPTION IS RAISED FOR TYPE CONVERSIONS
26
-- ON OUT ARRAY PARAMETERS.  IN PARTICULAR:
27
--   (A) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN THE ACTUAL
28
--       COMPONENT'S CONSTRAINTS DIFFER FROM THE FORMAL COMPONENT'S
29
--       CONSTRAINTS.
30
--   (B) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO
31
--       AN UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
32
--       OUTSIDE OF A FORMAL INDEX SUBTYPE.
33
--   (C) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL FOR CONVERSION TO A
34
--       CONSTRAINED ARRAY TYPE WHEN THE NUMBER OF COMPONENTS PER
35
--       DIMENSION OF THE ACTUAL DIFFERS FROM THAT OF THE FORMAL.
36
--   (D) CONSTRAINT_ERROR IS RAISED BEFORE THE CALL WHEN CONVERSION TO AN
37
--       UNCONSTRAINED ARRAY TYPE CAUSES AN ACTUAL INDEX BOUND TO LIE
38
--       OUTSIDE OF THE BASE INDEX TYPE OF THE FORMAL.
39
 
40
-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
41
-- ***       remove incompatibilities associated with the transition   -- 9X
42
-- ***       to Ada 9X.                                                -- 9X
43
-- ***                                                                 -- 9X
44
 
45
-- CPP 07/19/84
46
-- EG  10/29/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
47
--               AI-00387.
48
-- MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
49
-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
50
 
51
WITH SYSTEM;
52
WITH REPORT;  USE REPORT;
53
PROCEDURE C64103D IS
54
 
55
     BEGIN
56
     TEST ("C64103D", "CHECK THAT APPROPRIATE EXCEPTION IS RAISED ON " &
57
           "TYPE CONVERSIONS OF OUT ARRAY PARAMETERS");
58
 
59
     -----------------------------------------------
60
 
61
     DECLARE   -- (A)
62
     BEGIN     -- (A)
63
 
64
          DECLARE
65
               TYPE SUBINT IS RANGE 0..8;
66
               TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
67
               A0 : ARRAY_TYPE (0..3) := (0..3 => TRUE);
68
 
69
               PROCEDURE P2 (X : OUT ARRAY_TYPE) IS
70
               BEGIN
71
                    NULL;
72
               END P2;
73
          BEGIN
74
               P2 (ARRAY_TYPE (A0));                  -- OK.
75
          EXCEPTION
76
               WHEN OTHERS =>
77
                    FAILED ("EXCEPTION RAISED -P2 (A)");
78
          END;
79
 
80
     END; -- (A)
81
 
82
     -----------------------------------------------
83
 
84
     DECLARE   -- (B)
85
 
86
          TYPE SUBINT IS RANGE 0..8;
87
          TYPE ARRAY_TYPE IS ARRAY (SUBINT RANGE <>) OF BOOLEAN;
88
          TYPE AR1 IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
89
          A1 : AR1 (-1..7) := (-1..7 => TRUE);
90
          A2 : AR1 (1..9) := (1..9 => TRUE);
91
 
92
          PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
93
          BEGIN
94
               FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (B)");
95
          END P1;
96
 
97
     BEGIN     -- (B)
98
 
99
          BEGIN
100
               COMMENT ("CALL TO P1 (B) ON A1");
101
               P1 (ARRAY_TYPE (A1));
102
          EXCEPTION
103
               WHEN CONSTRAINT_ERROR =>
104
                    NULL;
105
               WHEN OTHERS =>
106
                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
107
          END;
108
 
109
          BEGIN
110
               COMMENT ("CALL TO P1 (B) ON A2");
111
               P1 (ARRAY_TYPE (A2));
112
          EXCEPTION
113
               WHEN CONSTRAINT_ERROR =>
114
                    NULL;
115
               WHEN OTHERS =>
116
                    FAILED ("WRONG EXCEPTION RAISED -P1 (B)");
117
          END;
118
 
119
     END; -- (B)
120
 
121
     -----------------------------------------------
122
 
123
     DECLARE   -- (C)
124
     BEGIN     -- (C)
125
 
126
          DECLARE
127
               TYPE INDEX1 IS RANGE 1..3;
128
               TYPE INDEX2 IS RANGE 1..4;
129
               TYPE AR_TYPE IS ARRAY (INDEX1, INDEX2) OF BOOLEAN;
130
               A0 : AR_TYPE := (1..3 => (1..4 => FALSE));
131
 
132
               TYPE I1 IS RANGE 1..4;
133
               TYPE I2 IS RANGE 1..3;
134
               TYPE ARRAY_TYPE IS ARRAY (I1, I2) OF BOOLEAN;
135
 
136
               PROCEDURE P1 (X : OUT ARRAY_TYPE) IS
137
               BEGIN
138
                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (C)");
139
               END P1;
140
          BEGIN
141
               P1 (ARRAY_TYPE (A0));
142
          EXCEPTION
143
               WHEN CONSTRAINT_ERROR =>
144
                    NULL;
145
               WHEN OTHERS =>
146
                    FAILED ("WRONG EXCEPTION RAISED -P1 (C)");
147
          END;
148
 
149
     END; -- (C)
150
 
151
     -----------------------------------------------
152
 
153
     DECLARE   -- (D)
154
     BEGIN     -- (D)
155
 
156
          DECLARE
157
               TYPE SM_INT IS RANGE 0..2;
158
               TYPE LG_INT IS RANGE SYSTEM.MIN_INT..SYSTEM.MAX_INT;
159
               TYPE AR_SMALL IS ARRAY (SM_INT RANGE <>) OF BOOLEAN;
160
               TYPE AR_LARGE IS ARRAY (LG_INT RANGE <>) OF BOOLEAN;
161
               A0 : AR_LARGE (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT) :=
162
                    (SYSTEM.MAX_INT - 2..SYSTEM.MAX_INT => TRUE);
163
 
164
               PROCEDURE P1 (X : OUT AR_SMALL) IS
165
               BEGIN
166
                    FAILED ("EXCEPTION NOT RAISED BEFORE CALL -P1 (D)");
167
               END P1;
168
          BEGIN
169
               IF LG_INT (SM_INT'BASE'LAST) < LG_INT'BASE'LAST THEN
170
                    P1 (AR_SMALL (A0));
171
               ELSE
172
                    COMMENT ("NOT APPLICABLE -P1 (D)");
173
               END IF;
174
          EXCEPTION
175
               WHEN CONSTRAINT_ERROR =>
176
                    COMMENT ("CONSTRAINT_ERROR RAISED - P1 (D)");
177
               WHEN OTHERS =>
178
                    FAILED ("WRONG EXCEPTION RAISED - P1 (D)");
179
          END;
180
 
181
     END; -- (D)
182
 
183
     -----------------------------------------------
184
 
185
     RESULT;
186
 
187
END C64103D;

powered by: WebSVN 2.1.0

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