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

4.104.114.84.95
Last change on this file since 48bfd992 was e56a2ef, checked in by Joel Sherrill <joel.sherrill@…>, on 06/03/97 at 00:32:50

updated to run

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