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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC3106B.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 THE FORMAL PARAMETER DENOTES THE ACTUAL
26
--     IN AN INSTANTIATION.
27
 
28
-- HISTORY:
29
--     LDC 06/20/88  CREATED ORIGINAL TEST
30
--     EDWARD V. BERARD, 10 AUGUST 1990  ADDED CHECKS FOR MULTI-
31
--                                       DIMENSIONAL ARRAYS
32
 
33
WITH REPORT ;
34
 
35
PROCEDURE CC3106B IS
36
 
37
BEGIN  -- CC3106B
38
 
39
    REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &
40
                "THE ACTUAL IN AN INSTANTIATION");
41
 
42
    LOCAL_BLOCK:
43
 
44
    DECLARE
45
 
46
        SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;
47
        TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;
48
        PRAGMA PACK(PCK_BOL) ;
49
 
50
        SHORT_START : CONSTANT := -100 ;
51
        SHORT_END   : CONSTANT := 100 ;
52
        TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
53
 
54
        SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
55
 
56
        TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
57
                            SEP, OCT, NOV, DEC) ;
58
 
59
        SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
60
 
61
        TYPE DAY_TYPE IS RANGE 1 .. 31 ;
62
        TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
63
        TYPE DATE IS RECORD
64
            MONTH : MONTH_TYPE ;
65
            DAY   : DAY_TYPE ;
66
            YEAR  : YEAR_TYPE ;
67
        END RECORD ;
68
 
69
        TODAY         : DATE := (MONTH => AUG,
70
                                 DAY   => 8,
71
                                 YEAR  => 1990) ;
72
 
73
        FIRST_DATE    : DATE := (DAY   => 6,
74
                                 MONTH => JUN,
75
                                 YEAR  => 1967) ;
76
 
77
        WALL_DATE     : DATE := (MONTH => NOV,
78
                                 DAY   => 9,
79
                                 YEAR  => 1989) ;
80
 
81
        SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
82
 
83
        TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
84
                                         FIRST_HALF,
85
                                         FIRST_FIVE) OF DATE ;
86
 
87
        TD_ARRAY : THREE_DIMENSIONAL := (THREE_DIMENSIONAL'RANGE =>
88
                                        (THREE_DIMENSIONAL'RANGE (2) =>
89
                                        (THREE_DIMENSIONAL'RANGE (3) =>
90
                                          TODAY))) ;
91
 
92
        TASK TYPE TSK IS
93
            ENTRY ENT_1;
94
            ENTRY ENT_2;
95
            ENTRY ENT_3;
96
        END TSK;
97
 
98
        GENERIC
99
 
100
            TYPE GEN_TYPE IS (<>);
101
            GEN_BOLARR         : IN OUT PCK_BOL;
102
            GEN_TYP            : IN OUT GEN_TYPE;
103
            GEN_TSK            : IN OUT TSK;
104
            TEST_VALUE         : IN DATE ;
105
            TEST_CUBE          : IN OUT THREE_DIMENSIONAL ;
106
 
107
        PACKAGE P IS
108
               PROCEDURE GEN_PROC1 ;
109
               PROCEDURE GEN_PROC2 ;
110
               PROCEDURE GEN_PROC3 ;
111
               PROCEDURE ARRAY_TEST ;
112
        END P;
113
 
114
        ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);
115
        SI         : SM_INT := 0 ;
116
        T          : TSK;
117
 
118
        PACKAGE BODY P IS
119
 
120
            PROCEDURE GEN_PROC1 IS
121
            BEGIN  -- GEN_PROC1
122
                GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);
123
                GEN_TYP := GEN_TYPE'VAL(4);
124
                IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)
125
                   THEN
126
                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
127
                                  "INSTANTIATED VALUES");
128
                END IF;
129
            END GEN_PROC1;
130
 
131
            PROCEDURE GEN_PROC2 IS
132
            BEGIN  -- GEN_PROC2
133
                IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR
134
                      GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN
135
                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
136
                                  "VALUES ASSIGNED IN THE MAIN " &
137
                                  "PROCEDURE");
138
                END IF;
139
                GEN_BOLARR(18) := TRUE;
140
                GEN_TYP := GEN_TYPE'VAL(9);
141
            END GEN_PROC2;
142
 
143
            PROCEDURE GEN_PROC3 IS
144
            BEGIN  -- GEN_PROC3
145
                GEN_TSK.ENT_2;
146
            END GEN_PROC3 ;
147
 
148
            PROCEDURE ARRAY_TEST IS
149
            BEGIN  -- ARRAY_TEST
150
 
151
                TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;
152
 
153
                IF (TD_ARRAY (0, JUN, 'C')  /= TEST_VALUE) OR
154
                      (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN
155
                    REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &
156
                                   "DIFFERENT THAN THE VALUES ASSIGNED " &
157
                                   "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;
158
                END IF ;
159
 
160
            END ARRAY_TEST ;
161
 
162
        END P ;
163
 
164
        TASK BODY TSK IS
165
        BEGIN  -- TSK
166
            ACCEPT ENT_1 DO
167
                REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");
168
            END;
169
            ACCEPT ENT_2 DO
170
                REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");
171
            END;
172
            ACCEPT ENT_3 DO
173
                REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");
174
            END;
175
        END TSK;
176
 
177
        PACKAGE INSTA1 IS NEW P (GEN_TYPE       => SM_INT,
178
                                 GEN_BOLARR     => ACT_BOLARR,
179
                                 GEN_TYP        => SI,
180
                                 GEN_TSK        => T,
181
                                 TEST_VALUE     => FIRST_DATE,
182
                                 TEST_CUBE      => TD_ARRAY) ;
183
 
184
    BEGIN  -- LOCAL_BLOCK
185
 
186
        INSTA1.GEN_PROC1;
187
        ACT_BOLARR(9) := TRUE;
188
        SI := 2;
189
        INSTA1.GEN_PROC2;
190
        IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR
191
              SI /= REPORT.IDENT_INT(9) THEN
192
            REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &
193
                          "ASSIGNED IN THE GENERIC PROCEDURE");
194
        END IF;
195
 
196
        T.ENT_1;
197
        INSTA1.GEN_PROC3;
198
        T.ENT_3;
199
 
200
        TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;
201
        INSTA1.ARRAY_TEST ;
202
 
203
     END LOCAL_BLOCK;
204
 
205
     REPORT.RESULT;
206
 
207
END CC3106B ;

powered by: WebSVN 2.1.0

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