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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn 
-- CC3127A.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 
--     FOR A CONSTRAINED IN FORMAL PARAMETER HAVING A RECORD OR PRIVATE
27 
--     TYPE WITH DISCRIMINANTS, CHECK THAT CONSTRAINT_ERROR IS RAISED
28 
--     IF AND ONLY IF CORRESPONDING DISCRIMINANTS OF THE ACTUAL AND
29 
--     FORMAL PARAMETER DO NOT HAVE THE SAME VALUES.
30 
 
31 
-- HISTORY:
32 
--     LB   12/04/86  CREATED ORIGINAL TEST.
33 
--     VCL  08/19/87  CORRECTED THE FORMAT OF THIS HEADER.
34 
 
35 
WITH REPORT; USE REPORT;
36 
 
37 
PROCEDURE  CC3127A  IS
38 
 
39 
     TYPE INT IS RANGE 1 .. 20;
40 
 
41 
BEGIN
42 
     TEST ("CC3127A","CORRESPONDING DISCRIMINANTS OF THE GENERIC "&
43 
                     "ACTUAL PARAMETER AND THE GENERIC FORMAL "&
44 
                     "PARAMETER MUST HAVE THE SAME VALUES.");
45 
     BEGIN
46 
          DECLARE
47 
               TYPE REC (A : INT) IS
48 
                    RECORD
49 
                         RINT : POSITIVE := 2;
50 
                    END RECORD;
51 
               SUBTYPE CON_REC IS REC(4);
52 
 
53 
               GENERIC
54 
                    GREC : IN CON_REC;
55 
               PACKAGE PA IS
56 
                    NREC : CON_REC := GREC;
57 
               END PA;
58 
          BEGIN
59 
               BEGIN
60 
                    DECLARE
61 
                         RVAR : REC(3);
62 
                         PACKAGE AB IS NEW PA(RVAR);
63 
                    BEGIN
64 
                         FAILED ("EXCEPTION NOT RAISED 1");
65 
                         AB.NREC.RINT := IDENT_INT(AB.NREC.RINT);
66 
                    END;
67 
               EXCEPTION
68 
                    WHEN CONSTRAINT_ERROR =>
69 
                         NULL;
70 
                    WHEN OTHERS =>
71 
                         FAILED ("WRONG EXCEPTION RAISED 1");
72 
               END;
73 
 
74 
               BEGIN
75 
                    DECLARE
76 
                         SVAR : REC(4);
77 
                         PACKAGE CD IS NEW PA(SVAR);
78 
                    BEGIN
79 
                         IF EQUAL(3,3) THEN
80 
                              CD.NREC.RINT := IDENT_INT(CD.NREC.RINT);
81 
                         END IF;
82 
                    END;
83 
               EXCEPTION
84 
                    WHEN OTHERS =>
85 
                         FAILED ("EXCEPTION RAISED 2");
86 
               END;
87 
          END;
88 
 
89 
          DECLARE
90 
               PACKAGE EF IS
91 
                    TYPE PRI_REC (G : INT) IS PRIVATE;
92 
               PRIVATE
93 
                    TYPE PRI_REC (G : INT) IS
94 
                         RECORD
95 
                              PINT : POSITIVE := 2;
96 
                         END RECORD;
97 
               END EF;
98 
               SUBTYPE CPRI_REC IS EF.PRI_REC(4);
99 
 
100 
               GENERIC
101 
                    GEN_REC : IN CPRI_REC;
102 
               PACKAGE GH IS
103 
                    NGEN_REC : CPRI_REC := GEN_REC;
104 
               END GH;
105 
 
106 
          BEGIN
107 
               BEGIN
108 
                    DECLARE
109 
                         PVAR : EF.PRI_REC(4);
110 
                         PACKAGE LM IS NEW GH(PVAR);
111 
                    BEGIN
112 
                         IF EQUAL(3,3) THEN
113 
                              LM.NGEN_REC := LM.NGEN_REC;
114 
                         END IF;
115 
                    END;
116 
               EXCEPTION
117 
                    WHEN OTHERS =>
118 
                         FAILED ("EXCEPTION RAISED 3");
119 
               END;
120 
 
121 
               BEGIN
122 
                    DECLARE
123 
                         PTVAR : EF.PRI_REC(5);
124 
                         PACKAGE PAC IS NEW GH(PTVAR);
125 
                    BEGIN
126 
                         FAILED ("EXCEPTION NOT RAISED 4");
127 
                         IF EQUAL(3,5) THEN
128 
                            COMMENT ("DISCRIMINANT OF PAC.NGEN_REC IS "&
129 
                                       INT'IMAGE(PAC.NGEN_REC.G));
130 
                         END IF;
131 
                    END;
132 
               EXCEPTION
133 
                    WHEN CONSTRAINT_ERROR =>
134 
                         NULL;
135 
                    WHEN OTHERS =>
136 
                         FAILED ("WRONG EXCEPTION RAISED 4");
137 
               END;
138 
          END;
139 
     END;
140 
 
141 
     RESULT;
142 
 
143 
END CC3127A;

powered by: WebSVN 2.1.0

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