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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C45291A.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 MEMBERSHIP TESTS YIELD CORRECT RESULTS FOR TASK
27
--     TYPES, LIMITED PRIVATE TYPES, COMPOSITE LIMITED TYPES, AND
28
--     PRIVATE TYPES WITHOUT DISCRIMINANTS.
29
 
30
-- HISTORY:
31
--     JET 08/10/88  CREATED ORIGINAL TEST.
32
 
33
WITH REPORT; USE REPORT;
34
PROCEDURE C45291A IS
35
 
36
     TASK TYPE TASK1 IS
37
          ENTRY E;
38
     END TASK1;
39
 
40
     PACKAGE PACK IS
41
          TYPE LIM_PRIV IS LIMITED PRIVATE;
42
          TYPE LIM_COMP IS ARRAY (1..10) OF LIM_PRIV;
43
          TYPE PRIV IS PRIVATE;
44
          PROCEDURE INIT(LP : OUT LIM_PRIV;
45
                         LC : IN OUT LIM_COMP;
46
                         P  : OUT PRIV);
47
     PRIVATE
48
          TYPE LIM_PRIV IS RANGE -100..100;
49
          TYPE PRIV IS RECORD
50
               I : INTEGER;
51
          END RECORD;
52
     END PACK;
53
 
54
     SUBTYPE SUB_TASK1 IS TASK1;
55
     SUBTYPE SUB_LIM_PRIV IS PACK.LIM_PRIV;
56
     SUBTYPE SUB_LIM_COMP IS PACK.LIM_COMP;
57
     SUBTYPE SUB_PRIV IS PACK.PRIV;
58
 
59
     T1 : TASK1;
60
     LP : PACK.LIM_PRIV;
61
     LC : PACK.LIM_COMP;
62
     P  : PACK.PRIV;
63
 
64
     TASK BODY TASK1 IS
65
     BEGIN
66
          ACCEPT E DO
67
               NULL;
68
          END E;
69
     END TASK1;
70
 
71
     PACKAGE BODY PACK IS
72
          PROCEDURE INIT (LP : OUT LIM_PRIV;
73
                          LC : IN OUT LIM_COMP;
74
                          P  : OUT PRIV) IS
75
          BEGIN
76
               LP := 0;
77
               LC := (OTHERS => 0);
78
               P  := (I => 0);
79
          END INIT;
80
     END PACK;
81
 
82
BEGIN
83
     TEST ("C45291A", "CHECK THAT THE MEMBERSHIP TESTS YIELD CORRECT " &
84
                      "RESULTS FOR TASK TYPES, LIMITED PRIVATE TYPES," &
85
                      " COMPOSITE LIMITED TYPES, AND PRIVATE TYPES " &
86
                      "WITHOUT DISCRIMINANTS");
87
 
88
     PACK.INIT(LP, LC, P);
89
 
90
     IF NOT IDENT_BOOL(T1 IN TASK1) THEN
91
          FAILED ("INCORRECT VALUE OF 'T1 IN TASK1'");
92
     END IF;
93
 
94
     IF IDENT_BOOL(T1 NOT IN TASK1) THEN
95
          FAILED ("INCORRECT VALUE OF 'T1 NOT IN TASK1'");
96
     END IF;
97
 
98
     IF NOT IDENT_BOOL(LP IN PACK.LIM_PRIV) THEN
99
          FAILED ("INCORRECT VALUE OF 'LP IN LIM_PRIV'");
100
     END IF;
101
 
102
     IF IDENT_BOOL(LP NOT IN PACK.LIM_PRIV) THEN
103
          FAILED ("INCORRECT VALUE OF 'LP NOT IN LIM_PRIV'");
104
     END IF;
105
 
106
     IF NOT IDENT_BOOL(LC IN PACK.LIM_COMP) THEN
107
          FAILED ("INCORRECT VALUE OF 'LC IN LIM_COMP'");
108
     END IF;
109
 
110
     IF IDENT_BOOL(LC NOT IN PACK.LIM_COMP) THEN
111
          FAILED ("INCORRECT VALUE OF 'LC NOT IN LIM_COMP'");
112
     END IF;
113
 
114
     IF NOT IDENT_BOOL(P IN PACK.PRIV) THEN
115
          FAILED ("INCORRECT VALUE OF 'P IN PRIV'");
116
     END IF;
117
 
118
     IF IDENT_BOOL(P NOT IN PACK.PRIV) THEN
119
          FAILED ("INCORRECT VALUE OF 'P NOT IN PRIV'");
120
     END IF;
121
 
122
     IF NOT IDENT_BOOL(T1 IN SUB_TASK1) THEN
123
          FAILED ("INCORRECT VALUE OF 'T1 IN SUB_TASK1'");
124
     END IF;
125
 
126
     IF IDENT_BOOL(T1 NOT IN SUB_TASK1) THEN
127
          FAILED ("INCORRECT VALUE OF 'T1 NOT IN SUB_TASK1'");
128
     END IF;
129
 
130
     IF NOT IDENT_BOOL(LP IN SUB_LIM_PRIV) THEN
131
          FAILED ("INCORRECT VALUE OF 'LP IN SUB_LIM_PRIV'");
132
     END IF;
133
 
134
     IF IDENT_BOOL(LP NOT IN SUB_LIM_PRIV) THEN
135
          FAILED ("INCORRECT VALUE OF 'LP NOT IN SUB_LIM_PRIV'");
136
     END IF;
137
 
138
     IF NOT IDENT_BOOL(LC IN SUB_LIM_COMP) THEN
139
          FAILED ("INCORRECT VALUE OF 'LC IN SUB_LIM_COMP'");
140
     END IF;
141
 
142
     IF IDENT_BOOL(LC NOT IN SUB_LIM_COMP) THEN
143
          FAILED ("INCORRECT VALUE OF 'LC NOT IN SUB_LIM_COMP'");
144
     END IF;
145
 
146
     IF NOT IDENT_BOOL(P IN SUB_PRIV) THEN
147
          FAILED ("INCORRECT VALUE OF 'P IN SUB_PRIV'");
148
     END IF;
149
 
150
     IF IDENT_BOOL(P NOT IN SUB_PRIV) THEN
151
          FAILED ("INCORRECT VALUE OF 'P NOT IN SUB_PRIV'");
152
     END IF;
153
 
154
     T1.E;
155
 
156
     RESULT;
157
 
158
END C45291A;

powered by: WebSVN 2.1.0

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