1-- 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
33WITH REPORT; USE REPORT;
34PROCEDURE C95072A IS
35
36BEGIN
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;
197END C95072A;
198