--
-- SPTEST / BODY
--
-- DESCRIPTION:
--
-- This package is the implementation of Test 7 of the RTEMS
-- Single Processor Test Suite.
--
-- DEPENDENCIES:
--
--
--
-- COPYRIGHT (c) 1989-2011.
-- On-Line Applications Research Corporation (OAR).
--
-- The license and distribution terms for this file may in
-- the file LICENSE in this distribution or at
-- http://www.rtems.org/license/LICENSE.
--
with INTERFACES; use INTERFACES;
with TEST_SUPPORT;
with TEXT_IO;
with UNSIGNED32_IO;
with RTEMS.EXTENSION;
with RTEMS.FATAL;
package body SPTEST is
type Task_Event_Type is (
Created,
Deleted,
Restarted,
Started
);
type Task_Event is record
The_Event : Task_Event_Type;
Task1 : RTEMS.Unsigned32;
Task2 : RTEMS.Unsigned32;
end record;
Task_Events : array (1 .. 10) of Task_Event;
Task_Events_Index : Natural := Task_Events'First;
procedure Log_Task_Event (
The_Event : in Task_Event_Type;
Task1 : in RTEMS.Unsigned32;
Task2 : in RTEMS.Unsigned32
) is
begin
if Task_Events_Index = Task_Events'Last then
RTEMS.Fatal.Error_Occurred ( 1 ); -- no other choice
else
Task_Events (Task_Events_Index).The_Event := The_Event;
Task_Events (Task_Events_Index).Task1 := Task1;
Task_Events (Task_Events_Index).Task2 := Task2;
Task_Events_Index := Task_Events_Index + 1;
end if;
end Log_Task_Event;
procedure Flush_Task_Event_Log is
begin
for I in Task_Events'First .. Task_Events_Index - 1 loop
case Task_Events (I).The_Event is
when Created =>
TEXT_IO.PUT( "TASKS_CREATE - " );
TEST_SUPPORT.PUT_NAME(
SPTEST.TASK_NAME( Task_Events (I).Task1 ),
FALSE
);
TEXT_IO.PUT_LINE( " - created." );
when Deleted =>
TEXT_IO.PUT( "TASKS_DELETE - " );
TEST_SUPPORT.PUT_NAME(
SPTEST.TASK_NAME( Task_Events (I).Task1 ),
FALSE
);
TEXT_IO.PUT( " deleting " );
TEST_SUPPORT.PUT_NAME(
SPTEST.TASK_NAME( Task_Events (I).Task2 ),
TRUE
);
when Restarted =>
TEXT_IO.PUT( "TASKS_RESTART - " );
TEST_SUPPORT.PUT_NAME(
SPTEST.TASK_NAME( Task_Events (I).Task1 ),
FALSE
);
TEXT_IO.PUT_LINE( " - restarted." );
when Started =>
TEXT_IO.PUT( "TASKS_START - " );
TEST_SUPPORT.PUT_NAME(
SPTEST.TASK_NAME( Task_Events (I).Task1 ),
FALSE
);
TEXT_IO.PUT_LINE( " - started." );
end case;
end loop;
-- Reset the events list
Task_Events_Index := Task_Events'First;
end Flush_Task_Event_Log;
--
-- TCB_To_ID
--
function TCB_To_ID (
TCB : RTEMS.TCB_POINTER
) return RTEMS.ID;
pragma Import (C, TCB_To_ID, "tcb_to_id" );
--
-- INIT
--
procedure INIT (
ARGUMENT : in RTEMS.TASKS.ARGUMENT
) is
pragma Unreferenced(ARGUMENT);
STATUS : RTEMS.STATUS_CODES;
begin
TEXT_IO.NEW_LINE( 2 );
TEXT_IO.PUT_LINE( "*** TEST 7 ***" );
SPTEST.EXTENSION_NAME( 1 ) := RTEMS.BUILD_NAME( 'E', 'X', 'T', ' ' );
RTEMS.EXTENSION.CREATE(
SPTEST.EXTENSION_NAME( 1 ),
SPTEST.EXTENSIONS'ACCESS,
EXTENSION_ID( 1 ),
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EXTENSION_CREATE" );
SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'A', '2', ' ' );
SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME( 'T', 'A', '3', ' ' );
SPTEST.TASK_NAME( 4 ) := RTEMS.BUILD_NAME( 'T', 'A', '4', ' ' );
RTEMS.TASKS.CREATE(
SPTEST.TASK_NAME( 1 ),
4,
RTEMS.MINIMUM_STACK_SIZE,
RTEMS.DEFAULT_MODES,
RTEMS.DEFAULT_ATTRIBUTES,
SPTEST.TASK_ID( 1 ),
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
RTEMS.TASKS.CREATE(
SPTEST.TASK_NAME( 2 ),
4,
RTEMS.MINIMUM_STACK_SIZE,
RTEMS.DEFAULT_MODES,
RTEMS.DEFAULT_ATTRIBUTES,
SPTEST.TASK_ID( 2 ),
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
RTEMS.TASKS.CREATE(
SPTEST.TASK_NAME( 3 ),
250,
RTEMS.MINIMUM_STACK_SIZE,
RTEMS.DEFAULT_MODES,
RTEMS.DEFAULT_ATTRIBUTES,
SPTEST.TASK_ID( 3 ),
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
RTEMS.TASKS.CREATE(
SPTEST.TASK_NAME( 4 ),
254,
RTEMS.MINIMUM_STACK_SIZE,
RTEMS.DEFAULT_MODES,
RTEMS.DEFAULT_ATTRIBUTES,
SPTEST.TASK_ID( 4 ),
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA4" );
RTEMS.TASKS.START(
SPTEST.TASK_ID( 1 ),
SPTEST.TASK_1'ACCESS,
0,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
RTEMS.TASKS.START(
SPTEST.TASK_ID( 2 ),
SPTEST.TASK_2'ACCESS,
0,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
RTEMS.TASKS.START(
SPTEST.TASK_ID( 3 ),
SPTEST.TASK_3'ACCESS,
0,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
RTEMS.TASKS.START(
SPTEST.TASK_ID( 4 ),
SPTEST.TASK_4'ACCESS,
0,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA4" );
RTEMS.TASKS.RESTART( SPTEST.TASK_ID( 3 ), 0, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESTART OF TA3" );
Flush_Task_Event_Log;
RTEMS.TASKS.SET_NOTE( SPTEST.TASK_ID( 1 ), 8, 4, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE OF TA1" );
TEXT_IO.PUT( "INIT - task_set_note - set TA1's NOTEPAD_8" );
TEXT_IO.PUT_LINE( " to TA1's initial priority: 4" );
RTEMS.TASKS.SET_NOTE( SPTEST.TASK_ID( 2 ), 8, 4, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE OF TA2" );
TEXT_IO.PUT( "INIT - task_set_note - set TA2's NOTEPAD_8" );
TEXT_IO.PUT_LINE( " to TA2's initial priority: 4" );
RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
end INIT;
--
-- TASK_1
--
procedure TASK_1 (
ARGUMENT : in RTEMS.TASKS.ARGUMENT
) is
pragma Unreferenced(ARGUMENT);
STATUS : RTEMS.STATUS_CODES;
THE_PRIORITY : RTEMS.TASKS.PRIORITY;
PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
begin
TEST_SUPPORT.PAUSE;
RTEMS.TASKS.SET_PRIORITY(
RTEMS.SELF,
RTEMS.TASKS.CURRENT_PRIORITY,
THE_PRIORITY,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
TEXT_IO.PUT( "TA1 - task_set_priority - ");
TEXT_IO.PUT( "get initial priority of self: ");
UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
TEXT_IO.NEW_LINE;
loop
RTEMS.TASKS.GET_NOTE( RTEMS.SELF, 8, THE_PRIORITY, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_GET_NOTE" );
TEXT_IO.PUT( "TA1 - task_get_note - ");
TEXT_IO.PUT( "get NOTEPAD_8 - current priority: " );
UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
TEXT_IO.NEW_LINE;
THE_PRIORITY := THE_PRIORITY - 1;
if THE_PRIORITY = 0 then
TEXT_IO.PUT_LINE( "TA1 - task_suspend - suspend TA2" );
RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 2 ), STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
TEXT_IO.PUT( "TA1 - task_set_priority - ");
TEXT_IO.PUT_LINE( "set priority of TA2 ( blocked )");
RTEMS.TASKS.SET_PRIORITY(
SPTEST.TASK_ID( 2 ),
5,
PREVIOUS_PRIORITY,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 2 ), STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
end if;
TEXT_IO.PUT( "TA1 - task_set_note - set TA2's NOTEPAD_8: " );
UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
TEXT_IO.NEW_LINE;
RTEMS.TASKS.SET_NOTE(
SPTEST.TASK_ID( 2 ),
8,
THE_PRIORITY,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE" );
TEXT_IO.PUT("TA1 - task_set_priority - set TA2's priority: ");
UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
TEXT_IO.NEW_LINE;
RTEMS.TASKS.SET_PRIORITY(
SPTEST.TASK_ID( 2 ),
THE_PRIORITY,
PREVIOUS_PRIORITY,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
end loop;
end TASK_1;
--
-- TASK_2
--
procedure TASK_2 (
ARGUMENT : in RTEMS.TASKS.ARGUMENT
) is
pragma Unreferenced(ARGUMENT);
STATUS : RTEMS.STATUS_CODES;
THE_PRIORITY : RTEMS.TASKS.PRIORITY;
PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
begin
loop
RTEMS.TASKS.GET_NOTE( RTEMS.SELF, 8, THE_PRIORITY, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_GET_NOTE" );
TEXT_IO.PUT( "TA2 - task_get_note - ");
TEXT_IO.PUT( "get NOTEPAD_8 - current priority: " );
UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
TEXT_IO.NEW_LINE;
THE_PRIORITY := THE_PRIORITY - 1;
if THE_PRIORITY = 0 then
TEXT_IO.PUT_LINE( "TA2 - task_suspend - suspend TA1" );
RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 1 ), STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
TEXT_IO.PUT( "TA2 - task_set_priority - ");
TEXT_IO.PUT_LINE( "set priority of TA1 ( blocked )");
RTEMS.TASKS.SET_PRIORITY(
SPTEST.TASK_ID( 1 ),
5,
PREVIOUS_PRIORITY,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
RTEMS.TASKS.DELETE(
SPTEST.TASK_ID( 1 ),
STATUS
); -- TA1 is blocked
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );
RTEMS.TASKS.DELETE(
SPTEST.TASK_ID( 3 ),
STATUS
); -- TA3 is ready
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
else
TEXT_IO.PUT( "TA2 - task_set_note - set TA1's NOTEPAD_8: " );
UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2 );
TEXT_IO.NEW_LINE;
RTEMS.TASKS.SET_NOTE(
SPTEST.TASK_ID( 1 ),
8,
THE_PRIORITY,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_NOTE" );
TEXT_IO.PUT( "TA2 - task_set_priority - ");
TEXT_IO.PUT( "set TA1's priority: ");
UNSIGNED32_IO.PUT( THE_PRIORITY, BASE => 10, WIDTH => 2);
TEXT_IO.NEW_LINE;
RTEMS.TASKS.SET_PRIORITY(
SPTEST.TASK_ID( 1 ),
THE_PRIORITY,
PREVIOUS_PRIORITY,
STATUS
);
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
end if;
end loop;
end TASK_2;
--
-- TASK_3
--
procedure TASK_3 (
ARGUMENT : in RTEMS.TASKS.ARGUMENT
) is
pragma Unreferenced(ARGUMENT);
STATUS : RTEMS.STATUS_CODES;
begin
loop
RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
end loop;
end TASK_3;
--
-- TASK_4
--
procedure TASK_4 (
ARGUMENT : in RTEMS.TASKS.ARGUMENT
) is
pragma Unreferenced(ARGUMENT);
begin
Flush_Task_Event_Log;
TEXT_IO.PUT_LINE( "TA4 - exitting task" );
end TASK_4;
--
-- TASK_EXIT_EXTENSION
--
procedure TASK_EXIT_EXTENSION (
RUNNING_TASK : in RTEMS.TCB_POINTER
) is
begin
if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 then
TEXT_IO.PUT_LINE( "TASK_EXITTED - user extension invoked correctly" );
end if;
TEXT_IO.PUT_LINE( "*** END OF TEST 7 ***" );
RTEMS.SHUTDOWN_EXECUTIVE( 0 );
end TASK_EXIT_EXTENSION;
--
-- TASK_CREATE_EXTENSION
--
function TASK_CREATE_EXTENSION (
UNUSED : in RTEMS.TCB_POINTER;
CREATED_TASK : in RTEMS.TCB_POINTER
) return RTEMS.Boolean is
pragma Unreferenced(UNUSED);
begin
if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ) > 0 then
Log_Task_Event (
Created,
TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( CREATED_TASK ) ),
0
);
end if;
return RTEMS.True;
end TASK_CREATE_EXTENSION;
--
-- TASK_DELETE_EXTENSION
--
procedure TASK_DELETE_EXTENSION (
RUNNING_TASK : in RTEMS.TCB_POINTER;
DELETED_TASK : in RTEMS.TCB_POINTER
) is
begin
if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ) > 0 and
TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) ) > 0 then
Log_Task_Event (
Deleted,
TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RUNNING_TASK ) ),
TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( DELETED_TASK ) )
);
end if;
end TASK_DELETE_EXTENSION;
--
-- TASK_RESTART_EXTENSION
--
procedure TASK_RESTART_EXTENSION (
UNUSED : in RTEMS.TCB_POINTER;
RESTARTED_TASK : in RTEMS.TCB_POINTER
) is
pragma Unreferenced(UNUSED);
begin
if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ) > 0 then
Log_Task_Event (
Restarted,
TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( RESTARTED_TASK ) ),
0
);
end if;
end TASK_RESTART_EXTENSION;
--
-- TASK_START_EXTENSION
--
procedure TASK_START_EXTENSION (
UNUSED : in RTEMS.TCB_POINTER;
STARTED_TASK : in RTEMS.TCB_POINTER
) is
pragma Unreferenced(UNUSED);
begin
if TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ) > 0 then
Log_Task_Event (
Started,
TEST_SUPPORT.TASK_NUMBER( TCB_To_ID( STARTED_TASK ) ),
0
);
end if;
end TASK_START_EXTENSION;
end SPTEST;
