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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- CC3125A.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 RAISED IF THE INITIAL VALUE OF A
26 
-- GENERIC IN PARAMETER DOES NOT SATISFY ITS SUBTYPE CONSTRAINT.
27 
 
28 
-- THIS TEST CHECKS PARAMETERS OF A NON-GENERIC TYPE.
29 
 
30 
-- DAT 8/10/81
31 
-- SPS 4/14/82
32 
 
33 
WITH REPORT; USE REPORT;
34 
 
35 
PROCEDURE CC3125A IS
36 
 
37 
BEGIN
38 
     TEST ("CC3125A","GENERIC PARAMETER DEFAULTS OF " &
39 
                     "NON-GENERIC TYPE EVALUATED AND CHECKED WHEN " &
40 
                     "DECLARATION IS INSTANTIATED AND DEFAULT USED");
41 
 
42 
     FOR I IN 1 .. 3 LOOP
43 
          COMMENT ("LOOP ITERATION");
44 
          BEGIN
45 
 
46 
               DECLARE
47 
                    SUBTYPE T IS INTEGER RANGE 1 .. IDENT_INT(1);
48 
                    SUBTYPE I_1_2 IS INTEGER RANGE
49 
                         IDENT_INT (1) .. IDENT_INT (2);
50 
 
51 
                    GENERIC
52 
                         P,Q : T := I_1_2'(I);
53 
                    PACKAGE PKG IS
54 
                         R: T := P;
55 
                    END PKG;
56 
 
57 
               BEGIN
58 
 
59 
                    BEGIN
60 
                         DECLARE
61 
                              PACKAGE P1 IS NEW PKG;
62 
                         BEGIN
63 
                              IF I = IDENT_INT(1) THEN
64 
                                   IF P1.R /= IDENT_INT(1)
65 
                                   THEN FAILED ("BAD INITIAL"&
66 
                                        " VALUE");
67 
                                   END IF;
68 
                              ELSIF I = 2 THEN
69 
                                   FAILED ("SUBTYPE NOT CHECKED AT " &
70 
                                           "INSTANTIATION");
71 
                              ELSE
72 
                                   FAILED ("DEFAULT NOT EVALUATED AT " &
73 
                                           "INSTANTIATION");
74 
                              END IF;
75 
                         EXCEPTION
76 
                              WHEN OTHERS => FAILED ("WRONG HANDLER");
77 
                         END;
78 
                    EXCEPTION
79 
                         WHEN CONSTRAINT_ERROR =>
80 
                              CASE I IS
81 
                                   WHEN 1 =>
82 
                                        FAILED ("INCORRECT EXCEPTION");
83 
                                   WHEN 2 =>
84 
                                        COMMENT ("CONSTRAINT CHECKED" &
85 
                                             " ON INSTANTIATION");
86 
                                   WHEN 3 =>
87 
                                        COMMENT ("DEFAULT EVALUATED " &
88 
                                             "ON INSTANTIATION");
89 
                              END CASE;
90 
                    END;
91 
               EXCEPTION
92 
                    WHEN OTHERS =>
93 
                         FAILED ("WRONG EXCEPTION");
94 
               END;
95 
          EXCEPTION
96 
               WHEN CONSTRAINT_ERROR =>
97 
                    CASE I IS
98 
                         WHEN 1 =>
99 
                              FAILED ("NO EXCEPTION SHOULD BE RAISED");
100 
                         WHEN 2 =>
101 
                              FAILED ("DEFAULT CHECKED AGAINST " &
102 
                                      "SUBTYPE AT DECLARATION");
103 
                         WHEN 3 =>
104 
                              FAILED ("DEFAULT EVALUATED AT " &
105 
                                      "DECLARATION");
106 
                    END CASE;
107 
          END;
108 
     END LOOP;
109 
 
110 
     RESULT;
111 
END CC3125A;

powered by: WebSVN 2.1.0

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