source: rtems/c/src/ada-tests/mptests/mp09/mptest.adb @ 0f4b25df

--
--  MPTEST / BODY
--
--  DESCRIPTION:
--
--  This package is the implementation for Test 9 of the RTEMS
--  Multiprocessor Test Suite.
--
--  DEPENDENCIES:
--
--
--
--  COPYRIGHT (c) 1989-1997.
--  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.com/license/LICENSE.
--
--  $Id$
--

with INTERFACES; use INTERFACES;
with RTEMS;
with TEST_SUPPORT;
with TEXT_IO;
with UNSIGNED32_IO;

package body MPTEST is

   package body PER_NODE_CONFIGURATION is separate;

--PAGE
--
--  INIT
--

   procedure INIT (
      ARGUMENT : in     RTEMS.TASK_ARGUMENT
   ) is
      STATUS : RTEMS.STATUS_CODES;
   begin

      TEXT_IO.NEW_LINE( 2 );
      TEXT_IO.PUT( "*** TEST 9 -- NODE " );
      UNSIGNED32_IO.PUT(
         MPTEST.MULTIPROCESSING_CONFIGURATION.NODE,
         WIDTH => 1
      );
      TEXT_IO.PUT_LINE( " ***" );

      MPTEST.RECEIVE_BUFFER :=
         RTEMS.TO_BUFFER_POINTER( MPTEST.RECEIVE_BUFFER_AREA'ADDRESS );

      MPTEST.BUFFER_1 :=
         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_1'ADDRESS );

      MPTEST.BUFFER_2 :=
         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_2'ADDRESS );

      MPTEST.BUFFER_3 :=
         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_3'ADDRESS );

      MPTEST.BUFFER_4 :=
         RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_4'ADDRESS );

      MPTEST.FILL_BUFFER( "123456789012345 ", MPTEST.BUFFER_AREA_1 );
      MPTEST.FILL_BUFFER( "abcdefghijklmno ", MPTEST.BUFFER_AREA_2 );
      MPTEST.FILL_BUFFER( "ABCDEFGHIJKLMNO ", MPTEST.BUFFER_AREA_3 );
      MPTEST.FILL_BUFFER( "PQRSTUVWXYZ(){} ", MPTEST.BUFFER_AREA_4 );

      MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  '1', '1', '1', ' ' );
      MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  '2', '2', '2', ' ' );

      MPTEST.QUEUE_NAME( 1 ) := RTEMS.BUILD_NAME(  'M', 'S', 'G', ' ' );

      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 1 then

         TEXT_IO.PUT_LINE( "Creating Message Queue (Global)" );
         RTEMS.MESSAGE_QUEUE_CREATE(
            MPTEST.QUEUE_NAME( 1 ),
            3,
            RTEMS.GLOBAL + RTEMS.LIMIT,
            MPTEST.QUEUE_ID( 1 ),
            STATUS
         );
         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );

      end if;

      TEXT_IO.PUT_LINE( "Creating Test_task (local)" );
      RTEMS.TASK_CREATE(
         MPTEST.TASK_NAME( MPTEST.MULTIPROCESSING_CONFIGURATION.NODE ),
         MPTEST.MULTIPROCESSING_CONFIGURATION.NODE,
         2048,
         RTEMS.TIMESLICE,
         RTEMS.DEFAULT_ATTRIBUTES,
         MPTEST.TASK_ID( 1 ),
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );

      TEXT_IO.PUT_LINE( "Starting Test_task (local)" );
      RTEMS.TASK_START(
         MPTEST.TASK_ID( 1 ),
         MPTEST.TEST_TASK'ACCESS,
         0,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );

      TEXT_IO.PUT_LINE( "Deleting initialization task" );
      RTEMS.TASK_DELETE( RTEMS.SELF, STATUS );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );

   end INIT;

--PAGE
--
--  SEND_MESSAGES
--

   procedure SEND_MESSAGES is
      BROADCAST_COUNT     : RTEMS.UNSIGNED32;
      STATUS              : RTEMS.STATUS_CODES;
   begin

      TEXT_IO.PUT( "message_queue_send : " );
      MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_1 );
      TEXT_IO.NEW_LINE;

      RTEMS.MESSAGE_QUEUE_SEND(
         MPTEST.QUEUE_ID( 1 ),
         MPTEST.BUFFER_1,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" );

      TEXT_IO.PUT_LINE( "Delaying for a second" );
      RTEMS.TASK_WAKE_AFTER(
         1 * TEST_SUPPORT.TICKS_PER_SECOND,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

      TEXT_IO.PUT( "message_queue_urgent : " );
      MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_2 );
      TEXT_IO.NEW_LINE;

      RTEMS.MESSAGE_QUEUE_URGENT(
         MPTEST.QUEUE_ID( 1 ),
         MPTEST.BUFFER_2,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_URGENT" );

      TEXT_IO.PUT_LINE( "Delaying for a second" );
      RTEMS.TASK_WAKE_AFTER(
         1 * TEST_SUPPORT.TICKS_PER_SECOND,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

      TEXT_IO.PUT( "message_queue_broadcast : " );
      MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_3 );
      TEXT_IO.NEW_LINE;

      RTEMS.MESSAGE_QUEUE_BROADCAST(
         MPTEST.QUEUE_ID( 1 ),
         MPTEST.BUFFER_3,
         BROADCAST_COUNT,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_BROADCAST" );

      TEXT_IO.PUT_LINE( "Delaying for a second" );
      RTEMS.TASK_WAKE_AFTER(
         1 * TEST_SUPPORT.TICKS_PER_SECOND,
         STATUS
      );
      TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );

   end SEND_MESSAGES;

--PAGE
--
--  RECEIVE_MESSAGES
--

   procedure RECEIVE_MESSAGES is
      INDEX               : RTEMS.UNSIGNED32;
      STATUS              : RTEMS.STATUS_CODES;
   begin

      for INDEX in 1 .. 3
      loop

         TEXT_IO.PUT_LINE( "Receiving message ..." );
         RTEMS.MESSAGE_QUEUE_RECEIVE(
            MPTEST.QUEUE_ID( 1 ),
            MPTEST.RECEIVE_BUFFER,
            RTEMS.DEFAULT_OPTIONS,
            RTEMS.NO_TIMEOUT,
            STATUS
         );
         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" );

         TEXT_IO.PUT( "Received : " );
         MPTEST.PUT_BUFFER( MPTEST.RECEIVE_BUFFER_AREA );
         TEXT_IO.NEW_LINE;

      end loop;

      TEXT_IO.PUT_LINE( "Receiver delaying for a second" );

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

   end RECEIVE_MESSAGES;

--PAGE
--
--  FILL_BUFFER
--

--
-- Depends on tricks to make the copy work.
--

   procedure FILL_BUFFER (
      SOURCE : in     STRING;
      BUFFER :    out RTEMS.BUFFER
   ) is
      SOURCE_BUFFER : RTEMS.BUFFER_POINTER;
   begin

      SOURCE_BUFFER := RTEMS.TO_BUFFER_POINTER(
                          SOURCE( SOURCE'FIRST )'ADDRESS
                       );

      BUFFER.FIELD1 := SOURCE_BUFFER.FIELD1;
      BUFFER.FIELD2 := SOURCE_BUFFER.FIELD2;
      BUFFER.FIELD3 := SOURCE_BUFFER.FIELD3;
      BUFFER.FIELD4 := SOURCE_BUFFER.FIELD4;

   end FILL_BUFFER;

--PAGE
--
--  PUT_BUFFER
--

--
-- Depends on tricks to make the output work.
--

   procedure PUT_BUFFER (
      BUFFER : in     RTEMS.BUFFER
   ) is
   begin

      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD1, FALSE );
      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD2, FALSE );
      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD3, FALSE );
      TEST_SUPPORT.PUT_NAME( BUFFER.FIELD4, FALSE );

   end PUT_BUFFER;

--PAGE
--
--  TEST_TASK
--

   procedure TEST_TASK (
      ARGUMENT : in     RTEMS.TASK_ARGUMENT
   ) is
      COUNT   : RTEMS.UNSIGNED32;
      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( "Getting QID of message queue" );

      loop

         RTEMS.MESSAGE_QUEUE_IDENT(
            MPTEST.QUEUE_NAME( 1 ),
            RTEMS.SEARCH_ALL_NODES,
            MPTEST.QUEUE_ID( 1 ),
            STATUS
         );

         exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );

      end loop;

      if MPTEST.MULTIPROCESSING_CONFIGURATION.NODE = 2 then

         RTEMS.MESSAGE_QUEUE_DELETE( MPTEST.QUEUE_ID( 1 ), STATUS );

         TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
            STATUS,
            RTEMS.ILLEGAL_ON_REMOTE_OBJECT,
            "MESSAGE_QUEUE_DELETE"
         );

         TEXT_IO.PUT_LINE(
         "message_queue_delete correctly returned ILLEGAL_ON_REMOTE_OBJECT"
         );

         MPTEST.SEND_MESSAGES;

         MPTEST.RECEIVE_MESSAGES;

         TEXT_IO.PUT_LINE( "Flushing remote empty queue" );
         RTEMS.MESSAGE_QUEUE_FLUSH( MPTEST.QUEUE_ID( 1 ), COUNT, STATUS );
         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_FLUSH" );
         UNSIGNED32_IO.PUT( COUNT, WIDTH => 1 );
         TEXT_IO.PUT_LINE(
            " messages were flushed from remote empty queue"
         );

         TEXT_IO.PUT_LINE(
            "Send messages to be flushed from remote queue"
         );
         RTEMS.MESSAGE_QUEUE_SEND(
            MPTEST.QUEUE_ID( 1 ),
            MPTEST.BUFFER_1,
            STATUS
         );
         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" );

         TEXT_IO.PUT_LINE( "Flushing remote queue" );
         RTEMS.MESSAGE_QUEUE_FLUSH( MPTEST.QUEUE_ID( 1 ), COUNT, STATUS );
         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_FLUSH" );
         UNSIGNED32_IO.PUT( COUNT, WIDTH => 1 );
         TEXT_IO.PUT_LINE(
            " messages were flushed from the remote queue"
         );

         TEXT_IO.PUT_LINE( "Waiting for message queue to be deleted" );
         RTEMS.MESSAGE_QUEUE_RECEIVE(
            MPTEST.QUEUE_ID( 1 ),
            MPTEST.RECEIVE_BUFFER,
            RTEMS.DEFAULT_OPTIONS,
            RTEMS.NO_TIMEOUT,
            STATUS
         );
         TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
            STATUS,
            RTEMS.OBJECT_WAS_DELETED,
            "MESSAGE_QUEUE_FLUSH"
         );

      else

         MPTEST.RECEIVE_MESSAGES;

         MPTEST.SEND_MESSAGES;

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

         RTEMS.MESSAGE_QUEUE_DELETE( MPTEST.QUEUE_ID( 1 ), STATUS );
         TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_DELETE" );

      end if;

      TEXT_IO.PUT_LINE( "*** END OF TEST 9 ***" );

      RTEMS.SHUTDOWN_EXECUTIVE( 0 );

   end TEST_TASK;

end MPTEST;