Mercurial > hg > CbC > CbC_gcc

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