source: rtems/testsuites/ada/mptests/mp09/mptest.adb @ ee537ea

5
Last change on this file since ee537ea was ee537ea, checked in by Sebastian Huber <sebastian.huber@…>, on 10/12/17 at 08:00:10

ada-tests: Move to testsuites/ada

This solves a build dependency issue, e.g. building tests before
librtemsbsp.a exists.

Close #3079.

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