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

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC3016C.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 AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A
26
--  PACKAGE. CHECK THAT THE STATEMENTS IN AN INSTANTIATED GENERIC
27
--  PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE
28
--  DECLARATIONS (IN SPEC AND IN BODY).
29
 
30
-- HISTORY:
31
--         EDWARD V. BERARD, 8 AUGUST 1990
32
 
33
WITH REPORT;
34
 
35
PROCEDURE  CC3016C  IS
36
 
37
    GENERIC
38
 
39
        TYPE SOME_TYPE IS PRIVATE ;
40
        FIRST_INITIAL_VALUE  : IN SOME_TYPE ;
41
        SECOND_INITIAL_VALUE : IN SOME_TYPE ;
42
        WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
43
                               RESULT : OUT SOME_TYPE) ;
44
        WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
45
                                      RESULT : OUT SOME_TYPE) ;
46
        WITH PROCEDURE THIRD_CHANGE (FIRST  : IN SOME_TYPE ;
47
                                     RESULT : OUT SOME_TYPE) ;
48
        FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
49
        SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
50
        THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
51
        FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
52
        FIFTH_EXPECTED_RESULT     : IN SOME_TYPE ;
53
        SIXTH_EXPECTED_RESULT     : IN SOME_TYPE ;
54
 
55
    PACKAGE OUTER IS
56
 
57
        VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
58
 
59
        FUNCTION INNER_VARIABLE RETURN SOME_TYPE ;
60
 
61
        GENERIC
62
 
63
            INITIAL_VALUE : IN SOME_TYPE ;
64
            WITH PROCEDURE CHANGE (FIRST  : IN SOME_TYPE ;
65
                                   RESULT : OUT SOME_TYPE) ;
66
            WITH PROCEDURE SECOND_CHANGE (FIRST  : IN SOME_TYPE ;
67
                                          RESULT : OUT SOME_TYPE) ;
68
            FIRST_EXPECTED_RESULT     : IN SOME_TYPE ;
69
            SECOND_EXPECTED_RESULT    : IN SOME_TYPE ;
70
            THIRD_EXPECTED_RESULT     : IN SOME_TYPE ;
71
            FOURTH_EXPECTED_RESULT    : IN SOME_TYPE ;
72
 
73
        PACKAGE INNER  IS
74
            VARIABLE : SOME_TYPE := INITIAL_VALUE ;
75
        END INNER ;
76
 
77
    END OUTER ;
78
 
79
 
80
    PACKAGE BODY OUTER IS
81
 
82
        ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ;
83
 
84
        PACKAGE BODY  INNER  IS
85
            ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ;
86
        BEGIN  -- INNER
87
 
88
            CHANGE (FIRST  => VARIABLE,
89
                    RESULT => VARIABLE) ;
90
            CHANGE (FIRST  => ANOTHER_VARIABLE,
91
                    RESULT => ANOTHER_VARIABLE) ;
92
            OUTER.SECOND_CHANGE (FIRST  => OUTER.VARIABLE,
93
                                 RESULT => OUTER.VARIABLE) ;
94
            OUTER.CHANGE (FIRST  => OUTER.ANOTHER_VARIABLE,
95
                          RESULT => OUTER.ANOTHER_VARIABLE) ;
96
 
97
            IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR
98
               (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR
99
               (OUTER.VARIABLE
100
                       /= THIRD_EXPECTED_RESULT) OR
101
               (OUTER.ANOTHER_VARIABLE
102
                       /= FOURTH_EXPECTED_RESULT) THEN
103
                    REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ;
104
            END IF;
105
 
106
        END INNER ;
107
 
108
        PACKAGE NEW_INNER IS NEW INNER
109
            (INITIAL_VALUE          => SECOND_INITIAL_VALUE,
110
             CHANGE                 => CHANGE,
111
             SECOND_CHANGE          => THIRD_CHANGE,
112
             FIRST_EXPECTED_RESULT  => FIRST_EXPECTED_RESULT,
113
             SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT,
114
             THIRD_EXPECTED_RESULT  => THIRD_EXPECTED_RESULT,
115
             FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ;
116
 
117
        FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS
118
        BEGIN
119
            RETURN NEW_INNER.VARIABLE ;
120
        END INNER_VARIABLE ;
121
 
122
    BEGIN  -- OUTER
123
 
124
        SECOND_CHANGE (FIRST  => VARIABLE,
125
                       RESULT => VARIABLE) ;
126
        SECOND_CHANGE (FIRST  => ANOTHER_VARIABLE,
127
                       RESULT => ANOTHER_VARIABLE) ;
128
 
129
        IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR
130
           (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR
131
           (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN
132
            REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ;
133
        END IF;
134
 
135
    END OUTER ;
136
 
137
    PROCEDURE DOUBLE (THIS_VALUE          : IN  INTEGER;
138
                      GIVING_THIS_RESULT  : OUT INTEGER) IS
139
    BEGIN -- DOUBLE
140
        GIVING_THIS_RESULT := 2 * THIS_VALUE ;
141
    END DOUBLE ;
142
 
143
    PROCEDURE ADD_20 (TO_THIS_VALUE      : IN  INTEGER;
144
                      GIVING_THIS_RESULT : OUT INTEGER) IS
145
    BEGIN -- ADD_20
146
        GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ;
147
    END ADD_20 ;
148
 
149
    PROCEDURE TIMES_FIVE (THIS_VALUE          : IN  INTEGER;
150
                          GIVING_THIS_RESULT  : OUT INTEGER) IS
151
    BEGIN -- TIMES_FIVE
152
        GIVING_THIS_RESULT := 5 * THIS_VALUE ;
153
    END TIMES_FIVE ;
154
 
155
BEGIN -- CC3016C
156
 
157
    REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " &
158
                 "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " &
159
                 "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " &
160
                 "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ;
161
 
162
    LOCAL_BLOCK:
163
 
164
    DECLARE
165
 
166
        PACKAGE NEW_OUTER IS NEW OUTER
167
            (SOME_TYPE                 => INTEGER,
168
            FIRST_INITIAL_VALUE        => 7,
169
            SECOND_INITIAL_VALUE       => 11,
170
            CHANGE                     => DOUBLE,
171
            SECOND_CHANGE              => ADD_20,
172
            THIRD_CHANGE               => TIMES_FIVE,
173
            FIRST_EXPECTED_RESULT      => 22,
174
            SECOND_EXPECTED_RESULT     => 22,
175
            THIRD_EXPECTED_RESULT      => 27,
176
            FOURTH_EXPECTED_RESULT     => 14,
177
            FIFTH_EXPECTED_RESULT      => 47,
178
            SIXTH_EXPECTED_RESULT      => 34) ;
179
 
180
    BEGIN  -- LOCAL_BLOCK    
181
 
182
        IF (NEW_OUTER.VARIABLE /= 47) OR
183
           (NEW_OUTER.INNER_VARIABLE /= 22) THEN
184
            REPORT.FAILED("ASSIGNED VALUES INCORRECT - " &
185
                          "BODY OF MAIN PROGRAM") ;
186
        END IF;
187
 
188
    END LOCAL_BLOCK ;
189
 
190
    REPORT.RESULT;
191
 
192
END CC3016C;

powered by: WebSVN 2.1.0

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