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

4.104.114.84.95
Last change on this file since 48bfd992 was bf9ae83, checked in by Joel Sherrill <joel.sherrill@…>, on 06/02/97 at 20:32:11

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