Mercurial > hg > CbC > CbC_gcc

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C940006.A
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 --
26 -- OBJECTIVE:
27 -- Check that the body of a protected function can have external calls
28 -- to other protected functions and that the body of a protected
29 -- procedure can have external calls to protected procedures and to
30 -- protected functions.
31 --
32 -- TEST DESCRIPTION:
33 -- Use a subset of the simulation of the freeway on-ramp described in
34 -- c940005. In this case two protected objects are used but only a
35 -- minimum of routines are shown in each. Both objects are hard coded
36 -- and detail two adjacent on-ramps (Ramp_31 & Ramp_32) with routines in
37 -- each which use external calls to the other.
38
39 --
40 --
41 -- CHANGE HISTORY:
42 -- 06 Dec 94 SAIC ACVC 2.0
43 --
44 --!
45
46 with Report;
47
48 procedure C940006 is
49
50 begin
51
52 Report.Test ("C940006", "Check external calls of protected functions" &
53 " and procedures");
54
55 declare -- encapsulate the test
56
57 -- Weighted load given to each potential problem area and accumulated
58 type Load_Factor is range 0..8;
59 --
60 Clear_Level : constant Load_Factor := 0;
61 Minimum_Level : constant Load_Factor := 1;
62 Moderate_Level : constant Load_Factor := 3;
63 Serious_Level : constant Load_Factor := 4;
64 Critical_Level : constant Load_Factor := 6;
65
66 --================================================================
67 -- Only the Routines that are used in this test are shown
68 --
69 protected Ramp_31 is
70
71 function Local_Overload return Load_Factor;
72 procedure Set_Local_Overload(Sensor_Level : Load_Factor);
73 procedure Notify;
74 function Next_Ramp_Overload return Load_Factor;
75 function Freeway_Overload return Load_Factor;
76 procedure Downstream_Ramps;
77 function Get_DSR_Accumulate return Load_Factor;
78
79 private
80 Next_Ramp_Alert : Boolean := false; -- Next Ramp is in trouble?
81
82 -- Current state of the various Sample Points
83 Local_State : Load_Factor := Clear_Level;
84 -- Accumulated load for next three downstream ramps
85 DSR_Accumulate : Load_Factor := Clear_Level;
86
87 end Ramp_31;
88 --================================================================
89 -- Only the Routines that are used in this test are shown
90 --
91 protected Ramp_32 is
92
93 function Local_Overload return Load_Factor;
94 procedure Set_Local_Overload (Sensor_Level : Load_Factor);
95
96 private
97
98 Local_State : Load_Factor := Clear_Level;
99
100 end Ramp_32;
101 --================================================================
102 protected body Ramp_31 is
103
104 -- These Set/Clear routines are triggered by real-time sensors that
105 -- reflect traffic state
106 procedure Set_Local_Overload (Sensor_Level : Load_Factor) is
107 begin
108 -- Notify "previous" ramp to check this one for current state.
109 -- Subsequent changes in state will not send an alert
110 null; --::::: (see Ramp_32 for this code)
111 Local_State := Sensor_Level;
112 null; --::::: Start local meter if not already started
113 end Set_Local_Overload;
114
115 function Local_Overload return Load_Factor is
116 begin
117 return Local_State;
118 end Local_Overload;
119
120 -- This is notification from the next ramp that it is in
121 -- overload. With this provision we only need to sample the next
122 -- ramp during adverse conditions.
123 procedure Notify is
124 begin
125 Next_Ramp_Alert := true;
126 end Notify;
127
128 function Next_Ramp_Overload return Load_Factor is
129 begin
130 if Next_Ramp_Alert then
131 -- EXTERNAL FUNCTION CALL FROM FUNCTION
132 -- Get next ramp's current state
133 return Ramp_32.Local_Overload;
134 else
135 return Clear_Level;
136 end if;
137 end Next_Ramp_Overload;
138
139 -- return the summation of all the load factors
140 function Freeway_Overload return Load_Factor is
141 begin
142 return Local_Overload
143 -- + :::: others
144 + Next_Ramp_Overload;
145 end Freeway_Overload;
146
147 -- Snapshot the states of the next three downstream ramps
148 procedure Downstream_Ramps is
149 begin
150 DSR_Accumulate := Ramp_32.Local_Overload; -- EXTERNAL FUNCTION
151 -- :::: + Ramp_33.Local_Overload -- FROM PROCEDURE
152 -- :::: + Ramp_34.Local_Overload
153 end Downstream_Ramps;
154
155 -- Get last snapshot
156 function Get_DSR_Accumulate return Load_Factor is
157 begin
158 return DSR_Accumulate;
159 end Get_DSR_Accumulate;
160
161 end Ramp_31;
162 --================================================================
163 protected body Ramp_32 is
164
165 function Local_Overload return Load_Factor is
166 begin
167 return Local_State;
168 end;
169
170
171 -- These Set/Clear routines are triggered by real-time sensors that
172 -- reflect traffic state
173 procedure Set_Local_Overload(Sensor_Level : Load_Factor) is
174 begin
175 if Local_State = Clear_Level then
176 -- Notify "previous" ramp to check this one for current state.
177 -- Subsequent changes in state will not send an alert
178 -- When the situation clears another routine performs the
179 -- all_clear notification. (not shown)
180 -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE
181 Ramp_31.Notify;
182 end if;
183 Local_State := Sensor_Level;
184 null; --::::: Start local meter if not already started
185 end;
186
187 end Ramp_32;
188 --================================================================
189
190
191
192 begin -- declare
193
194 -- Test driver. This is ALL test control code
195 -- Simulate calls to the protected functions and procedures
196 -- from without the protected object, these will, in turn make the
197 -- external calls.
198
199 -- Check initial conditions, exercising the simple calls
200 if not (Ramp_31.Local_Overload = Clear_Level and
201 Ramp_31.Next_Ramp_Overload = Clear_Level and
202 Ramp_31.Freeway_Overload = Clear_Level) and
203 Ramp_32.Local_Overload = Clear_Level then
204 Report.Failed ("Initial Calls provided unexpected Results");
205 end if;
206
207 -- Simulate real-time sensors reporting overloads at a hardware level
208 Ramp_31.Set_Local_Overload (1);
209 Ramp_32.Set_Local_Overload (3);
210
211 Ramp_31.Downstream_Ramps; -- take the current snapshot
212
213 if not (Ramp_31.Local_Overload = Minimum_Level and
214 Ramp_31.Get_DSR_Accumulate = Moderate_Level and
215 Ramp_31.Freeway_Overload = Serious_Level) then
216 Report.Failed ("Secondary Calls provided unexpected Results");
217 end if;
218
219 end; -- declare
220
221 Report.Result;
222
223 end C940006;