Context Navigation

source: rtems/testsuites/ada/sptests/sp11/sptest.adb @ 76bd25e

5

Last change on this file since 76bd25e 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: 26.1 KB

Line
1	--
2	-- SPTEST / BODY
3	--
4	-- DESCRIPTION:
5	--
6	-- This package is the implementation of Test 11 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.CLOCK;
26	with RTEMS.EVENT;
27	with RTEMS.TIMER;
28
29	package body SPTEST is
30
31	--
32	-- INIT
33	--
34
35	procedure INIT (
36	ARGUMENT : in RTEMS.TASKS.ARGUMENT
37	) is
38	pragma Unreferenced(ARGUMENT);
39	STATUS : RTEMS.STATUS_CODES;
40	begin
41
42	TEXT_IO.NEW_LINE( 2 );
43	TEST_SUPPORT.ADA_TEST_BEGIN;
44
45	SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
46	SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'A', '2', ' ' );
47
48	RTEMS.TASKS.CREATE(
49	SPTEST.TASK_NAME( 1 ),
50	4,
51	2048,
52	RTEMS.DEFAULT_MODES,
53	RTEMS.DEFAULT_ATTRIBUTES,
54	SPTEST.TASK_ID( 1 ),
55	STATUS
56	);
57	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
58
59	RTEMS.TASKS.CREATE(
60	SPTEST.TASK_NAME( 2 ),
61	4,
62	2048,
63	RTEMS.DEFAULT_MODES,
64	RTEMS.DEFAULT_ATTRIBUTES,
65	SPTEST.TASK_ID( 2 ),
66	STATUS
67	);
68	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
69
70	RTEMS.TASKS.START(
71	SPTEST.TASK_ID( 1 ),
72	SPTEST.TASK_1'ACCESS,
73	0,
74	STATUS
75	);
76	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
77
78	RTEMS.TASKS.START(
79	SPTEST.TASK_ID( 2 ),
80	SPTEST.TASK_2'ACCESS,
81	0,
82	STATUS
83	);
84	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
85
86	SPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'M', '1', ' ' );
87	SPTEST.TIMER_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'M', '2', ' ' );
88	SPTEST.TIMER_NAME( 3 ) := RTEMS.BUILD_NAME( 'T', 'M', '3', ' ' );
89	SPTEST.TIMER_NAME( 4 ) := RTEMS.BUILD_NAME( 'T', 'M', '4', ' ' );
90	SPTEST.TIMER_NAME( 5 ) := RTEMS.BUILD_NAME( 'T', 'M', '5', ' ' );
91	SPTEST.TIMER_NAME( 6 ) := RTEMS.BUILD_NAME( 'T', 'M', '6', ' ' );
92
93	RTEMS.TIMER.CREATE(
94	SPTEST.TIMER_NAME( 1 ),
95	SPTEST.TIMER_ID( 1 ),
96	STATUS
97	);
98	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM1" );
99
100	RTEMS.TIMER.CREATE(
101	SPTEST.TIMER_NAME( 2 ),
102	SPTEST.TIMER_ID( 2 ),
103	STATUS
104	);
105	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM2" );
106
107	RTEMS.TIMER.CREATE(
108	SPTEST.TIMER_NAME( 3 ),
109	SPTEST.TIMER_ID( 3 ),
110	STATUS
111	);
112	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM3" );
113
114	RTEMS.TIMER.CREATE(
115	SPTEST.TIMER_NAME( 4 ),
116	SPTEST.TIMER_ID( 4 ),
117	STATUS
118	);
119	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM4" );
120
121	RTEMS.TIMER.CREATE(
122	SPTEST.TIMER_NAME( 5 ),
123	SPTEST.TIMER_ID( 5 ),
124	STATUS
125	);
126	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM5" );
127
128	RTEMS.TIMER.CREATE(
129	SPTEST.TIMER_NAME( 6 ),
130	SPTEST.TIMER_ID( 6 ),
131	STATUS
132	);
133	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM6" );
134
135	RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
136	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
137
138	end INIT;
139
140	--
141	-- TASK_1
142	--
143
144	procedure TASK_1 (
145	ARGUMENT : in RTEMS.TASKS.ARGUMENT
146	) is
147	pragma Unreferenced(ARGUMENT);
148	EVENTOUT : RTEMS.EVENT_SET;
149	TIME : RTEMS.TIME_OF_DAY;
150	STATUS : RTEMS.STATUS_CODES;
151	INDEX : RTEMS.UNSIGNED32;
152	begin
153
154	TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_16 to TA2" );
155	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_16, STATUS );
156	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 16" );
157
158	TEXT_IO.PUT_LINE(
159	"TA1 - event_receive - waiting forever on EVENT_14 and EVENT_15"
160	);
161	RTEMS.EVENT.RECEIVE(
162	RTEMS.EVENT_14 + RTEMS.EVENT_15,
163	RTEMS.DEFAULT_OPTIONS,
164	RTEMS.NO_TIMEOUT,
165	EVENTOUT,
166	STATUS
167	);
168	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 14 and 15" );
169	TEXT_IO.PUT( "TA1 - EVENT_14 and EVENT_15 received - eventout => ");
170	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
171	TEXT_IO.NEW_LINE;
172
173	TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_18 to TA2" );
174	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_18, STATUS );
175	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 18" );
176
177	TEXT_IO.PUT_LINE(
178	"TA1 - event_receive - waiting with 10 second timeout on EVENT_14"
179	);
180	RTEMS.EVENT.RECEIVE(
181	RTEMS.EVENT_14,
182	RTEMS.DEFAULT_OPTIONS,
183	10 * TEST_SUPPORT.TICKS_PER_SECOND,
184	EVENTOUT,
185	STATUS
186	);
187	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 14" );
188	TEXT_IO.PUT( "TA1 - EVENT_14 received - eventout => ");
189	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
190	TEXT_IO.NEW_LINE;
191
192	TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_19 to TA2" );
193	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_19, STATUS );
194	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 19" );
195
196	RTEMS.CLOCK.GET_TOD( TIME, STATUS );
197	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
198	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_get - ", TIME, "" );
199	TEXT_IO.NEW_LINE;
200
201	TEST_SUPPORT.PAUSE;
202
203	TEXT_IO.PUT_LINE(
204	"TA1 - event_send - send EVENT_18 to self after 5 seconds"
205	);
206	RTEMS.TIMER.FIRE_AFTER(
207	SPTEST.TIMER_ID( 1 ),
208	5 * TEST_SUPPORT.TICKS_PER_SECOND,
209	SPTEST.TA1_SEND_18_TO_SELF_5_SECONDS'ACCESS,
210	RTEMS.NULL_ADDRESS,
211	STATUS
212	);
213	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 5 seconds" );
214
215	TEXT_IO.PUT_LINE(
216	"TA1 - event_receive - waiting forever on EVENT_18"
217	);
218	RTEMS.EVENT.RECEIVE(
219	RTEMS.EVENT_18,
220	RTEMS.DEFAULT_OPTIONS,
221	RTEMS.NO_TIMEOUT,
222	EVENTOUT,
223	STATUS
224	);
225	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 18" );
226
227	RTEMS.CLOCK.GET_TOD( TIME, STATUS );
228	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
229
230	TEXT_IO.PUT( "TA1 - EVENT_18 received - eventout => ");
231	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
232	TEXT_IO.NEW_LINE;
233
234	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_get - ", TIME, "" );
235	TEXT_IO.NEW_LINE;
236
237	TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_3 to self" );
238	RTEMS.EVENT.SEND( RTEMS.SELF, RTEMS.EVENT_3, STATUS );
239	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 3" );
240
241	TEXT_IO.PUT_LINE(
242	"TA1 - event_receive - EVENT_3 or EVENT_22 - NO_WAIT and EVENT_ANY"
243	);
244	RTEMS.EVENT.RECEIVE(
245	RTEMS.EVENT_3 + RTEMS.EVENT_22,
246	RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
247	RTEMS.NO_TIMEOUT,
248	EVENTOUT,
249	STATUS
250	);
251	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 3 and 22" );
252	TEXT_IO.PUT( "TA1 - EVENT_3 received - eventout => ");
253	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
254	TEXT_IO.NEW_LINE;
255
256	TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_4 to self" );
257	RTEMS.EVENT.SEND( RTEMS.SELF, RTEMS.EVENT_4, STATUS );
258	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 4" );
259
260	TEXT_IO.PUT_LINE(
261	"TA1 - event_receive - waiting forever on EVENT_4 or EVENT_5 - EVENT_ANY"
262	);
263	RTEMS.EVENT.RECEIVE(
264	RTEMS.EVENT_4 + RTEMS.EVENT_5,
265	RTEMS.EVENT_ANY,
266	RTEMS.NO_TIMEOUT,
267	EVENTOUT,
268	STATUS
269	);
270	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 4 and 5" );
271	TEXT_IO.PUT( "TA1 - EVENT_4 received - eventout => ");
272	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
273	TEXT_IO.NEW_LINE;
274
275	TEST_SUPPORT.PAUSE;
276
277	TEXT_IO.PUT_LINE(
278	"TA1 - event_send - send EVENT_18 to self after 5 seconds"
279	);
280	RTEMS.TIMER.FIRE_AFTER(
281	SPTEST.TIMER_ID( 1 ),
282	5 * TEST_SUPPORT.TICKS_PER_SECOND,
283	SPTEST.TA1_SEND_18_TO_SELF_5_SECONDS'ACCESS,
284	RTEMS.NULL_ADDRESS,
285	STATUS
286	);
287	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 5 seconds" );
288
289	TEXT_IO.PUT_LINE(
290	"TA1 - timer_cancel - cancelling timer for event EVENT_18"
291	);
292	RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
293	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
294
295	TEXT_IO.PUT_LINE(
296	"TA1 - event_send - send EVENT_8 to self after 60 seconds"
297	);
298	RTEMS.TIMER.FIRE_AFTER(
299	SPTEST.TIMER_ID( 1 ),
300	60 * TEST_SUPPORT.TICKS_PER_SECOND,
301	SPTEST.TA1_SEND_8_TO_SELF_60_SECONDS'ACCESS,
302	RTEMS.NULL_ADDRESS,
303	STATUS
304	);
305	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 60 secs" );
306
307	TEXT_IO.PUT_LINE(
308	"TA1 - event_send - send EVENT_9 to self after 60 seconds"
309	);
310	RTEMS.TIMER.FIRE_AFTER(
311	SPTEST.TIMER_ID( 2 ),
312	60 * TEST_SUPPORT.TICKS_PER_SECOND,
313	SPTEST.TA1_SEND_9_TO_SELF_60_SECONDS'ACCESS,
314	RTEMS.NULL_ADDRESS,
315	STATUS
316	);
317	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 60 secs" );
318
319	TEXT_IO.PUT_LINE(
320	"TA1 - event_send - send EVENT_10 to self after 60 seconds"
321	);
322	RTEMS.TIMER.FIRE_AFTER(
323	SPTEST.TIMER_ID( 3 ),
324	60 * TEST_SUPPORT.TICKS_PER_SECOND,
325	SPTEST.TA1_SEND_10_TO_SELF'ACCESS,
326	RTEMS.NULL_ADDRESS,
327	STATUS
328	);
329	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 60 secs" );
330
331	TEXT_IO.PUT_LINE(
332	"TA1 - timer_cancel - cancelling timer for event EVENT_8"
333	);
334	RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
335	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
336
337	TIME := ( 1988, 2, 12, 8, 15, 0, 0 );
338
339	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
340	TEXT_IO.NEW_LINE;
341	RTEMS.CLOCK.SET( TIME, STATUS );
342	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
343
344	TEXT_IO.PUT_LINE(
345	"TA1 - event_send - send EVENT_1 every second"
346	);
347	RTEMS.TIMER.FIRE_AFTER(
348	SPTEST.TIMER_ID( 1 ),
349	TEST_SUPPORT.TICKS_PER_SECOND,
350	SPTEST.TA1_SEND_1_TO_SELF_EVERY_SECOND'ACCESS,
351	RTEMS.NULL_ADDRESS,
352	STATUS
353	);
354	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 1 SECOND" );
355
356	INDEX := 0;
357
358	loop
359
360	exit when INDEX = 3;
361
362	RTEMS.EVENT.RECEIVE(
363	RTEMS.EVENT_1,
364	RTEMS.EVENT_ANY,
365	RTEMS.NO_TIMEOUT,
366	EVENTOUT,
367	STATUS
368	);
369	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 1" );
370
371	RTEMS.CLOCK.GET_TOD( TIME, STATUS );
372	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
373
374	TEXT_IO.PUT( "TA1 - EVENT_1 received - eventout => ");
375	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
376	TEST_SUPPORT.PRINT_TIME( " - at ", TIME, "" );
377	TEXT_IO.NEW_LINE;
378
379	if INDEX < 2 then
380	RTEMS.TIMER.RESET( SPTEST.TIMER_ID( 1 ), STATUS );
381	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 TIMER RESET" );
382	end if;
383
384	INDEX := INDEX + 1;
385	end loop;
386
387	TEXT_IO.PUT_LINE(
388	"TA1 - timer_cancel - cancelling timer for event EVENT_1"
389	);
390	RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
391	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
392
393	TEST_SUPPORT.PAUSE;
394
395	TIME.DAY := 13;
396	TEXT_IO.PUT_LINE(
397	"TA1 - event_send - send EVENT_11 to self in 1 day"
398	);
399	RTEMS.TIMER.FIRE_WHEN(
400	SPTEST.TIMER_ID( 1 ),
401	TIME,
402	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
403	RTEMS.NULL_ADDRESS,
404	STATUS
405	);
406	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 1 day" );
407
408	TIME.HOUR := 7;
409	TEXT_IO.PUT_LINE(
410	"TA1 - event_send - send EVENT_11 to self in 1 day"
411	);
412	RTEMS.TIMER.FIRE_WHEN(
413	SPTEST.TIMER_ID( 2 ),
414	TIME,
415	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
416	RTEMS.NULL_ADDRESS,
417	STATUS
418	);
419	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 1 day" );
420	TIME.HOUR := 8;
421
422	TIME.DAY := 14;
423	TEXT_IO.PUT_LINE(
424	"TA1 - event_send - send EVENT_11 to self in 2 days"
425	);
426	RTEMS.TIMER.FIRE_WHEN(
427	SPTEST.TIMER_ID( 3 ),
428	TIME,
429	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
430	RTEMS.NULL_ADDRESS,
431	STATUS
432	);
433	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );
434
435	TEXT_IO.PUT_LINE(
436	"TA1 - timer_cancel - cancelling EVENT_11 to self in 1 day"
437	);
438	RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
439	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
440
441	TEXT_IO.PUT_LINE(
442	"TA1 - timer_cancel - cancelling EVENT_11 to self in 2 days"
443	);
444	RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 3 ), STATUS );
445	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
446
447	TEXT_IO.PUT_LINE(
448	"TA1 - event_send - resending EVENT_11 to self in 2 days"
449	);
450	RTEMS.TIMER.FIRE_WHEN(
451	SPTEST.TIMER_ID( 3 ),
452	TIME,
453	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
454	RTEMS.NULL_ADDRESS,
455	STATUS
456	);
457	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );
458
459	TIME.DAY := 15;
460	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
461	TEXT_IO.NEW_LINE;
462	RTEMS.CLOCK.SET( TIME, STATUS );
463	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
464	TEXT_IO.PUT_LINE(
465	"TA1 - event_receive - waiting forever on EVENT_11"
466	);
467	RTEMS.EVENT.RECEIVE(
468	RTEMS.EVENT_11,
469	RTEMS.DEFAULT_OPTIONS,
470	RTEMS.NO_TIMEOUT,
471	EVENTOUT,
472	STATUS
473	);
474	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 11" );
475	TEXT_IO.PUT( "TA1 - EVENT_11 received - eventout => ");
476	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
477	TEXT_IO.NEW_LINE;
478
479	TEST_SUPPORT.PAUSE;
480
481	-- The following code tests the case of deleting a timer ???
482
483	TEXT_IO.PUT_LINE( "TA1 - event_send/event_receive combination" );
484	RTEMS.TIMER.FIRE_AFTER(
485	SPTEST.TIMER_ID( 1 ),
486	10,
487	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
488	RTEMS.NULL_ADDRESS,
489	STATUS
490	);
491	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 10 ticks" );
492	RTEMS.EVENT.RECEIVE(
493	RTEMS.EVENT_11,
494	RTEMS.DEFAULT_OPTIONS,
495	11,
496	EVENTOUT,
497	STATUS
498	);
499	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE" );
500
501	TIME := ( 1988, 2, 12, 8, 15, 0, 0 );
502
503	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
504	TEXT_IO.NEW_LINE;
505	RTEMS.CLOCK.SET( TIME, STATUS );
506	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
507
508	TIME.DAY := 13;
509	TEXT_IO.PUT_LINE(
510	"TA1 - event_receive all outstanding events"
511	);
512	RTEMS.EVENT.RECEIVE(
513	RTEMS.ALL_EVENTS,
514	RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
515	RTEMS.NO_TIMEOUT,
516	EVENTOUT,
517	STATUS
518	);
519	TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
520	STATUS,
521	RTEMS.UNSATISFIED,
522	"EVENT_RECEIVE all events"
523	);
524
525	TEXT_IO.PUT_LINE(
526	"TA1 - event_send - send EVENT_10 to self in 1 day"
527	);
528	RTEMS.TIMER.FIRE_WHEN(
529	SPTEST.TIMER_ID( 1 ),
530	TIME,
531	SPTEST.TA1_SEND_10_TO_SELF'ACCESS,
532	RTEMS.NULL_ADDRESS,
533	STATUS
534	);
535	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 1 day" );
536
537	TIME.DAY := 14;
538	TEXT_IO.PUT_LINE(
539	"TA1 - event_send - send EVENT_11 to self in 2 days"
540	);
541	RTEMS.TIMER.FIRE_WHEN(
542	SPTEST.TIMER_ID( 2 ),
543	TIME,
544	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
545	RTEMS.NULL_ADDRESS,
546	STATUS
547	);
548	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );
549
550	TIME := ( 1988, 2, 12, 7, 15, 0, 0 );
551
552	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
553	TEXT_IO.NEW_LINE;
554	TEXT_IO.PUT_LINE( "TA1 - set time backwards" );
555	RTEMS.CLOCK.SET( TIME, STATUS );
556	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
557
558	RTEMS.EVENT.RECEIVE(
559	RTEMS.ALL_EVENTS,
560	RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
561	RTEMS.NO_TIMEOUT,
562	EVENTOUT,
563	STATUS
564	);
565	if EVENTOUT >= RTEMS.EVENT_0 then
566	TEXT_IO.PUT( "ERROR - " );
567	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
568	TEXT_IO.PUT_LINE( " events received" );
569	else
570	TEXT_IO.PUT_LINE( "TA1 - no events received" );
571	end if;
572	TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
573	STATUS,
574	RTEMS.UNSATISFIED,
575	"EVENT_RECEIVE all events"
576	);
577
578	TIME := ( 1988, 2, 14, 7, 15, 0, 0 );
579
580	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
581	TEXT_IO.NEW_LINE;
582	TEXT_IO.PUT_LINE( "TA1 - set time forwards (leave a timer)" );
583	RTEMS.CLOCK.SET( TIME, STATUS );
584	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
585
586	RTEMS.EVENT.RECEIVE(
587	RTEMS.ALL_EVENTS,
588	RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
589	RTEMS.NO_TIMEOUT,
590	EVENTOUT,
591	STATUS
592	);
593	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE all events" );
594	if EVENTOUT = RTEMS.EVENT_10 then
595	TEXT_IO.PUT_LINE( "TA1 - EVENT_10 received" );
596	else
597	TEXT_IO.PUT( "ERROR - " );
598	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
599	TEXT_IO.PUT_LINE( " events received" );
600	end if;
601
602	TEXT_IO.PUT_LINE(
603	"TA1 - event_send - send EVENT_11 to self in 100 ticks"
604	);
605	RTEMS.TIMER.FIRE_AFTER(
606	SPTEST.TIMER_ID( 1 ),
607	100,
608	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
609	RTEMS.NULL_ADDRESS,
610	STATUS
611	);
612	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 100 ticks" );
613
614	TEXT_IO.PUT_LINE(
615	"TA1 - event_send - send EVENT_11 to self in 200 ticks"
616	);
617	RTEMS.TIMER.FIRE_AFTER(
618	SPTEST.TIMER_ID( 2 ),
619	100,
620	SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
621	RTEMS.NULL_ADDRESS,
622	STATUS
623	);
624	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 200 ticks" );
625
626	TEST_SUPPORT.ADA_TEST_END;
627	RTEMS.SHUTDOWN_EXECUTIVE( 0 );
628
629	end TASK_1;
630
631	--
632	-- TASK_2
633	--
634
635	procedure TASK_2 (
636	ARGUMENT : in RTEMS.TASKS.ARGUMENT
637	) is
638	pragma Unreferenced(ARGUMENT);
639	EVENTOUT : RTEMS.EVENT_SET;
640	TIME : RTEMS.TIME_OF_DAY;
641	STATUS : RTEMS.STATUS_CODES;
642	begin
643
644	RTEMS.TASKS.WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
645	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
646
647	TEXT_IO.PUT_LINE(
648	"TA2 - event_receive - waiting forever on EVENT_16"
649	);
650	RTEMS.EVENT.RECEIVE(
651	RTEMS.EVENT_16,
652	RTEMS.DEFAULT_OPTIONS,
653	RTEMS.NO_TIMEOUT,
654	EVENTOUT,
655	STATUS
656	);
657	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 16" );
658	TEXT_IO.PUT( "TA2 - EVENT_16 received - eventout => ");
659	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
660	TEXT_IO.NEW_LINE;
661
662	TEXT_IO.PUT_LINE(
663	"TA2 - event_send - send EVENT_14 and EVENT_15 to TA1"
664	);
665	RTEMS.EVENT.SEND(
666	SPTEST.TASK_ID( 1 ),
667	RTEMS.EVENT_14 + RTEMS.EVENT_15,
668	STATUS
669	);
670	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 14 and 15" );
671
672	TEXT_IO.PUT_LINE(
673	"TA2 - event_receive - waiting forever on EVENT_17 or EVENT_18 - EVENT_ANY"
674	);
675	RTEMS.EVENT.RECEIVE(
676	RTEMS.EVENT_17 + RTEMS.EVENT_18,
677	RTEMS.EVENT_ANY,
678	RTEMS.NO_TIMEOUT,
679	EVENTOUT,
680	STATUS
681	);
682	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 17 and 18" );
683	TEXT_IO.PUT( "TA2 - EVENT_17 or EVENT_18 received - eventout => ");
684	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
685	TEXT_IO.NEW_LINE;
686
687	TEXT_IO.PUT_LINE(
688	"TA2 - event_send - send EVENT_14 to TA1"
689	);
690	RTEMS.EVENT.SEND(
691	SPTEST.TASK_ID( 1 ),
692	RTEMS.EVENT_14,
693	STATUS
694	);
695	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 14" );
696
697	TIME := ( 1988, 2, 12, 8, 15, 0, 0 );
698
699	TEST_SUPPORT.PRINT_TIME( "TA2 - clock_set - ", TIME, "" );
700	TEXT_IO.NEW_LINE;
701	RTEMS.CLOCK.SET( TIME, STATUS );
702	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA2 CLOCK_SET" );
703
704	TIME.SECOND := TIME.SECOND + 5;
705	TEXT_IO.PUT_LINE(
706	"TA2 - event_send - sending EVENT_10 to self after 5 seconds"
707	);
708	RTEMS.TIMER.FIRE_WHEN(
709	SPTEST.TIMER_ID( 5 ),
710	TIME,
711	SPTEST.TA2_SEND_10_TO_SELF'ACCESS,
712	RTEMS.NULL_ADDRESS,
713	STATUS
714	);
715	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 5 SECONDS" );
716
717	TEXT_IO.PUT_LINE(
718	"TA2 - event_receive - waiting forever on EVENT_10"
719	);
720	RTEMS.EVENT.RECEIVE(
721	RTEMS.EVENT_10,
722	RTEMS.DEFAULT_OPTIONS,
723	RTEMS.NO_TIMEOUT,
724	EVENTOUT,
725	STATUS
726	);
727	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
728
729	RTEMS.CLOCK.GET_TOD( TIME, STATUS );
730	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
731
732	TEXT_IO.PUT( "TA2 - EVENT_10 received - eventout => ");
733	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
734	TEXT_IO.NEW_LINE;
735
736	TEST_SUPPORT.PRINT_TIME( "TA1 - clock_get - ", TIME, "" );
737	TEXT_IO.NEW_LINE;
738
739	TEXT_IO.PUT_LINE( "TA2 - event_receive - PENDING_EVENTS" );
740	RTEMS.EVENT.RECEIVE(
741	RTEMS.PENDING_EVENTS,
742	RTEMS.DEFAULT_OPTIONS,
743	RTEMS.NO_TIMEOUT,
744	EVENTOUT,
745	STATUS
746	);
747	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
748	TEXT_IO.PUT( "TA2 - eventout => ");
749	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
750	TEXT_IO.NEW_LINE;
751
752	TEXT_IO.PUT_LINE(
753	"TA2 - event_receive - EVENT_19 - NO_WAIT"
754	);
755	RTEMS.EVENT.RECEIVE(
756	RTEMS.EVENT_19,
757	RTEMS.NO_WAIT,
758	RTEMS.NO_TIMEOUT,
759	EVENTOUT,
760	STATUS
761	);
762	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
763	TEXT_IO.PUT( "TA2 - EVENT_19 received - eventout => ");
764	UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
765	TEXT_IO.NEW_LINE;
766
767	TEXT_IO.PUT_LINE( "TA2 - task_delete - deletes self" );
768	RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 2 ), STATUS );
769	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE of TA2" );
770
771	end TASK_2;
772
773	--
774	-- TA1_SEND_18_TO_SELF_5_SECONDS
775	--
776
777	procedure TA1_SEND_18_TO_SELF_5_SECONDS (
778	IGNORED_ID : in RTEMS.ID;
779	IGNORED_ADDRESS : in RTEMS.ADDRESS
780	)
781	is
782	pragma Unreferenced(IGNORED_ID);
783	pragma Unreferenced(IGNORED_ADDRESS);
784	STATUS : RTEMS.STATUS_CODES;
785	begin
786
787	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_18, STATUS );
788	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 18" );
789
790	end TA1_SEND_18_TO_SELF_5_SECONDS;
791
792	--
793	-- TA1_SEND_8_TO_SELF_60_SECONDS
794	--
795
796	procedure TA1_SEND_8_TO_SELF_60_SECONDS (
797	IGNORED_ID : in RTEMS.ID;
798	IGNORED_ADDRESS : in RTEMS.ADDRESS
799	)
800	is
801	pragma Unreferenced(IGNORED_ID);
802	pragma Unreferenced(IGNORED_ADDRESS);
803	STATUS : RTEMS.STATUS_CODES;
804	begin
805
806	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_8, STATUS );
807	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 8" );
808
809	end TA1_SEND_8_TO_SELF_60_SECONDS;
810
811	--
812	-- TA1_SEND_9_TO_SELF_60_SECONDS
813	--
814
815	procedure TA1_SEND_9_TO_SELF_60_SECONDS (
816	IGNORED_ID : in RTEMS.ID;
817	IGNORED_ADDRESS : in RTEMS.ADDRESS
818	)
819	is
820	pragma Unreferenced(IGNORED_ID);
821	pragma Unreferenced(IGNORED_ADDRESS);
822	STATUS : RTEMS.STATUS_CODES;
823	begin
824
825	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_9, STATUS );
826	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 9" );
827
828	end TA1_SEND_9_TO_SELF_60_SECONDS;
829
830	--
831	-- TA1_SEND_10_TO_SELF
832	--
833
834	procedure TA1_SEND_10_TO_SELF (
835	IGNORED_ID : in RTEMS.ID;
836	IGNORED_ADDRESS : in RTEMS.ADDRESS
837	)
838	is
839	pragma Unreferenced(IGNORED_ID);
840	pragma Unreferenced(IGNORED_ADDRESS);
841	STATUS : RTEMS.STATUS_CODES;
842	begin
843
844	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_10, STATUS );
845	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 10" );
846
847	end TA1_SEND_10_TO_SELF;
848
849	--
850	-- TA1_SEND_1_TO_SELF_EVERY_SECOND
851	--
852
853	procedure TA1_SEND_1_TO_SELF_EVERY_SECOND (
854	IGNORED_ID : in RTEMS.ID;
855	IGNORED_ADDRESS : in RTEMS.ADDRESS
856	)
857	is
858	pragma Unreferenced(IGNORED_ID);
859	pragma Unreferenced(IGNORED_ADDRESS);
860	STATUS : RTEMS.STATUS_CODES;
861	begin
862
863	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_1, STATUS );
864	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 1" );
865
866	end TA1_SEND_1_TO_SELF_EVERY_SECOND;
867
868	--
869	-- TA1_SEND_11_TO_SELF
870	--
871
872	procedure TA1_SEND_11_TO_SELF (
873	IGNORED_ID : in RTEMS.ID;
874	IGNORED_ADDRESS : in RTEMS.ADDRESS
875	)
876	is
877	pragma Unreferenced(IGNORED_ID);
878	pragma Unreferenced(IGNORED_ADDRESS);
879	STATUS : RTEMS.STATUS_CODES;
880	begin
881
882	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_11, STATUS );
883	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 11" );
884
885	end TA1_SEND_11_TO_SELF;
886
887	--
888	-- TA2_SEND_10_TO_SELF
889	--
890
891	procedure TA2_SEND_10_TO_SELF (
892	IGNORED_ID : in RTEMS.ID;
893	IGNORED_ADDRESS : in RTEMS.ADDRESS
894	)
895	is
896	pragma Unreferenced(IGNORED_ID);
897	pragma Unreferenced(IGNORED_ADDRESS);
898	STATUS : RTEMS.STATUS_CODES;
899	begin
900
901	RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_10, STATUS );
902	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 10" );
903
904	end TA2_SEND_10_TO_SELF;
905
906	end SPTEST;

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

Download in other formats: