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

4.104.114.84.95
Last change on this file since 820901ba was 820901ba, checked in by Joel Sherrill <joel.sherrill@…>, on 05/03/05 at 21:41:45

2005-05-03 Joel Sherrill <joel@…>

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