source: rtems/c/src/ada-tests/mptests/mp06/mptest.adb @ c499856

4.115
Last change on this file since c499856 was c499856, checked in by Chris Johns <chrisj@…>, on Mar 20, 2014 at 9:10:47 PM

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

  • Property mode set to 100644
File size: 5.7 KB
Line 
1--
2--  MPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation for Test 6 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.EVENT;
24with RTEMS.TASKS;
25with RTEMS.TIMER;
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 6 -- NODE " );
44      UNSIGNED32_IO.PUT(
45         TEST_SUPPORT.NODE,
46         WIDTH => 1
47      );
48      TEXT_IO.PUT_LINE( " ***" );
49
50      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
51      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );
52
53      TEXT_IO.PUT_LINE( "Creating Test_task (Global)" );
54
55      RTEMS.TASKS.CREATE( 
56         MPTEST.TASK_NAME( TEST_SUPPORT.NODE ), 
57         TEST_SUPPORT.NODE, 
58         2048, 
59         RTEMS.DEFAULT_MODES,
60         RTEMS.GLOBAL,
61         MPTEST.TASK_ID( 1 ),
62         STATUS
63      );
64      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
65
66      TEXT_IO.PUT_LINE( "Starting Test_task (Global)" );
67
68      RTEMS.TASKS.START(
69         MPTEST.TASK_ID( 1 ),
70         MPTEST.TEST_TASK'ACCESS,
71         0,
72         STATUS
73      );
74      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
75
76      MPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'M', '1', ' ' );
77      MPTEST.TIMER_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'M', '2', ' ' );
78
79      RTEMS.TIMER.CREATE(
80         MPTEST.TIMER_NAME( TEST_SUPPORT.NODE ),
81         MPTEST.TIMER_ID( 1 ),
82         STATUS
83      );
84      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE" );
85
86      TEXT_IO.PUT_LINE( "Deleting initialization task" );
87
88      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
89      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
90
91   end INIT;
92
93--
94--  STOP_TEST_TSR
95--
96 
97   procedure STOP_TEST_TSR (
98      IGNORED1 : in     RTEMS.ID;
99      IGNORED2 : in     RTEMS.ADDRESS
100   ) is
101   begin
102 
103      MPTEST.STOP_TEST := TRUE;
104 
105   end STOP_TEST_TSR;
106 
107--
108--  TEST_TASK
109--
110
111   procedure TEST_TASK (
112      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
113   ) is
114      COUNT                    : RTEMS.UNSIGNED32;
115      EVENT_OUT                : RTEMS.EVENT_SET;
116      EVENT_FOR_THIS_ITERATION : RTEMS.EVENT_SET;
117      STATUS                   : RTEMS.STATUS_CODES;
118   begin
119
120      MPTEST.STOP_TEST := FALSE;
121
122      if TEST_SUPPORT.NODE = 1 then
123         MPTEST.REMOTE_NODE     := 2;
124      else
125         MPTEST.REMOTE_NODE     := 1;
126      end if;
127
128      TEXT_IO.PUT( "Remote task's name is : " );
129      TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ), TRUE );
130
131      TEXT_IO.PUT_LINE( "Getting TID of remote task" );
132
133      loop
134
135         RTEMS.TASKS.IDENT( 
136            MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ),
137            RTEMS.SEARCH_ALL_NODES,
138            MPTEST.REMOTE_TID,
139            STATUS
140         );
141
142         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
143
144      end loop;
145
146      if TEST_SUPPORT.NODE = 1 then
147         TEXT_IO.PUT_LINE( "Sending events to remote task" );
148      else
149         TEXT_IO.PUT_LINE( "Receiving events from remote task" );
150      end if;
151
152      RTEMS.TIMER.FIRE_AFTER(
153         MPTEST.TIMER_ID( 1 ),
154         5 * TEST_SUPPORT.TICKS_PER_SECOND,
155         MPTEST.STOP_TEST_TSR'ACCESS,
156         RTEMS.NULL_ADDRESS,
157         STATUS
158      );
159      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
160 
161      COUNT := 0;
162
163      loop
164 
165         exit when MPTEST.STOP_TEST = TRUE;
166
167         EVENT_FOR_THIS_ITERATION := 
168            MPTEST.EVENT_SET_TABLE( 
169               INTEGER( COUNT ) mod MPTEST.EVENT_SET_TABLE'LAST + 1
170            );
171
172         if TEST_SUPPORT.NODE = 1 then
173
174            RTEMS.EVENT.SEND( 
175               MPTEST.REMOTE_TID,
176               EVENT_FOR_THIS_ITERATION,
177               STATUS
178            );
179            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
180
181         else
182
183            RTEMS.EVENT.RECEIVE( 
184               EVENT_FOR_THIS_ITERATION,
185               RTEMS.DEFAULT_OPTIONS,
186               1 * TEST_SUPPORT.TICKS_PER_SECOND,
187               EVENT_OUT,
188               STATUS
189            );
190
191            if RTEMS.ARE_STATUSES_EQUAL( STATUS, RTEMS.TIMEOUT ) then
192               TEXT_IO.NEW_LINE( 1 );
193
194               if TEST_SUPPORT.NODE = 2 then
195                  TEXT_IO.PUT_LINE(
196                     "Correct behavior if the other node exitted."
197                  );
198               else
199                  TEXT_IO.PUT_LINE(
200                     "ERROR... node 1 died"
201                  );
202               end if;
203
204               exit;
205
206            else
207
208               TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE" );
209
210            end if;
211
212         end if;
213
214         if (COUNT mod MPTEST.MAXIMUM_DOTS) = 0 then
215
216            TEST_SUPPORT.PUT_DOT( "." );
217
218         end if;
219
220         COUNT := COUNT + 1;
221
222      end loop;
223
224      TEXT_IO.NEW_LINE;
225
226      if TEST_SUPPORT.NODE = 2 then
227
228         RTEMS.EVENT.RECEIVE( 
229            RTEMS.EVENT_16,
230            RTEMS.DEFAULT_OPTIONS,
231            1 * TEST_SUPPORT.TICKS_PER_SECOND,
232            EVENT_OUT,
233            STATUS
234         );
235         TEST_SUPPORT.FATAL_DIRECTIVE_STATUS( 
236            RTEMS.TIMEOUT,
237            STATUS,
238            "EVENT_RECEIVE"
239         );
240
241         TEXT_IO.NEW_LINE;
242         TEXT_IO.PUT_LINE( "event_receive - correctly returned TIMEOUT" );
243
244      end if;
245
246      TEXT_IO.PUT_LINE( "*** END OF TEST 6 ***" );
247
248      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
249
250   end TEST_TASK;
251
252end MPTEST;
Note: See TracBrowser for help on using the repository browser.