Warning, /testsuites/ada/mptests/mp06/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 6 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.EVENT;
0042 with RTEMS.TIMER;
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 MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( '1', '1', '1', ' ' );
0070 MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( '2', '2', '2', ' ' );
0071
0072 TEXT_IO.PUT_LINE( "Creating Test_task (Global)" );
0073
0074 RTEMS.TASKS.CREATE(
0075 MPTEST.TASK_NAME( TEST_SUPPORT.NODE ),
0076 TEST_SUPPORT.NODE,
0077 2048,
0078 RTEMS.DEFAULT_MODES,
0079 RTEMS.GLOBAL,
0080 MPTEST.TASK_ID( 1 ),
0081 STATUS
0082 );
0083 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0084
0085 TEXT_IO.PUT_LINE( "Starting Test_task (Global)" );
0086
0087 RTEMS.TASKS.START(
0088 MPTEST.TASK_ID( 1 ),
0089 MPTEST.TEST_TASK'ACCESS,
0090 0,
0091 STATUS
0092 );
0093 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0094
0095 MPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'M', '1', ' ' );
0096 MPTEST.TIMER_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'M', '2', ' ' );
0097
0098 RTEMS.TIMER.CREATE(
0099 MPTEST.TIMER_NAME( TEST_SUPPORT.NODE ),
0100 MPTEST.TIMER_ID( 1 ),
0101 STATUS
0102 );
0103 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE" );
0104
0105 TEXT_IO.PUT_LINE( "Deleting initialization task" );
0106
0107 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0108 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0109
0110 end INIT;
0111
0112 --
0113 -- STOP_TEST_TSR
0114 --
0115
0116 procedure STOP_TEST_TSR (
0117 IGNORED1 : in RTEMS.ID;
0118 IGNORED2 : in RTEMS.ADDRESS
0119 ) is
0120 begin
0121
0122 MPTEST.STOP_TEST := TRUE;
0123
0124 end STOP_TEST_TSR;
0125
0126 --
0127 -- TEST_TASK
0128 --
0129
0130 procedure TEST_TASK (
0131 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0132 ) is
0133 pragma Unreferenced(ARGUMENT);
0134 COUNT : RTEMS.UNSIGNED32;
0135 EVENT_OUT : RTEMS.EVENT_SET;
0136 EVENT_FOR_THIS_ITERATION : RTEMS.EVENT_SET;
0137 STATUS : RTEMS.STATUS_CODES;
0138 begin
0139
0140 MPTEST.STOP_TEST := FALSE;
0141
0142 if TEST_SUPPORT.NODE = 1 then
0143 MPTEST.REMOTE_NODE := 2;
0144 else
0145 MPTEST.REMOTE_NODE := 1;
0146 end if;
0147
0148 TEXT_IO.PUT( "Remote task's name is : " );
0149 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ), TRUE );
0150
0151 TEXT_IO.PUT_LINE( "Getting TID of remote task" );
0152
0153 loop
0154
0155 RTEMS.TASKS.IDENT(
0156 MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ),
0157 RTEMS.SEARCH_ALL_NODES,
0158 MPTEST.REMOTE_TID,
0159 STATUS
0160 );
0161
0162 exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0163
0164 end loop;
0165
0166 if TEST_SUPPORT.NODE = 1 then
0167 TEXT_IO.PUT_LINE( "Sending events to remote task" );
0168 else
0169 TEXT_IO.PUT_LINE( "Receiving events from remote task" );
0170 end if;
0171
0172 RTEMS.TIMER.FIRE_AFTER(
0173 MPTEST.TIMER_ID( 1 ),
0174 5 * TEST_SUPPORT.TICKS_PER_SECOND,
0175 MPTEST.STOP_TEST_TSR'ACCESS,
0176 RTEMS.NULL_ADDRESS,
0177 STATUS
0178 );
0179 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
0180
0181 COUNT := 0;
0182
0183 loop
0184
0185 exit when MPTEST.STOP_TEST;
0186
0187 EVENT_FOR_THIS_ITERATION :=
0188 MPTEST.EVENT_SET_TABLE(
0189 INTEGER( COUNT ) mod MPTEST.EVENT_SET_TABLE'LAST + 1
0190 );
0191
0192 if TEST_SUPPORT.NODE = 1 then
0193
0194 RTEMS.EVENT.SEND(
0195 MPTEST.REMOTE_TID,
0196 EVENT_FOR_THIS_ITERATION,
0197 STATUS
0198 );
0199 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
0200
0201 else
0202
0203 RTEMS.EVENT.RECEIVE(
0204 EVENT_FOR_THIS_ITERATION,
0205 RTEMS.DEFAULT_OPTIONS,
0206 1 * TEST_SUPPORT.TICKS_PER_SECOND,
0207 EVENT_OUT,
0208 STATUS
0209 );
0210
0211 if RTEMS.ARE_STATUSES_EQUAL( STATUS, RTEMS.TIMEOUT ) then
0212 TEXT_IO.NEW_LINE( 1 );
0213
0214 if TEST_SUPPORT.NODE = 2 then
0215 TEXT_IO.PUT_LINE(
0216 "Correct behavior if the other node exitted."
0217 );
0218 else
0219 TEXT_IO.PUT_LINE(
0220 "ERROR... node 1 died"
0221 );
0222 end if;
0223
0224 exit;
0225
0226 else
0227
0228 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE" );
0229
0230 end if;
0231
0232 end if;
0233
0234 if (COUNT mod MPTEST.MAXIMUM_DOTS) = 0 then
0235
0236 TEST_SUPPORT.PUT_DOT( "." );
0237
0238 end if;
0239
0240 COUNT := COUNT + 1;
0241
0242 end loop;
0243
0244 TEXT_IO.NEW_LINE;
0245
0246 if TEST_SUPPORT.NODE = 2 then
0247
0248 RTEMS.EVENT.RECEIVE(
0249 RTEMS.EVENT_16,
0250 RTEMS.DEFAULT_OPTIONS,
0251 1 * TEST_SUPPORT.TICKS_PER_SECOND,
0252 EVENT_OUT,
0253 STATUS
0254 );
0255 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0256 RTEMS.TIMEOUT,
0257 STATUS,
0258 "EVENT_RECEIVE"
0259 );
0260
0261 TEXT_IO.NEW_LINE;
0262 TEXT_IO.PUT_LINE( "event_receive - correctly returned TIMEOUT" );
0263
0264 end if;
0265
0266 TEST_SUPPORT.ADA_TEST_END;
0267
0268 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0269
0270 end TEST_TASK;
0271
0272 end MPTEST;
