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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc1104c.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CC1104C.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 A GENERIC FORMAL IN OUT PARAMETER CAN HAVE A
27
--     LIMITED TYPE.
28
 
29
-- HISTORY:
30
--     BCB 08/03/88  CREATED ORIGINAL TEST.
31
 
32
WITH REPORT; USE REPORT;
33
 
34
PROCEDURE CC1104C IS
35
 
36
     TASK TYPE TSK IS
37
          ENTRY E;
38
     END TSK;
39
 
40
     VAR : INTEGER := IDENT_INT(0);
41
     NEW_VAL : INTEGER := IDENT_INT(5);
42
 
43
     TSK_VAR : TSK;
44
 
45
     PACKAGE PP IS
46
          TYPE LP IS LIMITED PRIVATE;
47
          PROCEDURE INIT (ONE : OUT LP; TWO : INTEGER);
48
          FUNCTION EQUAL (ONE : LP; TWO : INTEGER) RETURN BOOLEAN;
49
     PRIVATE
50
          TYPE LP IS RANGE 1 .. 100;
51
     END PP;
52
 
53
     USE PP;
54
 
55
     TYPE REC IS RECORD
56
          COMP : LP;
57
     END RECORD;
58
 
59
     C : LP;
60
 
61
     REC_VAR : REC;
62
 
63
     GENERIC
64
          TYPE T IS LIMITED PRIVATE;
65
          IN_OUT_VAR : IN OUT T;
66
          IN_OUT_TSK : IN OUT TSK;
67
          VAL : IN OUT T;
68
          WITH PROCEDURE INIT (L : IN OUT T; R : T);
69
     PROCEDURE P;
70
 
71
     GENERIC
72
          VAL : IN OUT LP;
73
     PROCEDURE Q;
74
 
75
     GENERIC
76
          VAL : IN OUT REC;
77
     PROCEDURE R;
78
 
79
     PACKAGE BODY PP IS
80
          PROCEDURE INIT(ONE : OUT LP; TWO : INTEGER) IS
81
          BEGIN
82
               ONE := LP(TWO);
83
          END INIT;
84
 
85
          FUNCTION EQUAL(ONE : LP; TWO : INTEGER) RETURN BOOLEAN IS
86
          BEGIN
87
               RETURN ONE = LP(TWO);
88
          END EQUAL;
89
     END PP;
90
 
91
     TASK BODY TSK IS
92
     BEGIN
93
          ACCEPT E;
94
     END TSK;
95
 
96
     PROCEDURE P IS
97
     BEGIN
98
          INIT(IN_OUT_VAR,VAL);
99
          IN_OUT_TSK.E;
100
          INIT(C,50);
101
     END P;
102
 
103
     PROCEDURE Q IS
104
     BEGIN
105
          INIT(VAL,75);
106
          INIT(REC_VAR.COMP,50);
107
     END Q;
108
 
109
     PROCEDURE R IS
110
     BEGIN
111
          INIT(VAL.COMP,75);
112
     END R;
113
 
114
     PROCEDURE I (ONE : IN OUT INTEGER; TWO : INTEGER) IS
115
     BEGIN
116
          ONE := TWO;
117
     END I;
118
 
119
     PROCEDURE NEW_P IS NEW P(INTEGER,VAR,TSK_VAR,NEW_VAL,I);
120
 
121
     PROCEDURE NEW_Q IS NEW Q(C);
122
 
123
     PROCEDURE NEW_R IS NEW R(REC_VAR);
124
 
125
BEGIN
126
     TEST ("CC1104C", "CHECK THAT A GENERIC FORMAL IN OUT PARAMETER " &
127
                      "CAN HAVE A LIMITED TYPE");
128
 
129
     NEW_P;
130
 
131
     IF NOT EQUAL(VAR,5) THEN
132
          FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
133
                  "GENERIC PACKAGE - 1");
134
     END IF;
135
 
136
     NEW_Q;
137
 
138
     IF NOT EQUAL(C,75) THEN
139
          FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
140
                  "GENERIC PACKAGE - 2");
141
     END IF;
142
 
143
     NEW_R;
144
 
145
     IF NOT EQUAL(REC_VAR.COMP,75) THEN
146
          FAILED ("WRONG VALUE ASSIGNED TO IN OUT PARAMETER IN " &
147
                  "GENERIC PACKAGE - 3");
148
     END IF;
149
 
150
     RESULT;
151
END CC1104C;

powered by: WebSVN 2.1.0

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