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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC3126A.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 AND ONLY IF THE ACTUAL
27
--     PARAMETER DOES NOT HAVE THE SAME NUMBER OF COMPONENTS
28
--     (PER DIMENSION) AS THE FORMAL PARAMETER. ALSO THAT FOR NULL
29
--     ARRAYS NO ERROR IS RAISED.
30
 
31
-- HISTORY:
32
--     LB  12/02/86
33
--     DWC 08/11/87  CHANGED HEADING FORMAT.
34
--     RJW 10/26/89  INITIALIZED VARIABLE H.
35
 
36
WITH REPORT; USE REPORT;
37
 
38
PROCEDURE  CC3126A  IS
39
 
40
BEGIN
41
     TEST ("CC3126A","GENERIC ACTUAL PARAMETER MUST HAVE THE SAME "&
42
                     "NUMBER OF COMPONENTS (PER DIMENSION) AS THE "&
43
                     "GENERIC FORMAL PARMETER");
44
     BEGIN
45
          DECLARE
46
               TYPE ARRY1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
47
               SUBTYPE ARR IS ARRY1 (1 .. 10);
48
 
49
               GENERIC
50
                    GARR : IN ARR;
51
               PACKAGE P IS
52
                    NARR : ARR := GARR;
53
               END P;
54
 
55
          BEGIN
56
               BEGIN
57
                    DECLARE
58
                         X : ARRY1 (2 .. 11) := (2 .. 11 => 0);
59
                         PACKAGE Q IS NEW P(X);
60
                    BEGIN
61
                         Q.NARR(2) := 1;
62
                    END;
63
               EXCEPTION
64
                    WHEN OTHERS =>
65
                         FAILED ("EXCEPTION RAISED 1");
66
               END;
67
 
68
               BEGIN
69
                    DECLARE
70
                         S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
71
                         PACKAGE R IS NEW P(S);
72
                    BEGIN
73
                         FAILED ("EXCEPTION NOT RAISED 2");
74
                         R.NARR(1) := IDENT_INT(R.NARR(1));
75
                    END;
76
               EXCEPTION
77
                    WHEN CONSTRAINT_ERROR =>
78
                         NULL;
79
                    WHEN OTHERS =>
80
                         FAILED ("WRONG EXCEPTION RAISED 2");
81
               END;
82
 
83
               BEGIN
84
                    DECLARE
85
                         G : ARRY1 (1 .. 9) := (1 .. 9 => 0);
86
                         PACKAGE K IS NEW P(G);
87
                    BEGIN
88
                         FAILED ("EXCEPTION NOT RAISED 3");
89
                         IF EQUAL(3,3) THEN
90
                              K.NARR(1) := IDENT_INT(K.NARR(1));
91
                         END IF;
92
                    END;
93
               EXCEPTION
94
                    WHEN CONSTRAINT_ERROR =>
95
                         NULL;
96
                    WHEN OTHERS =>
97
                         FAILED ("WRONG EXCEPTION RAISED 3");
98
               END;
99
 
100
               BEGIN
101
                    DECLARE
102
                         S : ARRY1 (1 .. 11) := (1 .. 11 => 0);
103
                         PACKAGE F IS NEW P(S(2 .. 11));
104
                    BEGIN
105
                         F.NARR(2) := IDENT_INT(F.NARR(2));
106
                    END;
107
               EXCEPTION
108
                    WHEN OTHERS =>
109
                         FAILED ("EXCEPTION RAISED 4");
110
               END;
111
          END;
112
 
113
          DECLARE
114
               SUBTYPE STR IS STRING(1 .. 20);
115
 
116
               GENERIC
117
                    GVAR : IN STR;
118
               PACKAGE M IS
119
                    NVAR : STR := GVAR;
120
               END M;
121
 
122
          BEGIN
123
               BEGIN
124
                    DECLARE
125
                         L : STRING (2 .. 15);
126
                         PACKAGE U IS NEW M(L);
127
                    BEGIN
128
                         FAILED ("EXCEPTION NOT RAISED 5");
129
                         U.NVAR(2) := IDENT_CHAR(U.NVAR(2));
130
                    END;
131
               EXCEPTION
132
                    WHEN CONSTRAINT_ERROR =>
133
                         NULL;
134
                    WHEN OTHERS =>
135
                         FAILED ("WRONG EXCEPTION RAISED 5");
136
               END;
137
 
138
               BEGIN
139
                    DECLARE
140
                         H : STRING (1 .. 20) := (OTHERS => 'R');
141
                         PACKAGE J IS NEW M(H);
142
                    BEGIN
143
                         IF EQUAL(3,3) THEN
144
                              J.NVAR(2) := IDENT_CHAR(J.NVAR(2));
145
                         END IF;
146
                    END;
147
               EXCEPTION
148
                    WHEN OTHERS =>
149
                         FAILED ("EXCEPTION RAISED 6");
150
               END;
151
          EXCEPTION
152
               WHEN OTHERS =>
153
                    FAILED ("UNEXPECTED ERROR RAISED STRINGS");
154
          END;
155
 
156
          DECLARE
157
               TYPE NARRY IS ARRAY (INTEGER RANGE <>) OF INTEGER;
158
               SUBTYPE SNARRY IS NARRY (2 .. 0);
159
 
160
               GENERIC
161
                    RD : IN SNARRY;
162
               PACKAGE JA IS
163
                    CD : SNARRY := RD;
164
               END JA;
165
          BEGIN
166
               BEGIN
167
                    DECLARE
168
                         AD : NARRY(1 .. 0);
169
                         PACKAGE PA IS NEW JA(AD);
170
                    BEGIN
171
                         IF NOT EQUAL(0,PA.CD'LAST) THEN
172
                              FAILED ("PARAMETER ATTRIBUTE INCORRECT");
173
                         END IF;
174
                    END;
175
               EXCEPTION
176
                    WHEN OTHERS =>
177
                         FAILED ("EXCEPTION RAISED 7");
178
               END;
179
          EXCEPTION
180
               WHEN OTHERS =>
181
                    FAILED ("UNEXPECTED EXCEPTION RAISED FOR ARRAYS "&
182
                            "WITH NULL RANGES");
183
          END;
184
     END;
185
 
186
     RESULT;
187
 
188
END CC3126A;

powered by: WebSVN 2.1.0

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