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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C95072A.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 SCALAR AND ACCESS PARAMETERS ARE COPIED FOR ALL THREE
26
-- PARAMETER MODES.
27
-- SUBTESTS ARE:
28
--   (A)  SCALAR PARAMETERS TO ENTRIES.
29
--   (B)  ACCESS PARAMETERS TO ENTRIES.
30
 
31
-- JWC 7/22/85
32
 
33
WITH REPORT; USE REPORT;
34
PROCEDURE C95072A IS
35
 
36
BEGIN
37
     TEST ("C95072A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
38
                      "COPIED");
39
 
40
     --------------------------------------------------
41
 
42
     DECLARE  -- (A)
43
 
44
          I : INTEGER;
45
          E : EXCEPTION;
46
 
47
          TASK TA IS
48
               ENTRY EA (EI : IN INTEGER; EO : OUT INTEGER;
49
                         EIO : IN OUT INTEGER);
50
          END TA;
51
 
52
          TASK BODY TA IS
53
 
54
               TMP : INTEGER;
55
 
56
          BEGIN
57
 
58
               ACCEPT EA (EI : IN INTEGER; EO : OUT INTEGER;
59
                          EIO : IN OUT INTEGER) DO
60
 
61
                    TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
62
 
63
                    EO := 10;
64
                    IF EI /= TMP THEN
65
                         FAILED ("ASSIGNMENT TO SCALAR OUT " &
66
                                 "PARAMETER CHANGES THE VALUE OF " &
67
                                 "INPUT PARAMETER");
68
                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
69
                    END IF;
70
 
71
                    EIO := EIO + 100;
72
                    IF EI /= TMP THEN
73
                         FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
74
                                 "PARAMETER CHANGES THE VALUE OF " &
75
                                 "INPUT PARAMETER");
76
                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
77
                    END IF;
78
 
79
                    I := I + 1;
80
                    IF EI /= TMP THEN
81
                         FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
82
                                 "PARAMETER CHANGES THE VALUE OF " &
83
                                 "INPUT PARAMETER");
84
                    END IF;
85
 
86
                    RAISE E;            -- CHECK EXCEPTION HANDLING.
87
               END EA;
88
 
89
          EXCEPTION
90
               WHEN OTHERS => NULL;
91
          END TA;
92
 
93
     BEGIN  -- (A)
94
 
95
          I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
96
          TA.EA (I, I, I);
97
          FAILED ("EXCEPTION NOT RAISED - A");
98
 
99
     EXCEPTION
100
          WHEN E =>
101
               IF I /= 1 THEN
102
                    CASE I IS
103
                         WHEN 11  =>
104
                              FAILED ("OUT ACTUAL SCALAR PARAMETER " &
105
                                      "CHANGED GLOBAL VALUE");
106
                         WHEN 101 =>
107
                              FAILED ("IN OUT ACTUAL SCALAR " &
108
                                      "PARAMETER CHANGED GLOBAL VALUE");
109
                         WHEN 111 =>
110
                              FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
111
                                      "PARAMETERS CHANGED GLOBAL " &
112
                                      "VALUE");
113
                         WHEN OTHERS =>
114
                              FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
115
                                      "VALUE");
116
                    END CASE;
117
               END IF;
118
          WHEN OTHERS =>
119
               FAILED ("WRONG EXCEPTION RAISED - A");
120
     END;  -- (A)
121
 
122
     --------------------------------------------------
123
 
124
     DECLARE  -- (B)
125
 
126
          TYPE ACCTYPE IS ACCESS INTEGER;
127
 
128
          I : ACCTYPE;
129
          E : EXCEPTION;
130
 
131
          TASK TB IS
132
               ENTRY EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
133
                         EIO : IN OUT ACCTYPE);
134
          END TB;
135
 
136
          TASK BODY TB IS
137
 
138
               TMP : ACCTYPE;
139
 
140
          BEGIN
141
 
142
               ACCEPT EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
143
                          EIO : IN OUT ACCTYPE) DO
144
 
145
                    TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
146
 
147
                    I := NEW INTEGER'(101);
148
                    IF EI /= TMP THEN
149
                         FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
150
                                 "PARAMETER CHANGES THE VALUE OF " &
151
                                 "INPUT PARAMETER");
152
                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
153
                    END IF;
154
 
155
                    EO := NEW INTEGER'(1);
156
                    IF EI /= TMP THEN
157
                         FAILED ("ASSIGNMENT TO ACCESS OUT " &
158
                                 "PARAMETER CHANGES THE VALUE OF " &
159
                                 "INPUT PARAMETER");
160
                         TMP := EI;     -- RESET TMP FOR NEXT CASE.
161
                    END IF;
162
 
163
                    EIO := NEW INTEGER'(10);
164
                    IF EI /= TMP THEN
165
                         FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
166
                                 "PARAMETER CHANGES THE VALUE OF " &
167
                                 "INPUT PARAMETER");
168
                    END IF;
169
 
170
                    RAISE E;            -- CHECK EXCEPTION HANDLING.
171
               END EB;
172
 
173
          EXCEPTION
174
               WHEN OTHERS => NULL;
175
          END TB;
176
 
177
     BEGIN  -- (B)
178
 
179
          I := NEW INTEGER'(100);
180
          TB.EB (I, I, I);
181
          FAILED ("EXCEPTION NOT RAISED - B");
182
 
183
     EXCEPTION
184
          WHEN E =>
185
               IF I.ALL /= 101 THEN
186
                    FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
187
                            "PARAMETER VALUE CHANGED DESPITE " &
188
                            "RAISED EXCEPTION");
189
               END IF;
190
          WHEN OTHERS =>
191
               FAILED ("WRONG EXCEPTION RAISED - B");
192
     END;  -- (B)
193
 
194
     --------------------------------------------------
195
 
196
     RESULT;
197
END C95072A;

powered by: WebSVN 2.1.0

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