source: rtems/c/src/ada-tests/sptests/sp04/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: 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.rtems.com/license/LICENSE.
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      PREVIOUS_MODE : RTEMS.MODE;
141      TIME          : RTEMS.TIME_OF_DAY;
142      START_TIME    : RTEMS.INTERVAL;
143      END_TIME      : RTEMS.INTERVAL;
144      STATUS        : RTEMS.STATUS_CODES;
145   begin
146
147      TEXT_IO.PUT_LINE( "TA1 - task_suspend - on Task 2" );
148      RTEMS.TASK_SUSPEND( TASK_ID( 2 ), STATUS );
149      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND OF TA2" );
150 
151      TEXT_IO.PUT_LINE( "TA1 - task_suspend - on Task 3" );
152      RTEMS.TASK_SUSPEND( TASK_ID( 3 ), STATUS );
153      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND OF TA3" );
154 
155      TEXT_IO.PUT_LINE( "TA1 - killing time" );
156
157      RTEMS.CLOCK_GET(
158         RTEMS.CLOCK_GET_SECONDS_SINCE_EPOCH,
159         START_TIME'ADDRESS,
160         STATUS
161      );
162      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
163
164      loop
165         RTEMS.CLOCK_GET(
166            RTEMS.CLOCK_GET_SECONDS_SINCE_EPOCH,
167            END_TIME'ADDRESS,
168            STATUS
169         );
170         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
171
172         exit when END_TIME > (START_TIME + 2);
173      end loop;
174
175      TEXT_IO.PUT_LINE( "TA1 - task_resume - on Task 2" );
176      RTEMS.TASK_RESUME( TASK_ID( 2 ), STATUS );
177      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME OF TA2" );
178 
179      TEXT_IO.PUT_LINE( "TA1 - task_resume - on Task 3" );
180      RTEMS.TASK_RESUME( TASK_ID( 3 ), STATUS );
181      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME OF TA3" );
182 
183      loop
184
185         if SPTEST.RUN_COUNT( 1 ) = 3 then
186
187            TEXT_IO.PUT_LINE(
188               "TA1 - task_mode - change mode to NO PREEMPT"
189            );
190            RTEMS.TASK_MODE(
191               RTEMS.NO_PREEMPT,
192               RTEMS.PREEMPT_MASK,
193               PREVIOUS_MODE,
194               STATUS
195            );
196            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
197
198            RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
199            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
200
201            OLD_SECONDS := TIME.SECOND;
202
203            SECONDS := 0;
204            loop
205
206               exit when SECONDS >= 6;
207
208               RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
209               TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
210
211               if TIME.SECOND /= OLD_SECONDS then
212                  OLD_SECONDS := TIME.SECOND;
213                  SECONDS := SECONDS + 1;
214                  TEST_SUPPORT.PRINT_TIME( "TA1 - ", TIME, "" );
215                  TEXT_IO.NEW_LINE;
216               end if;
217
218            end loop;
219
220            TEXT_IO.PUT_LINE(
221               "TA1 - task_mode - change mode to PREEMPT"
222            );
223
224            RTEMS.TASK_MODE(
225               RTEMS.PREEMPT,
226               RTEMS.PREEMPT_MASK,
227               PREVIOUS_MODE,
228               STATUS
229            );
230            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
231
232<<LOOP_LABEL>>
233            goto LOOP_LABEL;
234
235         end if;
236
237      end loop;
238
239   end TASK_1;
240
241--PAGE
242--
243--  TASK_2
244--
245
246   procedure TASK_2 (
247      ARGUMENT : in     RTEMS.TASK_ARGUMENT
248   ) is
249   begin
250
251<<LOOP_LABEL>>
252         goto LOOP_LABEL;
253
254   end TASK_2;
255
256--PAGE
257--
258--  TASK_3
259--
260
261   procedure TASK_3 (
262      ARGUMENT : in     RTEMS.TASK_ARGUMENT
263   ) is
264   begin
265
266<<LOOP_LABEL>>
267         goto LOOP_LABEL;
268
269   end TASK_3;
270
271--PAGE
272--
273--  TASK_SWITCH
274--
275
276   procedure TASK_SWITCH (
277      UNUSED : in     RTEMS.TCB_POINTER;
278      HEIR   : in     RTEMS.TCB_POINTER
279   ) is
280      INDEX  : RTEMS.UNSIGNED32;
281      TIME   : RTEMS.TIME_OF_DAY;
282      STATUS : RTEMS.STATUS_CODES;
283      function TCB_To_ID (
284         TCB : RTEMS.TCB_POINTER
285      ) return RTEMS.ID;
286      pragma Import (C, TCB_To_ID, "tcb_to_id" );
287         
288   begin
289
290      --INDEX := TEST_SUPPORT.TASK_NUMBER( HEIR.OBJECT.ID );
291      INDEX := TCB_To_ID( HEIR );
292
293      case INDEX is
294         when 1  | 2 | 3 =>
295            SPTEST.RUN_COUNT( INDEX ) := SPTEST.RUN_COUNT( INDEX ) + 1;
296
297            RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
298            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET" );
299
300            TEST_SUPPORT.PUT_NAME( SPTEST.TASK_NAME( INDEX ), FALSE );
301            TEST_SUPPORT.PRINT_TIME( "- ", TIME, "" );
302            TEXT_IO.NEW_LINE;
303           
304            if TIME.SECOND >= 16 then
305               TEXT_IO.PUT_LINE( "*** END OF TEST 4 ***" );
306               RTEMS.SHUTDOWN_EXECUTIVE( 0 );
307            end if;
308
309         when others =>
310            NULL;
311      end case;
312
313   end TASK_SWITCH;
314
315end SPTEST;
Note: See TracBrowser for help on using the repository browser.