Context Navigation

sptest.adb @ f619250

4.115

Last change on this file since f619250 was 9b4422a2, checked in by Joel Sherrill <joel.sherrill@…>, on 05/03/12 at 15:09:24

Remove All CVS Id Strings Possible Using a Script

Script does what is expected and tries to do it as
smartly as possible.

+ remove occurrences of two blank comment lines

next to each other after Id string line removed.

+ remove entire comment blocks which only exited to

contain CVS Ids

+ If the processing left a blank line at the top of

a file, it was removed.

Property mode set to 100644

File size: 15.3 KB

Line
1	--
2	-- SPTEST / BODY
3	--
4	-- DESCRIPTION:
5	--
6	-- This package is the implementation of Test 7 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.com/license/LICENSE.
19	--
20
21	with INTERFACES; use INTERFACES;
22	with TEST_SUPPORT;
23	with TEXT_IO;
24	with UNSIGNED32_IO;
25	with RTEMS.EXTENSION;
26	with RTEMS.FATAL;
27
28	package body SPTEST is
29
30	type Task_Event_Type is (
31	Created,
32	Deleted,
33	Restarted,
34	Started
35	);
36
37	type Task_Event is record
38	The_Event : Task_Event_Type;
39	Task1 : RTEMS.Unsigned32;
40	Task2 : RTEMS.Unsigned32;
41	end record;
42
43	Task_Events : array (1 .. 10) of Task_Event;
44	Task_Events_Index : Natural := Task_Events'First;
45
46	procedure Log_Task_Event (
47	The_Event : in Task_Event_Type;
48	Task1 : in RTEMS.Unsigned32;
49	Task2 : in RTEMS.Unsigned32
50	) is
51	begin
52	if Task_Events_Index = Task_Events'Last then
53	RTEMS.Fatal.Error_Occurred ( 1 ); -- no other choice
54	else
55	Task_Events (Task_Events_Index).The_Event := The_Event;
56	Task_Events (Task_Events_Index).Task1 := Task1;
57	Task_Events (Task_Events_Index).Task2 := Task2;
58	Task_Events_Index := Task_Events_Index + 1;
59	end if;
60	end Log_Task_Event;
61
62	procedure Flush_Task_Event_Log is
63	begin
64	for I in Task_Events'First .. Task_Events_Index - 1 loop
65
66	case Task_Events (I).The_Event is
67
68	when Created =>
69	TEXT_IO.PUT( "TASKS_CREATE - " );
70	TEST_SUPPORT.PUT_NAME(
71	SPTEST.TASK_NAME( Task_Events (I).Task1 ),
72	FALSE
73	);
74	TEXT_IO.PUT_LINE( " - created." );
75
76	when Deleted =>
77	TEXT_IO.PUT( "TASKS_DELETE - " );
78	TEST_SUPPORT.PUT_NAME(
79	SPTEST.TASK_NAME( Task_Events (I).Task1 ),
80	FALSE
81	);
82
83	TEXT_IO.PUT( " deleting " );
84	TEST_SUPPORT.PUT_NAME(
85	SPTEST.TASK_NAME( Task_Events (I).Task2 ),
86	TRUE
87	);
88
89	when Restarted =>
90	TEXT_IO.PUT( "TASKS_RESTART - " );
91	TEST_SUPPORT.PUT_NAME(
92	SPTEST.TASK_NAME( Task_Events (I).Task1 ),
93	FALSE
94	);
95	TEXT_IO.PUT_LINE( " - restarted." );
96
97	when Started =>
98	TEXT_IO.PUT( "TASKS_START - " );
99	TEST_SUPPORT.PUT_NAME(
100	SPTEST.TASK_NAME( Task_Events (I).Task1 ),
101	FALSE
102	);
103	TEXT_IO.PUT_LINE( " - started." );
104
105	end case;
106	end loop;
107
108	-- Reset the events list
109	Task_Events_Index := Task_Events'First;
110
111	end Flush_Task_Event_Log;
112
113	--
114	-- TCB_To_ID
115	--
116
117	function TCB_To_ID (
118	TCB : RTEMS.TCB_POINTER
119	) return RTEMS.ID;
120	pragma Import (C, TCB_To_ID, "tcb_to_id" );
121
122	--
123	-- INIT
124	--
125
126	procedure INIT (
127	ARGUMENT : in RTEMS.TASKS.ARGUMENT
128	) is
129	pragma Unreferenced(ARGUMENT);
130	STATUS : RTEMS.STATUS_CODES;
131	begin
132
133	TEXT_IO.NEW_LINE( 2 );
134	TEXT_IO.PUT_LINE( "* TEST 7 *" );
135
136	SPTEST.EXTENSION_NAME( 1 ) := RTEMS.BUILD_NAME( 'E', 'X', 'T', ' ' );
137
138	RTEMS.EXTENSION.CREATE(
139	SPTEST.EXTENSION_NAME( 1 ),
140	SPTEST.EXTENSIONS'ACCESS,
141	EXTENSION_ID( 1 ),
142	STATUS
143	);
144	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EXTENSION_CREATE" );
145
146	SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
147	SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'A', '2', ' ' );
148	SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME( 'T', 'A', '3', ' ' );
149	SPTEST.TASK_NAME( 4 ) := RTEMS.BUILD_NAME( 'T', 'A', '4', ' ' );
150
151	RTEMS.TASKS.CREATE(
152	SPTEST.TASK_NAME( 1 ),
153	4,
154	RTEMS.MINIMUM_STACK_SIZE,
155	RTEMS.DEFAULT_MODES,
156	RTEMS.DEFAULT_ATTRIBUTES,
157	SPTEST.TASK_ID( 1 ),
158	STATUS
159	);
160	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
161
162	RTEMS.TASKS.CREATE(
163	SPTEST.TASK_NAME( 2 ),
164	4,
165	RTEMS.MINIMUM_STACK_SIZE,
166	RTEMS.DEFAULT_MODES,
167	RTEMS.DEFAULT_ATTRIBUTES,
168	SPTEST.TASK_ID( 2 ),
169	STATUS
170	);
171	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
172
173	RTEMS.TASKS.CREATE(
174	SPTEST.TASK_NAME( 3 ),
175	250,
176	RTEMS.MINIMUM_STACK_SIZE,
177	RTEMS.DEFAULT_MODES,
178	RTEMS.DEFAULT_ATTRIBUTES,
179	SPTEST.TASK_ID( 3 ),
180	STATUS
181	);
182	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
183
184	RTEMS.TASKS.CREATE(
185	SPTEST.TASK_NAME( 4 ),
186	254,
187	RTEMS.MINIMUM_STACK_SIZE,
188	RTEMS.DEFAULT_MODES,
189	RTEMS.DEFAULT_ATTRIBUTES,
190	SPTEST.TASK_ID( 4 ),
191	STATUS
192	);
193	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA4" );
194
195	RTEMS.TASKS.START(
196	SPTEST.TASK_ID( 1 ),
197	SPTEST.TASK_1'ACCESS,
198	0,
199	STATUS
200	);
201	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
202
203	RTEMS.TASKS.START(
204	SPTEST.TASK_ID( 2 ),
205	SPTEST.TASK_2'ACCESS,
206	0,
207	STATUS
208	);
209	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
210
211	RTEMS.TASKS.START(
212	SPTEST.TASK_ID( 3 ),
213	SPTEST.TASK_3'ACCESS,
214	0,
215	STATUS
216	);
217	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
218
219	RTEMS.TASKS.START(
220	SPTEST.TASK_ID( 4 ),
221	SPTEST.TASK_4'ACCESS,
222	0,
223	STATUS
224	);
225	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA4" );
226
227	RTEMS.TASKS.RESTART( SPTEST.TASK_ID( 3 ), 0, STATUS );
228	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESTART OF TA3" );
229
230	Flush_Task_Event_Log;
231
232	RTEMS.TASKS.SET_NOTE( SPTEST.TASK_ID( 1 ), 8, 4, STATUS );
233	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE OF TA1" );
234	TEXT_IO.PUT( "INIT - task_set_note - set TA1's NOTEPAD_8" );
235	TEXT_IO.PUT_LINE( " to TA1's initial priority: 4" );
236
237	RTEMS.TASKS.SET_NOTE( SPTEST.TASK_ID( 2 ), 8, 4, STATUS );
238	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE OF TA2" );
239	TEXT_IO.PUT( "INIT - task_set_note - set TA2's NOTEPAD_8" );
240	TEXT_IO.PUT_LINE( " to TA2's initial priority: 4" );
241
242	RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
243	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
244
245	end INIT;
246
247	--
248	-- TASK_1
249	--
250
251	procedure TASK_1 (
252	ARGUMENT : in RTEMS.TASKS.ARGUMENT
253	) is
254	pragma Unreferenced(ARGUMENT);
255	STATUS : RTEMS.STATUS_CODES;
256	THE_PRIORITY : RTEMS.TASKS.PRIORITY;
257	PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
258	begin
259
260	TEST_SUPPORT.PAUSE;
261
262	RTEMS.TASKS.SET_PRIORITY(
263	RTEMS.SELF,
264	RTEMS.TASKS.CURRENT_PRIORITY,
265	THE_PRIORITY,
266	STATUS
267	);
268	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
269	TEXT_IO.PUT( "TA1 - task_set_priority - ");
270	TEXT_IO.PUT( "get initial priority of self: ");
271	UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
272	TEXT_IO.NEW_LINE;
273
274	loop
275
276	RTEMS.TASKS.GET_NOTE( RTEMS.SELF, 8, THE_PRIORITY, STATUS );
277	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_GET_NOTE" );
278	TEXT_IO.PUT( "TA1 - task_get_note - ");
279	TEXT_IO.PUT( "get NOTEPAD_8 - current priority: " );
280	UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
281	TEXT_IO.NEW_LINE;
282
283	THE_PRIORITY := THE_PRIORITY - 1;
284
285	if THE_PRIORITY = 0 then
286	TEXT_IO.PUT_LINE( "TA1 - task_suspend - suspend TA2" );
287	RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 2 ), STATUS );
288	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
289
290	TEXT_IO.PUT( "TA1 - task_set_priority - ");
291	TEXT_IO.PUT_LINE( "set priority of TA2 ( blocked )");
292	RTEMS.TASKS.SET_PRIORITY(
293	SPTEST.TASK_ID( 2 ),
294	5,
295	PREVIOUS_PRIORITY,
296	STATUS
297	);
298	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
299
300	RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 2 ), STATUS );
301	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
302
303	RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
304	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
305
306	end if;
307
308	TEXT_IO.PUT( "TA1 - task_set_note - set TA2's NOTEPAD_8: " );
309	UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
310	TEXT_IO.NEW_LINE;
311	RTEMS.TASKS.SET_NOTE(
312	SPTEST.TASK_ID( 2 ),
313	8,
314	THE_PRIORITY,
315	STATUS
316	);
317	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE" );
318
319	TEXT_IO.PUT("TA1 - task_set_priority - set TA2's priority: ");
320	UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
321	TEXT_IO.NEW_LINE;
322	RTEMS.TASKS.SET_PRIORITY(
323	SPTEST.TASK_ID( 2 ),
324	THE_PRIORITY,
325	PREVIOUS_PRIORITY,
326	STATUS
327	);
328	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
329
330	end loop;
331
332	end TASK_1;
333
334	--
335	-- TASK_2
336	--
337
338	procedure TASK_2 (
339	ARGUMENT : in RTEMS.TASKS.ARGUMENT
340	) is
341	pragma Unreferenced(ARGUMENT);
342	STATUS : RTEMS.STATUS_CODES;
343	THE_PRIORITY : RTEMS.TASKS.PRIORITY;
344	PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
345	begin
346
347	loop
348
349	RTEMS.TASKS.GET_NOTE( RTEMS.SELF, 8, THE_PRIORITY, STATUS );
350	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_GET_NOTE" );
351	TEXT_IO.PUT( "TA2 - task_get_note - ");
352	TEXT_IO.PUT( "get NOTEPAD_8 - current priority: " );
353	UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
354	TEXT_IO.NEW_LINE;
355
356	THE_PRIORITY := THE_PRIORITY - 1;
357
358	if THE_PRIORITY = 0 then
359	TEXT_IO.PUT_LINE( "TA2 - task_suspend - suspend TA1" );
360	RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 1 ), STATUS );
361	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
362
363	TEXT_IO.PUT( "TA2 - task_set_priority - ");
364	TEXT_IO.PUT_LINE( "set priority of TA1 ( blocked )");
365	RTEMS.TASKS.SET_PRIORITY(
366	SPTEST.TASK_ID( 1 ),
367	5,
368	PREVIOUS_PRIORITY,
369	STATUS
370	);
371	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
372
373	RTEMS.TASKS.DELETE(
374	SPTEST.TASK_ID( 1 ),
375	STATUS
376	); -- TA1 is blocked
377	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );
378
379	RTEMS.TASKS.DELETE(
380	SPTEST.TASK_ID( 3 ),
381	STATUS
382	); -- TA3 is ready
383	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
384
385	RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
386	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
387
388	else
389
390	TEXT_IO.PUT( "TA2 - task_set_note - set TA1's NOTEPAD_8: " );
391	UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
392	TEXT_IO.NEW_LINE;
393	RTEMS.TASKS.SET_NOTE(
394	SPTEST.TASK_ID( 1 ),
395	8,
396	THE_PRIORITY,
397	STATUS
398	);
399	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE" );
400
401	TEXT_IO.PUT( "TA2 - task_set_priority - ");
402	TEXT_IO.PUT( "set TA1's priority: ");
403	UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2);
404	TEXT_IO.NEW_LINE;
405	RTEMS.TASKS.SET_PRIORITY(
406	SPTEST.TASK_ID( 1 ),
407	THE_PRIORITY,
408	PREVIOUS_PRIORITY,
409	STATUS
410	);
411	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
412
413	end if;
414
415	end loop;
416
417	end TASK_2;
418
419	--
420	-- TASK_3
421	--
422
423	procedure TASK_3 (
424	ARGUMENT : in RTEMS.TASKS.ARGUMENT
425	) is
426	pragma Unreferenced(ARGUMENT);
427	STATUS : RTEMS.STATUS_CODES;
428	begin
429
430	loop
431
432	RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
433	TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
434
435	end loop;
436
437	end TASK_3;
438
439	--
440	-- TASK_4
441	--
442
443	procedure TASK_4 (
444	ARGUMENT : in RTEMS.TASKS.ARGUMENT
445	) is
446	pragma Unreferenced(ARGUMENT);
447	begin
448
449	Flush_Task_Event_Log;
450
451	TEXT_IO.PUT_LINE( "TA4 - exitting task" );
452
453	end TASK_4;
454
455	--
456	-- TASK_EXIT_EXTENSION
457	--
458
459	procedure TASK_EXIT_EXTENSION (
460	RUNNING_TASK : in RTEMS.TCB_POINTER
461	) is
462	begin
463
464	if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 then
465	TEXT_IO.PUT_LINE( "TASK_EXITTED - user extension invoked correctly" );
466	end if;
467
468	TEXT_IO.PUT_LINE( "* END OF TEST 7 *" );
469	RTEMS.SHUTDOWN_EXECUTIVE( 0 );
470
471	end TASK_EXIT_EXTENSION;
472
473	--
474	-- TASK_CREATE_EXTENSION
475	--
476
477	function TASK_CREATE_EXTENSION (
478	UNUSED : in RTEMS.TCB_POINTER;
479	CREATED_TASK : in RTEMS.TCB_POINTER
480	) return RTEMS.Boolean is
481	pragma Unreferenced(UNUSED);
482	begin
483
484	if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ) > 0 then
485	Log_Task_Event (
486	Created,
487	TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ),
488	0
489	);
490	end if;
491
492	return RTEMS.True;
493
494	end TASK_CREATE_EXTENSION;
495
496	--
497	-- TASK_DELETE_EXTENSION
498	--
499
500	procedure TASK_DELETE_EXTENSION (
501	RUNNING_TASK : in RTEMS.TCB_POINTER;
502	DELETED_TASK : in RTEMS.TCB_POINTER
503	) is
504	begin
505
506	if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 and
507	TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) ) > 0 then
508	Log_Task_Event (
509	Deleted,
510	TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ),
511	TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) )
512	);
513	end if;
514
515	end TASK_DELETE_EXTENSION;
516
517	--
518	-- TASK_RESTART_EXTENSION
519	--
520
521	procedure TASK_RESTART_EXTENSION (
522	UNUSED : in RTEMS.TCB_POINTER;
523	RESTARTED_TASK : in RTEMS.TCB_POINTER
524	) is
525	pragma Unreferenced(UNUSED);
526	begin
527
528	if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ) > 0 then
529	Log_Task_Event (
530	Restarted,
531	TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ),
532	0
533	);
534	end if;
535
536	end TASK_RESTART_EXTENSION;
537
538	--
539	-- TASK_START_EXTENSION
540	--
541
542	procedure TASK_START_EXTENSION (
543	UNUSED : in RTEMS.TCB_POINTER;
544	STARTED_TASK : in RTEMS.TCB_POINTER
545	) is
546	pragma Unreferenced(UNUSED);
547	begin
548
549	if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ) > 0 then
550	Log_Task_Event (
551	Started,
552	TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ),
553	0
554	);
555	end if;
556
557	end TASK_START_EXTENSION;
558
559	end SPTEST;

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

Context Navigation

source: rtems/c/src/ada-tests/sptests/sp07/sptest.adb @ f619250

Download in other formats: