Warning, /testsuites/ada/mptests/mp03/mptest.adb is written in an unsupported language. File is not indexed.
0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 -- This package is the implementation for Test 3 of the RTEMS
0005 -- Multiprocessor Test Suite.
0006 --
0007 -- DEPENDENCIES:
0008 --
0009 --
0010 --
0011 -- COPYRIGHT (c) 1989-2011.
0012 -- On-Line Applications Research Corporation (OAR).
0013 --
0014 -- Redistribution and use in source and binary forms, with or without
0015 -- modification, are permitted provided that the following conditions
0016 -- are met:
0017 -- 1. Redistributions of source code must retain the above copyright
0018 -- notice, this list of conditions and the following disclaimer.
0019 -- 2. Redistributions in binary form must reproduce the above copyright
0020 -- notice, this list of conditions and the following disclaimer in the
0021 -- documentation and/or other materials provided with the distribution.
0022 --
0023 -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
0024 -- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
0025 -- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
0026 -- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
0027 -- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
0028 -- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
0029 -- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
0030 -- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
0031 -- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
0032 -- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
0033 -- POSSIBILITY OF SUCH DAMAGE.
0034 --
0035
0036 with INTERFACES; use INTERFACES;
0037 with RTEMS.EVENT;
0038 with RTEMS.TIMER;
0039 with TEST_SUPPORT;
0040 with TEXT_IO;
0041 with UNSIGNED32_IO;
0042
0043 package body MPTEST is
0044
0045 --
0046 -- INIT
0047 --
0048
0049 procedure INIT (
0050 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0051 ) is
0052 pragma Unreferenced(ARGUMENT);
0053 STATUS : RTEMS.STATUS_CODES;
0054 begin
0055
0056 TEXT_IO.NEW_LINE( 2 );
0057 TEST_SUPPORT.ADA_TEST_BEGIN;
0058 TEXT_IO.PUT( "*** NODE " );
0059 UNSIGNED32_IO.PUT(
0060 TEST_SUPPORT.NODE,
0061 WIDTH => 1
0062 );
0063 TEXT_IO.PUT_LINE( " ***" );
0064
0065 MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( '1', '1', '1', ' ' );
0066 MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( '2', '2', '2', ' ' );
0067
0068 TEXT_IO.PUT_LINE( "Creating Test_task (Global)" );
0069 RTEMS.TASKS.CREATE(
0070 MPTEST.TASK_NAME( TEST_SUPPORT.NODE ),
0071 1,
0072 2048,
0073 RTEMS.NO_PREEMPT,
0074 RTEMS.GLOBAL,
0075 MPTEST.TASK_ID( 1 ),
0076 STATUS
0077 );
0078 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0079
0080 TEXT_IO.PUT_LINE( "Starting Test_task (Global)" );
0081 RTEMS.TASKS.START(
0082 MPTEST.TASK_ID( 1 ),
0083 MPTEST.TEST_TASK'ACCESS,
0084 0,
0085 STATUS
0086 );
0087 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0088
0089 MPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'M', '1', ' ' );
0090
0091 RTEMS.TIMER.CREATE(
0092 MPTEST.TIMER_NAME( 1 ),
0093 MPTEST.TIMER_ID( 1 ),
0094 STATUS
0095 );
0096 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE" );
0097
0098 TEXT_IO.PUT_LINE( "Deleting initialization task" );
0099 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0100 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0101
0102 end INIT;
0103
0104 --
0105 -- DELAYED_SEND_EVENT
0106 --
0107
0108 procedure DELAYED_SEND_EVENT (
0109 IGNORED_ID : in RTEMS.ID;
0110 IGNORED_ADDRESS : in RTEMS.ADDRESS
0111 ) is
0112 STATUS : RTEMS.STATUS_CODES;
0113 begin
0114
0115 RTEMS.EVENT.SEND( MPTEST.TASK_ID( 1 ), RTEMS.EVENT_16, STATUS );
0116 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" );
0117
0118 end DELAYED_SEND_EVENT;
0119
0120 --
0121 -- TEST_TASK
0122 --
0123
0124 procedure TEST_TASK (
0125 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0126 ) is
0127 pragma Unreferenced(ARGUMENT);
0128 TID : RTEMS.ID;
0129 STATUS : RTEMS.STATUS_CODES;
0130 begin
0131
0132 RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
0133 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
0134
0135 TEXT_IO.PUT_LINE( "Getting TID of remote task" );
0136 if TEST_SUPPORT.NODE = 1 then
0137 MPTEST.REMOTE_NODE := 2;
0138 else
0139 MPTEST.REMOTE_NODE := 1;
0140 end if;
0141
0142 TEXT_IO.PUT( "Remote task's name is : " );
0143 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ), TRUE );
0144
0145 loop
0146
0147 RTEMS.TASKS.IDENT(
0148 MPTEST.TASK_NAME( MPTEST.REMOTE_NODE ),
0149 RTEMS.SEARCH_ALL_NODES,
0150 MPTEST.REMOTE_TID,
0151 STATUS
0152 );
0153
0154 exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0155
0156 end loop;
0157
0158 RTEMS.TIMER.FIRE_AFTER(
0159 MPTEST.TIMER_ID( 1 ),
0160 10 * TEST_SUPPORT.TICKS_PER_SECOND,
0161 MPTEST.DELAYED_SEND_EVENT'ACCESS,
0162 RTEMS.NULL_ADDRESS,
0163 STATUS
0164 );
0165 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
0166
0167 MPTEST.TEST_TASK_SUPPORT( 1 );
0168
0169 RTEMS.TIMER.FIRE_AFTER(
0170 MPTEST.TIMER_ID( 1 ),
0171 11 * TEST_SUPPORT.TICKS_PER_SECOND,
0172 MPTEST.DELAYED_SEND_EVENT'ACCESS,
0173 RTEMS.NULL_ADDRESS,
0174 STATUS
0175 );
0176 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
0177
0178 if TEST_SUPPORT.NODE = 2 then
0179
0180 RTEMS.TASKS.WAKE_AFTER(
0181 2 * TEST_SUPPORT.TICKS_PER_SECOND,
0182 STATUS
0183 );
0184 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0185
0186 end if;
0187
0188 MPTEST.TEST_TASK_SUPPORT( 2 );
0189
0190 TEST_SUPPORT.ADA_TEST_END;
0191
0192 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0193
0194 end TEST_TASK;
0195
0196 --
0197 -- TEST_TASK_SUPPORT
0198 --
0199
0200
0201 procedure TEST_TASK_SUPPORT (
0202 NODE : in RTEMS.UNSIGNED32
0203 ) is
0204 EVENTS : RTEMS.EVENT_SET;
0205 STATUS : RTEMS.STATUS_CODES;
0206 begin
0207
0208 if TEST_SUPPORT.NODE = NODE then
0209
0210 loop
0211
0212 RTEMS.EVENT.RECEIVE(
0213 RTEMS.EVENT_16,
0214 RTEMS.NO_WAIT,
0215 RTEMS.NO_TIMEOUT,
0216 EVENTS,
0217 STATUS
0218 );
0219
0220 exit when RTEMS.ARE_STATUSES_EQUAL( RTEMS.SUCCESSFUL, STATUS );
0221
0222 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0223 STATUS,
0224 RTEMS.UNSATISFIED,
0225 "EVENT_RECEIVE"
0226 );
0227
0228 RTEMS.TASKS.WAKE_AFTER(
0229 2 * TEST_SUPPORT.TICKS_PER_SECOND,
0230 STATUS
0231 );
0232 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0233
0234 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( NODE ), FALSE );
0235 TEXT_IO.PUT_LINE( " - Suspending remote task" );
0236 RTEMS.TASKS.SUSPEND( MPTEST.REMOTE_TID, STATUS );
0237 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
0238
0239 RTEMS.TASKS.WAKE_AFTER(
0240 2 * TEST_SUPPORT.TICKS_PER_SECOND,
0241 STATUS
0242 );
0243 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0244
0245 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( NODE ), FALSE );
0246 TEXT_IO.PUT_LINE( " - Resuming remote task" );
0247
0248 RTEMS.TASKS.RESUME( MPTEST.REMOTE_TID, STATUS );
0249 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME" );
0250
0251 end loop;
0252
0253 else
0254
0255 loop
0256
0257 RTEMS.EVENT.RECEIVE(
0258 RTEMS.EVENT_16,
0259 RTEMS.NO_WAIT,
0260 RTEMS.NO_TIMEOUT,
0261 EVENTS,
0262 STATUS
0263 );
0264
0265 exit when RTEMS.ARE_STATUSES_EQUAL( RTEMS.SUCCESSFUL, STATUS );
0266
0267 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0268 STATUS,
0269 RTEMS.UNSATISFIED,
0270 "EVENT_RECEIVE"
0271 );
0272
0273 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( REMOTE_NODE ), FALSE );
0274 TEXT_IO.PUT_LINE( " - have I been suspended???" );
0275 RTEMS.TASKS.WAKE_AFTER(
0276 TEST_SUPPORT.TICKS_PER_SECOND / 2,
0277 STATUS
0278 );
0279 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0280
0281 end loop;
0282
0283 end if;
0284
0285 end TEST_TASK_SUPPORT;
0286
0287 end MPTEST;
