source: rtems/c/src/ada-tests/sptests/sp04/sptest.adb @ 948a069

Last change on this file since 948a069 was f6bcc8f, checked in by Joel Sherrill <joel.sherrill@…>, on Sep 4, 2003 at 1:25:16 PM

2003-09-04 Joel Sherrill <joel@…>

  • samples/base_sp/base_sp.adb, samples/base_sp/config.h, samples/base_sp/sptest.adb, samples/base_sp/sptest.ads, samples/hello/config.h, samples/hello/hello.adb, samples/hello/sptest.adb, samples/hello/sptest.ads, samples/ticker/config.h, samples/ticker/sptest.adb, samples/ticker/sptest.ads, samples/ticker/ticker.adb, sptests/sp01/config.h, sptests/sp01/sp01.adb, sptests/sp01/sptest.adb, sptests/sp01/sptest.ads, sptests/sp02/config.h, sptests/sp02/sp02.adb, sptests/sp02/sptest.adb, sptests/sp02/sptest.ads, sptests/sp03/config.h, sptests/sp03/sp03.adb, sptests/sp03/sptest.adb, sptests/sp03/sptest.ads, sptests/sp04/config.h, sptests/sp04/sp04.adb, sptests/sp04/sptest.adb, sptests/sp04/sptest.ads, sptests/sp05/config.h, sptests/sp05/sp05.adb, sptests/sp05/sptest.adb, sptests/sp05/sptest.ads, sptests/sp06/config.h, sptests/sp06/sp06.adb, sptests/sp06/sptest.adb, sptests/sp06/sptest.ads, sptests/sp07/config.h, sptests/sp07/sp07.adb, sptests/sp07/sptest.adb, sptests/sp07/sptest.ads, sptests/sp08/config.h, sptests/sp08/sp08.adb, sptests/sp08/sptest.adb, sptests/sp08/sptest.ads, sptests/sp09/config.h, sptests/sp09/sp09.adb, sptests/sp09/sptest.adb, sptests/sp09/sptest.ads, sptests/sp11/config.h, sptests/sp11/sp11.adb, sptests/sp11/sptest.adb, sptests/sp11/sptest.ads, sptests/sp12/config.h, sptests/sp12/sp12.adb, sptests/sp12/sptest.adb, sptests/sp12/sptest.ads, sptests/sp13/config.h, sptests/sp13/sp13.adb, sptests/sp13/sptest.adb, sptests/sp13/sptest.ads, sptests/sp14/config.h, sptests/sp14/sp14.adb, sptests/sp14/sptest.adb, sptests/sp14/sptest.ads, sptests/sp15/config.h, sptests/sp15/sp15.adb, sptests/sp15/sptest.adb, sptests/sp15/sptest.ads, sptests/sp16/config.h, sptests/sp16/sp16.adb, sptests/sp16/sptest.adb, sptests/sp16/sptest.ads, sptests/sp17/config.h, sptests/sp17/sp17.adb, sptests/sp17/sptest.adb, sptests/sp17/sptest.ads, sptests/sp19/config.h, sptests/sp19/sp19.adb, sptests/sp19/sptest.adp, sptests/sp19/sptest.ads, sptests/sp20/config.h, sptests/sp20/sp20.adb, sptests/sp20/sptest.adb, sptests/sp20/sptest.ads, sptests/sp21/config.h, sptests/sp21/sp21.adb, sptests/sp21/sptest.adb, sptests/sp21/sptest.ads, sptests/sp22/config.h, sptests/sp22/sp22.adb, sptests/sp22/sptest.adb, sptests/sp22/sptest.ads, sptests/sp23/config.h, sptests/sp23/sp23.adb, sptests/sp23/sptest.adb, sptests/sp23/sptest.ads, sptests/sp24/config.h, sptests/sp24/sp24.adb, sptests/sp24/sptest.adb, sptests/sp24/sptest.ads, sptests/sp25/config.h, sptests/sp25/sp25.adb, sptests/sp25/sptest.adb, sptests/sp25/sptest.ads, sptests/spsize/spsize.adb, sptests/spsize/sptest.adb, sptests/spsize/sptest.ads, support/address_io.adb, support/address_io.ads, support/float_io.ads, support/fp.inc, support/init.c, support/integer.inc, support/rtems_calling_overhead.ads, support/status_io.ads, support/test_support.adb, support/test_support.ads, support/time_test_support.adb, support/time_test_support.ads, support/timer_driver.adb, support/timer_driver.ads, support/unsigned32_io.ads, tmtests/tm01/config.h, tmtests/tm01/tm01.adb, tmtests/tm01/tmtest.adb, tmtests/tm01/tmtest.ads, tmtests/tm02/config.h, tmtests/tm02/tm02.adb, tmtests/tm02/tmtest.adb, tmtests/tm02/tmtest.ads, tmtests/tm03/config.h, tmtests/tm03/tm03.adb, tmtests/tm03/tmtest.adb, tmtests/tm03/tmtest.ads, tmtests/tm04/config.h, tmtests/tm04/tm04.adb, tmtests/tm04/tmtest.adb, tmtests/tm04/tmtest.ads, tmtests/tm05/config.h, tmtests/tm05/tm05.adb, tmtests/tm05/tmtest.adb, tmtests/tm05/tmtest.ads, tmtests/tm06/config.h, tmtests/tm06/tm06.adb, tmtests/tm06/tmtest.adb, tmtests/tm06/tmtest.ads, tmtests/tm07/config.h, tmtests/tm07/tm07.adb, tmtests/tm07/tmtest.adb, tmtests/tm07/tmtest.ads, tmtests/tm08/config.h, tmtests/tm08/tm08.adb, tmtests/tm08/tmtest.adb, tmtests/tm08/tmtest.ads, tmtests/tm09/config.h, tmtests/tm09/tm09.adb, tmtests/tm09/tmtest.adb, tmtests/tm09/tmtest.ads, tmtests/tm10/config.h, tmtests/tm10/tm10.adb, tmtests/tm10/tmtest.adb, tmtests/tm10/tmtest.ads, tmtests/tm11/config.h, tmtests/tm11/tm11.adb, tmtests/tm11/tmtest.adb, tmtests/tm11/tmtest.ads, tmtests/tm12/config.h, tmtests/tm12/tm12.adb, tmtests/tm12/tmtest.adb, tmtests/tm12/tmtest.ads, tmtests/tm13/config.h, tmtests/tm13/tm13.adb, tmtests/tm13/tmtest.adb, tmtests/tm13/tmtest.ads, tmtests/tm14/config.h, tmtests/tm14/tm14.adb, tmtests/tm14/tmtest.adb, tmtests/tm14/tmtest.ads, tmtests/tm15/config.h, tmtests/tm15/tm15.adb, tmtests/tm15/tmtest.adb, tmtests/tm15/tmtest.ads, tmtests/tm16/config.h, tmtests/tm16/tm16.adb, tmtests/tm16/tmtest.adb, tmtests/tm16/tmtest.ads, tmtests/tm17/config.h, tmtests/tm17/tm17.adb, tmtests/tm17/tmtest.adb, tmtests/tm17/tmtest.ads, tmtests/tm18/config.h, tmtests/tm18/tm18.adb, tmtests/tm18/tmtest.adb, tmtests/tm18/tmtest.ads, tmtests/tm19/config.h, tmtests/tm19/tm19.adb, tmtests/tm19/tmtest.adb, tmtests/tm19/tmtest.ads, tmtests/tm20/config.h, tmtests/tm20/tm20.adb, tmtests/tm20/tmtest.adb, tmtests/tm20/tmtest.ads, tmtests/tm21/config.h, tmtests/tm21/tm21.adb, tmtests/tm21/tmtest.adb, tmtests/tm21/tmtest.ads, tmtests/tm22/config.h, tmtests/tm22/tm22.adb, tmtests/tm22/tmtest.adb, tmtests/tm22/tmtest.ads, tmtests/tm23/config.h, tmtests/tm23/tm23.adb, tmtests/tm23/tmtest.adb, tmtests/tm23/tmtest.ads, tmtests/tm24/config.h, tmtests/tm24/tm24.adb, tmtests/tm24/tmtest.adb, tmtests/tm24/tmtest.ads, tmtests/tm25/config.h, tmtests/tm25/tm25.adb, tmtests/tm25/tmtest.adb, tmtests/tm25/tmtest.ads, tmtests/tm28/config.h, tmtests/tm28/tm28.adb, tmtests/tm28/tmtest.adb, tmtests/tm28/tmtest.ads, tmtests/tm29/config.h, tmtests/tm29/tm29.adb, tmtests/tm29/tmtest.adb, tmtests/tm29/tmtest.ads, tmtests/tmck/config.h, tmtests/tmck/tmck.adb, tmtests/tmck/tmtest.adb, tmtests/tmck/tmtest.ads, tmtests/tmoverhd/config.h, tmtests/tmoverhd/dummy_rtems.adb, tmtests/tmoverhd/dummy_rtems.ads, tmtests/tmoverhd/tmoverhd.adb, tmtests/tmoverhd/tmtest.adb, tmtests/tmoverhd/tmtest.ads: Removed incorrect statement about copyright assignment.
  • Property mode set to 100644
File size: 7.6 KB
Line 
1--
2--  SPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 4 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.OARcorp.com/rtems/license.html.
19--
20--  $Id$
21--
22
23with INTERFACES; use INTERFACES;
24with RTEMS;
25with TEST_SUPPORT;
26with TEXT_IO;
27
28package body SPTEST is
29
30--PAGE
31--
32--  INIT
33--
34
35   procedure INIT (
36      ARGUMENT : in     RTEMS.TASK_ARGUMENT
37   ) is
38      TIME   : RTEMS.TIME_OF_DAY;
39      STATUS : RTEMS.STATUS_CODES;
40   begin
41
42      TEXT_IO.NEW_LINE( 2 );
43      TEXT_IO.PUT_LINE( "*** TEST 4 ***" );
44
45      TIME := ( 1988, 12, 31, 9, 15, 0, 0 );
46
47      RTEMS.CLOCK_SET( TIME, STATUS );
48      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_SET" );
49
50      SPTEST.EXTENSION_NAME( 1 ) := RTEMS.BUILD_NAME(  'E', 'X', 'T', ' ' );
51
52      RTEMS.EXTENSION_CREATE(
53         SPTEST.EXTENSION_NAME( 1 ),
54         SPTEST.EXTENSIONS'ACCESS,
55         EXTENSION_ID( 1 ),
56         STATUS
57      );
58      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EXTENSION_CREATE" );
59
60      SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
61      SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
62      SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME(  'T', 'A', '3', ' ' );
63
64      SPTEST.RUN_COUNT( 1 ) := 0;
65      SPTEST.RUN_COUNT( 2 ) := 0;
66      SPTEST.RUN_COUNT( 3 ) := 0;
67
68      RTEMS.TASK_CREATE( 
69         SPTEST.TASK_NAME( 1 ), 
70         1, 
71         2048, 
72         RTEMS.TIMESLICE,
73         RTEMS.DEFAULT_ATTRIBUTES,
74         SPTEST.TASK_ID( 1 ),
75         STATUS
76      );
77      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
78
79      RTEMS.TASK_CREATE( 
80         SPTEST.TASK_NAME( 2 ), 
81         1, 
82         2048, 
83         RTEMS.TIMESLICE,
84         RTEMS.DEFAULT_ATTRIBUTES,
85         SPTEST.TASK_ID( 2 ),
86         STATUS
87      );
88      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
89
90      RTEMS.TASK_CREATE( 
91         SPTEST.TASK_NAME( 3 ), 
92         1, 
93         2048, 
94         RTEMS.TIMESLICE,
95         RTEMS.DEFAULT_ATTRIBUTES,
96         SPTEST.TASK_ID( 3 ),
97         STATUS
98      );
99      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
100
101      RTEMS.TASK_START(
102         SPTEST.TASK_ID( 1 ),
103         SPTEST.TASK_1'ACCESS,
104         0,
105         STATUS
106      );
107      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
108
109      RTEMS.TASK_START(
110         SPTEST.TASK_ID( 2 ),
111         SPTEST.TASK_2'ACCESS,
112         0,
113         STATUS
114      );
115      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
116
117      RTEMS.TASK_START(
118         SPTEST.TASK_ID( 3 ),
119         SPTEST.TASK_3'ACCESS,
120         0,
121         STATUS
122      );
123      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
124
125      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
126      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
127
128   end INIT;
129
130--PAGE
131--
132--  TASK_1
133--
134
135   procedure TASK_1 (
136      ARGUMENT : in     RTEMS.TASK_ARGUMENT
137   ) is
138      SECONDS       : RTEMS.UNSIGNED32;
139      OLD_SECONDS   : RTEMS.UNSIGNED32;
140      STARTED_DELAY : RTEMS.UNSIGNED32;
141      PREVIOUS_MODE : RTEMS.MODE;
142      TIME          : RTEMS.TIME_OF_DAY;
143      START_TIME    : RTEMS.INTERVAL;
144      END_TIME      : RTEMS.INTERVAL;
145      STATUS        : RTEMS.STATUS_CODES;
146   begin
147
148      TEXT_IO.PUT_LINE( "TA1 - task_suspend - on Task 2" );
149      RTEMS.TASK_SUSPEND( TASK_ID( 2 ), STATUS );
150      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND OF TA2" );
151 
152      TEXT_IO.PUT_LINE( "TA1 - task_suspend - on Task 3" );
153      RTEMS.TASK_SUSPEND( TASK_ID( 3 ), STATUS );
154      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND OF TA3" );
155 
156      TEXT_IO.PUT_LINE( "TA1 - killing time" );
157
158      RTEMS.CLOCK_GET(
159         RTEMS.CLOCK_GET_SECONDS_SINCE_EPOCH,
160         START_TIME'ADDRESS,
161         STATUS
162      );
163      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
164
165      loop
166         RTEMS.CLOCK_GET(
167            RTEMS.CLOCK_GET_SECONDS_SINCE_EPOCH,
168            END_TIME'ADDRESS,
169            STATUS
170         );
171         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
172
173         exit when END_TIME > (START_TIME + 2);
174      end loop;
175
176      TEXT_IO.PUT_LINE( "TA1 - task_resume - on Task 2" );
177      RTEMS.TASK_RESUME( TASK_ID( 2 ), STATUS );
178      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME OF TA2" );
179 
180      TEXT_IO.PUT_LINE( "TA1 - task_resume - on Task 3" );
181      RTEMS.TASK_RESUME( TASK_ID( 3 ), STATUS );
182      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME OF TA3" );
183 
184      loop
185
186         if SPTEST.RUN_COUNT( 1 ) = 3 then
187
188            TEXT_IO.PUT_LINE( 
189               "TA1 - task_mode - change mode to NO PREEMPT"
190            );
191            RTEMS.TASK_MODE( 
192               RTEMS.NO_PREEMPT, 
193               RTEMS.PREEMPT_MASK, 
194               PREVIOUS_MODE, 
195               STATUS
196            );
197            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
198
199            RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
200            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
201
202            OLD_SECONDS := TIME.SECOND;
203
204            SECONDS := 0;
205            loop
206
207               exit when SECONDS >= 6;
208
209               RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
210               TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
211
212               if TIME.SECOND /= OLD_SECONDS then
213                  OLD_SECONDS := TIME.SECOND;
214                  SECONDS := SECONDS + 1;
215                  TEST_SUPPORT.PRINT_TIME( "TA1 - ", TIME, "" );
216                  TEXT_IO.NEW_LINE;
217               end if;
218
219            end loop;
220
221            TEXT_IO.PUT_LINE( 
222               "TA1 - task_mode - change mode to PREEMPT"
223            );
224
225            RTEMS.TASK_MODE( 
226               RTEMS.PREEMPT, 
227               RTEMS.PREEMPT_MASK, 
228               PREVIOUS_MODE, 
229               STATUS
230            );
231            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
232
233<<LOOP_LABEL>>
234            goto LOOP_LABEL;
235
236         end if;
237
238      end loop;
239
240   end TASK_1;
241
242--PAGE
243--
244--  TASK_2
245--
246
247   procedure TASK_2 (
248      ARGUMENT : in     RTEMS.TASK_ARGUMENT
249   ) is
250   begin
251
252<<LOOP_LABEL>>
253         goto LOOP_LABEL;
254
255   end TASK_2;
256
257--PAGE
258--
259--  TASK_3
260--
261
262   procedure TASK_3 (
263      ARGUMENT : in     RTEMS.TASK_ARGUMENT
264   ) is
265   begin
266
267<<LOOP_LABEL>>
268         goto LOOP_LABEL;
269
270   end TASK_3;
271
272--PAGE
273--
274--  TASK_SWITCH
275--
276
277   procedure TASK_SWITCH (
278      UNUSED : in     RTEMS.TCB_POINTER;
279      HEIR   : in     RTEMS.TCB_POINTER
280   ) is
281      INDEX  : RTEMS.UNSIGNED32;
282      TIME   : RTEMS.TIME_OF_DAY;
283      STATUS : RTEMS.STATUS_CODES;
284      function TCB_To_ID (
285         TCB : RTEMS.TCB_POINTER
286      ) return RTEMS.ID;
287      pragma Import (C, TCB_To_ID, "tcb_to_id" );
288         
289   begin
290
291      --INDEX := TEST_SUPPORT.TASK_NUMBER( HEIR.OBJECT.ID );
292      INDEX := TCB_To_ID( HEIR );
293
294      case INDEX is
295         when 1  | 2 | 3 =>
296            SPTEST.RUN_COUNT( INDEX ) := SPTEST.RUN_COUNT( INDEX ) + 1;
297
298            RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
299            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
300
301            TEST_SUPPORT.PUT_NAME( SPTEST.TASK_NAME( INDEX ), FALSE );
302            TEST_SUPPORT.PRINT_TIME( "- ", TIME, "" );
303            TEXT_IO.NEW_LINE;
304           
305            if TIME.SECOND >= 16 then
306               TEXT_IO.PUT_LINE( "*** END OF TEST 4 ***" );
307               RTEMS.SHUTDOWN_EXECUTIVE( 0 );
308            end if;
309
310         when others =>
311            NULL;
312      end case;
313
314   end TASK_SWITCH;
315
316end SPTEST;
Note: See TracBrowser for help on using the repository browser.