Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c940011.a @ 111:04ced10e8804
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 -- C940011.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, in the body of a protected object created by the execution | |
28 -- of an allocator, external calls to other protected objects via | |
29 -- the access type are correctly performed | |
30 -- | |
31 -- TEST DESCRIPTION: | |
32 -- Use a subset of the simulation of the freeway on-ramp described in | |
33 -- c940005. In this case an array of access types is built with pointers | |
34 -- to successive ramps. The external calls within the protected | |
35 -- objects are made via the index into the array. Routines which refer | |
36 -- to the "previous" ramp and the "next" ramp are exercised. (Note: The | |
37 -- first and last ramps are assumed to be dummies and no first/last | |
38 -- condition code is included) | |
39 -- | |
40 -- | |
41 -- CHANGE HISTORY: | |
42 -- 06 Dec 94 SAIC ACVC 2.0 | |
43 -- | |
44 --! | |
45 | |
46 | |
47 with Report; | |
48 | |
49 | |
50 procedure C940011 is | |
51 | |
52 type Ramp; | |
53 type acc_Ramp is access Ramp; | |
54 | |
55 subtype Ramp_Index is integer range 1..4; | |
56 | |
57 | |
58 -- Weighted load given to each potential problem area and accumulated | |
59 type Load_Factor is range 0..8; | |
60 Clear_Level : constant Load_Factor := 0; | |
61 Moderate_Level : constant Load_Factor := 3; | |
62 | |
63 --================================================================ | |
64 -- Only the Routines that are used in this test are shown | |
65 -- | |
66 protected type Ramp is | |
67 | |
68 procedure Set_Index (Index : Ramp_Index); | |
69 procedure Set_Local_Overload (Sensor_Level : Load_Factor); | |
70 function Local_Overload return Load_Factor; | |
71 procedure Notify; | |
72 function Next_Ramp_Overload return Load_Factor; | |
73 | |
74 private | |
75 | |
76 This_Ramp : Ramp_Index; | |
77 | |
78 Next_Ramp_Alert : Boolean := false; -- Next Ramp is in trouble? | |
79 | |
80 -- Current state of the various Sample Points | |
81 Local_State : Load_Factor := Clear_Level; | |
82 | |
83 end Ramp; | |
84 --================================================================ | |
85 | |
86 -- Build a set of Ramp objects and an array of pointers to them | |
87 -- | |
88 Ramp_Array : array (Ramp_Index) of acc_Ramp := (Ramp_Index => new Ramp); | |
89 | |
90 --================================================================ | |
91 protected body Ramp is | |
92 | |
93 procedure Set_Index (Index : Ramp_Index) is | |
94 begin | |
95 This_Ramp := Index; | |
96 end Set_Index; | |
97 | |
98 -- These Set/Clear routines are triggered by real-time sensors that | |
99 -- reflect traffic state | |
100 procedure Set_Local_Overload(Sensor_Level : Load_Factor) is | |
101 begin | |
102 if Local_State = Clear_Level then | |
103 -- Notify "previous" ramp to check this one for current state. | |
104 -- Subsequent changes in state will not send an alert | |
105 -- When the situation clears another routine performs the | |
106 -- all_clear notification. (not shown) | |
107 -- EXTERNAL CALL OF PROCEDURE FROM PROCEDURE | |
108 Ramp_Array(This_Ramp - 1).Notify; -- index to previous ramp | |
109 end if; | |
110 Local_State := Sensor_Level; | |
111 null; --::::: Start local meter if not already started | |
112 end Set_Local_Overload; | |
113 | |
114 function Local_Overload return Load_Factor is | |
115 begin | |
116 return Local_State; | |
117 end Local_Overload; | |
118 | |
119 -- This is notification from the next ramp that it is in | |
120 -- overload. With this provision we only need to sample the next | |
121 -- ramp during adverse conditions. | |
122 procedure Notify is | |
123 begin | |
124 Next_Ramp_Alert := true; | |
125 end Notify; | |
126 | |
127 function Next_Ramp_Overload return Load_Factor is | |
128 begin | |
129 if Next_Ramp_Alert then | |
130 -- EXTERNAL FUNCTION CALL FROM FUNCTION | |
131 -- Get next ramp's current state | |
132 return Ramp_Array(This_Ramp + 1).Local_Overload; | |
133 else | |
134 return Clear_Level; | |
135 end if; | |
136 end Next_Ramp_Overload; | |
137 end Ramp; | |
138 | |
139 --================================================================ | |
140 | |
141 | |
142 begin | |
143 | |
144 | |
145 Report.Test ("C940011", "Protected Objects created by allocators: " & | |
146 "external calls via access types"); | |
147 | |
148 -- Initialize each Ramp | |
149 for i in Ramp_Index loop | |
150 Ramp_Array(i).Set_Index (i); | |
151 end loop; | |
152 | |
153 -- Test driver. This is ALL test control code | |
154 | |
155 -- Simulate calls to the protected functions and procedures | |
156 -- external calls. (do not call the "dummy" end ramps) | |
157 | |
158 -- Simple Call | |
159 if Ramp_Array(2).Next_Ramp_Overload /= Clear_level then | |
160 Report.Failed ("Primary call incorrect"); | |
161 end if; | |
162 | |
163 -- Call which results in an external procedure call via the array | |
164 -- index from within the protected object | |
165 Ramp_Array(3).Set_Local_Overload (Moderate_Level); | |
166 | |
167 -- Call which results in an external function call via the array | |
168 -- index from within the protected object | |
169 if Ramp_Array(2).Next_Ramp_Overload /= Moderate_level then | |
170 Report.Failed ("Secondary call incorrect"); | |
171 end if; | |
172 | |
173 Report.Result; | |
174 | |
175 end C940011; |