sptest.adb

RTEMS (Real-Time Executive for Multiprocessor Systems) is a free open source real-time operating sys

   
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 2 ), 
         RTEMS.DEFAULT_OPTIONS, 
         TIMEOUT, 
         STATUS 
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN OF SM2" );

      if ITS_PRIORITY < 64 then
         TEXT_IO.PUT( "PRI" );
         UNSIGNED32_IO.PUT( ITS_INDEX );
         TEXT_IO.PUT( " - WHY AM I HERE? (priority = " );
         UNSIGNED32_IO.PUT( ITS_PRIORITY );
         TEXT_IO.PUT_LINE( " )" );
         RTEMS.SHUTDOWN_EXECUTIVE( 0 );
      end if;

      if ITS_INDEX = 5 then
         TEXT_IO.PUT_LINE(
            "PRI5 - task_suspend - until all priority tasks blocked" 
         );
      end if;

      RTEMS.TASK_SUSPEND( RTEMS.SELF, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );

      TEXT_IO.PUT_LINE( "PRI5 - task_delete - all tasks waiting on SM2" );
      for INDEX in 1 .. 4 
      loop

         RTEMS.TASK_DELETE(  SPTEST.PRIORITY_TASK_ID( INDEX ), STATUS );
         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE LOOP" );

      end loop;

      TEXT_IO.PUT_LINE( "PRI5 - semaphore_obtain - nested" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 2 ), 
         RTEMS.DEFAULT_OPTIONS, 
         TIMEOUT, 
         STATUS 
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN NESTED" );

      TEXT_IO.PUT_LINE( "PRI5 - semaphore_release - nested" );
      RTEMS.SEMAPHORE_RELEASE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE NESTED" );

      TEXT_IO.PUT_LINE( "PRI5 - semaphore_release - restore priority" );
      RTEMS.SEMAPHORE_RELEASE( SPTEST.SEMAPHORE_ID( 2 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );

      RTEMS.TASK_SET_PRIORITY( 
         SPTEST.PRIORITY_TASK_ID( 5 ),
         RTEMS.CURRENT_PRIORITY,
         CURRENT_PRIORITY,
         STATUS
      );
      TEXT_IO.PUT( "PRI5 - priority of PRI5 is " );
      UNSIGNED32_IO.PUT( CURRENT_PRIORITY );
      TEXT_IO.NEW_LINE;
      TEST_SUPPORT.DIRECTIVE_FAILED( 
         STATUS, 
         "PRI5 TASK_SET_PRIORITY CURRENT" 
      );
      RTEMS.TASK_SUSPEND( RTEMS.SELF, STATUS );

   end PRIORITY_TASK;
   
--PAGE
-- 
--  TASK_1
--

   procedure TASK_1 (
      ARGUMENT : in     RTEMS.TASK_ARGUMENT
   ) is
      SMID   : RTEMS.ID;
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.SEMAPHORE_IDENT( 
         SPTEST.SEMAPHORE_NAME( 1 ), 
         RTEMS.SEARCH_ALL_NODES, 
         SMID, 
         STATUS 
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_IDENT OF SM1" );
      TEXT_IO.PUT( "TA1 - semaphore_ident - smid => " );
      UNSIGNED32_IO.PUT( SMID, WIDTH => 8, BASE => 16 );
      TEXT_IO.NEW_LINE;

      TEXT_IO.PUT_LINE( "TA1 - semaphore_obtain - wait forever on SM2" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 2 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM2" );
     
      TEXT_IO.PUT_LINE( "TA1 - got SM2" );

      TEXT_IO.PUT_LINE( "TA1 - semaphore_obtain - wait forever on SM3" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 3 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM3" );
     
      TEXT_IO.PUT_LINE( "TA1 - got SM3" );
   
      TEXT_IO.PUT_LINE( "TA1 - semaphore_obtain - get SM1 - NO_WAIT" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 1 ),
         RTEMS.NO_WAIT, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
     
      TEXT_IO.PUT_LINE( "TA1 - got SM1" );

      TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
      RTEMS.TASK_WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

TEST_SUPPORT.PAUSE;

      TEXT_IO.PUT_LINE( "TA1 - semaphore_release - release SM1" );
      RTEMS.SEMAPHORE_RELEASE( SPTEST.SEMAPHORE_ID( 1 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM1" );
     
      TEXT_IO.PUT_LINE( 
         "TA1 - semaphore_obtain - waiting for SM1 with 10 second timeout"
      );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 1 ),
         RTEMS.DEFAULT_MODES, 
         10 * TEST_SUPPORT.TICKS_PER_SECOND,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM3" );
     
      TEXT_IO.PUT_LINE( "TA1 - got SM1" );
   
      TEXT_IO.PUT_LINE( "TA1 - semaphore_release - release SM2" );
      RTEMS.SEMAPHORE_RELEASE( 
         SPTEST.SEMAPHORE_ID( 2 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM2" );

      TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
      RTEMS.TASK_WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

TEST_SUPPORT.PAUSE;

      TEXT_IO.PUT_LINE( "TA1 - task_delete - delete TA3" );
      RTEMS.TASK_DELETE( SPTEST.TASK_ID( 3 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );

      RTEMS.TASK_CREATE( 
         SPTEST.TASK_NAME( 4 ), 
         4, 
         2048, 
         RTEMS.DEFAULT_MODES,
         RTEMS.DEFAULT_ATTRIBUTES,
         SPTEST.TASK_ID( 4 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA4" );

      RTEMS.TASK_CREATE( 
         SPTEST.TASK_NAME( 5 ), 
         4, 
         2048, 
         RTEMS.DEFAULT_MODES,
         RTEMS.DEFAULT_ATTRIBUTES,
         SPTEST.TASK_ID( 5 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA5" );

      RTEMS.TASK_START(
         SPTEST.TASK_ID( 4 ),
         SPTEST.TASK_4'ACCESS,
         0,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA4" );

      RTEMS.TASK_START(
         SPTEST.TASK_ID( 5 ),
         SPTEST.TASK_5'ACCESS,
         0,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA5" );

      TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
      RTEMS.TASK_WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

      TEXT_IO.PUT_LINE( "TA1 - task_delete - delete TA4" );
      RTEMS.TASK_DELETE( SPTEST.TASK_ID( 4 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA4" );

      TEXT_IO.PUT_LINE( "TA1 - semaphore_release - release SM1" );
      RTEMS.SEMAPHORE_RELEASE( 
         SPTEST.SEMAPHORE_ID( 1 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM1" );

      TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 5 seconds" );
      RTEMS.TASK_WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

      TEXT_IO.PUT_LINE( "TA1 - semaphore_delete - delete SM1" );
      RTEMS.SEMAPHORE_DELETE( SPTEST.SEMAPHORE_ID( 1 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE OF SM1" );

      TEXT_IO.PUT_LINE( "TA1 - semaphore_delete - delete SM3" );
      RTEMS.SEMAPHORE_DELETE( SPTEST.SEMAPHORE_ID( 3 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_DELETE OF SM3" );

      TEXT_IO.PUT_LINE( "TA1 - task_delete - delete self" );
      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );

   end TASK_1;

--PAGE
-- 
--  TASK_2
--

   procedure TASK_2 (
      ARGUMENT : in    RTEMS.TASK_ARGUMENT
   ) is
      STATUS            : RTEMS.STATUS_CODES;
      PREVIOUS_PRIORITY : RTEMS.TASK_PRIORITY;
   begin
 
      TEXT_IO.PUT_LINE( "TA2 - semaphore_obtain - wait forever on SM1" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 1 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
     
      TEXT_IO.PUT_LINE( "TA2 - got SM1" );
   
      TEXT_IO.PUT_LINE( "TA2 - semaphore_release - release SM1" );
      RTEMS.SEMAPHORE_RELEASE( 
         SPTEST.SEMAPHORE_ID( 1 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM1" );

      TEXT_IO.PUT_LINE( 
         "TA2 - task_set_priority - make self highest priority task" 
      );
      RTEMS.TASK_SET_PRIORITY(
         RTEMS.SELF,
         3,
         PREVIOUS_PRIORITY,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY ON TA2" );
     
      TEXT_IO.PUT_LINE( "TA2 - semaphore_obtain - wait forever on SM2" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 2 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM2" );
     
      TEXT_IO.PUT_LINE( "TA2 - got SM2" );
   
      TEXT_IO.PUT_LINE( "TA2 - semaphore_release - release SM2" );
      RTEMS.SEMAPHORE_RELEASE( 
         SPTEST.SEMAPHORE_ID( 2 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM2" );
   
      TEXT_IO.PUT_LINE( "TA2 - task_delete - delete self" );
      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );

   end TASK_2;

--PAGE
-- 
--  TASK_3
--

   procedure TASK_3 (
      ARGUMENT : in    RTEMS.TASK_ARGUMENT
   ) is
      STATUS : RTEMS.STATUS_CODES;
   begin
 
      TEXT_IO.PUT_LINE( "TA3 - semaphore_obtain - wait forever on SM2" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 2 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM2" );
      TEXT_IO.PUT_LINE( "TA3 - got SM2" );
   
      TEXT_IO.PUT_LINE( "TA3 - semaphore_release - release SM2" );
      RTEMS.SEMAPHORE_RELEASE( 
         SPTEST.SEMAPHORE_ID( 2 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE ON SM2" );
   
      TEXT_IO.PUT_LINE( "TA3 - semaphore_obtain - wait forever on SM3" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 3 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM3" );
     
   end TASK_3;

--PAGE
-- 
--  TASK_4
--

   procedure TASK_4 (
      ARGUMENT : in    RTEMS.TASK_ARGUMENT
   ) is
      STATUS : RTEMS.STATUS_CODES;
   begin
 
      TEXT_IO.PUT_LINE( "TA4 - semaphore_obtain - wait forever on SM1" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 1 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
     
   end TASK_4;

--PAGE
-- 
--  TASK_5
--

   procedure TASK_5 (
      ARGUMENT : in    RTEMS.TASK_ARGUMENT
   ) is
      STATUS : RTEMS.STATUS_CODES;
   begin
 
      TEXT_IO.PUT_LINE( "TA5 - semaphore_obtain - wait forever on SM1" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 1 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN ON SM1" );
     
      TEXT_IO.PUT_LINE( "TA5 - got SM1" );
   
      TEXT_IO.PUT_LINE( "TA5 - semaphore_obtain - wait forever on SM1" );
      RTEMS.SEMAPHORE_OBTAIN( 
         SPTEST.SEMAPHORE_ID( 1 ),
         RTEMS.DEFAULT_MODES, 
         RTEMS.NO_TIMEOUT,
         STATUS
      );
      TEST_SUPPORT.FATAL_DIRECTIVE_STATUS( 
         STATUS, 
         RTEMS.OBJECT_WAS_DELETED, 
         "SEMAPHORE_OBTAIN ON SM1" 
      );
      TEXT_IO.PUT_LINE( "TA5 - SM1 deleted by TA1" );
    
      TEXT_IO.PUT_LINE( "*** END OF TEST 12 ***" );
      RTEMS.SHUTDOWN_EXECUTIVE( 0 );
   
   end TASK_5;

end SPTEST;