source: rtems/c/src/ada-tests/mptests/mp09/mptest.adb @ bf9ae83

4.104.114.84.95
Last change on this file since bf9ae83 was bf9ae83, checked in by Joel Sherrill <joel.sherrill@…>, on Jun 2, 1997 at 8:32:11 PM

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: 9.7 KB
Line 
1--
2--  MPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation for Test 9 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 9 -- NODE " );
47      UNSIGNED32_IO.PUT(
48         MPTEST.MULTIPROCESSING_CONFIGURATION.NODE,
49         WIDTH => 1
50      );
51      TEXT_IO.PUT_LINE( " ***" );
52
53      MPTEST.RECEIVE_BUFFER :=
54         RTEMS.TO_BUFFER_POINTER( MPTEST.RECEIVE_BUFFER_AREA'ADDRESS );
55
56      MPTEST.BUFFER_1 :=
57         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_1'ADDRESS );
58
59      MPTEST.BUFFER_2 :=
60         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_2'ADDRESS );
61
62      MPTEST.BUFFER_3 :=
63         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_3'ADDRESS );
64
65      MPTEST.BUFFER_4 :=
66         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_4'ADDRESS );
67
68      MPTEST.FILL_BUFFER( "123456789012345 ", MPTEST.BUFFER_AREA_1 );
69      MPTEST.FILL_BUFFER( "abcdefghijklmno ", MPTEST.BUFFER_AREA_2 );
70      MPTEST.FILL_BUFFER( "ABCDEFGHIJKLMNO ", MPTEST.BUFFER_AREA_3 );
71      MPTEST.FILL_BUFFER( "PQRSTUVWXYZ(){} ", MPTEST.BUFFER_AREA_4 );
72
73      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
74      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );
75
76      MPTEST.QUEUE_NAME( 1 ) := RTEMS.BUILD_NAME(  'M', 'S', 'G', ' ' );
77
78      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then
79
80         TEXT_IO.PUT_LINE( "Creating Message Queue (Global)" );
81         RTEMS.MESSAGE_QUEUE_CREATE(
82            MPTEST.QUEUE_NAME( 1 ),
83            3,
84            RTEMS.GLOBAL + RTEMS.LIMIT,
85            MPTEST.QUEUE_ID( 1 ),
86            STATUS
87         );
88         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
89
90      end if;
91
92      TEXT_IO.PUT_LINE( "Creating Test_task (local)" );
93      RTEMS.TASK_CREATE(
94         MPTEST.TASK_NAME( MPTEST.MULTIPROCESSING_CONFIGURATION.NODE ),
95         MPTEST.MULTIPROCESSING_CONFIGURATION.NODE,
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 (local)" );
105      RTEMS.TASK_START(
106         MPTEST.TASK_ID( 1 ),
107         MPTEST.TEST_TASK'ACCESS,
108         0,
109         STATUS
110      );
111      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
112
113      TEXT_IO.PUT_LINE( "Deleting initialization task" );
114      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
115      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
116
117   end INIT;
118
119--PAGE
120--
121--  SEND_MESSAGES
122--
123
124   procedure SEND_MESSAGES is
125      BROADCAST_COUNT     : RTEMS.UNSIGNED32;
126      STATUS              : RTEMS.STATUS_CODES;
127   begin
128
129      TEXT_IO.PUT( "message_queue_send : " );
130      MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_1 );
131      TEXT_IO.NEW_LINE;
132
133      RTEMS.MESSAGE_QUEUE_SEND(
134         MPTEST.QUEUE_ID( 1 ),
135         MPTEST.BUFFER_1,
136         STATUS
137      );
138      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" );
139
140      TEXT_IO.PUT_LINE( "Delaying for a second" );
141      RTEMS.TASK_WAKE_AFTER(
142         1 * TEST_SUPPORT.TICKS_PER_SECOND,
143         STATUS
144      );
145      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
146
147      TEXT_IO.PUT( "message_queue_urgent : " );
148      MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_2 );
149      TEXT_IO.NEW_LINE;
150
151      RTEMS.MESSAGE_QUEUE_URGENT(
152         MPTEST.QUEUE_ID( 1 ),
153         MPTEST.BUFFER_2,
154         STATUS
155      );
156      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_URGENT" );
157
158      TEXT_IO.PUT_LINE( "Delaying for a second" );
159      RTEMS.TASK_WAKE_AFTER(
160         1 * TEST_SUPPORT.TICKS_PER_SECOND,
161         STATUS
162      );
163      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
164
165      TEXT_IO.PUT( "message_queue_broadcast : " );
166      MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_3 );
167      TEXT_IO.NEW_LINE;
168
169      RTEMS.MESSAGE_QUEUE_BROADCAST(
170         MPTEST.QUEUE_ID( 1 ),
171         MPTEST.BUFFER_3,
172         BROADCAST_COUNT,
173         STATUS
174      );
175      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_BROADCAST" );
176
177      TEXT_IO.PUT_LINE( "Delaying for a second" );
178      RTEMS.TASK_WAKE_AFTER(
179         1 * TEST_SUPPORT.TICKS_PER_SECOND,
180         STATUS
181      );
182      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
183
184   end SEND_MESSAGES;
185
186--PAGE
187--
188--  RECEIVE_MESSAGES
189--
190
191   procedure RECEIVE_MESSAGES is
192      INDEX               : RTEMS.UNSIGNED32;
193      STATUS              : RTEMS.STATUS_CODES;
194   begin
195
196      for INDEX in 1 .. 3
197      loop
198
199         TEXT_IO.PUT_LINE( "Receiving message ..." );
200         RTEMS.MESSAGE_QUEUE_RECEIVE(
201            MPTEST.QUEUE_ID( 1 ),
202            MPTEST.RECEIVE_BUFFER,
203            RTEMS.DEFAULT_OPTIONS,
204            RTEMS.NO_TIMEOUT,
205            STATUS
206         );
207         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" );
208
209         TEXT_IO.PUT( "Received : " );
210         MPTEST.PUT_BUFFER( MPTEST.RECEIVE_BUFFER_AREA );
211         TEXT_IO.NEW_LINE;
212
213      end loop;
214
215      TEXT_IO.PUT_LINE( "Receiver delaying for a second" );
216
217      RTEMS.TASK_WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
218      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
219
220   end RECEIVE_MESSAGES;
221
222--PAGE
223--
224--  FILL_BUFFER
225--
226
227--
228-- Depends on tricks to make the copy work.
229--
230
231   procedure FILL_BUFFER (
232      SOURCE : in     STRING;
233      BUFFER :    out RTEMS.BUFFER
234   ) is
235      SOURCE_BUFFER : RTEMS.BUFFER_POINTER;
236   begin
237
238      SOURCE_BUFFER := RTEMS.TO_BUFFER_POINTER(
239                          SOURCE( SOURCE'FIRST )'ADDRESS
240                       );
241
242      BUFFER.FIELD1 := SOURCE_BUFFER.FIELD1;
243      BUFFER.FIELD2 := SOURCE_BUFFER.FIELD2;
244      BUFFER.FIELD3 := SOURCE_BUFFER.FIELD3;
245      BUFFER.FIELD4 := SOURCE_BUFFER.FIELD4;
246
247   end FILL_BUFFER;
248
249--PAGE
250--
251--  PUT_BUFFER
252--
253
254--
255-- Depends on tricks to make the output work.
256--
257
258   procedure PUT_BUFFER (
259      BUFFER : in     RTEMS.BUFFER
260   ) is
261   begin
262
263      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD1, FALSE );
264      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD2, FALSE );
265      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD3, FALSE );
266      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD4, FALSE );
267
268   end PUT_BUFFER;
269
270--PAGE
271--
272--  TEST_TASK
273--
274
275   procedure TEST_TASK (
276      ARGUMENT : in     RTEMS.TASK_ARGUMENT
277   ) is
278      COUNT   : RTEMS.UNSIGNED32;
279      STATUS  : RTEMS.STATUS_CODES;
280   begin
281
282      RTEMS.TASK_WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
283      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
284
285      TEXT_IO.PUT_LINE( "Getting QID of message queue" );
286
287      loop
288
289         RTEMS.MESSAGE_QUEUE_IDENT(
290            MPTEST.QUEUE_NAME( 1 ),
291            RTEMS.SEARCH_ALL_NODES,
292            MPTEST.QUEUE_ID( 1 ),
293            STATUS
294         );
295
296         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
297
298      end loop;
299
300      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 2 then
301
302         RTEMS.MESSAGE_QUEUE_DELETE( MPTEST.QUEUE_ID( 1 ), STATUS );
303
304         TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
305            STATUS,
306            RTEMS.ILLEGAL_ON_REMOTE_OBJECT,
307            "MESSAGE_QUEUE_DELETE"
308         );
309
310         TEXT_IO.PUT_LINE(
311         "message_queue_delete correctly returned ILLEGAL_ON_REMOTE_OBJECT"
312         );
313
314         MPTEST.SEND_MESSAGES;
315
316         MPTEST.RECEIVE_MESSAGES;
317
318         TEXT_IO.PUT_LINE( "Flushing remote empty queue" );
319         RTEMS.MESSAGE_QUEUE_FLUSH( MPTEST.QUEUE_ID( 1 ), COUNT, STATUS );
320         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_FLUSH" );
321         UNSIGNED32_IO.PUT( COUNT, WIDTH => 1 );
322         TEXT_IO.PUT_LINE(
323            " messages were flushed from remote empty queue"
324         );
325
326         TEXT_IO.PUT_LINE(
327            "Send messages to be flushed from remote queue"
328         );
329         RTEMS.MESSAGE_QUEUE_SEND(
330            MPTEST.QUEUE_ID( 1 ),
331            MPTEST.BUFFER_1,
332            STATUS
333         );
334         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" );
335
336         TEXT_IO.PUT_LINE( "Flushing remote queue" );
337         RTEMS.MESSAGE_QUEUE_FLUSH( MPTEST.QUEUE_ID( 1 ), COUNT, STATUS );
338         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_FLUSH" );
339         UNSIGNED32_IO.PUT( COUNT, WIDTH => 1 );
340         TEXT_IO.PUT_LINE(
341            " messages were flushed from the remote queue"
342         );
343
344         TEXT_IO.PUT_LINE( "Waiting for message queue to be deleted" );
345         RTEMS.MESSAGE_QUEUE_RECEIVE(
346            MPTEST.QUEUE_ID( 1 ),
347            MPTEST.RECEIVE_BUFFER,
348            RTEMS.DEFAULT_OPTIONS,
349            RTEMS.NO_TIMEOUT,
350            STATUS
351         );
352         TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
353            STATUS,
354            RTEMS.OBJECT_WAS_DELETED,
355            "MESSAGE_QUEUE_FLUSH"
356         );
357
358      else
359
360         MPTEST.RECEIVE_MESSAGES;
361
362         MPTEST.SEND_MESSAGES;
363
364         RTEMS.TASK_WAKE_AFTER(
365            5 * TEST_SUPPORT.TICKS_PER_SECOND,
366            STATUS
367         );
368         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
369
370         RTEMS.MESSAGE_QUEUE_DELETE( MPTEST.QUEUE_ID( 1 ), STATUS );
371         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_DELETE" );
372
373      end if;
374
375      TEXT_IO.PUT_LINE( "*** END OF TEST 9 ***" );
376
377      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
378
379   end TEST_TASK;
380
381end MPTEST;
Note: See TracBrowser for help on using the repository browser.