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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C64106B.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 ASSIGNMENTS TO FORMAL PARAMETERS OF UNCONSTRAINED RECORD,
26 
--   PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT DEFAULT CONSTRAINTS
27 
--   RAISE CONSTRAINT_ERROR IF AN ATTEMPT IS MADE TO CHANGE THE
28 
--   CONSTRAINT OF THE ACTUAL PARAMETER.
29 
--   SUBTESTS ARE:
30 
--        (A) RECORD TYPE.
31 
--        (B) PRIVATE TYPE.
32 
--        (C) LIMITED PRIVATE TYPE.
33 
 
34 
-- DAS  1/15/81
35 
-- CPP  8/9/84
36 
 
37 
WITH REPORT;
38 
PROCEDURE C64106B IS
39 
 
40 
     USE REPORT;
41 
 
42 
BEGIN
43 
 
44 
     TEST ("C64106B", "CHECK ASSIGNMENT TO FORMAL PARAMETERS OF " &
45 
                      "UNCONSTRAINED TYPE (WITH NO DEFAULT)");
46 
 
47 
     --------------------------------------------------
48 
 
49 
     DECLARE  -- (A)
50 
 
51 
          PACKAGE PKG IS
52 
 
53 
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
54 
                    RECORD
55 
                         INTFIELD  : INTEGER;
56 
                         STRFIELD  : STRING (1..CONSTRAINT);
57 
                    END RECORD;
58 
 
59 
               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
60 
                                      REC6 : IN OUT RECTYPE);
61 
          END PKG;
62 
 
63 
          REC9 : PKG.RECTYPE(IDENT_INT(9))    :=
64 
                 (IDENT_INT(9), 9, "123456789");
65 
          REC6 : PKG.RECTYPE(IDENT_INT(6))    :=
66 
                 (IDENT_INT(6), 5, "AEIOUY");
67 
 
68 
          PACKAGE BODY PKG IS
69 
 
70 
               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
71 
                                      REC6 : IN OUT RECTYPE) IS
72 
 
73 
                    REC4 : CONSTANT RECTYPE(IDENT_INT(4)) :=
74 
                           (IDENT_INT(4), 4, "OOPS");
75 
 
76 
               BEGIN
77 
                    BEGIN  -- (A.1)
78 
                         REC9 := REC6;
79 
                         FAILED ("CONSTRAINT_ERROR NOT RAISED - A.1");
80 
                    EXCEPTION
81 
                         WHEN CONSTRAINT_ERROR =>
82 
                              NULL;
83 
                         WHEN OTHERS =>
84 
                              FAILED ("WRONG EXCEPTION RAISED - A.1");
85 
                    END;   -- (A.1)
86 
 
87 
                    BEGIN  -- (A.2)
88 
                         REC6 := REC4;
89 
                         FAILED ("CONSTRAINT_ERROR NOT RAISED - A.2");
90 
                    EXCEPTION
91 
                         WHEN CONSTRAINT_ERROR =>
92 
                              NULL;
93 
                         WHEN OTHERS =>
94 
                              FAILED ("WRONG EXCEPTION RAISED - A.2");
95 
                    END;   -- (A.2)
96 
 
97 
                    REC9 := (IDENT_INT(9), 9, "987654321");
98 
 
99 
               END CHK_RECTYPE;
100 
          END PKG;
101 
 
102 
     BEGIN  -- (A)
103 
 
104 
          PKG.CHK_RECTYPE (REC9, REC6);
105 
          IF REC9.STRFIELD /= IDENT_STR("987654321") THEN
106 
               FAILED ("ASSIGNMENT TO REC9 FAILED - (A)");
107 
          END IF;
108 
 
109 
     END;   -- (A)
110 
 
111 
     --------------------------------------------------
112 
 
113 
     DECLARE  -- (B)
114 
 
115 
          PACKAGE PKG IS
116 
 
117 
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS PRIVATE;
118 
 
119 
               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
120 
                                      REC6 : IN OUT RECTYPE);
121 
          PRIVATE
122 
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
123 
                    RECORD
124 
                         INTFIELD  : INTEGER;
125 
                         STRFIELD  : STRING (1..CONSTRAINT);
126 
                    END RECORD;
127 
          END PKG;
128 
 
129 
          REC9 : PKG.RECTYPE(9);
130 
          REC6 : PKG.RECTYPE(6);
131 
 
132 
          PACKAGE BODY PKG IS
133 
 
134 
               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
135 
                                      REC6 : IN OUT RECTYPE) IS
136 
 
137 
                    REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS");
138 
 
139 
               BEGIN
140 
                    BEGIN  -- (B.1)
141 
                         REC9 := REC6;
142 
                         FAILED ("CONSTRAINT_ERROR NOT RAISED - B.1");
143 
                    EXCEPTION
144 
                         WHEN CONSTRAINT_ERROR =>
145 
                              NULL;
146 
                         WHEN OTHERS =>
147 
                              FAILED ("WRONG EXCEPTION RAISED - B.1");
148 
                    END;   -- (B.1)
149 
 
150 
                    BEGIN  -- (B.2)
151 
                         REC6 := REC4;
152 
                         FAILED ("CONSTRAINT_ERROR NOT RAISED - B.2");
153 
                    EXCEPTION
154 
                         WHEN CONSTRAINT_ERROR =>
155 
                              NULL;
156 
                         WHEN OTHERS =>
157 
                              FAILED ("WRONG EXCEPTION RAISED - B.2");
158 
                    END;   -- (B.2)
159 
               END CHK_RECTYPE;
160 
 
161 
          BEGIN
162 
               REC9 := (9, 9, "123456789");
163 
               REC6 := (6, 5, "AEIOUY");
164 
          END PKG;
165 
 
166 
     BEGIN  -- (B)
167 
 
168 
          PKG.CHK_RECTYPE (REC9, REC6);
169 
 
170 
     END;   -- (B)
171 
 
172 
     --------------------------------------------------
173 
 
174 
     DECLARE  -- (C)
175 
 
176 
          PACKAGE PKG IS
177 
 
178 
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS LIMITED PRIVATE;
179 
 
180 
               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
181 
                                      REC6 : IN OUT RECTYPE);
182 
          PRIVATE
183 
               TYPE RECTYPE (CONSTRAINT : INTEGER) IS
184 
                    RECORD
185 
                         INTFIELD  : INTEGER;
186 
                         STRFIELD  : STRING (1..CONSTRAINT);
187 
                    END RECORD;
188 
          END PKG;
189 
 
190 
          REC6 : PKG.RECTYPE(IDENT_INT(6));
191 
          REC9 : PKG.RECTYPE(IDENT_INT(9));
192 
 
193 
          PACKAGE BODY PKG IS
194 
 
195 
               PROCEDURE CHK_RECTYPE (REC9 : OUT RECTYPE;
196 
                                      REC6 : IN OUT RECTYPE) IS
197 
 
198 
                    REC4 : CONSTANT RECTYPE(4)  := (4, 4, "OOPS");
199 
 
200 
               BEGIN
201 
                    BEGIN  -- (C.1)
202 
                         REC9 := REC6;
203 
                         FAILED ("CONSTRAINT_ERROR NOT RAISED - C.1");
204 
                    EXCEPTION
205 
                         WHEN CONSTRAINT_ERROR =>
206 
                              NULL;
207 
                         WHEN OTHERS =>
208 
                              FAILED ("WRONG EXCEPTION RAISED - C.1");
209 
                    END;   -- (C.1)
210 
 
211 
                    BEGIN  -- (C.2)
212 
                         REC6 := REC4;
213 
                         FAILED ("CONSTRAINT_ERROR NOT RAISED - C.2");
214 
                    EXCEPTION
215 
                         WHEN CONSTRAINT_ERROR =>
216 
                              NULL;
217 
                         WHEN OTHERS =>
218 
                              FAILED ("WRONG EXCEPTION RAISED - C.2");
219 
                    END;   -- (C.2)
220 
               END CHK_RECTYPE;
221 
 
222 
          BEGIN
223 
               REC6 := (6, 5, "AEIOUY");
224 
               REC9 := (9, 9, "123456789");
225 
          END PKG;
226 
 
227 
     BEGIN  -- (C)
228 
 
229 
          PKG.CHK_RECTYPE (REC9, REC6);
230 
 
231 
     END;   -- (C)
232 
 
233 
     --------------------------------------------------
234 
 
235 
     RESULT;
236 
 
237 
END C64106B;

powered by: WebSVN 2.1.0

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