source: rtems/testsuites/ada/sptests/sp07/sptest.adb @ ee537ea

5
Last change on this file since ee537ea was ee537ea, checked in by Sebastian Huber <sebastian.huber@…>, on 10/12/17 at 08:00:10

ada-tests: Move to testsuites/ada

This solves a build dependency issue, e.g. building tests before
librtemsbsp.a exists.

Close #3079.

  • Property mode set to 100644
File size: 13.4 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.DELETE( RTEMS.SELF, STATUS );
233      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
234
235   end INIT;
236
237--
238--  TASK_1
239--
240
241   procedure TASK_1 (
242      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
243   ) is
244      pragma Unreferenced(ARGUMENT);
245      STATUS            : RTEMS.STATUS_CODES;
246      THE_PRIORITY      : RTEMS.TASKS.PRIORITY;
247      PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
248   begin
249
250      TEST_SUPPORT.PAUSE;
251
252      RTEMS.TASKS.SET_PRIORITY(
253         RTEMS.SELF,
254         RTEMS.TASKS.CURRENT_PRIORITY,
255         THE_PRIORITY,
256         STATUS
257      );
258      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
259      TEXT_IO.PUT( "TA1 - task_set_priority - ");
260      TEXT_IO.PUT( "get initial priority of self: ");
261      UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
262      TEXT_IO.NEW_LINE;
263
264      loop
265
266         THE_PRIORITY := THE_PRIORITY - 1;
267
268         if THE_PRIORITY = 0 then
269            TEXT_IO.PUT_LINE( "TA1 - task_suspend - suspend TA2" );
270            RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 2 ), STATUS );
271            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
272
273            TEXT_IO.PUT( "TA1 - task_set_priority - ");
274            TEXT_IO.PUT_LINE( "set priority of TA2 ( blocked )");
275            RTEMS.TASKS.SET_PRIORITY(
276               SPTEST.TASK_ID( 2 ),
277               5,
278               PREVIOUS_PRIORITY,
279               STATUS
280            );
281            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
282
283            RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 2 ), STATUS );
284            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
285
286            RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
287            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
288
289         end if;
290
291         TEXT_IO.PUT("TA1 - task_set_priority - set TA2's priority: ");
292         UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
293         TEXT_IO.NEW_LINE;
294         RTEMS.TASKS.SET_PRIORITY(
295            SPTEST.TASK_ID( 2 ),
296            THE_PRIORITY,
297            PREVIOUS_PRIORITY,
298            STATUS
299         );
300         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
301
302      end loop;
303   
304   end TASK_1;
305
306--
307--  TASK_2
308--
309
310   procedure TASK_2 (
311      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
312   ) is
313      pragma Unreferenced(ARGUMENT);
314      STATUS            : RTEMS.STATUS_CODES;
315      THE_PRIORITY      : RTEMS.TASKS.PRIORITY;
316      PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
317   begin
318
319      loop
320
321         THE_PRIORITY := THE_PRIORITY - 1;
322
323         if THE_PRIORITY = 0 then
324            TEXT_IO.PUT_LINE( "TA2 - task_suspend - suspend TA1" );
325            RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 1 ), STATUS );
326            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
327
328            TEXT_IO.PUT( "TA2 - task_set_priority - ");
329            TEXT_IO.PUT_LINE( "set priority of TA1 ( blocked )");
330            RTEMS.TASKS.SET_PRIORITY(
331               SPTEST.TASK_ID( 1 ),
332               5,
333               PREVIOUS_PRIORITY,
334               STATUS
335            );
336            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
337
338            RTEMS.TASKS.DELETE(
339               SPTEST.TASK_ID( 1 ),
340               STATUS
341            );                            -- TA1 is blocked
342            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );
343
344            RTEMS.TASKS.DELETE(
345               SPTEST.TASK_ID( 3 ),
346               STATUS
347            );                            -- TA3 is ready
348            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
349
350            RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
351            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
352
353         else
354
355            TEXT_IO.PUT( "TA2 - task_set_priority - ");
356            TEXT_IO.PUT( "set TA1's priority: ");
357            UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2);
358            TEXT_IO.NEW_LINE;
359            RTEMS.TASKS.SET_PRIORITY(
360               SPTEST.TASK_ID( 1 ),
361               THE_PRIORITY,
362               PREVIOUS_PRIORITY,
363               STATUS
364            );
365            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
366
367         end if;
368
369      end loop;
370   
371   end TASK_2;
372
373--
374--  TASK_3
375--
376
377   procedure TASK_3 (
378      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
379   ) is
380      pragma Unreferenced(ARGUMENT);
381      STATUS : RTEMS.STATUS_CODES;
382   begin
383   
384      loop
385
386         RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
387         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
388
389      end loop;
390
391   end TASK_3;
392
393--
394--  TASK_4
395--
396
397   procedure TASK_4 (
398      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
399   ) is
400      pragma Unreferenced(ARGUMENT);
401   begin
402
403      Flush_Task_Event_Log;
404
405      TEXT_IO.PUT_LINE( "TA4 - exitting task" );
406
407   end TASK_4;
408
409--
410--  TASK_EXIT_EXTENSION
411--
412
413   procedure TASK_EXIT_EXTENSION (
414      RUNNING_TASK : in     RTEMS.TCB_POINTER
415   ) is
416   begin
417
418      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 then
419         TEXT_IO.PUT_LINE( "TASK_EXITTED - user extension invoked correctly" );
420      end if;
421
422      TEXT_IO.PUT_LINE( "*** END OF TEST 7 ***" );
423      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
424
425   end TASK_EXIT_EXTENSION;
426
427--
428--  TASK_CREATE_EXTENSION
429--
430
431   function TASK_CREATE_EXTENSION (
432      UNUSED       : in     RTEMS.TCB_POINTER;
433      CREATED_TASK : in     RTEMS.TCB_POINTER
434   ) return RTEMS.Boolean is
435      pragma Unreferenced(UNUSED);
436   begin
437
438      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ) > 0 then
439         Log_Task_Event (
440            Created,
441            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ),
442            0
443         );
444      end if;
445
446      return RTEMS.True;
447
448   end TASK_CREATE_EXTENSION;
449
450--
451--  TASK_DELETE_EXTENSION
452--
453
454   procedure TASK_DELETE_EXTENSION (
455      RUNNING_TASK : in     RTEMS.TCB_POINTER;
456      DELETED_TASK : in     RTEMS.TCB_POINTER
457   ) is
458   begin
459
460      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 and
461        TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) ) > 0 then
462         Log_Task_Event (
463            Deleted,
464            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ),
465            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) )
466         );
467      end if;
468
469   end TASK_DELETE_EXTENSION;
470
471--
472--  TASK_RESTART_EXTENSION
473--
474
475   procedure TASK_RESTART_EXTENSION (
476      UNUSED         : in     RTEMS.TCB_POINTER;
477      RESTARTED_TASK : in     RTEMS.TCB_POINTER
478   ) is
479      pragma Unreferenced(UNUSED);
480   begin
481
482      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ) > 0 then
483         Log_Task_Event (
484            Restarted,
485            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ),
486            0
487         );
488      end if;
489
490   end TASK_RESTART_EXTENSION;
491
492--
493--  TASK_START_EXTENSION
494--
495
496   procedure TASK_START_EXTENSION (
497      UNUSED       : in     RTEMS.TCB_POINTER;
498      STARTED_TASK : in     RTEMS.TCB_POINTER
499   ) is
500      pragma Unreferenced(UNUSED);
501   begin
502
503      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ) > 0 then
504         Log_Task_Event (
505            Started,
506            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ),
507            0
508         );
509      end if;
510
511   end TASK_START_EXTENSION;
512
513end SPTEST;
Note: See TracBrowser for help on using the repository browser.