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/] [c37209a.ada] - Blame information for rev 316

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

Line No. Rev Author Line
1 294 jeremybenn 
-- C37209A.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 CONSTRAINT_ERROR IS NOT RAISED FOR A CONSTANT OBJECT
26 
-- DECLARATION WHOSE SUBTYPE INDICATION SPECIFIES AN UNCONSTRAINED
27 
-- TYPE WITH DEFAULT DISCRIMINANT VALUES AND WHOSE INITIALIZATION
28 
-- EXPRESSION SPECIFIES A VALUE WHOSE DISCRIMINANTS ARE NOT EQUAL TO
29 
-- THE DEFAULT VALUE.
30 
 
31 
-- R.WILLIAMS 8/25/86
32 
 
33 
WITH REPORT; USE REPORT;
34 
PROCEDURE C37209A IS
35 
 
36 
BEGIN
37 
     TEST ( "C37209A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
38 
                       "FOR A CONSTANT OBJECT DECLARATION WHOSE " &
39 
                       "SUBTYPE INDICATION SPECIFIES AN " &
40 
                       "UNCONSTRAINED TYPE WITH DEFAULT " &
41 
                       "DISCRIMINANT VALUES AND WHOSE " &
42 
                       "INITIALIZATION EXPRESSION SPECIFIES A VALUE " &
43 
                       "WHOSE DISCRIMINANTS ARE NOT EQUAL TO THE " &
44 
                       "DEFAULT VALUE" );
45 
     DECLARE
46 
 
47 
          TYPE REC1 (D : INTEGER := IDENT_INT (5)) IS
48 
               RECORD
49 
                    NULL;
50 
               END RECORD;
51 
 
52 
     BEGIN
53 
          DECLARE
54 
               R1 : CONSTANT REC1 := (D => IDENT_INT (10));
55 
          BEGIN
56 
               COMMENT ( "NO EXCEPTION RAISED AT DECLARATION OF R1" );
57 
          EXCEPTION
58 
               WHEN OTHERS =>
59 
                    FAILED ( "EXCEPTION FOR R1 RAISED INSIDE BLOCK" );
60 
          END;
61 
 
62 
     EXCEPTION
63 
          WHEN CONSTRAINT_ERROR =>
64 
               FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
65 
                        "R1" );
66 
          WHEN OTHERS =>
67 
               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION OF " &
68 
                        "R1" );
69 
     END;
70 
 
71 
 
72 
     BEGIN
73 
          DECLARE
74 
               PACKAGE PRIV IS
75 
                    TYPE REC2 (D : INTEGER:= IDENT_INT (5)) IS PRIVATE;
76 
                    R2 : CONSTANT REC2;
77 
 
78 
               PRIVATE
79 
                    TYPE REC2 (D : INTEGER := IDENT_INT (5)) IS
80 
                         RECORD
81 
                              NULL;
82 
                         END RECORD;
83 
 
84 
                    R2 : CONSTANT REC2 := (D => IDENT_INT (10));
85 
               END PRIV;
86 
 
87 
               USE PRIV;
88 
 
89 
          BEGIN
90 
               DECLARE
91 
                    I : INTEGER := R2.D;
92 
               BEGIN
93 
                    COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
94 
                              "OF R2" );
95 
              END;
96 
          END;
97 
 
98 
     EXCEPTION
99 
          WHEN CONSTRAINT_ERROR =>
100 
               FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
101 
                         "R2" );
102 
          WHEN OTHERS =>
103 
               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
104 
                        "OF R2" );
105 
     END;
106 
 
107 
     BEGIN
108 
          DECLARE
109 
               PACKAGE LPRIV IS
110 
                    TYPE REC3 (D : INTEGER:= IDENT_INT (5)) IS
111 
                         LIMITED PRIVATE;
112 
 
113 
                    R3 : CONSTANT REC3;
114 
 
115 
               PRIVATE
116 
                    TYPE REC3 (D : INTEGER := IDENT_INT (5)) IS
117 
                         RECORD
118 
                              NULL;
119 
                         END RECORD;
120 
 
121 
                    R3 : CONSTANT REC3 := (D => IDENT_INT (10));
122 
               END LPRIV;
123 
 
124 
               USE LPRIV;
125 
 
126 
          BEGIN
127 
               DECLARE
128 
                    I : INTEGER;
129 
               BEGIN
130 
                    I := R3.D;
131 
                    COMMENT ( "NO EXCEPTION RAISED AT DECLARATION " &
132 
                              "OF R3" );
133 
              END;
134 
          END;
135 
     EXCEPTION
136 
          WHEN CONSTRAINT_ERROR =>
137 
               FAILED ( "CONSTRAINT_ERROR RAISED AT DECLARATION OF " &
138 
                         "R3" );
139 
          WHEN OTHERS =>
140 
               FAILED ( "OTHER EXCEPTION RAISED AT DECLARATION " &
141 
                        "OF R3" );
142 
     END;
143 
 
144 
     RESULT;
145 
END C37209A;

powered by: WebSVN 2.1.0

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