annotate gcc/testsuite/ada/acats/tests/c9/c951001.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 -- C951001.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 two procedures in a protected object will not be
kono
parents:
diff changeset
28 -- executed concurrently.
kono
parents:
diff changeset
29 --
kono
parents:
diff changeset
30 -- TEST DESCRIPTION:
kono
parents:
diff changeset
31 -- A very simple example of two tasks calling two procedures in the same
kono
parents:
diff changeset
32 -- protected object is used. Test control code has been added to the
kono
parents:
diff changeset
33 -- procedures such that, whichever gets called first executes a lengthy
kono
parents:
diff changeset
34 -- calculation giving sufficient time (on a multiprocessor or a
kono
parents:
diff changeset
35 -- time-slicing machine) for the other task to get control and call the
kono
parents:
diff changeset
36 -- other procedure. The control code verifies that entry to the second
kono
parents:
diff changeset
37 -- routine is postponed until the first is complete.
kono
parents:
diff changeset
38 --
kono
parents:
diff changeset
39 --
kono
parents:
diff changeset
40 -- CHANGE HISTORY:
kono
parents:
diff changeset
41 -- 06 Dec 94 SAIC ACVC 2.0
kono
parents:
diff changeset
42 --
kono
parents:
diff changeset
43 --!
kono
parents:
diff changeset
44
kono
parents:
diff changeset
45 with Report;
kono
parents:
diff changeset
46 with ImpDef;
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 procedure C951001 is
kono
parents:
diff changeset
49
kono
parents:
diff changeset
50 protected Ramp_31 is
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 procedure Add_Meter_Queue;
kono
parents:
diff changeset
53 procedure Subtract_Meter_Queue;
kono
parents:
diff changeset
54 function TC_Failed return Boolean;
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 private
kono
parents:
diff changeset
57
kono
parents:
diff changeset
58 Ramp_Count : integer range 0..20 := 4; -- Start test with some
kono
parents:
diff changeset
59 -- vehicles on the ramp
kono
parents:
diff changeset
60
kono
parents:
diff changeset
61 TC_Add_Started : Boolean := false;
kono
parents:
diff changeset
62 TC_Subtract_Started : Boolean := false;
kono
parents:
diff changeset
63 TC_Add_Finished : Boolean := false;
kono
parents:
diff changeset
64 TC_Subtract_Finished : Boolean := false;
kono
parents:
diff changeset
65 TC_Concurrent_Running: Boolean := false;
kono
parents:
diff changeset
66
kono
parents:
diff changeset
67 end Ramp_31;
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69
kono
parents:
diff changeset
70 protected body Ramp_31 is
kono
parents:
diff changeset
71
kono
parents:
diff changeset
72 function TC_Failed return Boolean is
kono
parents:
diff changeset
73 begin
kono
parents:
diff changeset
74 -- this indicator will have been set true if any instance
kono
parents:
diff changeset
75 -- of concurrent running has been proved
kono
parents:
diff changeset
76 return TC_Concurrent_Running;
kono
parents:
diff changeset
77 end TC_Failed;
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79
kono
parents:
diff changeset
80 procedure Add_Meter_Queue is
kono
parents:
diff changeset
81 begin
kono
parents:
diff changeset
82 --==================================================
kono
parents:
diff changeset
83 -- This section is all Test_Control code
kono
parents:
diff changeset
84 TC_Add_Started := true;
kono
parents:
diff changeset
85 if TC_Subtract_Started then
kono
parents:
diff changeset
86 if not TC_Subtract_Finished then
kono
parents:
diff changeset
87 TC_Concurrent_Running := true;
kono
parents:
diff changeset
88 end if;
kono
parents:
diff changeset
89 else
kono
parents:
diff changeset
90 -- Subtract has not started.
kono
parents:
diff changeset
91 -- Execute a lengthy routine to give it a chance to do so
kono
parents:
diff changeset
92 ImpDef.Exceed_Time_Slice;
kono
parents:
diff changeset
93
kono
parents:
diff changeset
94 if TC_Subtract_Started then
kono
parents:
diff changeset
95 -- Subtract was able to start so we have concurrent
kono
parents:
diff changeset
96 -- running and the test has failed
kono
parents:
diff changeset
97 TC_Concurrent_Running := true;
kono
parents:
diff changeset
98 end if;
kono
parents:
diff changeset
99 end if;
kono
parents:
diff changeset
100 TC_Add_Finished := true;
kono
parents:
diff changeset
101 --==================================================
kono
parents:
diff changeset
102 Ramp_Count := Ramp_Count + 1;
kono
parents:
diff changeset
103 end Add_Meter_Queue;
kono
parents:
diff changeset
104
kono
parents:
diff changeset
105 procedure Subtract_Meter_Queue is
kono
parents:
diff changeset
106 begin
kono
parents:
diff changeset
107 --==================================================
kono
parents:
diff changeset
108 -- This section is all Test_Control code
kono
parents:
diff changeset
109 TC_Subtract_Started := true;
kono
parents:
diff changeset
110 if TC_Add_Started then
kono
parents:
diff changeset
111 if not TC_Add_Finished then
kono
parents:
diff changeset
112 -- We already have concurrent running
kono
parents:
diff changeset
113 TC_Concurrent_Running := true;
kono
parents:
diff changeset
114 end if;
kono
parents:
diff changeset
115 else
kono
parents:
diff changeset
116 -- Add has not started.
kono
parents:
diff changeset
117 -- Execute a lengthy routine to give it a chance to do so
kono
parents:
diff changeset
118 ImpDef.Exceed_Time_Slice;
kono
parents:
diff changeset
119
kono
parents:
diff changeset
120 if TC_Add_Started then
kono
parents:
diff changeset
121 -- Add was able to start so we have concurrent
kono
parents:
diff changeset
122 -- running and the test has failed
kono
parents:
diff changeset
123 TC_Concurrent_Running := true;
kono
parents:
diff changeset
124 end if;
kono
parents:
diff changeset
125 end if;
kono
parents:
diff changeset
126 TC_Subtract_Finished := true;
kono
parents:
diff changeset
127 --==================================================
kono
parents:
diff changeset
128 Ramp_Count := Ramp_Count - 1;
kono
parents:
diff changeset
129 end Subtract_Meter_Queue;
kono
parents:
diff changeset
130
kono
parents:
diff changeset
131 end Ramp_31;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 begin
kono
parents:
diff changeset
134
kono
parents:
diff changeset
135 Report.Test ("C951001", "Check that two procedures in a protected" &
kono
parents:
diff changeset
136 " object will not be executed concurrently");
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 declare -- encapsulate the test
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140 task Vehicle_1;
kono
parents:
diff changeset
141 task Vehicle_2;
kono
parents:
diff changeset
142
kono
parents:
diff changeset
143
kono
parents:
diff changeset
144 -- Vehicle_1 and Vehicle_2 are simulations of Instances of the task
kono
parents:
diff changeset
145 -- of type Vehicle in different stages of execution
kono
parents:
diff changeset
146
kono
parents:
diff changeset
147 task body Vehicle_1 is
kono
parents:
diff changeset
148 begin
kono
parents:
diff changeset
149 null; -- ::::: stub. preparation code
kono
parents:
diff changeset
150
kono
parents:
diff changeset
151 -- Add to the count of vehicles on the queue
kono
parents:
diff changeset
152 Ramp_31.Add_Meter_Queue;
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 null; -- ::::: stub: wait at the meter then pass to first sensor
kono
parents:
diff changeset
155
kono
parents:
diff changeset
156 -- Reduce the count of vehicles on the queue
kono
parents:
diff changeset
157 null; -- ::::: stub: Ramp_31.Subtract_Meter_Queue
kono
parents:
diff changeset
158 exception
kono
parents:
diff changeset
159 when others =>
kono
parents:
diff changeset
160 Report.Failed ("Unexpected Exception in Vehicle_1 task");
kono
parents:
diff changeset
161 end Vehicle_1;
kono
parents:
diff changeset
162
kono
parents:
diff changeset
163
kono
parents:
diff changeset
164 task body Vehicle_2 is
kono
parents:
diff changeset
165 begin
kono
parents:
diff changeset
166 null; -- ::::: stub. preparation code
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 -- Add to the count of vehicles on the queue
kono
parents:
diff changeset
169 null; -- ::::: stub Ramp_31.Add_Meter_Queue;
kono
parents:
diff changeset
170
kono
parents:
diff changeset
171 null; -- ::::: stub: wait at the meter then pass to first sensor
kono
parents:
diff changeset
172
kono
parents:
diff changeset
173 -- Reduce the count of vehicles on the queue
kono
parents:
diff changeset
174 Ramp_31.Subtract_Meter_Queue;
kono
parents:
diff changeset
175 exception
kono
parents:
diff changeset
176 when others =>
kono
parents:
diff changeset
177 Report.Failed ("Unexpected Exception in Vehicle_2 task");
kono
parents:
diff changeset
178 end Vehicle_2;
kono
parents:
diff changeset
179
kono
parents:
diff changeset
180
kono
parents:
diff changeset
181
kono
parents:
diff changeset
182 begin
kono
parents:
diff changeset
183 null;
kono
parents:
diff changeset
184 end; -- encapsulation
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 if Ramp_31.TC_Failed then
kono
parents:
diff changeset
187 Report.Failed ("Concurrent Running detected");
kono
parents:
diff changeset
188 end if;
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190 Report.Result;
kono
parents:
diff changeset
191
kono
parents:
diff changeset
192 end C951001;