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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C85014B.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
--     CHECK THAT THE BASE TYPE OF THE FORMAL PARAMETER AND THE RESULT
27
--     TYPE ARE USED TO DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING
28
--     RENAMED.
29
 
30
-- HISTORY:
31
--     JET 03/24/88  CREATED ORIGINAL TEST.
32
 
33
WITH REPORT; USE REPORT;
34
PROCEDURE C85014B IS
35
 
36
     TYPE INT IS NEW INTEGER;
37
     SUBTYPE SUBINT0 IS INT RANGE 0..INT'LAST;
38
     SUBTYPE SUBINT1 IS INT RANGE 1..INT'LAST;
39
 
40
     TASK TYPE T1 IS
41
          ENTRY ENTER (I1: IN OUT INTEGER);
42
          ENTRY STOP;
43
     END T1;
44
 
45
     TASK TYPE T2 IS
46
          ENTRY ENTER (I1: IN OUT INT);
47
          ENTRY STOP;
48
     END T2;
49
 
50
     TASK1 : T1;
51
     TASK2 : T2;
52
 
53
     FUNCTION F RETURN T1 IS
54
     BEGIN
55
          RETURN TASK1;
56
     END F;
57
 
58
     FUNCTION F RETURN T2 IS
59
     BEGIN
60
          RETURN TASK2;
61
     END F;
62
 
63
     PROCEDURE PROC (I1: IN OUT INTEGER) IS
64
     BEGIN
65
          I1 := I1 + 1;
66
     END PROC;
67
 
68
     PROCEDURE PROC (I1: IN OUT INT) IS
69
     BEGIN
70
          I1 := I1 + 2;
71
     END PROC;
72
 
73
     FUNCTION FUNK (I1: INTEGER) RETURN INTEGER IS
74
     BEGIN
75
          RETURN I1 + 1;
76
     END FUNK;
77
 
78
     FUNCTION FUNK (I1: INTEGER) RETURN INT IS
79
     BEGIN
80
          RETURN INT(I1) + 2;
81
     END FUNK;
82
 
83
     FUNCTION FUNKX (N : NATURAL) RETURN POSITIVE IS
84
     BEGIN
85
          RETURN N + 1;
86
     END FUNKX;
87
 
88
     FUNCTION FUNKX (N : SUBINT0) RETURN SUBINT1 IS
89
     BEGIN
90
          RETURN N + 2;
91
     END FUNKX;
92
 
93
     TASK BODY T1 IS
94
          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
95
     BEGIN
96
          WHILE ACCEPTING_ENTRIES LOOP
97
               SELECT
98
                    ACCEPT ENTER (I1 : IN OUT INTEGER) DO
99
                         I1 := I1 + 1;
100
                    END ENTER;
101
               OR
102
                    ACCEPT STOP DO
103
                         ACCEPTING_ENTRIES := FALSE;
104
                    END STOP;
105
               END SELECT;
106
          END LOOP;
107
     END T1;
108
 
109
     TASK BODY T2 IS
110
          ACCEPTING_ENTRIES : BOOLEAN := TRUE;
111
     BEGIN
112
          WHILE ACCEPTING_ENTRIES LOOP
113
               SELECT
114
                    ACCEPT ENTER (I1 : IN OUT INT) DO
115
                         I1 := I1 + 2;
116
                    END ENTER;
117
               OR
118
                    ACCEPT STOP DO
119
                         ACCEPTING_ENTRIES := FALSE;
120
                    END STOP;
121
               END SELECT;
122
          END LOOP;
123
     END T2;
124
 
125
BEGIN
126
     TEST ("C85014B", "CHECK THAT THE BASE TYPE OF THE FORMAL " &
127
                      "PARAMETER AND THE RESULT TYPE ARE USED TO " &
128
                      "DETERMINE WHICH SUBPROGRAM OR ENTRY IS BEING " &
129
                      "RENAMED");
130
 
131
     DECLARE
132
          PROCEDURE PROC1 (J1: IN OUT INTEGER) RENAMES PROC;
133
          PROCEDURE PROC2 (J1: IN OUT INT) RENAMES PROC;
134
 
135
          FUNCTION FUNK1 (J1: INTEGER) RETURN INTEGER RENAMES FUNK;
136
          FUNCTION FUNK2 (J1: INTEGER) RETURN INT RENAMES FUNK;
137
 
138
          PROCEDURE ENTRY1 (J1: IN OUT INTEGER) RENAMES F.ENTER;
139
          PROCEDURE ENTRY2 (J1: IN OUT INT) RENAMES F.ENTER;
140
 
141
          FUNCTION FUNK3 (J1: POSITIVE) RETURN NATURAL RENAMES FUNKX;
142
          FUNCTION FUNK4 (J1: SUBINT1) RETURN SUBINT0 RENAMES FUNKX;
143
 
144
          K1 : INTEGER := 0;
145
          K2 : INT := 0;
146
     BEGIN
147
          PROC1(K1);
148
          IF K1 /= IDENT_INT(1) THEN
149
               FAILED("INCORRECT RETURN VALUE FROM PROC1");
150
          END IF;
151
 
152
          K1 := FUNK1(K1);
153
          IF K1 /= IDENT_INT(2) THEN
154
               FAILED("INCORRECT RETURN VALUE FROM FUNK1");
155
          END IF;
156
 
157
          ENTRY1(K1);
158
          IF K1 /= IDENT_INT(3) THEN
159
               FAILED("INCORRECT RETURN VALUE FROM ENTRY1");
160
          END IF;
161
 
162
          K1 := FUNK3(K1);
163
          IF K1 /= IDENT_INT(4) THEN
164
               FAILED("INCORRECT RETURN VALUE FROM FUNK3");
165
          END IF;
166
 
167
          PROC2(K2);
168
          IF INTEGER(K2) /= IDENT_INT(2) THEN
169
               FAILED("INCORRECT RETURN VALUE FROM PROC2");
170
          END IF;
171
 
172
          K2 := FUNK2(INTEGER(K2));
173
          IF INTEGER(K2) /= IDENT_INT(4) THEN
174
               FAILED("INCORRECT RETURN VALUE FROM FUNK2");
175
          END IF;
176
 
177
          ENTRY2(K2);
178
          IF INTEGER(K2) /= IDENT_INT(6) THEN
179
               FAILED("INCORRECT RETURN VALUE FROM ENTRY2");
180
          END IF;
181
 
182
          K2 := FUNK4(K2);
183
          IF INTEGER(K2) /= IDENT_INT(8) THEN
184
               FAILED("INCORRECT RETURN VALUE FROM FUNK4");
185
          END IF;
186
     END;
187
 
188
     TASK1.STOP;
189
     TASK2.STOP;
190
 
191
     RESULT;
192
END C85014B;

powered by: WebSVN 2.1.0

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