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;