Context Navigation

source: rtems/testsuites/ada/sptests/sp12/sptest.adb @ bc96f3b4

5

Last change on this file since bc96f3b4 was f6c9334d, checked in by Sebastian Huber <sebastian.huber@…>, on 12/01/17 at 07:51:17
ada: Add standard test begin/end message
Property mode set to `100644`
File size: 23.5 KB

Line
1	--
2	-- SPTEST / BODY
3	--
4	-- DESCRIPTION:
5	--
6	-- This package is the implementation of Test 12 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
21	with INTERFACES; use INTERFACES;
22	with TEST_SUPPORT;
23	with TEXT_IO;
24	with UNSIGNED32_IO;
25	with RTEMS.SEMAPHORE;
26
27	package 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	TEST_SUPPORT.ADA_TEST_BEGIN;
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
49	SPTEST.PRIORITY_TASK_NAME( 1 ) :=
50	RTEMS.BUILD_NAME( 'P', 'R', 'I', '1' );
51	SPTEST.PRIORITY_TASK_NAME( 2 ) :=
52	RTEMS.BUILD_NAME( 'P', 'R', 'I', '2' );
53	SPTEST.PRIORITY_TASK_NAME( 3 ) :=
54	RTEMS.BUILD_NAME( 'P', 'R', 'I', '3' );
55	SPTEST.PRIORITY_TASK_NAME( 4 ) :=
56	RTEMS.BUILD_NAME( 'P', 'R', 'I', '4' );
57	SPTEST.PRIORITY_TASK_NAME( 5 ) :=
58	RTEMS.BUILD_NAME( 'P', 'R', 'I', '5' );
59
60	SPTEST.SEMAPHORE_NAME( 1 ) := RTEMS.BUILD_NAME( 'S', 'M', '1', ' ' );
61	SPTEST.SEMAPHORE_NAME( 2 ) := RTEMS.BUILD_NAME( 'S', 'M', '2', ' ' );
62	SPTEST.SEMAPHORE_NAME( 3 ) := RTEMS.BUILD_NAME( 'S', 'M', '3', ' ' );
63
64	RTEMS.SEMAPHORE.CREATE(
65	SPTEST.SEMAPHORE_NAME( 1 ),
66	1,
67	RTEMS.DEFAULT_ATTRIBUTES,
68	RTEMS.TASKS.NO_PRIORITY,
69	SPTEST.SEMAPHORE_ID( 1 ),
70	STATUS
71	);
72	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM1" );
73
74	RTEMS.SEMAPHORE.CREATE(
75	SPTEST.SEMAPHORE_NAME( 2 ),
76	0,
77	RTEMS.PRIORITY,
78	RTEMS.TASKS.NO_PRIORITY,
79	SPTEST.SEMAPHORE_ID( 2 ),
80	STATUS
81	);
82	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM2" );
83
84	RTEMS.SEMAPHORE.CREATE(
85	SPTEST.SEMAPHORE_NAME( 3 ),
86	1,
87	RTEMS.DEFAULT_ATTRIBUTES,
88	RTEMS.TASKS.NO_PRIORITY,
89	SPTEST.SEMAPHORE_ID( 3 ),
90	STATUS
91	);
92	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM3" );
93
94	TEXT_IO.PUT_LINE( "INIT - Forward priority queue test" );
95	SPTEST.PRIORITY_TEST_DRIVER( 0 );
96
97	TEXT_IO.PUT_LINE( "INIT - Backward priority queue test" );
98	SPTEST.PRIORITY_TEST_DRIVER( 32 );
99
100	TEST_SUPPORT.PAUSE;
101
102	TEXT_IO.PUT_LINE(
103	"INIT - Binary Semaphore and Priority Inheritance Test"
104	);
105
106	RTEMS.SEMAPHORE.DELETE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
107	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE OF SM2" );
108
109	TEXT_IO.PUT_LINE(
110	"INIT - semaphore_create - allocated binary semaphore"
111	);
112	RTEMS.SEMAPHORE.CREATE(
113	SPTEST.SEMAPHORE_NAME( 2 ),
114	0,
115	RTEMS.BINARY_SEMAPHORE + RTEMS.PRIORITY + RTEMS.INHERIT_PRIORITY,
116	RTEMS.TASKS.NO_PRIORITY,
117	SPTEST.SEMAPHORE_ID( 2 ),
118	STATUS
119	);
120	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM2" );
121
122	TEXT_IO.PUT_LINE(
123	"INIT - semaphore_release - allocated binary semaphore"
124	);
125	RTEMS.SEMAPHORE.RELEASE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
126	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE OF SM2" );
127
128	TEXT_IO.PUT_LINE(
129	"INIT - semaphore_delete - allocated binary semaphore"
130	);
131	RTEMS.SEMAPHORE.DELETE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
132	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE OF SM2" );
133
134	RTEMS.SEMAPHORE.CREATE(
135	SPTEST.SEMAPHORE_NAME( 2 ),
136	1,
137	RTEMS.BINARY_SEMAPHORE + RTEMS.PRIORITY + RTEMS.INHERIT_PRIORITY,
138	RTEMS.TASKS.NO_PRIORITY,
139	SPTEST.SEMAPHORE_ID( 2 ),
140	STATUS
141	);
142	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM2" );
143
144	SPTEST.PRIORITY_TEST_DRIVER( 64 );
145
146	TEST_SUPPORT.PAUSE;
147
148	RTEMS.SEMAPHORE.DELETE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
149	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE OF SM2" );
150
151	RTEMS.SEMAPHORE.CREATE(
152	SPTEST.SEMAPHORE_NAME( 2 ),
153	0,
154	RTEMS.PRIORITY,
155	RTEMS.TASKS.NO_PRIORITY,
156	SPTEST.SEMAPHORE_ID( 2 ),
157	STATUS
158	);
159	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE OF SM2" );
160
161	RTEMS.SEMAPHORE.RELEASE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
162	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE OF SM2" );
163
164	RTEMS.TASKS.CREATE(
165	SPTEST.TASK_NAME( 1 ),
166	4,
167	2048,
168	RTEMS.DEFAULT_MODES,
169	RTEMS.DEFAULT_ATTRIBUTES,
170	SPTEST.TASK_ID( 1 ),
171	STATUS
172	);
173	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
174
175	RTEMS.TASKS.CREATE(
176	SPTEST.TASK_NAME( 2 ),
177	4,
178	2048,
179	RTEMS.DEFAULT_MODES,
180	RTEMS.DEFAULT_ATTRIBUTES,
181	SPTEST.TASK_ID( 2 ),
182	STATUS
183	);
184	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
185
186	RTEMS.TASKS.CREATE(
187	SPTEST.TASK_NAME( 3 ),
188	4,
189	2048,
190	RTEMS.DEFAULT_MODES,
191	RTEMS.DEFAULT_ATTRIBUTES,
192	SPTEST.TASK_ID( 3 ),
193	STATUS
194	);
195	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
196
197	RTEMS.TASKS.START(
198	SPTEST.TASK_ID( 1 ),
199	SPTEST.TASK_1'ACCESS,
200	0,
201	STATUS
202	);
203	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
204
205	RTEMS.TASKS.START(
206	SPTEST.TASK_ID( 2 ),
207	SPTEST.TASK_2'ACCESS,
208	0,
209	STATUS
210	);
211	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
212
213	RTEMS.TASKS.START(
214	SPTEST.TASK_ID( 3 ),
215	SPTEST.TASK_3'ACCESS,
216	0,
217	STATUS
218	);
219	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
220
221	RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
222	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
223
224	end INIT;
225
226	--
227	-- PRIORITY_TEST_DRIVER
228	--
229
230	procedure PRIORITY_TEST_DRIVER (
231	PRIORITY_BASE : in RTEMS.UNSIGNED32
232	) is
233	PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
234	STATUS : RTEMS.STATUS_CODES;
235	begin
236
237	for INDEX in 1 .. 5
238	loop
239
240	case INDEX is
241	when 1 \| 2 \| 3 =>
242	SPTEST.TASK_PRIORITY( INDEX ) :=
243	PRIORITY_BASE + RTEMS.TASKS.PRIORITY( INDEX );
244	when others =>
245	SPTEST.TASK_PRIORITY( INDEX ) := PRIORITY_BASE + 3;
246	end case;
247
248	RTEMS.TASKS.CREATE(
249	SPTEST.PRIORITY_TASK_NAME( INDEX ),
250	SPTEST.TASK_PRIORITY( INDEX ),
251	2048,
252	RTEMS.DEFAULT_MODES,
253	RTEMS.DEFAULT_ATTRIBUTES,
254	SPTEST.PRIORITY_TASK_ID( INDEX ),
255	STATUS
256	);
257	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOOP" );
258
259	end loop;
260
261	if PRIORITY_BASE = 0 then
262
263	for INDEX in 1 .. 5
264	loop
265
266	RTEMS.TASKS.START(
267	SPTEST.PRIORITY_TASK_ID( INDEX ),
268	SPTEST.PRIORITY_TASK'ACCESS,
269	RTEMS.TASKS.ARGUMENT( INDEX ),
270	STATUS
271	);
272	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
273
274	end loop;
275
276	else
277
278	for INDEX in reverse 1 .. 5
279	loop
280
281	RTEMS.TASKS.START(
282	SPTEST.PRIORITY_TASK_ID( INDEX ),
283	SPTEST.PRIORITY_TASK'ACCESS,
284	RTEMS.TASKS.ARGUMENT( INDEX ),
285	STATUS
286	);
287	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
288
289	RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
290	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER LOOP" );
291
292	if PRIORITY_BASE = 64 then
293	if INDEX = 4 then
294	RTEMS.TASKS.SET_PRIORITY(
295	SPTEST.PRIORITY_TASK_ID( 5 ),
296	PRIORITY_BASE + 4,
297	PREVIOUS_PRIORITY,
298	STATUS
299	);
300	TEXT_IO.PUT( "PDRV - change priority of PRI5 from " );
301	UNSIGNED32_IO.PUT( PREVIOUS_PRIORITY );
302	TEXT_IO.PUT( " to " );
303	UNSIGNED32_IO.PUT( PRIORITY_BASE + 4 );
304	TEXT_IO.NEW_LINE;
305	TEST_SUPPORT.DIRECTIVE_FAILED(
306	STATUS,
307	"PDRV TASK_SET_PRIORITY"
308	);
309	end if;
310
311	RTEMS.TASKS.SET_PRIORITY(
312	SPTEST.PRIORITY_TASK_ID( 5 ),
313	RTEMS.TASKS.CURRENT_PRIORITY,
314	PREVIOUS_PRIORITY,
315	STATUS
316	);
317	TEXT_IO.PUT( "PDRV - priority of PRI5 is " );
318	UNSIGNED32_IO.PUT( PREVIOUS_PRIORITY );
319	TEXT_IO.NEW_LINE;
320	TEST_SUPPORT.DIRECTIVE_FAILED(
321	STATUS,
322	"PDRV TASK_SET_PRIORITY"
323	);
324	end if;
325
326	end loop;
327
328	end if;
329
330	RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
331	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER AFTER LOOP" );
332
333	if PRIORITY_BASE = 0 then
334	for INDEX in 1 .. 5
335	loop
336
337	RTEMS.SEMAPHORE.RELEASE(
338	SPTEST.SEMAPHORE_ID( 2 ),
339	STATUS
340	);
341	TEST_SUPPORT.DIRECTIVE_FAILED(
342	STATUS,
343	"SEMAPHORE_RELEASE LOOP"
344	);
345
346	end loop;
347	end if;
348
349	if PRIORITY_BASE = 64 then
350
351	TEXT_IO.PUT_LINE( "PDRV - task_resume - PRI5" );
352	RTEMS.TASKS.RESUME( SPTEST.PRIORITY_TASK_ID( 5 ), STATUS );
353	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME" );
354
355	RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
356	TEST_SUPPORT.DIRECTIVE_FAILED(
357	STATUS,
358	"TASK_WAKE_AFTER SO PRI5 can run"
359	);
360
361	RTEMS.TASKS.DELETE( SPTEST.PRIORITY_TASK_ID( 5 ), STATUS );
362	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF PRI5" );
363	else
364
365	for INDEX in 1 .. 5
366	loop
367
368	RTEMS.TASKS.DELETE(
369	SPTEST.PRIORITY_TASK_ID( INDEX ),
370	STATUS
371	);
372	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE LOOP" );
373
374	end loop;
375	end if;
376
377
378	end PRIORITY_TEST_DRIVER;
379
380	--
381	-- PRIORITY_TASK
382	--
383
384	procedure PRIORITY_TASK (
385	ITS_INDEX : in RTEMS.TASKS.ARGUMENT
386	) is
387	TIMEOUT : RTEMS.INTERVAL;
388	ITS_PRIORITY : RTEMS.TASKS.PRIORITY;
389	CURRENT_PRIORITY : RTEMS.TASKS.PRIORITY;
390	STATUS : RTEMS.STATUS_CODES;
391	begin
392
393	ITS_PRIORITY := SPTEST.TASK_PRIORITY( INTEGER( ITS_INDEX ) );
394
395	if ITS_PRIORITY < 3 then
396	TIMEOUT := 5 * TEST_SUPPORT.TICKS_PER_SECOND;
397	else
398	TIMEOUT := RTEMS.NO_TIMEOUT;
399	end if;
400
401	TEST_SUPPORT.PUT_NAME( PRIORITY_TASK_NAME( INTEGER(ITS_INDEX) ), FALSE );
402	TEXT_IO.PUT_LINE( " - semaphore_obtain - wait forever on SM2" );
403
404	RTEMS.SEMAPHORE.OBTAIN(
405	SPTEST.SEMAPHORE_ID( 2 ),
406	RTEMS.DEFAULT_OPTIONS,
407	TIMEOUT,
408	STATUS
409	);
410	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN OF SM2" );
411
412	if ITS_PRIORITY < 64 then
413	TEXT_IO.PUT( "PRI" );
414	UNSIGNED32_IO.PUT( ITS_INDEX );
415	TEXT_IO.PUT( " - WHY AM I HERE? (priority = " );
416	UNSIGNED32_IO.PUT( ITS_PRIORITY );
417	TEXT_IO.PUT_LINE( " )" );
418	RTEMS.SHUTDOWN_EXECUTIVE( 0 );
419	end if;
420
421	if ITS_INDEX = 5 then
422	TEXT_IO.PUT_LINE(
423	"PRI5 - task_suspend - until all priority tasks blocked"
424	);
425	end if;
426
427	RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
428	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
429
430	TEXT_IO.PUT_LINE( "PRI5 - task_delete - all tasks waiting on SM2" );
431	for INDEX in 1 .. 4
432	loop
433
434	RTEMS.TASKS.DELETE( SPTEST.PRIORITY_TASK_ID( INDEX ), STATUS );
435	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE LOOP" );
436
437	end loop;
438
439	TEXT_IO.PUT_LINE( "PRI5 - semaphore_obtain - nested" );
440	RTEMS.SEMAPHORE.OBTAIN(
441	SPTEST.SEMAPHORE_ID( 2 ),
442	RTEMS.DEFAULT_OPTIONS,
443	TIMEOUT,
444	STATUS
445	);
446	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN NESTED" );
447
448	TEXT_IO.PUT_LINE( "PRI5 - semaphore_release - nested" );
449	RTEMS.SEMAPHORE.RELEASE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
450	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE NESTED" );
451
452	TEXT_IO.PUT_LINE( "PRI5 - semaphore_release - restore priority" );
453	RTEMS.SEMAPHORE.RELEASE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
454	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
455
456	RTEMS.TASKS.SET_PRIORITY(
457	SPTEST.PRIORITY_TASK_ID( 5 ),
458	RTEMS.TASKS.CURRENT_PRIORITY,
459	CURRENT_PRIORITY,
460	STATUS
461	);
462	TEXT_IO.PUT( "PRI5 - priority of PRI5 is " );
463	UNSIGNED32_IO.PUT( CURRENT_PRIORITY );
464	TEXT_IO.NEW_LINE;
465	TEST_SUPPORT.DIRECTIVE_FAILED(
466	STATUS,
467	"PRI5 TASK_SET_PRIORITY CURRENT"
468	);
469	RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
470	-- DOES NOT RETURN. Following check makes compiler happy
471	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
472
473	end PRIORITY_TASK;
474
475	--
476	-- TASK_1
477	--
478
479	procedure TASK_1 (
480	ARGUMENT : in RTEMS.TASKS.ARGUMENT
481	) is
482	pragma Unreferenced(ARGUMENT);
483	SMID : RTEMS.ID;
484	STATUS : RTEMS.STATUS_CODES;
485	begin
486
487	RTEMS.SEMAPHORE.IDENT(
488	SPTEST.SEMAPHORE_NAME( 1 ),
489	RTEMS.SEARCH_ALL_NODES,
490	SMID,
491	STATUS
492	);
493	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_IDENT OF SM1" );
494	TEXT_IO.PUT( "TA1 - semaphore_ident - smid => " );
495	UNSIGNED32_IO.PUT( SMID, WIDTH => 8, BASE => 16 );
496	TEXT_IO.NEW_LINE;
497
498	TEXT_IO.PUT_LINE( "TA1 - semaphore_obtain - wait forever on SM2" );
499	RTEMS.SEMAPHORE.OBTAIN(
500	SPTEST.SEMAPHORE_ID( 2 ),
501	RTEMS.DEFAULT_MODES,
502	RTEMS.NO_TIMEOUT,
503	STATUS
504	);
505	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM2" );
506
507	TEXT_IO.PUT_LINE( "TA1 - got SM2" );
508
509	TEXT_IO.PUT_LINE( "TA1 - semaphore_obtain - wait forever on SM3" );
510	RTEMS.SEMAPHORE.OBTAIN(
511	SPTEST.SEMAPHORE_ID( 3 ),
512	RTEMS.DEFAULT_MODES,
513	RTEMS.NO_TIMEOUT,
514	STATUS
515	);
516	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM3" );
517
518	TEXT_IO.PUT_LINE( "TA1 - got SM3" );
519
520	TEXT_IO.PUT_LINE( "TA1 - semaphore_obtain - get SM1 - NO_WAIT" );
521	RTEMS.SEMAPHORE.OBTAIN(
522	SPTEST.SEMAPHORE_ID( 1 ),
523	RTEMS.NO_WAIT,
524	RTEMS.NO_TIMEOUT,
525	STATUS
526	);
527	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
528
529	TEXT_IO.PUT_LINE( "TA1 - got SM1" );
530
531	TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
532	RTEMS.TASKS.WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
533	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
534
535	TEST_SUPPORT.PAUSE;
536
537	TEXT_IO.PUT_LINE( "TA1 - semaphore_release - release SM1" );
538	RTEMS.SEMAPHORE.RELEASE( SPTEST.SEMAPHORE_ID( 1 ), STATUS );
539	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM1" );
540
541	TEXT_IO.PUT_LINE(
542	"TA1 - semaphore_obtain - waiting for SM1 with 10 second timeout"
543	);
544	RTEMS.SEMAPHORE.OBTAIN(
545	SPTEST.SEMAPHORE_ID( 1 ),
546	RTEMS.DEFAULT_MODES,
547	10 * TEST_SUPPORT.TICKS_PER_SECOND,
548	STATUS
549	);
550	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM3" );
551
552	TEXT_IO.PUT_LINE( "TA1 - got SM1" );
553
554	TEXT_IO.PUT_LINE( "TA1 - semaphore_release - release SM2" );
555	RTEMS.SEMAPHORE.RELEASE(
556	SPTEST.SEMAPHORE_ID( 2 ),
557	STATUS
558	);
559	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM2" );
560
561	TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
562	RTEMS.TASKS.WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
563	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
564
565	TEST_SUPPORT.PAUSE;
566
567	TEXT_IO.PUT_LINE( "TA1 - task_delete - delete TA3" );
568	RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 3 ), STATUS );
569	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
570
571	RTEMS.TASKS.CREATE(
572	SPTEST.TASK_NAME( 4 ),
573	4,
574	2048,
575	RTEMS.DEFAULT_MODES,
576	RTEMS.DEFAULT_ATTRIBUTES,
577	SPTEST.TASK_ID( 4 ),
578	STATUS
579	);
580	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA4" );
581
582	RTEMS.TASKS.CREATE(
583	SPTEST.TASK_NAME( 5 ),
584	4,
585	2048,
586	RTEMS.DEFAULT_MODES,
587	RTEMS.DEFAULT_ATTRIBUTES,
588	SPTEST.TASK_ID( 5 ),
589	STATUS
590	);
591	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA5" );
592
593	RTEMS.TASKS.START(
594	SPTEST.TASK_ID( 4 ),
595	SPTEST.TASK_4'ACCESS,
596	0,
597	STATUS
598	);
599	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA4" );
600
601	RTEMS.TASKS.START(
602	SPTEST.TASK_ID( 5 ),
603	SPTEST.TASK_5'ACCESS,
604	0,
605	STATUS
606	);
607	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA5" );
608
609	TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
610	RTEMS.TASKS.WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
611	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
612
613	TEXT_IO.PUT_LINE( "TA1 - task_delete - delete TA4" );
614	RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 4 ), STATUS );
615	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA4" );
616
617	TEXT_IO.PUT_LINE( "TA1 - semaphore_release - release SM1" );
618	RTEMS.SEMAPHORE.RELEASE(
619	SPTEST.SEMAPHORE_ID( 1 ),
620	STATUS
621	);
622	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM1" );
623
624	TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
625	RTEMS.TASKS.WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
626	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
627
628	TEXT_IO.PUT_LINE( "TA1 - semaphore_delete - delete SM1" );
629	RTEMS.SEMAPHORE.DELETE( SPTEST.SEMAPHORE_ID( 1 ), STATUS );
630	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE OF SM1" );
631
632	TEXT_IO.PUT_LINE( "TA1 - semaphore_delete - delete SM3" );
633	RTEMS.SEMAPHORE.DELETE( SPTEST.SEMAPHORE_ID( 3 ), STATUS );
634	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE OF SM3" );
635
636	TEXT_IO.PUT_LINE( "TA1 - task_delete - delete self" );
637	RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
638	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );
639
640	end TASK_1;
641
642	--
643	-- TASK_2
644	--
645
646	procedure TASK_2 (
647	ARGUMENT : in RTEMS.TASKS.ARGUMENT
648	) is
649	pragma Unreferenced(ARGUMENT);
650	STATUS : RTEMS.STATUS_CODES;
651	PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
652	begin
653
654	TEXT_IO.PUT_LINE( "TA2 - semaphore_obtain - wait forever on SM1" );
655	RTEMS.SEMAPHORE.OBTAIN(
656	SPTEST.SEMAPHORE_ID( 1 ),
657	RTEMS.DEFAULT_MODES,
658	RTEMS.NO_TIMEOUT,
659	STATUS
660	);
661	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
662
663	TEXT_IO.PUT_LINE( "TA2 - got SM1" );
664
665	TEXT_IO.PUT_LINE( "TA2 - semaphore_release - release SM1" );
666	RTEMS.SEMAPHORE.RELEASE(
667	SPTEST.SEMAPHORE_ID( 1 ),
668	STATUS
669	);
670	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM1" );
671
672	TEXT_IO.PUT_LINE(
673	"TA2 - task_set_priority - make self highest priority task"
674	);
675	RTEMS.TASKS.SET_PRIORITY(
676	RTEMS.SELF,
677	3,
678	PREVIOUS_PRIORITY,
679	STATUS
680	);
681	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY ON TA2" );
682
683	TEXT_IO.PUT_LINE( "TA2 - semaphore_obtain - wait forever on SM2" );
684	RTEMS.SEMAPHORE.OBTAIN(
685	SPTEST.SEMAPHORE_ID( 2 ),
686	RTEMS.DEFAULT_MODES,
687	RTEMS.NO_TIMEOUT,
688	STATUS
689	);
690	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM2" );
691
692	TEXT_IO.PUT_LINE( "TA2 - got SM2" );
693
694	TEXT_IO.PUT_LINE( "TA2 - semaphore_release - release SM2" );
695	RTEMS.SEMAPHORE.RELEASE(
696	SPTEST.SEMAPHORE_ID( 2 ),
697	STATUS
698	);
699	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM2" );
700
701	TEXT_IO.PUT_LINE( "TA2 - task_delete - delete self" );
702	RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
703	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
704
705	end TASK_2;
706
707	--
708	-- TASK_3
709	--
710
711	procedure TASK_3 (
712	ARGUMENT : in RTEMS.TASKS.ARGUMENT
713	) is
714	pragma Unreferenced(ARGUMENT);
715	STATUS : RTEMS.STATUS_CODES;
716	begin
717
718	TEXT_IO.PUT_LINE( "TA3 - semaphore_obtain - wait forever on SM2" );
719	RTEMS.SEMAPHORE.OBTAIN(
720	SPTEST.SEMAPHORE_ID( 2 ),
721	RTEMS.DEFAULT_MODES,
722	RTEMS.NO_TIMEOUT,
723	STATUS
724	);
725	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM2" );
726	TEXT_IO.PUT_LINE( "TA3 - got SM2" );
727
728	TEXT_IO.PUT_LINE( "TA3 - semaphore_release - release SM2" );
729	RTEMS.SEMAPHORE.RELEASE(
730	SPTEST.SEMAPHORE_ID( 2 ),
731	STATUS
732	);
733	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM2" );
734
735	TEXT_IO.PUT_LINE( "TA3 - semaphore_obtain - wait forever on SM3" );
736	RTEMS.SEMAPHORE.OBTAIN(
737	SPTEST.SEMAPHORE_ID( 3 ),
738	RTEMS.DEFAULT_MODES,
739	RTEMS.NO_TIMEOUT,
740	STATUS
741	);
742	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM3" );
743
744	end TASK_3;
745
746	--
747	-- TASK_4
748	--
749
750	procedure TASK_4 (
751	ARGUMENT : in RTEMS.TASKS.ARGUMENT
752	) is
753	pragma Unreferenced(ARGUMENT);
754	STATUS : RTEMS.STATUS_CODES;
755	begin
756
757	TEXT_IO.PUT_LINE( "TA4 - semaphore_obtain - wait forever on SM1" );
758	RTEMS.SEMAPHORE.OBTAIN(
759	SPTEST.SEMAPHORE_ID( 1 ),
760	RTEMS.DEFAULT_MODES,
761	RTEMS.NO_TIMEOUT,
762	STATUS
763	);
764	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
765
766	end TASK_4;
767
768	--
769	-- TASK_5
770	--
771
772	procedure TASK_5 (
773	ARGUMENT : in RTEMS.TASKS.ARGUMENT
774	) is
775	pragma Unreferenced(ARGUMENT);
776	STATUS : RTEMS.STATUS_CODES;
777	begin
778
779	TEXT_IO.PUT_LINE( "TA5 - semaphore_obtain - wait forever on SM1" );
780	RTEMS.SEMAPHORE.OBTAIN(
781	SPTEST.SEMAPHORE_ID( 1 ),
782	RTEMS.DEFAULT_MODES,
783	RTEMS.NO_TIMEOUT,
784	STATUS
785	);
786	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
787
788	TEXT_IO.PUT_LINE( "TA5 - got SM1" );
789
790	TEXT_IO.PUT_LINE( "TA5 - semaphore_obtain - wait forever on SM1" );
791	RTEMS.SEMAPHORE.OBTAIN(
792	SPTEST.SEMAPHORE_ID( 1 ),
793	RTEMS.DEFAULT_MODES,
794	RTEMS.NO_TIMEOUT,
795	STATUS
796	);
797	TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
798	STATUS,
799	RTEMS.OBJECT_WAS_DELETED,
800	"SEMAPHORE_OBTAIN ON SM1"
801	);
802	TEXT_IO.PUT_LINE( "TA5 - SM1 deleted by TA1" );
803
804	TEST_SUPPORT.ADA_TEST_END;
805	RTEMS.SHUTDOWN_EXECUTIVE( 0 );
806
807	end TASK_5;
808
809	end SPTEST;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: