annotate gcc/testsuite/ada/acats/tests/c9/c940006.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- C940006.A
kono
parents:
diff changeset
2 --
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 --
kono
parents:
diff changeset
26 -- OBJECTIVE:
kono
parents:
diff changeset
27 -- Check that the body of a protected function can have external calls
kono
parents:
diff changeset
28 -- to other protected functions and that the body of a protected
kono
parents:
diff changeset
29 -- procedure can have external calls to protected procedures and to
kono
parents:
diff changeset
30 -- protected functions.
kono
parents:
diff changeset
31 --
kono
parents:
diff changeset
32 -- TEST DESCRIPTION:
kono
parents:
diff changeset
33 -- Use a subset of the simulation of the freeway on-ramp described in
kono
parents:
diff changeset
34 -- c940005. In this case two protected objects are used but only a
kono
parents:
diff changeset
35 -- minimum of routines are shown in each. Both objects are hard coded
kono
parents:
diff changeset
36 -- and detail two adjacent on-ramps (Ramp_31 & Ramp_32) with routines in
kono
parents:
diff changeset
37 -- each which use external calls to the other.
kono
parents:
diff changeset
38
kono
parents:
diff changeset
39 --
kono
parents:
diff changeset
40 --
kono
parents:
diff changeset
41 -- CHANGE HISTORY:
kono
parents:
diff changeset
42 -- 06 Dec 94 SAIC ACVC 2.0
kono
parents:
diff changeset
43 --
kono
parents:
diff changeset
44 --!
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 with Report;
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 procedure C940006 is
kono
parents:
diff changeset
49
kono
parents:
diff changeset
50 begin
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 Report.Test ("C940006", "Check external calls of protected functions" &
kono
parents:
diff changeset
53 " and procedures");
kono
parents:
diff changeset
54
kono
parents:
diff changeset
55 declare -- encapsulate the test
kono
parents:
diff changeset
56
kono
parents:
diff changeset
57 -- Weighted load given to each potential problem area and accumulated
kono
parents:
diff changeset
58 type Load_Factor is range 0..8;
kono
parents:
diff changeset
59 --
kono
parents:
diff changeset
60 Clear_Level : constant Load_Factor := 0;
kono
parents:
diff changeset
61 Minimum_Level : constant Load_Factor := 1;
kono
parents:
diff changeset
62 Moderate_Level : constant Load_Factor := 3;
kono
parents:
diff changeset
63 Serious_Level : constant Load_Factor := 4;
kono
parents:
diff changeset
64 Critical_Level : constant Load_Factor := 6;
kono
parents:
diff changeset
65
kono
parents:
diff changeset
66 --================================================================
kono
parents:
diff changeset
67 -- Only the Routines that are used in this test are shown
kono
parents:
diff changeset
68 --
kono
parents:
diff changeset
69 protected Ramp_31 is
kono
parents:
diff changeset
70
kono
parents:
diff changeset
71 function Local_Overload return Load_Factor;
kono
parents:
diff changeset
72 procedure Set_Local_Overload(Sensor_Level : Load_Factor);
kono
parents:
diff changeset
73 procedure Notify;
kono
parents:
diff changeset
74 function Next_Ramp_Overload return Load_Factor;
kono
parents:
diff changeset
75 function Freeway_Overload return Load_Factor;
kono
parents:
diff changeset
76 procedure Downstream_Ramps;
kono
parents:
diff changeset
77 function Get_DSR_Accumulate return Load_Factor;
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 private
kono
parents:
diff changeset
80 Next_Ramp_Alert : Boolean := false; -- Next Ramp is in trouble?
kono
parents:
diff changeset
81
kono
parents:
diff changeset
82 -- Current state of the various Sample Points
kono
parents:
diff changeset
83 Local_State : Load_Factor := Clear_Level;
kono
parents:
diff changeset
84 -- Accumulated load for next three downstream ramps
kono
parents:
diff changeset
85 DSR_Accumulate : Load_Factor := Clear_Level;
kono
parents:
diff changeset
86
kono
parents:
diff changeset
87 end Ramp_31;
kono
parents:
diff changeset
88 --================================================================
kono
parents:
diff changeset
89 -- Only the Routines that are used in this test are shown
kono
parents:
diff changeset
90 --
kono
parents:
diff changeset
91 protected Ramp_32 is
kono
parents:
diff changeset
92
kono
parents:
diff changeset
93 function Local_Overload return Load_Factor;
kono
parents:
diff changeset
94 procedure Set_Local_Overload (Sensor_Level : Load_Factor);
kono
parents:
diff changeset
95
kono
parents:
diff changeset
96 private
kono
parents:
diff changeset
97
kono
parents:
diff changeset
98 Local_State : Load_Factor := Clear_Level;
kono
parents:
diff changeset
99
kono
parents:
diff changeset
100 end Ramp_32;
kono
parents:
diff changeset
101 --================================================================
kono
parents:
diff changeset
102 protected body Ramp_31 is
kono
parents:
diff changeset
103
kono
parents:
diff changeset
104 -- These Set/Clear routines are triggered by real-time sensors that
kono
parents:
diff changeset
105 -- reflect traffic state
kono
parents:
diff changeset
106 procedure Set_Local_Overload (Sensor_Level : Load_Factor) is
kono
parents:
diff changeset
107 begin
kono
parents:
diff changeset
108 -- Notify "previous" ramp to check this one for current state.
kono
parents:
diff changeset
109 -- Subsequent changes in state will not send an alert
kono
parents:
diff changeset
110 null; --::::: (see Ramp_32 for this code)
kono
parents:
diff changeset
111 Local_State := Sensor_Level;
kono
parents:
diff changeset
112 null; --::::: Start local meter if not already started
kono
parents:
diff changeset
113 end Set_Local_Overload;
kono
parents:
diff changeset
114
kono
parents:
diff changeset
115 function Local_Overload return Load_Factor is
kono
parents:
diff changeset
116 begin
kono
parents:
diff changeset
117 return Local_State;
kono
parents:
diff changeset
118 end Local_Overload;
kono
parents:
diff changeset
119
kono
parents:
diff changeset
120 -- This is notification from the next ramp that it is in
kono
parents:
diff changeset
121 -- overload. With this provision we only need to sample the next
kono
parents:
diff changeset
122 -- ramp during adverse conditions.
kono
parents:
diff changeset
123 procedure Notify is
kono
parents:
diff changeset
124 begin
kono
parents:
diff changeset
125 Next_Ramp_Alert := true;
kono
parents:
diff changeset
126 end Notify;
kono
parents:
diff changeset
127
kono
parents:
diff changeset
128 function Next_Ramp_Overload return Load_Factor is
kono
parents:
diff changeset
129 begin
kono
parents:
diff changeset
130 if Next_Ramp_Alert then
kono
parents:
diff changeset
131 -- EXTERNAL FUNCTION CALL FROM FUNCTION
kono
parents:
diff changeset
132 -- Get next ramp's current state
kono
parents:
diff changeset
133 return Ramp_32.Local_Overload;
kono
parents:
diff changeset
134 else
kono
parents:
diff changeset
135 return Clear_Level;
kono
parents:
diff changeset
136 end if;
kono
parents:
diff changeset
137 end Next_Ramp_Overload;
kono
parents:
diff changeset
138
kono
parents:
diff changeset
139 -- return the summation of all the load factors
kono
parents:
diff changeset
140 function Freeway_Overload return Load_Factor is
kono
parents:
diff changeset
141 begin
kono
parents:
diff changeset
142 return Local_Overload
kono
parents:
diff changeset
143 -- + :::: others
kono
parents:
diff changeset
144 + Next_Ramp_Overload;
kono
parents:
diff changeset
145 end Freeway_Overload;
kono
parents:
diff changeset
146
kono
parents:
diff changeset
147 -- Snapshot the states of the next three downstream ramps
kono
parents:
diff changeset
148 procedure Downstream_Ramps is
kono
parents:
diff changeset
149 begin
kono
parents:
diff changeset
150 DSR_Accumulate := Ramp_32.Local_Overload; -- EXTERNAL FUNCTION
kono
parents:
diff changeset
151 -- :::: + Ramp_33.Local_Overload -- FROM PROCEDURE
kono
parents:
diff changeset
152 -- :::: + Ramp_34.Local_Overload
kono
parents:
diff changeset
153 end Downstream_Ramps;
kono
parents:
diff changeset
154
kono
parents:
diff changeset
155 -- Get last snapshot
kono
parents:
diff changeset
156 function Get_DSR_Accumulate return Load_Factor is
kono
parents:
diff changeset
157 begin
kono
parents:
diff changeset
158 return DSR_Accumulate;
kono
parents:
diff changeset
159 end Get_DSR_Accumulate;
kono
parents:
diff changeset
160
kono
parents:
diff changeset
161 end Ramp_31;
kono
parents:
diff changeset
162 --================================================================
kono
parents:
diff changeset
163 protected body Ramp_32 is
kono
parents:
diff changeset
164
kono
parents:
diff changeset
165 function Local_Overload return Load_Factor is
kono
parents:
diff changeset
166 begin
kono
parents:
diff changeset
167 return Local_State;
kono
parents:
diff changeset
168 end;
kono
parents:
diff changeset
169
kono
parents:
diff changeset
170
kono
parents:
diff changeset
171 -- These Set/Clear routines are triggered by real-time sensors that
kono
parents:
diff changeset
172 -- reflect traffic state
kono
parents:
diff changeset
173 procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
kono
parents:
diff changeset
174 begin
kono
parents:
diff changeset
175 if Local_State = Clear_Level then
kono
parents:
diff changeset
176 -- Notify "previous" ramp to check this one for current state.
kono
parents:
diff changeset
177 -- Subsequent changes in state will not send an alert
kono
parents:
diff changeset
178 -- When the situation clears another routine performs the
kono
parents:
diff changeset
179 -- all_clear notification. (not shown)
kono
parents:
diff changeset
180 -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
kono
parents:
diff changeset
181 Ramp_31.Notify;
kono
parents:
diff changeset
182 end if;
kono
parents:
diff changeset
183 Local_State := Sensor_Level;
kono
parents:
diff changeset
184 null; --::::: Start local meter if not already started
kono
parents:
diff changeset
185 end;
kono
parents:
diff changeset
186
kono
parents:
diff changeset
187 end Ramp_32;
kono
parents:
diff changeset
188 --================================================================
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190
kono
parents:
diff changeset
191
kono
parents:
diff changeset
192 begin -- declare
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 -- Test driver. This is ALL test control code
kono
parents:
diff changeset
195 -- Simulate calls to the protected functions and procedures
kono
parents:
diff changeset
196 -- from without the protected object, these will, in turn make the
kono
parents:
diff changeset
197 -- external calls.
kono
parents:
diff changeset
198
kono
parents:
diff changeset
199 -- Check initial conditions, exercising the simple calls
kono
parents:
diff changeset
200 if not (Ramp_31.Local_Overload = Clear_Level and
kono
parents:
diff changeset
201 Ramp_31.Next_Ramp_Overload = Clear_Level and
kono
parents:
diff changeset
202 Ramp_31.Freeway_Overload = Clear_Level) and
kono
parents:
diff changeset
203 Ramp_32.Local_Overload = Clear_Level then
kono
parents:
diff changeset
204 Report.Failed ("Initial Calls provided unexpected Results");
kono
parents:
diff changeset
205 end if;
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 -- Simulate real-time sensors reporting overloads at a hardware level
kono
parents:
diff changeset
208 Ramp_31.Set_Local_Overload (1);
kono
parents:
diff changeset
209 Ramp_32.Set_Local_Overload (3);
kono
parents:
diff changeset
210
kono
parents:
diff changeset
211 Ramp_31.Downstream_Ramps; -- take the current snapshot
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 if not (Ramp_31.Local_Overload = Minimum_Level and
kono
parents:
diff changeset
214 Ramp_31.Get_DSR_Accumulate = Moderate_Level and
kono
parents:
diff changeset
215 Ramp_31.Freeway_Overload = Serious_Level) then
kono
parents:
diff changeset
216 Report.Failed ("Secondary Calls provided unexpected Results");
kono
parents:
diff changeset
217 end if;
kono
parents:
diff changeset
218
kono
parents:
diff changeset
219 end; -- declare
kono
parents:
diff changeset
220
kono
parents:
diff changeset
221 Report.Result;
kono
parents:
diff changeset
222
kono
parents:
diff changeset
223 end C940006;