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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3125b.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn 
-- CC3125B.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 FOR A GENERIC IN PARAMETER
26 
-- HAVING AN ENUMERATION TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL
27 
-- PARAMETER LIES OUTSIDE THE RANGE OF THE FORMAL PARAMETER.
28 
 
29 
-- TBN  12/15/86
30 
 
31 
WITH REPORT; USE REPORT;
32 
PROCEDURE CC3125B IS
33 
 
34 
     TYPE COLOR IS (GREEN, RED, WHITE, BLUE, ORANGE, PINK);
35 
     SUBTYPE FLAG IS COLOR RANGE RED .. BLUE;
36 
 
37 
     FUNCTION IDENT_COL (X : COLOR) RETURN COLOR IS
38 
     BEGIN
39 
          IF EQUAL (3, 3) THEN
40 
               RETURN X;
41 
          END IF;
42 
          RETURN GREEN;
43 
     END IDENT_COL;
44 
 
45 
BEGIN
46 
     TEST ("CC3125B", "CHECK THAT CONSTRAINT_ERROR IS RAISED FOR A " &
47 
                      "GENERIC IN PARAMETER HAVING AN ENUMERATION " &
48 
                      "TYPE IF AND ONLY IF THE VALUE OF THE ACTUAL " &
49 
                      "PARAMETER LIES OUTSIDE THE RANGE OF THE " &
50 
                      "FORMAL PARAMETER");
51 
     DECLARE
52 
          GENERIC
53 
               GEN_COL : IN FLAG;
54 
          PACKAGE P IS
55 
               PAC_COL : FLAG := GEN_COL;
56 
          END P;
57 
     BEGIN
58 
          BEGIN
59 
               DECLARE
60 
                    PACKAGE P1 IS NEW P(IDENT_COL(RED));
61 
               BEGIN
62 
                    IF P1.PAC_COL /= IDENT_COL(RED) THEN
63 
                         FAILED ("INCORRECT VALUE PASSED - 1");
64 
                    END IF;
65 
               END;
66 
          EXCEPTION
67 
               WHEN OTHERS =>
68 
                    FAILED ("EXCEPTION RAISED - 1");
69 
          END;
70 
 
71 
          BEGIN
72 
               DECLARE
73 
                    PACKAGE P2 IS NEW P(IDENT_COL(GREEN));
74 
               BEGIN
75 
                    FAILED ("NO EXCEPTION RAISED - 2");
76 
               END;
77 
          EXCEPTION
78 
               WHEN CONSTRAINT_ERROR =>
79 
                    NULL;
80 
               WHEN OTHERS =>
81 
                    FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
82 
          END;
83 
 
84 
          BEGIN
85 
               DECLARE
86 
                    PACKAGE P3 IS NEW P(IDENT_COL(PINK));
87 
               BEGIN
88 
                    FAILED ("NO EXCEPTION RAISED - 3");
89 
               END;
90 
          EXCEPTION
91 
               WHEN CONSTRAINT_ERROR =>
92 
                    NULL;
93 
               WHEN OTHERS =>
94 
                    FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
95 
          END;
96 
     END;
97 
     -------------------------------------------------------------------
98 
 
99 
     DECLARE
100 
          GENERIC
101 
               TYPE GEN_TYP IS (<>);
102 
               GEN_COL : IN GEN_TYP;
103 
          PACKAGE Q IS
104 
               PAC_COL : GEN_TYP := GEN_COL;
105 
          END Q;
106 
     BEGIN
107 
          BEGIN
108 
               DECLARE
109 
                    PACKAGE Q1 IS NEW Q(FLAG, IDENT_COL(BLUE));
110 
               BEGIN
111 
                    IF Q1.PAC_COL /= IDENT_COL(BLUE) THEN
112 
                         FAILED ("INCORRECT VALUE PASSED - 4");
113 
                    END IF;
114 
               END;
115 
          EXCEPTION
116 
               WHEN OTHERS =>
117 
                    FAILED ("EXCEPTION RAISED - 4");
118 
          END;
119 
 
120 
          BEGIN
121 
               DECLARE
122 
                    PACKAGE Q2 IS NEW Q(FLAG, IDENT_COL(GREEN));
123 
               BEGIN
124 
                    FAILED ("NO EXCEPTION RAISED - 5");
125 
               END;
126 
          EXCEPTION
127 
               WHEN CONSTRAINT_ERROR =>
128 
                    NULL;
129 
               WHEN OTHERS =>
130 
                    FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
131 
          END;
132 
 
133 
          BEGIN
134 
               DECLARE
135 
                    PACKAGE Q3 IS NEW Q(FLAG, IDENT_COL(PINK));
136 
               BEGIN
137 
                    FAILED ("NO EXCEPTION RAISED - 6");
138 
               END;
139 
          EXCEPTION
140 
               WHEN CONSTRAINT_ERROR =>
141 
                    NULL;
142 
               WHEN OTHERS =>
143 
                    FAILED ("UNEXPECTED EXCEPTION RAISED - 6");
144 
          END;
145 
     END;
146 
 
147 
     RESULT;
148 
END CC3125B;

powered by: WebSVN 2.1.0

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