source: rtems/testsuites/ada/sptests/sp19/sptest.adp @ 6899a8d

5
Last change on this file since 6899a8d was ee537ea, checked in by Sebastian Huber <sebastian.huber@…>, on Oct 12, 2017 at 8:00:10 AM

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: 10.7 KB
Line 
1--
2--  SPTEST / BODY
3--
4--  DESCRIPTION:
5--
6--  This package is the implementation of Test 19 of the RTEMS
7--  Single Processor Test Suite.
8--
9--  DEPENDENCIES:
10--
11-- 
12--
13--  COPYRIGHT (c) 1989, 1990, 1991, 1992, 1993, 1994.
14--  On-Line Applications Research Corporation (OAR).
15--
16
17with INTERFACES; use INTERFACES;
18with FLOAT_IO;
19with TEST_SUPPORT;
20with TEXT_IO;
21with UNSIGNED32_IO;
22with RTEMS.CLOCK;
23
24include(../../support/fp.inc)
25include(../../support/integer.inc)
26
27package body SPTEST is
28
29--
30--  INIT
31--
32
33   procedure INIT (
34      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
35   ) is
36      pragma Unreferenced(ARGUMENT);
37      STATUS : RTEMS.STATUS_CODES;
38   begin
39
40      TEXT_IO.NEW_LINE( 2 );
41      TEXT_IO.PUT_LINE( "*** TEST 19 ***" );
42
43      SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
44      SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
45      SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME(  'T', 'A', '3', ' ' );
46      SPTEST.TASK_NAME( 4 ) := RTEMS.BUILD_NAME(  'T', 'A', '4', ' ' );
47      SPTEST.TASK_NAME( 5 ) := RTEMS.BUILD_NAME(  'T', 'A', '5', ' ' );
48      SPTEST.TASK_NAME( 6 ) := RTEMS.BUILD_NAME(  'F', 'P', '1', ' ' );
49
50      RTEMS.TASKS.CREATE(
51         SPTEST.TASK_NAME( 1 ),
52         2,
53         2048,
54         RTEMS.DEFAULT_MODES,
55         RTEMS.FLOATING_POINT,
56         SPTEST.TASK_ID( 1 ),
57         STATUS
58      );
59      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
60
61      RTEMS.TASKS.CREATE(
62         SPTEST.TASK_NAME( 2 ),
63         2,
64         2048,
65         RTEMS.DEFAULT_MODES,
66         RTEMS.DEFAULT_ATTRIBUTES,
67         SPTEST.TASK_ID( 2 ),
68         STATUS
69      );
70      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
71
72      RTEMS.TASKS.CREATE(
73         SPTEST.TASK_NAME( 3 ),
74         2,
75         2048,
76         RTEMS.DEFAULT_MODES,
77         RTEMS.DEFAULT_ATTRIBUTES,
78         SPTEST.TASK_ID( 3 ),
79         STATUS
80      );
81      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
82
83      RTEMS.TASKS.CREATE(
84         SPTEST.TASK_NAME( 4 ),
85         2,
86         2048,
87         RTEMS.DEFAULT_MODES,
88         RTEMS.FLOATING_POINT,
89         SPTEST.TASK_ID( 4 ),
90         STATUS
91      );
92      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA4" );
93
94      RTEMS.TASKS.CREATE(
95         SPTEST.TASK_NAME( 5 ),
96         2,
97         2048,
98         RTEMS.DEFAULT_MODES,
99         RTEMS.FLOATING_POINT,
100         SPTEST.TASK_ID( 5 ),
101         STATUS
102      );
103      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA5" );
104
105      RTEMS.TASKS.CREATE(
106         SPTEST.TASK_NAME( 6 ),
107         1,
108         2048,
109         RTEMS.DEFAULT_MODES,
110         RTEMS.FLOATING_POINT,
111         SPTEST.TASK_ID( 6 ),
112         STATUS
113      );
114      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF FP1" );
115
116      RTEMS.TASKS.START(
117         SPTEST.TASK_ID( 6 ),
118         SPTEST.FIRST_FP_TASK'ACCESS,
119         0,
120         STATUS
121      );
122      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF FP1" );
123
124      RTEMS.TASKS.START(
125         SPTEST.TASK_ID( 1 ),
126         SPTEST.TASK_1'ACCESS,
127         0,
128         STATUS
129      );
130      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
131
132      RTEMS.TASKS.START(
133         SPTEST.TASK_ID( 2 ),
134         SPTEST.TASK_1'ACCESS,
135         0,
136         STATUS
137      );
138      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
139
140      RTEMS.TASKS.START(
141         SPTEST.TASK_ID( 3 ),
142         SPTEST.TASK_1'ACCESS,
143         0,
144         STATUS
145      );
146      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
147
148      RTEMS.TASKS.START(
149         SPTEST.TASK_ID( 4 ),
150         SPTEST.FP_TASK'ACCESS,
151         0,
152         STATUS
153      );
154      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA4" );
155
156      RTEMS.TASKS.START(
157         SPTEST.TASK_ID( 5 ),
158         SPTEST.FP_TASK'ACCESS,
159         0,
160         STATUS
161      );
162      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA5" );
163
164      --
165      --  Load "task dependent factors" in the context areas
166      --
167
168      SPTEST.FP_FACTORS( 0 ) :=    0.0;
169      SPTEST.FP_FACTORS( 1 ) := 1000.1;
170      SPTEST.FP_FACTORS( 2 ) := 2000.2;
171      SPTEST.FP_FACTORS( 3 ) := 3000.3;
172      SPTEST.FP_FACTORS( 4 ) := 4000.4;
173      SPTEST.FP_FACTORS( 5 ) := 5000.5;
174      SPTEST.FP_FACTORS( 6 ) := 6000.6;
175      SPTEST.FP_FACTORS( 7 ) := 7000.7;
176      SPTEST.FP_FACTORS( 8 ) := 8000.8;
177      SPTEST.FP_FACTORS( 9 ) := 9000.9;
178
179      SPTEST.INTEGER_FACTORS( 0 ) := 16#0000#;
180      SPTEST.INTEGER_FACTORS( 1 ) := 16#1000#;
181      SPTEST.INTEGER_FACTORS( 2 ) := 16#2000#;
182      SPTEST.INTEGER_FACTORS( 3 ) := 16#3000#;
183      SPTEST.INTEGER_FACTORS( 4 ) := 16#4000#;
184      SPTEST.INTEGER_FACTORS( 5 ) := 16#5000#;
185      SPTEST.INTEGER_FACTORS( 6 ) := 16#6000#;
186      SPTEST.INTEGER_FACTORS( 7 ) := 16#7000#;
187      SPTEST.INTEGER_FACTORS( 8 ) := 16#8000#;
188      SPTEST.INTEGER_FACTORS( 9 ) := 16#9000#;
189
190      RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
191      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
192
193   end INIT;
194
195--
196--  FIRST_FP_TASK
197--
198
199   procedure FIRST_FP_TASK (
200      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
201   ) is
202      STATUS     : RTEMS.STATUS_CODES;
203      TID        : RTEMS.ID;
204      TIME       : RTEMS.TIME_OF_DAY;
205      TASK_INDEX : RTEMS.UNSIGNED32;
206      INTEGER_DECLARE;
207      FP_DECLARE;
208   begin
209
210      RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
211      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
212
213      TASK_INDEX := TEST_SUPPORT.TASK_NUMBER( TID );
214   
215      INTEGER_LOAD( INTEGER_FACTORS( TASK_INDEX ) );
216      FP_LOAD( FP_FACTORS( TASK_INDEX ) );
217
218      TEST_SUPPORT.PUT_NAME( SPTEST.TASK_NAME( TASK_INDEX ), FALSE );
219      TEXT_IO.PUT( " - integer base = (" );
220      UNSIGNED32_IO.PUT( INTEGER_FACTORS( TASK_INDEX ), BASE => 16 );
221      TEXT_IO.PUT_LINE( ")" );
222
223      --
224      --  C implementation prints NA if no hardware FP support.
225      --
226
227      TEST_SUPPORT.PUT_NAME(
228         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
229         FALSE
230      );
231      TEXT_IO.PUT( " - float base = (" );
232      FLOAT_IO.PUT( FP_FACTORS( TASK_INDEX ) );
233      TEXT_IO.PUT_LINE( ")" );
234
235      FP_CHECK( FP_FACTORS( TASK_INDEX ) );
236      INTEGER_CHECK( INTEGER_FACTORS( TASK_INDEX ) );
237      if ARGUMENT = 0 then
238         RTEMS.TASKS.RESTART(
239            RTEMS.SELF,
240            1,
241            STATUS
242         );
243         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESTART OF SELF" );
244      else
245         TIME := ( 1988, 12, 31, 9, 0, 0, 0 );
246         RTEMS.CLOCK.SET( TIME, STATUS );
247         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_SET" );
248
249         RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
250         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
251      end if;
252
253   end FIRST_FP_TASK;
254
255--
256--  FP_TASK
257--
258
259   procedure FP_TASK (
260      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
261   ) is
262      pragma Unreferenced(ARGUMENT);
263      STATUS     : RTEMS.STATUS_CODES;
264      TID        : RTEMS.ID;
265      TIME       : RTEMS.TIME_OF_DAY;
266      TASK_INDEX : RTEMS.UNSIGNED32;
267      INTEGER_DECLARE;
268      FP_DECLARE;
269   begin
270
271      RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
272      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
273   
274      TASK_INDEX := TEST_SUPPORT.TASK_NUMBER( TID );
275 
276      INTEGER_LOAD( INTEGER_FACTORS( TASK_INDEX ) );
277      FP_LOAD( FP_FACTORS( TASK_INDEX ) );
278 
279      TEST_SUPPORT.PUT_NAME(
280         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
281         FALSE
282      );
283      TEXT_IO.PUT( " - integer base = (" );
284      UNSIGNED32_IO.PUT( INTEGER_FACTORS( TASK_INDEX ), BASE => 16 );
285      TEXT_IO.PUT_LINE( ")" );
286 
287      --
288      --  C implementation prints NA if no hardware FP support.
289      --
290 
291      TEST_SUPPORT.PUT_NAME(
292         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
293         FALSE
294      );
295      TEXT_IO.PUT( " - float base = (" );
296      FLOAT_IO.PUT( FP_FACTORS( TASK_INDEX ) );
297      TEXT_IO.PUT_LINE( ")" );
298
299      loop
300
301         RTEMS.CLOCK.GET_TOD( TIME, STATUS );
302         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
303
304         if TIME.SECOND >= 16 then
305
306            if TEST_SUPPORT.TASK_NUMBER( TID ) = 4 then
307               TEXT_IO.PUT_LINE( "TA4 - task_delete - self" );
308               RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
309               TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA4" );
310            end if;
311     
312            TEXT_IO.PUT_LINE( "TA5 - task_delete - TA3" );
313            RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 3 ), STATUS );
314            TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
315 
316            TEXT_IO.PUT_LINE( "*** END OF TEST 19 ***" );
317            RTEMS.SHUTDOWN_EXECUTIVE( 0 );
318         end if;
319
320         TEST_SUPPORT.PUT_NAME(
321            SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
322            FALSE
323         );
324
325         TEST_SUPPORT.PRINT_TIME( " - clock_get - ", TIME, "" );
326         TEXT_IO.NEW_LINE;
327
328         INTEGER_CHECK( INTEGER_FACTORS( TASK_INDEX ) );
329         FP_CHECK( FP_FACTORS( TASK_INDEX ) );
330 
331         RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
332         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
333         
334      end loop;
335   
336   end FP_TASK;
337
338--
339--  TASK_1
340--
341
342   procedure TASK_1 (
343      ARGUMENT : in     RTEMS.TASKS.ARGUMENT
344   ) is
345      pragma Unreferenced(ARGUMENT);
346      STATUS     : RTEMS.STATUS_CODES;
347      TID        : RTEMS.ID;
348      TIME       : RTEMS.TIME_OF_DAY;
349      TASK_INDEX : RTEMS.UNSIGNED32;
350      INTEGER_DECLARE;
351      FP_DECLARE;
352   begin
353
354      RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
355      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
356   
357      TASK_INDEX := TEST_SUPPORT.TASK_NUMBER( TID );
358 
359      INTEGER_LOAD( INTEGER_FACTORS( TASK_INDEX ) );
360      FP_LOAD( FP_FACTORS( TASK_INDEX ) );
361 
362      TEST_SUPPORT.PUT_NAME(
363         SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
364         FALSE
365      );
366      TEXT_IO.PUT( " - integer base = (" );
367      UNSIGNED32_IO.PUT( INTEGER_FACTORS( TASK_INDEX ), BASE => 16 );
368      TEXT_IO.PUT_LINE( ")" );
369 
370      loop
371
372         RTEMS.CLOCK.GET_TOD( TIME, STATUS );
373         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
374
375         TEST_SUPPORT.PUT_NAME(
376            SPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
377            FALSE
378         );
379
380         TEST_SUPPORT.PRINT_TIME( " - clock_get - ", TIME, "" );
381         TEXT_IO.NEW_LINE;
382
383         INTEGER_CHECK( INTEGER_FACTORS( TASK_INDEX ) );
384         FP_CHECK( FP_FACTORS( TASK_INDEX ) );
385
386         RTEMS.TASKS.WAKE_AFTER(
387            TEST_SUPPORT.TASK_NUMBER( TID ) * 5 *
388              TEST_SUPPORT.TICKS_PER_SECOND,
389            STATUS
390         );
391         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
392         
393      end loop;
394   
395   end TASK_1;
396
397end SPTEST;
Note: See TracBrowser for help on using the repository browser.