source: rtems/testsuites/ada/mptests/mp03/mptest.adb @ f6c9334d

5
Last change on this file since f6c9334d was f6c9334d, checked in by Sebastian Huber <sebastian.huber@…>, on 12/01/17 at 07:51:17

ada: Add standard test begin/end message
  • Property mode set to 100644
File size: 6.6 KB
Line 
1--
2--  This package is the implementation for Test 3 of the RTEMS
3--  Multiprocessor Test Suite.
4--
5--  DEPENDENCIES:
6--
7-- 
8--
9--  COPYRIGHT (c) 1989-2011.
10--  On-Line Applications Research Corporation (OAR).
11--
12--  The license and distribution terms for this file may in
13--  the file LICENSE in this distribution or at
14--  http://www.rtems.org/license/LICENSE.
15--
16
17with INTERFACES; use INTERFACES;
18with RTEMS;
19with RTEMS.EVENT;
20with RTEMS.TASKS;
21with RTEMS.TIMER;
22with TEST_SUPPORT;
23with TEXT_IO;
24with UNSIGNED32_IO;
25
26package body MPTEST is
27
28--
29--  INIT
30--
31
32   procedure INIT (
33      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
34   ) is
35      STATUS : RTEMS.STATUS_CODES;
36   begin
37
38      TEXT_IO.NEW_LINE( 2 );
39      TEST_SUPPORT.ADA_TEST_BEGIN;
40      TEXT_IO.PUT( "*** NODE " );
41      UNSIGNED32_IO.PUT(
42         TEST_SUPPORT.NODE,
43         WIDTH => 1
44      );
45      TEXT_IO.PUT_LINE( " ***" );
46     
47      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
48      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );
49
50      TEXT_IO.PUT_LINE( "Creating Test_task (Global)" );
51      RTEMS.TASKS.CREATE(
52         MPTEST.TASK_NAME( TEST_SUPPORT.NODE ),
53         1,
54         2048,
55         RTEMS.NO_PREEMPT,
56         RTEMS.GLOBAL,
57         MPTEST.TASK_ID( 1 ),
58         STATUS
59      );
60      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
61
62      TEXT_IO.PUT_LINE( "Starting Test_task (Global)" );
63      RTEMS.TASKS.START(
64         MPTEST.TASK_ID( 1 ),
65         MPTEST.TEST_TASK'ACCESS,
66         0,
67         STATUS
68      );
69      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
70
71      MPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'M', '1', ' ' );
72
73      RTEMS.TIMER.CREATE(
74         MPTEST.TIMER_NAME( 1 ),
75         MPTEST.TIMER_ID( 1 ),
76         STATUS
77      );
78      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE" );
79
80      TEXT_IO.PUT_LINE( "Deleting initialization task" );
81      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
82      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
83
84   end INIT;
85
86--
87--  DELAYED_SEND_EVENT
88--
89
90   procedure DELAYED_SEND_EVENT (
91      IGNORED_ID      : in     RTEMS.ID;
92      IGNORED_ADDRESS : in     RTEMS.ADDRESS
93   ) is
94      STATUS  : RTEMS.STATUS_CODES;
95   begin
96
97      RTEMS.EVENT.SEND( MPTEST.TASK_ID( 1 ), RTEMS.EVENT_16, STATUS );
98      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
99
100   end DELAYED_SEND_EVENT;
101
102--
103--  TEST_TASK
104--
105
106   procedure TEST_TASK (
107      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
108   ) is
109      TID         : RTEMS.ID;
110      STATUS      : RTEMS.STATUS_CODES;
111   begin
112
113      RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
114      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
115   
116      TEXT_IO.PUT_LINE( "Getting TID of remote task" );
117      if TEST_SUPPORT.NODE = 1 then
118         MPTEST.REMOTE_NODE := 2;
119      else
120         MPTEST.REMOTE_NODE := 1;
121      end if;
122
123      TEXT_IO.PUT( "Remote task's name is : " );
124      TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ), TRUE );
125
126      loop
127
128         RTEMS.TASKS.IDENT(
129            MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ),
130            RTEMS.SEARCH_ALL_NODES,
131            MPTEST.REMOTE_TID,
132            STATUS
133         );
134
135         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
136
137      end loop;
138
139      RTEMS.TIMER.FIRE_AFTER(
140         MPTEST.TIMER_ID( 1 ),
141         10 * TEST_SUPPORT.TICKS_PER_SECOND,
142         MPTEST.DELAYED_SEND_EVENT'ACCESS,
143         RTEMS.NULL_ADDRESS,
144         STATUS
145      );
146      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
147
148      MPTEST.TEST_TASK_SUPPORT( 1 );
149
150      RTEMS.TIMER.FIRE_AFTER(
151         MPTEST.TIMER_ID( 1 ),
152         11 * TEST_SUPPORT.TICKS_PER_SECOND,
153         MPTEST.DELAYED_SEND_EVENT'ACCESS,
154         RTEMS.NULL_ADDRESS,
155         STATUS
156      );
157      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
158
159      if TEST_SUPPORT.NODE = 2 then
160         
161         RTEMS.TASKS.WAKE_AFTER(
162            2 * TEST_SUPPORT.TICKS_PER_SECOND,
163            STATUS
164         );
165        TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
166
167      end if;
168
169      MPTEST.TEST_TASK_SUPPORT( 2 );
170
171      TEST_SUPPORT.ADA_TEST_END;
172
173      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
174
175   end TEST_TASK;
176
177--
178--  TEST_TASK_SUPPORT
179--
180
181
182   procedure TEST_TASK_SUPPORT (
183      NODE : in    RTEMS.UNSIGNED32
184   ) is
185      EVENTS : RTEMS.EVENT_SET;
186      STATUS : RTEMS.STATUS_CODES;
187   begin
188
189      if TEST_SUPPORT.NODE = NODE then
190
191         loop
192
193            RTEMS.EVENT.RECEIVE(
194               RTEMS.EVENT_16,
195               RTEMS.NO_WAIT,
196               RTEMS.NO_TIMEOUT,
197               EVENTS,
198               STATUS
199            );
200
201            exit when RTEMS.ARE_STATUSES_EQUAL( RTEMS.SUCCESSFUL, STATUS );
202
203            TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
204               STATUS,
205               RTEMS.UNSATISFIED,
206               "EVENT_RECEIVE"
207            );
208
209            RTEMS.TASKS.WAKE_AFTER(
210               2 * TEST_SUPPORT.TICKS_PER_SECOND,
211               STATUS
212            );
213            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
214
215            TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( NODE ), FALSE );
216            TEXT_IO.PUT_LINE( " - Suspending remote task" );
217            RTEMS.TASKS.SUSPEND( MPTEST.REMOTE_TID, STATUS );
218            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
219
220            RTEMS.TASKS.WAKE_AFTER(
221               2 * TEST_SUPPORT.TICKS_PER_SECOND,
222               STATUS
223            );
224            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
225
226            TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( NODE ), FALSE );
227            TEXT_IO.PUT_LINE( " - Resuming remote task" );
228
229            RTEMS.TASKS.RESUME( MPTEST.REMOTE_TID, STATUS );
230            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME" );
231
232         end loop;
233
234      else
235
236         loop
237
238            RTEMS.EVENT.RECEIVE(
239               RTEMS.EVENT_16,
240               RTEMS.NO_WAIT,
241               RTEMS.NO_TIMEOUT,
242               EVENTS,
243               STATUS
244            );
245
246            exit when RTEMS.ARE_STATUSES_EQUAL( RTEMS.SUCCESSFUL, STATUS );
247
248            TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
249               STATUS,
250               RTEMS.UNSATISFIED,
251               "EVENT_RECEIVE"
252            );
253
254            TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( REMOTE_NODE ), FALSE );
255            TEXT_IO.PUT_LINE( " - have I been suspended???" );
256            RTEMS.TASKS.WAKE_AFTER(
257               TEST_SUPPORT.TICKS_PER_SECOND / 2,
258               STATUS
259            );
260            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
261
262         end loop;
263
264      end if;
265
266   end TEST_TASK_SUPPORT;
267
268end MPTEST;
Note: See TracBrowser for help on using the repository browser.