Back to home page

LXR

 
 

    


Warning, /testsuites/ada/mptests/mp10/mptest.adb is written in an unsupported language. File is not indexed.

0001 -- SPDX-License-Identifier: BSD-2-Clause
0002 
0003 --
0004 --  MPTEST / BODY
0005 --
0006 --  DESCRIPTION:
0007 --
0008 --  This package is the implementation for Test 10 of the RTEMS
0009 --  Multiprocessor Test Suite.
0010 --
0011 --  DEPENDENCIES:
0012 --
0013 --
0014 --
0015 --  COPYRIGHT (c) 1989-2011.
0016 --  On-Line Applications Research Corporation (OAR).
0017 --
0018 --  Redistribution and use in source and binary forms, with or without
0019 --  modification, are permitted provided that the following conditions
0020 --  are met:
0021 --  1. Redistributions of source code must retain the above copyright
0022 --     notice, this list of conditions and the following disclaimer.
0023 --  2. Redistributions in binary form must reproduce the above copyright
0024 --     notice, this list of conditions and the following disclaimer in the
0025 --     documentation and/or other materials provided with the distribution.
0026 --
0027 --  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
0028 --  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
0029 --  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
0030 --  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
0031 --  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
0032 --  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
0033 --  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
0034 --  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
0035 --  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
0036 --  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
0037 --  POSSIBILITY OF SUCH DAMAGE.
0038 --
0039 
0040 with INTERFACES; use INTERFACES;
0041 with RTEMS.MESSAGE_QUEUE;
0042 with RTEMS.SEMAPHORE;
0043 with TEST_SUPPORT;
0044 with TEXT_IO;
0045 with UNSIGNED32_IO;
0046 
0047 package body MPTEST is
0048 
0049 --
0050 --  INIT
0051 --
0052 
0053    procedure INIT (
0054       ARGUMENT : in     RTEMS.TASKS.ARGUMENT
0055    ) is
0056       pragma Unreferenced(ARGUMENT);
0057       STATUS : RTEMS.STATUS_CODES;
0058    begin
0059 
0060       TEXT_IO.NEW_LINE( 2 );
0061       TEST_SUPPORT.ADA_TEST_BEGIN;
0062       TEXT_IO.PUT( "*** NODE " );
0063       UNSIGNED32_IO.PUT(
0064          TEST_SUPPORT.NODE,
0065          WIDTH => 1
0066       );
0067       TEXT_IO.PUT_LINE( " ***" );
0068 
0069 
0070       MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
0071       MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME(  'T', 'A', '2', ' ' );
0072       MPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME(  'S', 'A', '3', ' ' );
0073 
0074       MPTEST.QUEUE_NAME( 1 ) := RTEMS.BUILD_NAME(  'M', 'S', 'G', ' ' );
0075 
0076       MPTEST.SEMAPHORE_NAME( 1 ) := RTEMS.BUILD_NAME(  'S', 'E', 'M', ' ' );
0077 
0078       if TEST_SUPPORT.NODE = 1 then
0079 
0080          TEXT_IO.PUT_LINE( "Creating Message Queue (Global)" );
0081          RTEMS.MESSAGE_QUEUE.CREATE(
0082             MPTEST.QUEUE_NAME( 1 ),
0083             3,
0084             3,
0085             RTEMS.GLOBAL,
0086             MPTEST.QUEUE_ID( 1 ),
0087             STATUS
0088          );
0089          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
0090 
0091          TEXT_IO.PUT_LINE( "Creating Semaphore (Global)" );
0092          RTEMS.SEMAPHORE.CREATE(
0093             MPTEST.SEMAPHORE_NAME( 1 ),
0094             0,
0095             RTEMS.GLOBAL + RTEMS.PRIORITY,
0096             RTEMS.TASKS.NO_PRIORITY,
0097             MPTEST.SEMAPHORE_ID( 1 ),
0098             STATUS
0099          );
0100          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE" );
0101 
0102          RTEMS.TASKS.WAKE_AFTER( 10 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0103          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0104 
0105       else
0106 
0107          TEXT_IO.PUT_LINE( "Creating Test_task 1 (local)" );
0108          RTEMS.TASKS.CREATE(
0109             MPTEST.TASK_NAME( 1 ),
0110             1,
0111             2048,
0112             RTEMS.TIMESLICE,
0113             RTEMS.DEFAULT_ATTRIBUTES,
0114             MPTEST.TASK_ID( 1 ),
0115             STATUS
0116          );
0117          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0118 
0119          TEXT_IO.PUT_LINE( "Starting Test_task 1 (local)" );
0120          RTEMS.TASKS.START(
0121             MPTEST.TASK_ID( 1 ),
0122             MPTEST.TEST_TASK_1'ACCESS,
0123             0,
0124             STATUS
0125          );
0126          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0127 
0128          TEXT_IO.PUT_LINE( "Creating Test_task 2 (local)" );
0129          RTEMS.TASKS.CREATE(
0130             MPTEST.TASK_NAME( 2 ),
0131             1,
0132             2048,
0133             RTEMS.TIMESLICE,
0134             RTEMS.DEFAULT_ATTRIBUTES,
0135             MPTEST.TASK_ID( 2 ),
0136             STATUS
0137          );   
0138          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0139  
0140          TEXT_IO.PUT_LINE( "Starting Test_task 2 (local)" );
0141          RTEMS.TASKS.START(
0142             MPTEST.TASK_ID( 2 ),
0143             MPTEST.TEST_TASK_2'ACCESS,
0144             0,
0145             STATUS
0146          );   
0147          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0148 
0149          TEXT_IO.PUT_LINE( "Creating Test_task 3 (local)" );
0150          RTEMS.TASKS.CREATE(
0151             MPTEST.TASK_NAME( 3 ),
0152             1,
0153             2048,
0154             RTEMS.TIMESLICE,
0155             RTEMS.DEFAULT_ATTRIBUTES,
0156             MPTEST.TASK_ID( 3 ),
0157             STATUS
0158          );   
0159          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0160  
0161          TEXT_IO.PUT_LINE( "Starting Test_task 3 (local)" );
0162          RTEMS.TASKS.START(
0163             MPTEST.TASK_ID( 3 ),
0164             MPTEST.TEST_TASK_3'ACCESS,
0165             0,
0166             STATUS
0167          );   
0168          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0169 
0170          TEXT_IO.PUT_LINE( "Sleeping for 1 second ..." );
0171          RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0172          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0173 
0174          TEXT_IO.PUT_LINE( "Deleting Test_task 2" );
0175          RTEMS.TASKS.DELETE( MPTEST.TASK_ID( 2 ), STATUS );
0176          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF 2" );
0177 
0178          TEXT_IO.PUT_LINE( "Deleting Test_task 1" );
0179          RTEMS.TASKS.DELETE( MPTEST.TASK_ID( 1 ), STATUS );
0180          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF 1" );
0181 
0182          TEXT_IO.PUT_LINE( "Restarting Test_task 3" );
0183          RTEMS.TASKS.RESTART( MPTEST.TASK_ID( 3 ), 1, STATUS );
0184          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESTART OF 3" );
0185 
0186       end if;
0187 
0188       TEST_SUPPORT.ADA_TEST_END;
0189 
0190       RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0191 
0192    end INIT;
0193 
0194 --
0195 --  TEST_TASK_1
0196 --
0197 
0198    procedure TEST_TASK_1 (
0199       ARGUMENT : in     RTEMS.TASKS.ARGUMENT
0200    ) is
0201       pragma Unreferenced(ARGUMENT);
0202       RECEIVE_BUFFER_AREA : MPTEST.BUFFER;
0203       RECEIVE_BUFFER      : RTEMS.ADDRESS;
0204       STATUS              : RTEMS.STATUS_CODES;
0205       MESSAGE_SIZE        : RTEMS.SIZE := 0;
0206    begin
0207 
0208       RECEIVE_BUFFER := RECEIVE_BUFFER_AREA'ADDRESS;
0209 
0210       TEXT_IO.PUT_LINE( "Getting QID of message queue" );
0211 
0212       loop
0213 
0214          RTEMS.MESSAGE_QUEUE.IDENT(
0215             MPTEST.QUEUE_NAME( 1 ),
0216             RTEMS.SEARCH_ALL_NODES,
0217             MPTEST.QUEUE_ID( 1 ),
0218             STATUS
0219          );
0220 
0221          exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0222 
0223       end loop;
0224 
0225       TEXT_IO.PUT_LINE( "Attempting to receive message ..." );
0226       RTEMS.MESSAGE_QUEUE.RECEIVE(
0227          MPTEST.QUEUE_ID( 1 ),
0228          RECEIVE_BUFFER,
0229          RTEMS.DEFAULT_OPTIONS,
0230          RTEMS.NO_TIMEOUT,
0231          MESSAGE_SIZE,
0232          STATUS
0233       );
0234       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" );
0235 
0236    end TEST_TASK_1;
0237 
0238 --
0239 --  TEST_TASK_2
0240 --
0241  
0242    procedure TEST_TASK_2 (
0243       ARGUMENT : in     RTEMS.TASKS.ARGUMENT
0244    ) is
0245       pragma Unreferenced(ARGUMENT);
0246       STATUS : RTEMS.STATUS_CODES;
0247    begin 
0248  
0249       TEXT_IO.PUT_LINE( "Getting SMID of semaphore" );
0250 
0251       loop
0252 
0253          RTEMS.SEMAPHORE.IDENT(
0254             MPTEST.SEMAPHORE_NAME( 1 ),
0255             RTEMS.SEARCH_ALL_NODES,
0256             MPTEST.SEMAPHORE_ID( 1 ),
0257             STATUS
0258          ); 
0259  
0260          exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0261 
0262       end loop;
0263 
0264       TEXT_IO.PUT_LINE( "Attempting to acquire semaphore ..." );
0265       RTEMS.SEMAPHORE.OBTAIN(
0266          MPTEST.SEMAPHORE_ID( 1 ),
0267          RTEMS.DEFAULT_OPTIONS,
0268          RTEMS.NO_TIMEOUT,
0269          STATUS
0270       ); 
0271       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
0272  
0273    end TEST_TASK_2;
0274 
0275 -- 
0276 --  TEST_TASK_3
0277 -- 
0278   
0279    procedure TEST_TASK_3 ( 
0280       RESTART : in     RTEMS.TASKS.ARGUMENT 
0281    ) is 
0282       STATUS : RTEMS.STATUS_CODES;
0283    begin
0284 
0285       if RESTART = 1 then
0286 
0287          RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS ); 
0288          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE" );
0289 
0290       end if;
0291 
0292       TEXT_IO.PUT_LINE( "Getting SMID of semaphore" );
0293 
0294       loop
0295 
0296          RTEMS.SEMAPHORE.IDENT(
0297             MPTEST.SEMAPHORE_NAME( 1 ),
0298             RTEMS.SEARCH_ALL_NODES,
0299             MPTEST.SEMAPHORE_ID( 1 ),
0300             STATUS    
0301          ); 
0302 
0303          exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0304 
0305       end loop;
0306 
0307       TEXT_IO.PUT_LINE( "Attempting to acquire semaphore ..." );
0308       RTEMS.SEMAPHORE.OBTAIN(
0309          MPTEST.SEMAPHORE_ID( 1 ),
0310          RTEMS.DEFAULT_OPTIONS,
0311          RTEMS.NO_TIMEOUT, 
0312          STATUS  
0313       );  
0314       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
0315   
0316    end TEST_TASK_3; 
0317  
0318 end MPTEST;