source: rtems/c/src/ada-tests/mptests/mp13/mptest.adb @ 144d79a

4.104.114.84.95
Last change on this file since 144d79a was bf9ae83, checked in by Joel Sherrill <joel.sherrill@…>, on 06/02/97 at 20:32:11

modified copyright notice to be the same as RTEMS 4.0.0.

changed the CVS ID string to be a "development" version.

  • Property mode set to 100644
File size: 8.8 KB
Line 
1--
2--  MPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation for Test 13 of the RTEMS
7--  Multiprocessor Test Suite.
8--
9--  DEPENDENCIES:
10--
11--
12--
13--  COPYRIGHT (c) 1989-1997.
14--  On-Line Applications Research Corporation (OAR).
15--  Copyright assigned to U.S. Government, 1994.
16--
17--  The license and distribution terms for this file may in
18--  the file LICENSE in this distribution or at
19--  http://www.OARcorp.com/rtems/license.html.
20--
21--  $Id$
22--
23
24with INTERFACES; use INTERFACES;
25with RTEMS;
26with TEST_SUPPORT;
27with TEXT_IO;
28with UNSIGNED32_IO;
29
30package body MPTEST is
31
32   package body PER_NODE_CONFIGURATION is separate;
33
34--PAGE
35--
36--  INIT
37--
38
39   procedure INIT (
40      ARGUMENT : in     RTEMS.TASK_ARGUMENT
41   ) is
42      STATUS : RTEMS.STATUS_CODES;
43   begin
44
45      TEXT_IO.NEW_LINE( 2 );
46      TEXT_IO.PUT( "*** TEST 13 -- NODE " );
47      UNSIGNED32_IO.PUT(
48         MPTEST.MULTIPROCESSING_CONFIGURATION.NODE,
49         WIDTH => 1
50      );
51      TEXT_IO.PUT_LINE( " ***" );
52
53      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
54      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );
55
56      MPTEST.QUEUE_NAME( 1 ) := RTEMS.BUILD_NAME(  'M', 'S', 'G', ' ' );
57
58      MPTEST.SEMAPHORE_NAME( 1 ) := RTEMS.BUILD_NAME(  'S', 'E', 'M', ' ' );
59
60      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then
61
62         TEXT_IO.PUT_LINE( "Creating Message Queue (Global)" );
63         RTEMS.MESSAGE_QUEUE_CREATE(
64            MPTEST.QUEUE_NAME( 1 ),
65            3,
66            RTEMS.GLOBAL + RTEMS.LIMIT,
67            MPTEST.QUEUE_ID( 1 ),
68            STATUS
69         );
70         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
71
72         TEXT_IO.PUT_LINE( "Creating Semaphore (Global)" );
73         RTEMS.SEMAPHORE_CREATE(
74            MPTEST.SEMAPHORE_NAME( 1 ),
75            1,
76            RTEMS.GLOBAL + RTEMS.PRIORITY,
77            MPTEST.SEMAPHORE_ID( 1 ),
78            STATUS
79         );
80         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE" );
81
82         RTEMS.SEMAPHORE_OBTAIN(
83            MPTEST.SEMAPHORE_ID( 1 ),
84            RTEMS.DEFAULT_OPTIONS,
85            RTEMS.NO_TIMEOUT,
86            STATUS
87         );
88         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
89
90      end if;
91
92      TEXT_IO.PUT_LINE( "Creating Test_task 1 (local)" );
93         RTEMS.TASK_CREATE(
94         MPTEST.TASK_NAME( 1 ),
95         1,
96         2048,
97         RTEMS.TIMESLICE,
98         RTEMS.DEFAULT_ATTRIBUTES,
99         MPTEST.TASK_ID( 1 ),
100         STATUS
101      );
102      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
103
104      TEXT_IO.PUT_LINE( "Starting Test_task 1 (local)" );
105      RTEMS.TASK_START(
106         MPTEST.TASK_ID( 1 ),
107         MPTEST.TEST_TASK_1'ACCESS,
108         0,
109         STATUS
110      );
111      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
112
113      TEXT_IO.PUT_LINE( "Creating Test_task 2 (local)" );
114      RTEMS.TASK_CREATE(
115         MPTEST.TASK_NAME( 2 ),
116         1,
117         2048,
118         RTEMS.TIMESLICE,
119         RTEMS.DEFAULT_ATTRIBUTES,
120         MPTEST.TASK_ID( 2 ),
121         STATUS
122      );
123      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
124
125      TEXT_IO.PUT_LINE( "Starting Test_task 2 (local)" );
126      RTEMS.TASK_START(
127         MPTEST.TASK_ID( 2 ),
128         MPTEST.TEST_TASK_2'ACCESS,
129         0,
130         STATUS
131      );
132      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
133
134      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then
135
136         RTEMS.TASK_WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
137         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
138
139         TEXT_IO.PUT_LINE( "*** END OF TEST 13 ***" );
140
141         RTEMS.SHUTDOWN_EXECUTIVE( 0 );
142
143      end if;
144
145      TEXT_IO.PUT_LINE( "Deleting initialization task" );
146      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
147      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
148
149   end INIT;
150
151--PAGE
152--
153--  TEST_TASK_1
154--
155
156   procedure TEST_TASK_1 (
157      ARGUMENT : in     RTEMS.TASK_ARGUMENT
158   ) is
159      COUNT               : RTEMS.UNSIGNED32;
160      RECEIVE_BUFFER_AREA : RTEMS.BUFFER;
161      RECEIVE_BUFFER      : RTEMS.BUFFER_POINTER;
162      STATUS              : RTEMS.STATUS_CODES;
163   begin
164
165      RECEIVE_BUFFER :=
166         RTEMS.TO_BUFFER_POINTER( RECEIVE_BUFFER_AREA'ADDRESS );
167
168      TEXT_IO.PUT_LINE( "Getting QID of message queue" );
169
170      loop
171
172         RTEMS.MESSAGE_QUEUE_IDENT(
173            MPTEST.QUEUE_NAME( 1 ),
174            RTEMS.SEARCH_ALL_NODES,
175            MPTEST.QUEUE_ID( 1 ),
176            STATUS
177         );
178
179         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
180
181      end loop;
182
183      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then
184
185         TEXT_IO.PUT_LINE( "Receiving message ..." );
186         RTEMS.MESSAGE_QUEUE_RECEIVE(
187            MPTEST.QUEUE_ID( 1 ),
188            RECEIVE_BUFFER,
189            RTEMS.DEFAULT_OPTIONS,
190            RTEMS.NO_TIMEOUT,
191            STATUS
192         );
193         TEXT_IO.PUT_LINE( "How did I get back from here???" );
194         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" );
195
196      end if;
197
198      RTEMS.TASK_WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
199      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
200
201      TEXT_IO.PUT_LINE( "Receiving message ..." );
202      RTEMS.MESSAGE_QUEUE_RECEIVE(
203         MPTEST.QUEUE_ID( 1 ),
204         RECEIVE_BUFFER,
205         RTEMS.DEFAULT_OPTIONS,
206         2 * TEST_SUPPORT.TICKS_PER_SECOND,
207         STATUS
208      );
209      TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
210         STATUS,
211         RTEMS.TIMEOUT,
212         "MESSAGE_QUEUE_RECEIVE"
213      );
214      TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
215         STATUS,
216         RTEMS.TIMEOUT,
217         "MESSAGE_QUEUE_OBTAIN"
218      );
219
220      TEXT_IO.PUT_LINE(
221         "message_queue_receive correctly returned TIMEOUT"
222      );
223
224      TEXT_IO.PUT_LINE( "Deleting self" );
225      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
226      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
227
228   end TEST_TASK_1;
229
230--PAGE
231--
232--  TEST_TASK_2
233--
234
235   procedure TEST_TASK_2 (
236      ARGUMENT : in     RTEMS.TASK_ARGUMENT
237   ) is
238      STATUS : RTEMS.STATUS_CODES;
239   begin
240
241      TEXT_IO.PUT_LINE( "Getting SMID of semaphore" );
242
243      loop
244
245         RTEMS.SEMAPHORE_IDENT(
246            MPTEST.SEMAPHORE_NAME( 1 ),
247            RTEMS.SEARCH_ALL_NODES,
248            MPTEST.SEMAPHORE_ID( 1 ),
249            STATUS
250         );
251
252         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
253
254      end loop;
255
256      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then
257
258         RTEMS.TASK_WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
259         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
260
261         TEXT_IO.PUT_LINE( "Releasing semaphore ..." );
262         RTEMS.SEMAPHORE_RELEASE( MPTEST.SEMAPHORE_ID( 1 ), STATUS );
263         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
264
265         RTEMS.TASK_WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND / 2, STATUS );
266         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
267
268         TEXT_IO.PUT_LINE( "Getting semaphore ..." );
269         RTEMS.SEMAPHORE_OBTAIN(
270            MPTEST.SEMAPHORE_ID( 1 ),
271            RTEMS.DEFAULT_OPTIONS,
272            RTEMS.NO_TIMEOUT,
273            STATUS
274         );
275         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
276
277         TEXT_IO.PUT_LINE( "Getting semaphore ..." );
278         RTEMS.SEMAPHORE_OBTAIN(
279            MPTEST.SEMAPHORE_ID( 1 ),
280            RTEMS.DEFAULT_OPTIONS,
281            RTEMS.NO_TIMEOUT,
282            STATUS
283         );
284         TEXT_IO.PUT_LINE( "How did I get back from here???" );
285         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
286
287      end if;
288
289      RTEMS.TASK_WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND / 2, STATUS );
290      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
291
292      TEXT_IO.PUT_LINE( "Getting semaphore ..." );
293      RTEMS.SEMAPHORE_OBTAIN(
294         MPTEST.SEMAPHORE_ID( 1 ),
295         RTEMS.DEFAULT_OPTIONS,
296         RTEMS.NO_TIMEOUT,
297         STATUS
298      );
299      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
300
301      TEXT_IO.PUT_LINE( "Releasing semaphore ..." );
302      RTEMS.SEMAPHORE_RELEASE( MPTEST.SEMAPHORE_ID( 1 ), STATUS );
303      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
304
305      RTEMS.TASK_WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
306      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
307
308      TEXT_IO.PUT_LINE( "Getting semaphore ..." );
309      RTEMS.SEMAPHORE_OBTAIN(
310         MPTEST.SEMAPHORE_ID( 1 ),
311         RTEMS.DEFAULT_OPTIONS,
312         2 * TEST_SUPPORT.TICKS_PER_SECOND,
313         STATUS
314      );
315      TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
316         STATUS,
317         RTEMS.TIMEOUT,
318         "SEMAPHORE_OBTAIN"
319      );
320      TEXT_IO.PUT_LINE( "semaphore_obtain correctly returned TIMEOUT" );
321
322      TEXT_IO.PUT_LINE( "*** END OF TEST 13 ***" );
323
324      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
325
326   end TEST_TASK_2;
327
328end MPTEST;
Note: See TracBrowser for help on using the repository browser.