source: rtems/c/src/ada-tests/mptests/mp10/mptest.adb @ 32c8960

4.115
Last change on this file since 32c8960 was c499856, checked in by Chris Johns <chrisj@…>, on 03/20/14 at 21:10:47

Change all references of rtems.com to rtems.org.

  • Property mode set to 100644
File size: 7.5 KB
Line 
1--
2--  MPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation for Test 10 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.SEMAPHORE;
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 10 -- NODE " );
44      UNSIGNED32_IO.PUT(
45         TEST_SUPPORT.NODE,
46         WIDTH => 1
47      );
48      TEXT_IO.PUT_LINE( " ***" );
49
50
51      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
52      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
53      MPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME(  'S', 'A', '3', ' ' );
54
55      MPTEST.QUEUE_NAME( 1 ) := RTEMS.BUILD_NAME(  'M', 'S', 'G', ' ' );
56
57      MPTEST.SEMAPHORE_NAME( 1 ) := RTEMS.BUILD_NAME(  'S', 'E', 'M', ' ' );
58
59      if TEST_SUPPORT.NODE = 1 then
60
61         TEXT_IO.PUT_LINE( "Creating Message Queue (Global)" );
62         RTEMS.MESSAGE_QUEUE.CREATE(
63            MPTEST.QUEUE_NAME( 1 ),
64            3,
65            RTEMS.GLOBAL + RTEMS.LIMIT,
66            MPTEST.QUEUE_ID( 1 ),
67            STATUS
68         );
69         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
70
71         TEXT_IO.PUT_LINE( "Creating Semaphore (Global)" );
72         RTEMS.SEMAPHORE.CREATE(
73            MPTEST.SEMAPHORE_NAME( 1 ),
74            0,
75            RTEMS.GLOBAL + RTEMS.PRIORITY,
76            MPTEST.SEMAPHORE_ID( 1 ),
77            STATUS
78         );
79         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE" );
80
81         RTEMS.TASKS.WAKE_AFTER( 10 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
82         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
83
84      else
85
86         TEXT_IO.PUT_LINE( "Creating Test_task 1 (local)" );
87         RTEMS.TASKS.CREATE(
88            MPTEST.TASK_NAME( 1 ),
89            1,
90            2048,
91            RTEMS.TIMESLICE,
92            RTEMS.DEFAULT_ATTRIBUTES,
93            MPTEST.TASK_ID( 1 ),
94            STATUS
95         );
96         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
97
98         TEXT_IO.PUT_LINE( "Starting Test_task 1 (local)" );
99         RTEMS.TASKS.START(
100            MPTEST.TASK_ID( 1 ),
101            MPTEST.TEST_TASK_1'ACCESS,
102            0,
103            STATUS
104         );
105         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
106
107         TEXT_IO.PUT_LINE( "Creating Test_task 2 (local)" );
108         RTEMS.TASKS.CREATE(
109            MPTEST.TASK_NAME( 2 ),
110            1,
111            2048,
112            RTEMS.TIMESLICE,
113            RTEMS.DEFAULT_ATTRIBUTES,
114            MPTEST.TASK_ID( 2 ),
115            STATUS
116         );   
117         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
118 
119         TEXT_IO.PUT_LINE( "Starting Test_task 2 (local)" );
120         RTEMS.TASKS.START(
121            MPTEST.TASK_ID( 2 ),
122            MPTEST.TEST_TASK_2'ACCESS,
123            0,
124            STATUS
125         );   
126         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
127
128         TEXT_IO.PUT_LINE( "Creating Test_task 3 (local)" );
129         RTEMS.TASKS.CREATE(
130            MPTEST.TASK_NAME( 3 ),
131            1,
132            2048,
133            RTEMS.TIMESLICE,
134            RTEMS.DEFAULT_ATTRIBUTES,
135            MPTEST.TASK_ID( 3 ),
136            STATUS
137         );   
138         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
139 
140         TEXT_IO.PUT_LINE( "Starting Test_task 3 (local)" );
141         RTEMS.TASKS.START(
142            MPTEST.TASK_ID( 3 ),
143            MPTEST.TEST_TASK_3'ACCESS,
144            0,
145            STATUS
146         );   
147         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
148
149         TEXT_IO.PUT_LINE( "Sleeping for 1 second ..." );
150         RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
151         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
152
153         TEXT_IO.PUT_LINE( "Deleting Test_task 2" );
154         RTEMS.TASKS.DELETE( MPTEST.TASK_ID( 2 ), STATUS );
155         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF 2" );
156
157         TEXT_IO.PUT_LINE( "Deleting Test_task 1" );
158         RTEMS.TASKS.DELETE( MPTEST.TASK_ID( 1 ), STATUS );
159         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF 1" );
160
161         TEXT_IO.PUT_LINE( "Restarting Test_task 3" );
162         RTEMS.TASKS.RESTART( MPTEST.TASK_ID( 3 ), 1, STATUS );
163         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESTART OF 3" );
164
165      end if;
166
167      TEXT_IO.PUT_LINE( "*** END OF TEST 10 ***" );
168
169      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
170
171   end INIT;
172
173--
174--  TEST_TASK_1
175--
176
177   procedure TEST_TASK_1 (
178      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
179   ) is
180      COUNT               : RTEMS.UNSIGNED32;
181      RECEIVE_BUFFER_AREA : RTEMS.BUFFER;
182      RECEIVE_BUFFER      : RTEMS.BUFFER_POINTER;
183      STATUS              : RTEMS.STATUS_CODES;
184   begin
185
186      RECEIVE_BUFFER :=
187         RTEMS.TO_BUFFER_POINTER( RECEIVE_BUFFER_AREA'ADDRESS );
188
189      TEXT_IO.PUT_LINE( "Getting QID of message queue" );
190
191      loop
192
193         RTEMS.MESSAGE_QUEUE.IDENT(
194            MPTEST.QUEUE_NAME( 1 ),
195            RTEMS.SEARCH_ALL_NODES,
196            MPTEST.QUEUE_ID( 1 ),
197            STATUS
198         );
199
200         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
201
202      end loop;
203
204      TEXT_IO.PUT_LINE( "Attempting to receive message ..." );
205      RTEMS.MESSAGE_QUEUE.RECEIVE(
206         MPTEST.QUEUE_ID( 1 ),
207         RECEIVE_BUFFER,
208         RTEMS.DEFAULT_OPTIONS,
209         RTEMS.NO_TIMEOUT,
210         STATUS
211      );
212      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" );
213
214   end TEST_TASK_1;
215
216--
217--  TEST_TASK_2
218--
219 
220   procedure TEST_TASK_2 (
221      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
222   ) is
223      STATUS : RTEMS.STATUS_CODES;
224   begin
225 
226      TEXT_IO.PUT_LINE( "Getting SMID of semaphore" );
227
228      loop
229
230         RTEMS.SEMAPHORE.IDENT(
231            MPTEST.SEMAPHORE_NAME( 1 ),
232            RTEMS.SEARCH_ALL_NODES,
233            MPTEST.SEMAPHORE_ID( 1 ),
234            STATUS
235         );
236 
237         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
238
239      end loop;
240
241      TEXT_IO.PUT_LINE( "Attempting to acquire semaphore ..." );
242      RTEMS.SEMAPHORE.OBTAIN(
243         MPTEST.SEMAPHORE_ID( 1 ),
244         RTEMS.DEFAULT_OPTIONS,
245         RTEMS.NO_TIMEOUT,
246         STATUS
247      );
248      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
249 
250   end TEST_TASK_2;
251
252--
253--  TEST_TASK_3
254--
255 
256   procedure TEST_TASK_3 (
257      RESTART : in     RTEMS.TASKS.ARGUMENT
258   ) is
259      STATUS : RTEMS.STATUS_CODES;
260   begin
261
262      if RESTART = 1 then
263
264         RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
265         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE" );
266
267      end if;
268
269      TEXT_IO.PUT_LINE( "Getting SMID of semaphore" );
270
271      loop
272
273         RTEMS.SEMAPHORE.IDENT(
274            MPTEST.SEMAPHORE_NAME( 1 ),
275            RTEMS.SEARCH_ALL_NODES,
276            MPTEST.SEMAPHORE_ID( 1 ),
277            STATUS   
278         );
279
280         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
281
282      end loop;
283
284      TEXT_IO.PUT_LINE( "Attempting to acquire semaphore ..." );
285      RTEMS.SEMAPHORE.OBTAIN(
286         MPTEST.SEMAPHORE_ID( 1 ),
287         RTEMS.DEFAULT_OPTIONS,
288         RTEMS.NO_TIMEOUT,
289         STATUS 
290      ); 
291      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
292 
293   end TEST_TASK_3;
294 
295end MPTEST;
Note: See TracBrowser for help on using the repository browser.