Warning, /testsuites/ada/mptests/mp13/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 13 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 MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( '1', '1', '1', ' ' );
0070 MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( '2', '2', '2', ' ' );
0071
0072 MPTEST.QUEUE_NAME( 1 ) := RTEMS.BUILD_NAME( 'M', 'S', 'G', ' ' );
0073
0074 MPTEST.SEMAPHORE_NAME( 1 ) := RTEMS.BUILD_NAME( 'S', 'E', 'M', ' ' );
0075
0076 if TEST_SUPPORT.NODE = 1 then
0077
0078 TEXT_IO.PUT_LINE( "Creating Message Queue (Global)" );
0079 RTEMS.MESSAGE_QUEUE.CREATE(
0080 MPTEST.QUEUE_NAME( 1 ),
0081 3,
0082 3,
0083 RTEMS.GLOBAL,
0084 MPTEST.QUEUE_ID( 1 ),
0085 STATUS
0086 );
0087 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
0088
0089 TEXT_IO.PUT_LINE( "Creating Semaphore (Global)" );
0090 RTEMS.SEMAPHORE.CREATE(
0091 MPTEST.SEMAPHORE_NAME( 1 ),
0092 1,
0093 RTEMS.GLOBAL + RTEMS.PRIORITY,
0094 RTEMS.TASKS.NO_PRIORITY,
0095 MPTEST.SEMAPHORE_ID( 1 ),
0096 STATUS
0097 );
0098 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_CREATE" );
0099
0100 RTEMS.SEMAPHORE.OBTAIN(
0101 MPTEST.SEMAPHORE_ID( 1 ),
0102 RTEMS.DEFAULT_OPTIONS,
0103 RTEMS.NO_TIMEOUT,
0104 STATUS
0105 );
0106 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
0107
0108 end if;
0109
0110 TEXT_IO.PUT_LINE( "Creating Test_task 1 (local)" );
0111 RTEMS.TASKS.CREATE(
0112 MPTEST.TASK_NAME( 1 ),
0113 1,
0114 2048,
0115 RTEMS.TIMESLICE,
0116 RTEMS.DEFAULT_ATTRIBUTES,
0117 MPTEST.TASK_ID( 1 ),
0118 STATUS
0119 );
0120 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0121
0122 TEXT_IO.PUT_LINE( "Starting Test_task 1 (local)" );
0123 RTEMS.TASKS.START(
0124 MPTEST.TASK_ID( 1 ),
0125 MPTEST.TEST_TASK_1'ACCESS,
0126 0,
0127 STATUS
0128 );
0129 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0130
0131 TEXT_IO.PUT_LINE( "Creating Test_task 2 (local)" );
0132 RTEMS.TASKS.CREATE(
0133 MPTEST.TASK_NAME( 2 ),
0134 1,
0135 2048,
0136 RTEMS.TIMESLICE,
0137 RTEMS.DEFAULT_ATTRIBUTES,
0138 MPTEST.TASK_ID( 2 ),
0139 STATUS
0140 );
0141 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0142
0143 TEXT_IO.PUT_LINE( "Starting Test_task 2 (local)" );
0144 RTEMS.TASKS.START(
0145 MPTEST.TASK_ID( 2 ),
0146 MPTEST.TEST_TASK_2'ACCESS,
0147 0,
0148 STATUS
0149 );
0150 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0151
0152 if TEST_SUPPORT.NODE = 1 then
0153
0154 RTEMS.TASKS.WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0155 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0156
0157 TEST_SUPPORT.ADA_TEST_END;
0158
0159 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0160
0161 end if;
0162
0163 TEXT_IO.PUT_LINE( "Deleting initialization task" );
0164 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0165 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0166
0167 end INIT;
0168
0169 --
0170 -- TEST_TASK_1
0171 --
0172
0173 procedure TEST_TASK_1 (
0174 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0175 ) is
0176 pragma Unreferenced(ARGUMENT);
0177 RECEIVE_BUFFER_AREA : MPTEST.BUFFER;
0178 RECEIVE_BUFFER : RTEMS.ADDRESS;
0179 STATUS : RTEMS.STATUS_CODES;
0180 MESSAGE_SIZE : RTEMS.SIZE := 0;
0181 begin
0182
0183 RECEIVE_BUFFER := RECEIVE_BUFFER_AREA'ADDRESS;
0184
0185 TEXT_IO.PUT_LINE( "Getting QID of message queue" );
0186
0187 loop
0188
0189 RTEMS.MESSAGE_QUEUE.IDENT(
0190 MPTEST.QUEUE_NAME( 1 ),
0191 RTEMS.SEARCH_ALL_NODES,
0192 MPTEST.QUEUE_ID( 1 ),
0193 STATUS
0194 );
0195
0196 exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0197
0198 end loop;
0199
0200 if TEST_SUPPORT.NODE = 1 then
0201
0202 TEXT_IO.PUT_LINE( "Receiving message ..." );
0203 RTEMS.MESSAGE_QUEUE.RECEIVE(
0204 MPTEST.QUEUE_ID( 1 ),
0205 RECEIVE_BUFFER,
0206 RTEMS.DEFAULT_OPTIONS,
0207 RTEMS.NO_TIMEOUT,
0208 MESSAGE_SIZE,
0209 STATUS
0210 );
0211 TEXT_IO.PUT_LINE( "How did I get back from here???" );
0212 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" );
0213
0214 end if;
0215
0216 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0217 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0218
0219 TEXT_IO.PUT_LINE( "Receiving message ..." );
0220 RTEMS.MESSAGE_QUEUE.RECEIVE(
0221 MPTEST.QUEUE_ID( 1 ),
0222 RECEIVE_BUFFER,
0223 RTEMS.DEFAULT_OPTIONS,
0224 2 * TEST_SUPPORT.TICKS_PER_SECOND,
0225 MESSAGE_SIZE,
0226 STATUS
0227 );
0228 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0229 STATUS,
0230 RTEMS.TIMEOUT,
0231 "MESSAGE_QUEUE_RECEIVE"
0232 );
0233 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0234 STATUS,
0235 RTEMS.TIMEOUT,
0236 "MESSAGE_QUEUE_OBTAIN"
0237 );
0238
0239 TEXT_IO.PUT_LINE(
0240 "message_queue_receive correctly returned TIMEOUT"
0241 );
0242
0243 TEXT_IO.PUT_LINE( "Deleting self" );
0244 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0245 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0246
0247 end TEST_TASK_1;
0248
0249 --
0250 -- TEST_TASK_2
0251 --
0252
0253 procedure TEST_TASK_2 (
0254 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0255 ) is
0256 pragma Unreferenced(ARGUMENT);
0257 STATUS : RTEMS.STATUS_CODES;
0258 begin
0259
0260 TEXT_IO.PUT_LINE( "Getting SMID of semaphore" );
0261
0262 loop
0263
0264 RTEMS.SEMAPHORE.IDENT(
0265 MPTEST.SEMAPHORE_NAME( 1 ),
0266 RTEMS.SEARCH_ALL_NODES,
0267 MPTEST.SEMAPHORE_ID( 1 ),
0268 STATUS
0269 );
0270
0271 exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0272
0273 end loop;
0274
0275 if TEST_SUPPORT.NODE = 1 then
0276
0277 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0278 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0279
0280 TEXT_IO.PUT_LINE( "Releasing semaphore ..." );
0281 RTEMS.SEMAPHORE.RELEASE( MPTEST.SEMAPHORE_ID( 1 ), STATUS );
0282 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
0283
0284 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND / 2, STATUS );
0285 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0286
0287 TEXT_IO.PUT_LINE( "Getting semaphore ..." );
0288 RTEMS.SEMAPHORE.OBTAIN(
0289 MPTEST.SEMAPHORE_ID( 1 ),
0290 RTEMS.DEFAULT_OPTIONS,
0291 RTEMS.NO_TIMEOUT,
0292 STATUS
0293 );
0294 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
0295
0296 TEXT_IO.PUT_LINE( "Getting semaphore ..." );
0297 RTEMS.SEMAPHORE.OBTAIN(
0298 MPTEST.SEMAPHORE_ID( 1 ),
0299 RTEMS.DEFAULT_OPTIONS,
0300 RTEMS.NO_TIMEOUT,
0301 STATUS
0302 );
0303 TEXT_IO.PUT_LINE( "How did I get back from here???" );
0304 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
0305
0306 end if;
0307
0308 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND / 2, STATUS );
0309 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0310
0311 TEXT_IO.PUT_LINE( "Getting semaphore ..." );
0312 RTEMS.SEMAPHORE.OBTAIN(
0313 MPTEST.SEMAPHORE_ID( 1 ),
0314 RTEMS.DEFAULT_OPTIONS,
0315 RTEMS.NO_TIMEOUT,
0316 STATUS
0317 );
0318 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_OBTAIN" );
0319
0320 TEXT_IO.PUT_LINE( "Releasing semaphore ..." );
0321 RTEMS.SEMAPHORE.RELEASE( MPTEST.SEMAPHORE_ID( 1 ), STATUS );
0322 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "SEMAPHORE_RELEASE" );
0323
0324 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0325 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0326
0327 TEXT_IO.PUT_LINE( "Getting semaphore ..." );
0328 RTEMS.SEMAPHORE.OBTAIN(
0329 MPTEST.SEMAPHORE_ID( 1 ),
0330 RTEMS.DEFAULT_OPTIONS,
0331 2 * TEST_SUPPORT.TICKS_PER_SECOND,
0332 STATUS
0333 );
0334 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0335 STATUS,
0336 RTEMS.TIMEOUT,
0337 "SEMAPHORE_OBTAIN"
0338 );
0339 TEXT_IO.PUT_LINE( "semaphore_obtain correctly returned TIMEOUT" );
0340
0341 TEST_SUPPORT.ADA_TEST_END;
0342
0343 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0344
0345 end TEST_TASK_2;
0346
0347 end MPTEST;
