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