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

5
Last change on this file since 76bd25e was dda8142f, checked in by Sebastian Huber <sebastian.huber@…>, on Dec 1, 2017 at 2:22:02 PM

ada/sp07: Fix uninitialized variable

Bug was introduced by d5154d0f6a04f3b7ed59d9a09038576fe2640756.

Updates #2493.

  • 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      TEST_SUPPORT.ADA_TEST_BEGIN;
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      THE_PRIORITY := 4;
320
321      loop
322
323         THE_PRIORITY := THE_PRIORITY - 1;
324
325         if THE_PRIORITY = 0 then
326            TEXT_IO.PUT_LINE( "TA2 - task_suspend - suspend TA1" ); 
327            RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 1 ), STATUS );
328            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
329
330            TEXT_IO.PUT( "TA2 - task_set_priority - ");
331            TEXT_IO.PUT_LINE( "set priority of TA1 ( blocked )");
332            RTEMS.TASKS.SET_PRIORITY( 
333               SPTEST.TASK_ID( 1 ), 
334               5, 
335               PREVIOUS_PRIORITY, 
336               STATUS
337            );
338            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
339
340            RTEMS.TASKS.DELETE( 
341               SPTEST.TASK_ID( 1 ), 
342               STATUS
343            );                            -- TA1 is blocked
344            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );
345
346            RTEMS.TASKS.DELETE( 
347               SPTEST.TASK_ID( 3 ), 
348               STATUS
349            );                            -- TA3 is ready
350            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
351
352            RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
353            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
354
355         else
356
357            TEXT_IO.PUT( "TA2 - task_set_priority - "); 
358            TEXT_IO.PUT( "set TA1's priority: ");
359            UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2);
360            TEXT_IO.NEW_LINE;
361            RTEMS.TASKS.SET_PRIORITY( 
362               SPTEST.TASK_ID( 1 ), 
363               THE_PRIORITY, 
364               PREVIOUS_PRIORITY, 
365               STATUS
366            );
367            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
368
369         end if;
370
371      end loop;
372   
373   end TASK_2;
374
375--
376--  TASK_3
377--
378
379   procedure TASK_3 (
380      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
381   ) is
382      pragma Unreferenced(ARGUMENT);
383      STATUS : RTEMS.STATUS_CODES;
384   begin
385   
386      loop
387
388         RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
389         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
390
391      end loop;
392
393   end TASK_3;
394
395--
396--  TASK_4
397--
398
399   procedure TASK_4 (
400      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
401   ) is
402      pragma Unreferenced(ARGUMENT);
403   begin
404
405      Flush_Task_Event_Log;
406
407      TEXT_IO.PUT_LINE( "TA4 - exitting task" );
408
409   end TASK_4;
410
411--
412--  TASK_EXIT_EXTENSION
413--
414
415   procedure TASK_EXIT_EXTENSION (
416      RUNNING_TASK : in     RTEMS.TCB_POINTER
417   ) is
418   begin
419
420      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 then
421         TEXT_IO.PUT_LINE( "TASK_EXITTED - user extension invoked correctly" );
422      end if;
423
424      TEST_SUPPORT.ADA_TEST_END;
425      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
426
427   end TASK_EXIT_EXTENSION;
428
429--
430--  TASK_CREATE_EXTENSION
431--
432
433   function TASK_CREATE_EXTENSION (
434      UNUSED       : in     RTEMS.TCB_POINTER;
435      CREATED_TASK : in     RTEMS.TCB_POINTER
436   ) return RTEMS.Boolean is
437      pragma Unreferenced(UNUSED);
438   begin
439
440      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ) > 0 then
441         Log_Task_Event ( 
442            Created, 
443            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ),
444            0
445         );
446      end if;
447
448      return RTEMS.True;
449
450   end TASK_CREATE_EXTENSION;
451
452--
453--  TASK_DELETE_EXTENSION
454--
455
456   procedure TASK_DELETE_EXTENSION (
457      RUNNING_TASK : in     RTEMS.TCB_POINTER;
458      DELETED_TASK : in     RTEMS.TCB_POINTER
459   ) is
460   begin
461
462      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 and
463        TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) ) > 0 then
464         Log_Task_Event ( 
465            Deleted, 
466            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ),
467            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) )
468         );
469      end if;
470
471   end TASK_DELETE_EXTENSION;
472
473--
474--  TASK_RESTART_EXTENSION
475--
476
477   procedure TASK_RESTART_EXTENSION (
478      UNUSED         : in     RTEMS.TCB_POINTER;
479      RESTARTED_TASK : in     RTEMS.TCB_POINTER
480   ) is
481      pragma Unreferenced(UNUSED);
482   begin
483
484      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ) > 0 then
485         Log_Task_Event ( 
486            Restarted, 
487            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ),
488            0
489         );
490      end if;
491
492   end TASK_RESTART_EXTENSION;
493
494--
495--  TASK_START_EXTENSION
496--
497
498   procedure TASK_START_EXTENSION (
499      UNUSED       : in     RTEMS.TCB_POINTER;
500      STARTED_TASK : in     RTEMS.TCB_POINTER
501   ) is
502      pragma Unreferenced(UNUSED);
503   begin
504
505      if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ) > 0 then
506         Log_Task_Event ( 
507            Started, 
508            TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ),
509            0
510         );
511      end if;
512
513   end TASK_START_EXTENSION;
514
515end SPTEST;
Note: See TracBrowser for help on using the repository browser.