sptest.adb

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

         SPTEST.TIMER_ID( 3 ),
         TIME,
         SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
         RTEMS.NULL_ADDRESS,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );

      TIME.DAY := 15;
      TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
      TEXT_IO.NEW_LINE;
      RTEMS.CLOCK_SET( TIME, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
      TEXT_IO.PUT_LINE( 
         "TA1 - event_receive - waiting forever on EVENT_11"
      );
      RTEMS.EVENT_RECEIVE( 
         RTEMS.EVENT_11,
         RTEMS.DEFAULT_OPTIONS,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 11" );
      TEXT_IO.PUT( "TA1 - EVENT_11 received - eventout => ");
      UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
      TEXT_IO.NEW_LINE;

      TEST_SUPPORT.PAUSE;

-- The following code tests the case of deleting a timer ???

      TEXT_IO.PUT_LINE( "TA1 - event_send/event_receive combination" );
      RTEMS.TIMER_FIRE_AFTER( 
         SPTEST.TIMER_ID( 1 ),
         10,
         SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
         RTEMS.NULL_ADDRESS,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 10 ticks" );
      RTEMS.EVENT_RECEIVE( 
         RTEMS.EVENT_11,
         RTEMS.DEFAULT_OPTIONS,
         11,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE" );

      TIME := ( 1988, 2, 12, 8, 15, 0, 0 );

      TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
      TEXT_IO.NEW_LINE;
      RTEMS.CLOCK_SET( TIME, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );

      TIME.DAY := 13;
      TEXT_IO.PUT_LINE( 
         "TA1 - event_receive all outstanding events"
      );
      RTEMS.EVENT_RECEIVE(
         RTEMS.ALL_EVENTS,
         RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.FATAL_DIRECTIVE_STATUS( 
         STATUS, 
         RTEMS.UNSATISFIED, 
         "EVENT_RECEIVE all events" 
      );

      TEXT_IO.PUT_LINE( 
         "TA1 - event_send - send EVENT_10 to self in 1 day"
      );
      RTEMS.TIMER_FIRE_WHEN( 
         SPTEST.TIMER_ID( 1 ),
         TIME,
         SPTEST.TA1_SEND_10_TO_SELF'ACCESS,
         RTEMS.NULL_ADDRESS,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 1 day" );

      TIME.DAY := 14;
      TEXT_IO.PUT_LINE( 
         "TA1 - event_send - send EVENT_11 to self in 2 days"
      );
      RTEMS.TIMER_FIRE_WHEN( 
         SPTEST.TIMER_ID( 2 ),
         TIME,
         SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
         RTEMS.NULL_ADDRESS,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );

      TIME := ( 1988, 2, 12, 7, 15, 0, 0 );

      TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
      TEXT_IO.NEW_LINE;
      TEXT_IO.PUT_LINE( "TA1 - set time backwards" );
      RTEMS.CLOCK_SET( TIME, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );

      RTEMS.EVENT_RECEIVE( 
         RTEMS.ALL_EVENTS,
         RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      if EVENTOUT >= RTEMS.EVENT_0 then 
         TEXT_IO.PUT( "ERROR - " );
         UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
         TEXT_IO.PUT_LINE( " events received" );
      else
         TEXT_IO.PUT_LINE( "TA1 - no events received" );
      end if;
      TEST_SUPPORT.FATAL_DIRECTIVE_STATUS( 
         STATUS, 
         RTEMS.UNSATISFIED, 
         "EVENT_RECEIVE all events" 
      );

      TIME := ( 1988, 2, 14, 7, 15, 0, 0 );

      TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
      TEXT_IO.NEW_LINE;
      TEXT_IO.PUT_LINE( "TA1 - set time forwards (leave a timer)" );
      RTEMS.CLOCK_SET( TIME, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );

      RTEMS.EVENT_RECEIVE( 
         RTEMS.ALL_EVENTS,
         RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE all events" );
      if EVENTOUT = RTEMS.EVENT_10 then 
         TEXT_IO.PUT_LINE( "TA1 - EVENT_10 received" );
      else
         TEXT_IO.PUT( "ERROR - " );
         UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
         TEXT_IO.PUT_LINE( " events received" );
      end if;
         
      TEXT_IO.PUT_LINE( 
         "TA1 - event_send - send EVENT_11 to self in 100 ticks"
      );
      RTEMS.TIMER_FIRE_AFTER( 
         SPTEST.TIMER_ID( 1 ),
         100,
         SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
         RTEMS.NULL_ADDRESS,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 100 ticks" );

      TEXT_IO.PUT_LINE( 
         "TA1 - event_send - send EVENT_11 to self in 200 ticks"
      );
      RTEMS.TIMER_FIRE_AFTER( 
         SPTEST.TIMER_ID( 2 ),
         100,
         SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
         RTEMS.NULL_ADDRESS,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 200 ticks" );

      TEXT_IO.PUT_LINE( "*** END OF TEST 11 ***" );
      RTEMS.SHUTDOWN_EXECUTIVE( 0 );

   end TASK_1;

--PAGE
-- 
--  TASK_2
--

   procedure TASK_2 (
      ARGUMENT : in     RTEMS.TASK_ARGUMENT
   ) is
      EVENTOUT : RTEMS.EVENT_SET;
      TIME     : RTEMS.TIME_OF_DAY;
      STATUS   : RTEMS.STATUS_CODES;
   begin

      RTEMS.TASK_WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

      TEXT_IO.PUT_LINE( 
         "TA2 - event_receive - waiting forever on EVENT_16"
      );
      RTEMS.EVENT_RECEIVE( 
         RTEMS.EVENT_16,
         RTEMS.DEFAULT_OPTIONS,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 16" );
      TEXT_IO.PUT( "TA2 - EVENT_16 received - eventout => ");
      UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
      TEXT_IO.NEW_LINE;

      TEXT_IO.PUT_LINE( 
         "TA2 - event_send - send EVENT_14 and EVENT_15 to TA1"
      );
      RTEMS.EVENT_SEND( 
         SPTEST.TASK_ID( 1 ), 
         RTEMS.EVENT_14 + RTEMS.EVENT_15,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 14 and 15" );

      TEXT_IO.PUT_LINE( 
     "TA2 - event_receive - waiting forever on EVENT_17 or EVENT_18 - EVENT_ANY"
      );
      RTEMS.EVENT_RECEIVE( 
         RTEMS.EVENT_17 + RTEMS.EVENT_18,
         RTEMS.EVENT_ANY,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 17 and 18" );
      TEXT_IO.PUT( "TA2 - EVENT_17 or EVENT_18 received - eventout => ");
      UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
      TEXT_IO.NEW_LINE;

      TEXT_IO.PUT_LINE( 
         "TA2 - event_send - send EVENT_14 to TA1"
      );
      RTEMS.EVENT_SEND( 
         SPTEST.TASK_ID( 1 ), 
         RTEMS.EVENT_14,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 14" );

      TIME := ( 1988,  2, 12, 8, 15, 0, 0 );

      TEST_SUPPORT.PRINT_TIME( "TA2 - clock_set - ", TIME, "" );
      TEXT_IO.NEW_LINE;
      RTEMS.CLOCK_SET( TIME, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA2 CLOCK_SET" );

      TIME.SECOND := TIME.SECOND + 5;
      TEXT_IO.PUT_LINE( 
         "TA2 - event_send - sending EVENT_10 to self after 5 seconds"
      );
      RTEMS.TIMER_FIRE_WHEN( 
         SPTEST.TIMER_ID( 5 ),
         TIME,
         SPTEST.TA2_SEND_10_TO_SELF'ACCESS,
         RTEMS.NULL_ADDRESS,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 5 SECONDS" );

      TEXT_IO.PUT_LINE( 
         "TA2 - event_receive - waiting forever on EVENT_10"
      );
      RTEMS.EVENT_RECEIVE( 
         RTEMS.EVENT_10,
         RTEMS.DEFAULT_OPTIONS,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );

      RTEMS.CLOCK_GET( RTEMS.CLOCK_GET_TOD, TIME'ADDRESS, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_GET" );

      TEXT_IO.PUT( "TA2 - EVENT_10 received - eventout => ");
      UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
      TEXT_IO.NEW_LINE;

      TEST_SUPPORT.PRINT_TIME( "TA1 - clock_get - ", TIME, "" );
      TEXT_IO.NEW_LINE;

      TEXT_IO.PUT_LINE( "TA2 - event_receive - PENDING_EVENTS" );
      RTEMS.EVENT_RECEIVE( 
         RTEMS.PENDING_EVENTS,
         RTEMS.DEFAULT_OPTIONS,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
      TEXT_IO.PUT( "TA2 - eventout => ");
      UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
      TEXT_IO.NEW_LINE;

      TEXT_IO.PUT_LINE( 
         "TA2 - event_receive - EVENT_19 - NO_WAIT"
      );
      RTEMS.EVENT_RECEIVE( 
         RTEMS.EVENT_19,
         RTEMS.NO_WAIT,
         RTEMS.NO_TIMEOUT,
         EVENTOUT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
      TEXT_IO.PUT( "TA2 - EVENT_19 received - eventout => ");
      UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
      TEXT_IO.NEW_LINE;

      TEXT_IO.PUT_LINE( "TA2 - task_delete - deletes self" );
      RTEMS.TASK_DELETE( SPTEST.TASK_ID( 2 ), STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE of TA2" );

   end TASK_2;

--PAGE
-- 
--  TA1_SEND_18_TO_SELF_5_SECONDS
--

   procedure TA1_SEND_18_TO_SELF_5_SECONDS (
      IGNORED_ID      : in     RTEMS.ID;
      IGNORED_ADDRESS : in     RTEMS.ADDRESS
   )
   is
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.EVENT_SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_18, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 18" );

   end TA1_SEND_18_TO_SELF_5_SECONDS;

--PAGE
-- 
--  TA1_SEND_8_TO_SELF_60_SECONDS
--

   procedure TA1_SEND_8_TO_SELF_60_SECONDS (
      IGNORED_ID      : in     RTEMS.ID;
      IGNORED_ADDRESS : in     RTEMS.ADDRESS
   )
   is
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.EVENT_SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_8, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 8" );

   end TA1_SEND_8_TO_SELF_60_SECONDS;

--PAGE
-- 
--  TA1_SEND_9_TO_SELF_60_SECONDS
--

   procedure TA1_SEND_9_TO_SELF_60_SECONDS (
      IGNORED_ID      : in     RTEMS.ID;
      IGNORED_ADDRESS : in     RTEMS.ADDRESS
   )
   is
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.EVENT_SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_9, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 9" );

   end TA1_SEND_9_TO_SELF_60_SECONDS;

--PAGE
-- 
--  TA1_SEND_10_TO_SELF
--

   procedure TA1_SEND_10_TO_SELF (
      IGNORED_ID      : in     RTEMS.ID;
      IGNORED_ADDRESS : in     RTEMS.ADDRESS
   )
   is
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.EVENT_SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_10, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 10" );

   end TA1_SEND_10_TO_SELF;

--PAGE
-- 
--  TA1_SEND_1_TO_SELF_EVERY_SECOND
--

   procedure TA1_SEND_1_TO_SELF_EVERY_SECOND (
      IGNORED_ID      : in     RTEMS.ID;
      IGNORED_ADDRESS : in     RTEMS.ADDRESS
   )
   is
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.EVENT_SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_1, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 1" );

   end TA1_SEND_1_TO_SELF_EVERY_SECOND;

--PAGE
-- 
--  TA1_SEND_11_TO_SELF
--

   procedure TA1_SEND_11_TO_SELF (
      IGNORED_ID      : in     RTEMS.ID;
      IGNORED_ADDRESS : in     RTEMS.ADDRESS
   )
   is
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.EVENT_SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_11, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 11" );

   end TA1_SEND_11_TO_SELF;

--PAGE
-- 
--  TA2_SEND_10_TO_SELF
--

   procedure TA2_SEND_10_TO_SELF (
      IGNORED_ID      : in     RTEMS.ID;
      IGNORED_ADDRESS : in     RTEMS.ADDRESS
   )
   is
      STATUS : RTEMS.STATUS_CODES;
   begin

      RTEMS.EVENT_SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_10, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 10" );

   end TA2_SEND_10_TO_SELF;

end SPTEST;