summaryrefslogtreecommitdiffstats
path: root/testsuites/ada/sptests/sp07/sptest.adb
diff options
context:
space:
mode:
Diffstat (limited to 'testsuites/ada/sptests/sp07/sptest.adb')
-rw-r--r--testsuites/ada/sptests/sp07/sptest.adb513
1 files changed, 513 insertions, 0 deletions
diff --git a/testsuites/ada/sptests/sp07/sptest.adb b/testsuites/ada/sptests/sp07/sptest.adb
new file mode 100644
index 0000000000..d55aa73bf8
--- /dev/null
+++ b/testsuites/ada/sptests/sp07/sptest.adb
@@ -0,0 +1,513 @@
+--
+-- 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.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
+
+ 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_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
+
+ 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_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;