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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- C37209B.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 WHEN THE SUBTYPE
27 
--     INDICATION IN A CONSTANT OBJECT DECLARATION SPECIFIES A
28 
--     CONSTRAINED SUBTYPE WITH DISCRIMINANTS AND THE INITIALIZATION
29 
--     VALUE DOES NOT BELONG TO THE SUBTYPE (I. E., THE DISCRIMINANT
30 
--     VALUE DOES NOT MATCH THOSE SPECIFIED BY THE CONSTRAINT).
31 
 
32 
-- HISTORY:
33 
--     RJW 08/25/86  CREATED ORIGINAL TEST
34 
--     VCL 08/19/87  CHANGED THE RETURN TYPE OF FUNTION 'INIT' IN
35 
--                   PACKAGE 'PRIV2' SO THAT 'INIT' IS UNCONSTRAINED,
36 
--                   THUS NOT RAISING A CONSTRAINT ERROR ON RETURN FROM
37 
--                   'INIT'.
38 
 
39 
WITH REPORT; USE REPORT;
40 
PROCEDURE C37209B IS
41 
 
42 
BEGIN
43 
     TEST ( "C37209B", "CHECK THAT CONSTRAINT_ERROR IS RAISED WHEN " &
44 
                       "THE SUBTYPE INDICATION IN A CONSTANT " &
45 
                       "OBJECT DECLARATION SPECIFIES A CONSTRAINED " &
46 
                       "SUBTYPE WITH DISCRIMINANTS AND THE " &
47 
                       "INITIALIZATION VALUE DOES NOT BELONG TO " &
48 
                       "THE SUBTYPE (I. E., THE DISCRIMINANT VALUE " &
49 
                       "DOES NOT MATCH THOSE SPECIFIED BY THE " &
50 
                       "CONSTRAINT)" );
51 
     DECLARE
52 
 
53 
          TYPE REC (D : INTEGER) IS
54 
               RECORD
55 
                    NULL;
56 
               END RECORD;
57 
 
58 
          SUBTYPE REC1 IS REC (IDENT_INT (5));
59 
     BEGIN
60 
          DECLARE
61 
               R1 : CONSTANT REC1 := (D => IDENT_INT (10));
62 
               I  : INTEGER := IDENT_INT (R1.D);
63 
          BEGIN
64 
               FAILED ( "NO EXCEPTION RAISED FOR DECLARATION OF " &
65 
                        "R1" );
66 
          EXCEPTION
67 
               WHEN OTHERS =>
68 
                    FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
69 
          END;
70 
 
71 
     EXCEPTION
72 
          WHEN CONSTRAINT_ERROR =>
73 
               NULL;
74 
          WHEN OTHERS =>
75 
               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
76 
                        "R1" );
77 
     END;
78 
 
79 
 
80 
     BEGIN
81 
          DECLARE
82 
               PACKAGE PRIV1 IS
83 
                    TYPE REC (D : INTEGER) IS PRIVATE;
84 
                    SUBTYPE REC2 IS REC (IDENT_INT (5));
85 
                    R2 : CONSTANT REC2;
86 
 
87 
               PRIVATE
88 
                    TYPE REC (D : INTEGER) IS
89 
                         RECORD
90 
                              NULL;
91 
                         END RECORD;
92 
 
93 
                    R2 : CONSTANT REC2 := (D => IDENT_INT (10));
94 
               END PRIV1;
95 
 
96 
               USE PRIV1;
97 
 
98 
          BEGIN
99 
               DECLARE
100 
                    I : INTEGER := IDENT_INT (R2.D);
101 
               BEGIN
102 
                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
103 
                             "OF R2" );
104 
              END;
105 
          END;
106 
 
107 
     EXCEPTION
108 
          WHEN CONSTRAINT_ERROR =>
109 
               NULL;
110 
          WHEN OTHERS =>
111 
               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
112 
                        "OF R2" );
113 
     END;
114 
 
115 
     BEGIN
116 
          DECLARE
117 
               PACKAGE PRIV2 IS
118 
                    TYPE REC (D : INTEGER) IS PRIVATE;
119 
                    SUBTYPE REC3 IS REC (IDENT_INT (5));
120 
 
121 
                    FUNCTION INIT (D : INTEGER) RETURN REC;
122 
               PRIVATE
123 
                    TYPE REC (D : INTEGER) IS
124 
                         RECORD
125 
                              NULL;
126 
                         END RECORD;
127 
 
128 
               END PRIV2;
129 
 
130 
               PACKAGE BODY PRIV2 IS
131 
                    FUNCTION INIT (D : INTEGER) RETURN REC IS
132 
                    BEGIN
133 
                         RETURN (D => IDENT_INT (D));
134 
                    END INIT;
135 
               END PRIV2;
136 
 
137 
               USE PRIV2;
138 
 
139 
          BEGIN
140 
               DECLARE
141 
                    R3 : CONSTANT REC3 := INIT (10);
142 
                    I  : INTEGER := IDENT_INT (R3.D);
143 
               BEGIN
144 
                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
145 
                             "OF R3" );
146 
              END;
147 
          END;
148 
 
149 
     EXCEPTION
150 
          WHEN CONSTRAINT_ERROR =>
151 
               NULL;
152 
          WHEN OTHERS =>
153 
               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
154 
                        "OF R3" );
155 
     END;
156 
 
157 
     BEGIN
158 
          DECLARE
159 
               PACKAGE LPRIV IS
160 
                    TYPE REC  (D : INTEGER) IS
161 
                         LIMITED PRIVATE;
162 
                    SUBTYPE REC4 IS REC (IDENT_INT (5));
163 
 
164 
                    R4 : CONSTANT REC4;
165 
 
166 
               PRIVATE
167 
                    TYPE REC (D : INTEGER) IS
168 
                         RECORD
169 
                              NULL;
170 
                         END RECORD;
171 
 
172 
                    R4 : CONSTANT REC4 := (D => IDENT_INT (10));
173 
               END LPRIV;
174 
 
175 
               USE LPRIV;
176 
 
177 
          BEGIN
178 
               DECLARE
179 
                    I : INTEGER := IDENT_INT (R4.D);
180 
               BEGIN
181 
                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION " &
182 
                             "OF R4" );
183 
              END;
184 
          END;
185 
     EXCEPTION
186 
          WHEN CONSTRAINT_ERROR =>
187 
               NULL;
188 
          WHEN OTHERS =>
189 
               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
190 
                        "OF R4" );
191 
     END;
192 
 
193 
     RESULT;
194 
END C37209B;

powered by: WebSVN 2.1.0

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