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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC3120A.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 GENERIC IN PARAMETERS ARE ALWAYS COPIED, AND THAT
26
-- GENERIC IN OUT PARAMETERS ARE ALWAYS RENAMED.
27
 
28
-- DAT 8/10/81
29
-- SPS 10/21/82
30
 
31
WITH REPORT; USE REPORT;
32
 
33
PROCEDURE CC3120A IS
34
BEGIN
35
     TEST ("CC3120A", "GENERIC IN PARMS ARE COPIED, GENERIC IN OUT"
36
          & " PARMS ARE RENAMED");
37
 
38
     DECLARE
39
          S1, S2 : INTEGER;
40
          A1, A2, A3 : STRING (1 .. IDENT_INT (3));
41
 
42
          TYPE REC IS RECORD
43
               C1, C2 : INTEGER := 1;
44
          END RECORD;
45
 
46
          R1, R2 : REC;
47
 
48
          PACKAGE P IS
49
               TYPE PRIV IS PRIVATE;
50
               PROCEDURE SET_PRIV (P : IN OUT PRIV);
51
          PRIVATE
52
               TYPE PRIV IS NEW REC;
53
          END P;
54
          USE P;
55
 
56
          P1, P2 : PRIV;
57
          EX : EXCEPTION;
58
 
59
          GENERIC
60
               TYPE T IS PRIVATE;
61
               P1 : IN OUT T;
62
               P2 : IN T;
63
          PROCEDURE GP;
64
 
65
          B_ARR : ARRAY (1..10) OF BOOLEAN;
66
 
67
          PACKAGE BODY P IS
68
               PROCEDURE SET_PRIV (P : IN OUT PRIV) IS
69
               BEGIN
70
                    P.C1 := 3;
71
               END SET_PRIV;
72
          END P;
73
 
74
          PROCEDURE GP IS
75
          BEGIN
76
               IF P1 = P2 THEN
77
                    FAILED ("PARAMETER SCREW_UP SOMEWHERE");
78
               END IF;
79
               P1 := P2;
80
               IF P1 /= P2 THEN
81
                    FAILED ("ASSIGNMENT SCREW_UP SOMEWHERE");
82
               END IF;
83
               RAISE EX;
84
               FAILED ("RAISE STATEMENT DOESN'T WORK");
85
          END GP;
86
     BEGIN
87
          S1 := 4;
88
          S2 := 5;
89
          A1 := "XYZ";
90
          A2 := "ABC";
91
          A3 := "DEF";
92
          R1.C1 := 4;
93
          R2.C1 := 5;
94
          B_ARR := (1|3|5|7|9 => TRUE, 2|4|6|8|10 => FALSE);
95
          SET_PRIV (P2);
96
 
97
          IF S1 = S2
98
          OR A1 = A3
99
          OR R1 = R2
100
          OR P1 = P2 THEN
101
               FAILED ("WRONG ASSIGNMENT");
102
          END IF;
103
          BEGIN
104
               DECLARE
105
                    PROCEDURE PR IS NEW GP (INTEGER, S1, S2);
106
               BEGIN
107
                    S2 := S1;
108
                    PR;       -- OLD S2 ASSIGNED TO S1, SO S1 /= S2 NOW
109
                    FAILED ("EX NOT RAISED 1");
110
               EXCEPTION
111
                    WHEN EX => NULL;
112
               END;
113
 
114
               DECLARE
115
                    SUBTYPE STR_1_3 IS STRING (IDENT_INT (1)..3);
116
                    PROCEDURE PR IS NEW GP (STR_1_3, A1, A3);
117
               BEGIN
118
                    A3 := A1;
119
                    PR;
120
                    FAILED ("EX NOT RAISED 2");
121
               EXCEPTION
122
                    WHEN EX => NULL;
123
               END;
124
 
125
               DECLARE
126
                    PROCEDURE PR IS NEW GP (REC, R1, R2);
127
               BEGIN
128
                    R2 := R1;
129
                    PR;
130
                    FAILED ("EX NOT RAISED 3");
131
               EXCEPTION
132
                    WHEN EX => NULL;
133
               END;
134
 
135
               DECLARE
136
                    PROCEDURE PR IS NEW GP (PRIV, P1, P2);
137
               BEGIN
138
                    P2 := P1;
139
                    PR;
140
                    FAILED ("EX NOT RAISED 4");
141
               EXCEPTION
142
                    WHEN EX => NULL;
143
               END;
144
               DECLARE
145
                    PROCEDURE PR IS NEW GP (CHARACTER,
146
                                            A3(IDENT_INT(2)),
147
                                            A3(IDENT_INT(3)));
148
               BEGIN
149
                    A3(3) := A3(2);
150
                    PR;
151
                    FAILED ("EX NOT RAISED 5");
152
               EXCEPTION
153
                    WHEN EX => NULL;
154
               END;
155
 
156
               DECLARE
157
                    PROCEDURE PR IS NEW GP (BOOLEAN,
158
                                            B_ARR(IDENT_INT(2)),
159
                                            B_ARR(IDENT_INT(3)));
160
               BEGIN
161
                    B_ARR(3) := B_ARR(2);
162
                    PR;
163
                    FAILED ("EX NOT RAISED 6");
164
               EXCEPTION
165
                    WHEN EX => NULL;
166
               END;
167
          END;
168
 
169
          IF S1 = S2
170
          OR A1 = A2
171
          OR R1 = R2
172
          OR P1 = P2
173
          OR A3(2) = A3(3)
174
          OR B_ARR(2) = B_ARR(3) THEN
175
               FAILED ("ASSIGNMENT FAILED 2");
176
          END IF;
177
     END;
178
 
179
     RESULT;
180
END CC3120A;

powered by: WebSVN 2.1.0

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