source: rtems/c/src/ada-tests/sptests/sp07/sptest.adb @ bf9ae83

4.104.114.84.95
Last change on this file since bf9ae83 was bf9ae83, checked in by Joel Sherrill <joel.sherrill@…>, on Jun 2, 1997 at 8:32:11 PM

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: 12.8 KB
Line 
1--
2--  SPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 7 of the RTEMS
7--  Single Processor 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 SPTEST is
31
32--PAGE
33--
34--  INIT
35--
36
37   procedure INIT (
38      ARGUMENT : in     RTEMS.TASK_ARGUMENT
39   ) is
40      TIME   : RTEMS.TIME_OF_DAY;
41      STATUS : RTEMS.STATUS_CODES;
42   begin
43
44      TEXT_IO.NEW_LINE( 2 );
45      TEXT_IO.PUT_LINE( "*** TEST 7 ***" );
46
47      SPTEST.EXTENSION_NAME( 1 ) := RTEMS.BUILD_NAME(  'E', 'X', 'T', ' ' );
48
49      RTEMS.EXTENSION_CREATE(
50         SPTEST.EXTENSION_NAME( 1 ),
51         SPTEST.EXTENSIONS'ACCESS,
52         EXTENSION_ID( 1 ),
53         STATUS
54      );
55      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EXTENSION_CREATE" );
56
57      SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
58      SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
59      SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME(  'T', 'A', '3', ' ' );
60      SPTEST.TASK_NAME( 4 ) := RTEMS.BUILD_NAME(  'T', 'A', '4', ' ' );
61
62      RTEMS.TASK_CREATE( 
63         SPTEST.TASK_NAME( 1 ), 
64         4, 
65         2048, 
66         RTEMS.DEFAULT_MODES,
67         RTEMS.DEFAULT_ATTRIBUTES,
68         SPTEST.TASK_ID( 1 ),
69         STATUS
70      );
71      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
72
73      RTEMS.TASK_CREATE( 
74         SPTEST.TASK_NAME( 2 ), 
75         4, 
76         2048, 
77         RTEMS.DEFAULT_MODES,
78         RTEMS.DEFAULT_ATTRIBUTES,
79         SPTEST.TASK_ID( 2 ),
80         STATUS
81      );
82      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
83
84      RTEMS.TASK_CREATE( 
85         SPTEST.TASK_NAME( 3 ), 
86         250, 
87         2048, 
88         RTEMS.DEFAULT_MODES,
89         RTEMS.DEFAULT_ATTRIBUTES,
90         SPTEST.TASK_ID( 3 ),
91         STATUS
92      );
93      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
94
95      RTEMS.TASK_CREATE( 
96         SPTEST.TASK_NAME( 4 ), 
97         254, 
98         2048, 
99         RTEMS.DEFAULT_MODES,
100         RTEMS.DEFAULT_ATTRIBUTES,
101         SPTEST.TASK_ID( 4 ),
102         STATUS
103      );
104      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA4" );
105
106      RTEMS.TASK_START(
107         SPTEST.TASK_ID( 1 ),
108         SPTEST.TASK_1'ACCESS,
109         0,
110         STATUS
111      );
112      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
113
114      RTEMS.TASK_START(
115         SPTEST.TASK_ID( 2 ),
116         SPTEST.TASK_2'ACCESS,
117         0,
118         STATUS
119      );
120      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
121
122      RTEMS.TASK_START(
123         SPTEST.TASK_ID( 3 ),
124         SPTEST.TASK_3'ACCESS,
125         0,
126         STATUS
127      );
128      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
129
130      RTEMS.TASK_START(
131         SPTEST.TASK_ID( 4 ),
132         SPTEST.TASK_4'ACCESS,
133         0,
134         STATUS
135      );
136      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA4" );
137
138      RTEMS.TASK_RESTART( SPTEST.TASK_ID( 3 ), 0, STATUS );
139      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESTART OF TA3" );
140
141      RTEMS.TASK_SET_NOTE( SPTEST.TASK_ID( 1 ), 8, 4, STATUS );
142      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE OF TA1" );
143      TEXT_IO.PUT( "INIT - task_set_note - set TA1's NOTEPAD_8" ); 
144      TEXT_IO.PUT_LINE( " to TA1's initial priority:  4" );
145     
146      RTEMS.TASK_SET_NOTE( SPTEST.TASK_ID( 2 ), 8, 4, STATUS );
147      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE OF TA2" );
148      TEXT_IO.PUT( "INIT - task_set_note - set TA2's NOTEPAD_8" ); 
149      TEXT_IO.PUT_LINE( " to TA2's initial priority:  4" );
150
151      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
152      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
153
154   end INIT;
155
156--PAGE
157--
158--  TASK_1
159--
160
161   procedure TASK_1 (
162      ARGUMENT : in     RTEMS.TASK_ARGUMENT
163   ) is
164      STATUS            : RTEMS.STATUS_CODES;
165      THE_PRIORITY      : RTEMS.TASK_PRIORITY;
166      PREVIOUS_PRIORITY : RTEMS.TASK_PRIORITY;
167   begin
168
169      TEST_SUPPORT.PAUSE;
170
171      RTEMS.TASK_SET_PRIORITY( 
172         RTEMS.SELF, 
173         RTEMS.CURRENT_PRIORITY, 
174         THE_PRIORITY, 
175         STATUS
176      );
177      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
178      TEXT_IO.PUT( "TA1 - task_set_priority - ");
179      TEXT_IO.PUT( "get initial priority of self: ");
180      UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
181      TEXT_IO.NEW_LINE;
182
183      loop
184
185         RTEMS.TASK_GET_NOTE( RTEMS.SELF, 8, THE_PRIORITY, STATUS );
186         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_GET_NOTE" );
187         TEXT_IO.PUT( "TA1 - task_get_note - "); 
188         TEXT_IO.PUT( "get NOTEPAD_8 - current priority: " );
189         UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
190         TEXT_IO.NEW_LINE;
191
192         THE_PRIORITY := THE_PRIORITY - 1;
193
194         if THE_PRIORITY = 0 then
195            TEXT_IO.PUT_LINE( "TA1 - task_suspend - suspend TA2" ); 
196            RTEMS.TASK_SUSPEND( SPTEST.TASK_ID( 2 ), STATUS );
197            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
198
199            TEXT_IO.PUT( "TA1 - task_set_priority - ");
200            TEXT_IO.PUT_LINE( "set priority of TA2 ( blocked )");
201            RTEMS.TASK_SET_PRIORITY( 
202               SPTEST.TASK_ID( 2 ), 
203               5, 
204               PREVIOUS_PRIORITY, 
205               STATUS
206            );
207            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
208
209            RTEMS.TASK_DELETE( SPTEST.TASK_ID( 2 ), STATUS );
210            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
211
212            RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
213            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
214
215         end if;
216
217         TEXT_IO.PUT( "TA1 - task_set_note - set TA2's NOTEPAD_8: " );
218         UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
219         TEXT_IO.NEW_LINE;
220         RTEMS.TASK_SET_NOTE( 
221            SPTEST.TASK_ID( 2 ), 
222            8, 
223            THE_PRIORITY, 
224            STATUS
225         );
226         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE" );
227
228         TEXT_IO.PUT("TA1 - task_set_priority - set TA2's priority: ");
229         UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
230         TEXT_IO.NEW_LINE;
231         RTEMS.TASK_SET_PRIORITY( 
232            SPTEST.TASK_ID( 2 ), 
233            THE_PRIORITY, 
234            PREVIOUS_PRIORITY, 
235            STATUS
236         );
237         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
238
239      end loop;
240   
241   end TASK_1;
242
243--PAGE
244--
245--  TASK_2
246--
247
248   procedure TASK_2 (
249      ARGUMENT : in     RTEMS.TASK_ARGUMENT
250   ) is
251      STATUS            : RTEMS.STATUS_CODES;
252      THE_PRIORITY      : RTEMS.TASK_PRIORITY;
253      PREVIOUS_PRIORITY : RTEMS.TASK_PRIORITY;
254   begin
255
256      loop
257
258         RTEMS.TASK_GET_NOTE( RTEMS.SELF, 8, THE_PRIORITY, STATUS );
259         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_GET_NOTE" );
260         TEXT_IO.PUT( "TA2 - task_get_note - ");
261         TEXT_IO.PUT( "get NOTEPAD_8 - current priority: " );
262         UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
263         TEXT_IO.NEW_LINE;
264
265         THE_PRIORITY := THE_PRIORITY - 1;
266
267         if THE_PRIORITY = 0 then
268            TEXT_IO.PUT_LINE( "TA2 - task_suspend - suspend TA1" ); 
269            RTEMS.TASK_SUSPEND( SPTEST.TASK_ID( 1 ), STATUS );
270            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
271
272            TEXT_IO.PUT( "TA2 - task_set_priority - ");
273            TEXT_IO.PUT_LINE( "set priority of TA1 ( blocked )");
274            RTEMS.TASK_SET_PRIORITY( 
275               SPTEST.TASK_ID( 1 ), 
276               5, 
277               PREVIOUS_PRIORITY, 
278               STATUS
279            );
280            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
281
282            RTEMS.TASK_DELETE( 
283               SPTEST.TASK_ID( 1 ), 
284               STATUS
285            );                            -- TA1 is blocked
286            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );
287
288            RTEMS.TASK_DELETE( 
289               SPTEST.TASK_ID( 3 ), 
290               STATUS
291            );                            -- TA3 is ready
292            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
293
294            RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
295            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
296
297         else
298
299            TEXT_IO.PUT( "TA2 - task_set_note - set TA1's NOTEPAD_8: " );
300            UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
301            TEXT_IO.NEW_LINE;
302            RTEMS.TASK_SET_NOTE( 
303               SPTEST.TASK_ID( 1 ), 
304               8, 
305               THE_PRIORITY, 
306               STATUS
307            );
308            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE" );
309
310            TEXT_IO.PUT( "TA2 - task_set_priority - "); 
311            TEXT_IO.PUT( "set TA1's priority: ");
312            UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2);
313            TEXT_IO.NEW_LINE;
314            RTEMS.TASK_SET_PRIORITY( 
315               SPTEST.TASK_ID( 1 ), 
316               THE_PRIORITY, 
317               PREVIOUS_PRIORITY, 
318               STATUS
319            );
320            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
321
322         end if;
323
324      end loop;
325   
326   end TASK_2;
327
328--PAGE
329--
330--  TASK_3
331--
332
333   procedure TASK_3 (
334      ARGUMENT : in     RTEMS.TASK_ARGUMENT
335   ) is
336      STATUS : RTEMS.STATUS_CODES;
337   begin
338   
339      loop
340
341         RTEMS.TASK_WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
342         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
343
344      end loop;
345
346   end TASK_3;
347
348--PAGE
349--
350--  TASK_4
351--
352
353   procedure TASK_4 (
354      ARGUMENT : in     RTEMS.TASK_ARGUMENT
355   ) is
356   begin
357
358      TEXT_IO.PUT_LINE( "TA4 - exitting task" );
359
360   end TASK_4;
361
362--PAGE
363--
364--  TASK_EXIT_EXTENSION
365--
366
367   procedure TASK_EXIT_EXTENSION (
368      RUNNING_TASK : in     RTEMS.TCB_POINTER
369   ) is
370   begin
371
372      if TEST_SUPPORT.TASK_NUMBER( RUNNING_TASK.OBJECT.ID ) > 0 then
373         TEXT_IO.PUT_LINE( "TASK_EXITTED - user extension invoked correctly" );
374      end if;
375
376      TEXT_IO.PUT_LINE( "*** END OF TEST 7 ***" );
377      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
378
379   end TASK_EXIT_EXTENSION;
380
381--PAGE
382--
383--  TASK_CREATE_EXTENSION
384--
385
386   procedure TASK_CREATE_EXTENSION (
387      UNUSED       : in     RTEMS.TCB_POINTER;
388      CREATED_TASK : in     RTEMS.TCB_POINTER
389   ) is
390   begin
391
392      if TEST_SUPPORT.TASK_NUMBER( CREATED_TASK.OBJECT.ID ) > 0 then
393         TEXT_IO.PUT( "TASKS_CREATE - " );
394         TEST_SUPPORT.PUT_NAME( 
395            SPTEST.TASK_NAME( 
396               TEST_SUPPORT.TASK_NUMBER( CREATED_TASK.OBJECT.ID )
397            ),
398            FALSE
399         );
400         TEXT_IO.PUT_LINE( "- created." );
401      end if;
402
403   end TASK_CREATE_EXTENSION;
404
405--PAGE
406--
407--  TASK_DELETE_EXTENSION
408--
409
410   procedure TASK_DELETE_EXTENSION (
411      RUNNING_TASK : in     RTEMS.TCB_POINTER;
412      DELETED_TASK : in     RTEMS.TCB_POINTER
413   ) is
414   begin
415
416      if TEST_SUPPORT.TASK_NUMBER( RUNNING_TASK.OBJECT.ID ) > 0 then
417         TEXT_IO.PUT( "TASKS_DELETE - " );
418         TEST_SUPPORT.PUT_NAME( 
419            SPTEST.TASK_NAME( 
420               TEST_SUPPORT.TASK_NUMBER( RUNNING_TASK.OBJECT.ID ) 
421            ),
422            FALSE
423         );
424      end if;
425
426      if TEST_SUPPORT.TASK_NUMBER( DELETED_TASK.OBJECT.ID ) > 0 then
427         TEXT_IO.PUT( "deleting " );
428         TEST_SUPPORT.PUT_NAME( 
429            SPTEST.TASK_NAME( 
430               TEST_SUPPORT.TASK_NUMBER( DELETED_TASK.OBJECT.ID ) 
431            ),
432            TRUE
433         );
434      end if;
435
436   end TASK_DELETE_EXTENSION;
437
438--PAGE
439--
440--  TASK_RESTART_EXTENSION
441--
442
443   procedure TASK_RESTART_EXTENSION (
444      UNUSED         : in     RTEMS.TCB_POINTER;
445      RESTARTED_TASK : in     RTEMS.TCB_POINTER
446   ) is
447   begin
448
449      if TEST_SUPPORT.TASK_NUMBER( RESTARTED_TASK.OBJECT.ID ) > 0 then
450         TEXT_IO.PUT( "TASKS_RESTART - " );
451         TEST_SUPPORT.PUT_NAME( 
452            SPTEST.TASK_NAME( 
453               TEST_SUPPORT.TASK_NUMBER( RESTARTED_TASK.OBJECT.ID ) 
454            ),
455            FALSE
456         );
457         TEXT_IO.PUT_LINE( " - restarted." );
458      end if;
459
460   end TASK_RESTART_EXTENSION;
461
462--PAGE
463--
464--  TASK_START_EXTENSION
465--
466
467   procedure TASK_START_EXTENSION (
468      UNUSED       : in     RTEMS.TCB_POINTER;
469      STARTED_TASK : in     RTEMS.TCB_POINTER
470   ) is
471   begin
472
473      if TEST_SUPPORT.TASK_NUMBER( STARTED_TASK.OBJECT.ID ) > 0 then
474         TEXT_IO.PUT( "TASKS_START - " );
475         TEST_SUPPORT.PUT_NAME( 
476            SPTEST.TASK_NAME( 
477               TEST_SUPPORT.TASK_NUMBER( STARTED_TASK.OBJECT.ID ) 
478            ),
479            FALSE
480         );
481         TEXT_IO.PUT_LINE( " - started." );
482      end if;
483
484   end TASK_START_EXTENSION;
485
486end SPTEST;
Note: See TracBrowser for help on using the repository browser.