Warning, /testsuites/ada/mptests/mp09/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 9 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 TEST_SUPPORT;
0043 with TEXT_IO;
0044 with UNSIGNED32_IO;
0045
0046 package body MPTEST is
0047
0048 --
0049 -- INIT
0050 --
0051
0052 procedure INIT (
0053 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0054 ) is
0055 pragma Unreferenced(ARGUMENT);
0056 STATUS : RTEMS.STATUS_CODES;
0057 begin
0058
0059 TEXT_IO.NEW_LINE( 2 );
0060 TEST_SUPPORT.ADA_TEST_BEGIN;
0061 TEXT_IO.PUT( "*** NODE " );
0062 UNSIGNED32_IO.PUT(
0063 TEST_SUPPORT.NODE,
0064 WIDTH => 1
0065 );
0066 TEXT_IO.PUT_LINE( " ***" );
0067
0068 MPTEST.RECEIVE_BUFFER := MPTEST.RECEIVE_BUFFER_AREA'ADDRESS;
0069
0070 MPTEST.BUFFER_1 := MPTEST.BUFFER_AREA_1'ADDRESS;
0071
0072 MPTEST.BUFFER_2 := MPTEST.BUFFER_AREA_2'ADDRESS;
0073
0074 MPTEST.BUFFER_3 := MPTEST.BUFFER_AREA_3'ADDRESS;
0075
0076 MPTEST.BUFFER_4 := MPTEST.BUFFER_AREA_4'ADDRESS;
0077
0078 MPTEST.FILL_BUFFER( "123456789012345 ", MPTEST.BUFFER_AREA_1 );
0079 MPTEST.FILL_BUFFER( "abcdefghijklmno ", MPTEST.BUFFER_AREA_2 );
0080 MPTEST.FILL_BUFFER( "ABCDEFGHIJKLMNO ", MPTEST.BUFFER_AREA_3 );
0081 MPTEST.FILL_BUFFER( "PQRSTUVWXYZ(){} ", MPTEST.BUFFER_AREA_4 );
0082
0083 MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( '1', '1', '1', ' ' );
0084 MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( '2', '2', '2', ' ' );
0085
0086 MPTEST.QUEUE_NAME( 1 ) := RTEMS.BUILD_NAME( 'M', 'S', 'G', ' ' );
0087
0088 if TEST_SUPPORT.NODE = 1 then
0089
0090 TEXT_IO.PUT_LINE( "Creating Message Queue (Global)" );
0091 RTEMS.MESSAGE_QUEUE.CREATE(
0092 MPTEST.QUEUE_NAME( 1 ),
0093 3,
0094 3,
0095 RTEMS.GLOBAL,
0096 MPTEST.QUEUE_ID( 1 ),
0097 STATUS
0098 );
0099 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_CREATE" );
0100
0101 end if;
0102
0103 TEXT_IO.PUT_LINE( "Creating Test_task (local)" );
0104 RTEMS.TASKS.CREATE(
0105 MPTEST.TASK_NAME( TEST_SUPPORT.NODE ),
0106 TEST_SUPPORT.NODE,
0107 2048,
0108 RTEMS.TIMESLICE,
0109 RTEMS.DEFAULT_ATTRIBUTES,
0110 MPTEST.TASK_ID( 1 ),
0111 STATUS
0112 );
0113 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0114
0115 TEXT_IO.PUT_LINE( "Starting Test_task (local)" );
0116 RTEMS.TASKS.START(
0117 MPTEST.TASK_ID( 1 ),
0118 MPTEST.TEST_TASK'ACCESS,
0119 0,
0120 STATUS
0121 );
0122 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0123
0124 TEXT_IO.PUT_LINE( "Deleting initialization task" );
0125 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0126 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0127
0128 end INIT;
0129
0130 --
0131 -- SEND_MESSAGES
0132 --
0133
0134 procedure SEND_MESSAGES is
0135 BROADCAST_COUNT : RTEMS.UNSIGNED32;
0136 STATUS : RTEMS.STATUS_CODES;
0137 begin
0138
0139 TEXT_IO.PUT( "message_queue_send : " );
0140 MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_1 );
0141 TEXT_IO.NEW_LINE;
0142
0143 RTEMS.MESSAGE_QUEUE.SEND(
0144 MPTEST.QUEUE_ID( 1 ),
0145 MPTEST.BUFFER_1,
0146 16,
0147 STATUS
0148 );
0149 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" );
0150
0151 TEXT_IO.PUT_LINE( "Delaying for a second" );
0152 RTEMS.TASKS.WAKE_AFTER(
0153 1 * TEST_SUPPORT.TICKS_PER_SECOND,
0154 STATUS
0155 );
0156 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0157
0158 TEXT_IO.PUT( "message_queue_urgent : " );
0159 MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_2 );
0160 TEXT_IO.NEW_LINE;
0161
0162 RTEMS.MESSAGE_QUEUE.URGENT(
0163 MPTEST.QUEUE_ID( 1 ),
0164 MPTEST.BUFFER_2,
0165 16,
0166 STATUS
0167 );
0168 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_URGENT" );
0169
0170 TEXT_IO.PUT_LINE( "Delaying for a second" );
0171 RTEMS.TASKS.WAKE_AFTER(
0172 1 * TEST_SUPPORT.TICKS_PER_SECOND,
0173 STATUS
0174 );
0175 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0176
0177 TEXT_IO.PUT( "message_queue_broadcast : " );
0178 MPTEST.PUT_BUFFER( MPTEST.BUFFER_AREA_3 );
0179 TEXT_IO.NEW_LINE;
0180
0181 RTEMS.MESSAGE_QUEUE.BROADCAST(
0182 MPTEST.QUEUE_ID( 1 ),
0183 MPTEST.BUFFER_3,
0184 16,
0185 BROADCAST_COUNT,
0186 STATUS
0187 );
0188 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_BROADCAST" );
0189
0190 TEXT_IO.PUT_LINE( "Delaying for a second" );
0191 RTEMS.TASKS.WAKE_AFTER(
0192 1 * TEST_SUPPORT.TICKS_PER_SECOND,
0193 STATUS
0194 );
0195 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0196
0197 end SEND_MESSAGES;
0198
0199 --
0200 -- RECEIVE_MESSAGES
0201 --
0202
0203 procedure RECEIVE_MESSAGES is
0204 STATUS : RTEMS.STATUS_CODES;
0205 MESSAGE_SIZE : RTEMS.SIZE := 0;
0206 begin
0207
0208 for INDEX in 1 .. 3
0209 loop
0210
0211 TEXT_IO.PUT_LINE( "Receiving message ..." );
0212 RTEMS.MESSAGE_QUEUE.RECEIVE(
0213 MPTEST.QUEUE_ID( 1 ),
0214 MPTEST.RECEIVE_BUFFER,
0215 RTEMS.DEFAULT_OPTIONS,
0216 RTEMS.NO_TIMEOUT,
0217 MESSAGE_SIZE,
0218 STATUS
0219 );
0220 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" );
0221
0222 TEXT_IO.PUT( "Received : " );
0223 MPTEST.PUT_BUFFER( MPTEST.RECEIVE_BUFFER_AREA );
0224 TEXT_IO.NEW_LINE;
0225
0226 end loop;
0227
0228 TEXT_IO.PUT_LINE( "Receiver delaying for a second" );
0229
0230 RTEMS.TASKS.WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0231 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0232
0233 end RECEIVE_MESSAGES;
0234
0235 --
0236 -- FILL_BUFFER
0237 --
0238
0239 --
0240 -- Depends on tricks to make the copy work.
0241 --
0242
0243 procedure FILL_BUFFER (
0244 SOURCE : in STRING;
0245 BUFFER : out MPTEST.BUFFER
0246 ) is
0247 begin
0248
0249 BUFFER.FIELD1 := RTEMS.BUILD_NAME(
0250 SOURCE( SOURCE'FIRST ),
0251 SOURCE( SOURCE'FIRST + 1 ),
0252 SOURCE( SOURCE'FIRST + 2 ),
0253 SOURCE( SOURCE'FIRST + 3 )
0254 );
0255
0256 BUFFER.FIELD2 := RTEMS.BUILD_NAME(
0257 SOURCE( SOURCE'FIRST + 4 ),
0258 SOURCE( SOURCE'FIRST + 5 ),
0259 SOURCE( SOURCE'FIRST + 6 ),
0260 SOURCE( SOURCE'FIRST + 7 )
0261 );
0262
0263 BUFFER.FIELD3 := RTEMS.BUILD_NAME(
0264 SOURCE( SOURCE'FIRST + 8 ),
0265 SOURCE( SOURCE'FIRST + 9 ),
0266 SOURCE( SOURCE'FIRST + 10 ),
0267 SOURCE( SOURCE'FIRST + 11 )
0268 );
0269
0270 BUFFER.FIELD4 := RTEMS.BUILD_NAME(
0271 SOURCE( SOURCE'FIRST + 12 ),
0272 SOURCE( SOURCE'FIRST + 13 ),
0273 SOURCE( SOURCE'FIRST + 14 ),
0274 SOURCE( SOURCE'FIRST + 15 )
0275 );
0276
0277 end FILL_BUFFER;
0278
0279 --
0280 -- PUT_BUFFER
0281 --
0282
0283 --
0284 -- Depends on tricks to make the output work.
0285 --
0286
0287 procedure PUT_BUFFER (
0288 BUFFER : in MPTEST.BUFFER
0289 ) is
0290 begin
0291
0292 TEST_SUPPORT.PUT_NAME( BUFFER.FIELD1, FALSE );
0293 TEST_SUPPORT.PUT_NAME( BUFFER.FIELD2, FALSE );
0294 TEST_SUPPORT.PUT_NAME( BUFFER.FIELD3, FALSE );
0295 TEST_SUPPORT.PUT_NAME( BUFFER.FIELD4, FALSE );
0296
0297 end PUT_BUFFER;
0298
0299 --
0300 -- TEST_TASK
0301 --
0302
0303 procedure TEST_TASK (
0304 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0305 ) is
0306 pragma Unreferenced(ARGUMENT);
0307 COUNT : RTEMS.UNSIGNED32;
0308 STATUS : RTEMS.STATUS_CODES;
0309 MESSAGE_SIZE : RTEMS.SIZE := 0;
0310 begin
0311
0312 RTEMS.TASKS.WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0313 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0314
0315 TEXT_IO.PUT_LINE( "Getting QID of message queue" );
0316
0317 loop
0318
0319 RTEMS.MESSAGE_QUEUE.IDENT(
0320 MPTEST.QUEUE_NAME( 1 ),
0321 RTEMS.SEARCH_ALL_NODES,
0322 MPTEST.QUEUE_ID( 1 ),
0323 STATUS
0324 );
0325
0326 exit when RTEMS.IS_STATUS_SUCCESSFUL( STATUS );
0327
0328 end loop;
0329
0330 if TEST_SUPPORT.NODE = 2 then
0331
0332 RTEMS.MESSAGE_QUEUE.DELETE( MPTEST.QUEUE_ID( 1 ), STATUS );
0333
0334 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0335 STATUS,
0336 RTEMS.ILLEGAL_ON_REMOTE_OBJECT,
0337 "MESSAGE_QUEUE_DELETE"
0338 );
0339
0340 TEXT_IO.PUT_LINE(
0341 "message_queue_delete correctly returned ILLEGAL_ON_REMOTE_OBJECT"
0342 );
0343
0344 MPTEST.SEND_MESSAGES;
0345
0346 MPTEST.RECEIVE_MESSAGES;
0347
0348 TEXT_IO.PUT_LINE( "Flushing remote empty queue" );
0349 RTEMS.MESSAGE_QUEUE.FLUSH( MPTEST.QUEUE_ID( 1 ), COUNT, STATUS );
0350 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_FLUSH" );
0351 UNSIGNED32_IO.PUT( COUNT, WIDTH => 1 );
0352 TEXT_IO.PUT_LINE(
0353 " messages were flushed from remote empty queue"
0354 );
0355
0356 TEXT_IO.PUT_LINE(
0357 "Send messages to be flushed from remote queue"
0358 );
0359 RTEMS.MESSAGE_QUEUE.SEND(
0360 MPTEST.QUEUE_ID( 1 ),
0361 MPTEST.BUFFER_1,
0362 16,
0363 STATUS
0364 );
0365 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" );
0366
0367 TEXT_IO.PUT_LINE( "Flushing remote queue" );
0368 RTEMS.MESSAGE_QUEUE.FLUSH( MPTEST.QUEUE_ID( 1 ), COUNT, STATUS );
0369 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_FLUSH" );
0370 UNSIGNED32_IO.PUT( COUNT, WIDTH => 1 );
0371 TEXT_IO.PUT_LINE(
0372 " messages were flushed from the remote queue"
0373 );
0374
0375 TEXT_IO.PUT_LINE( "Waiting for message queue to be deleted" );
0376 RTEMS.MESSAGE_QUEUE.RECEIVE(
0377 MPTEST.QUEUE_ID( 1 ),
0378 MPTEST.RECEIVE_BUFFER,
0379 RTEMS.DEFAULT_OPTIONS,
0380 RTEMS.NO_TIMEOUT,
0381 MESSAGE_SIZE,
0382 STATUS
0383 );
0384 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0385 STATUS,
0386 RTEMS.OBJECT_WAS_DELETED,
0387 "MESSAGE_QUEUE_FLUSH"
0388 );
0389
0390 else
0391
0392 MPTEST.RECEIVE_MESSAGES;
0393
0394 MPTEST.SEND_MESSAGES;
0395
0396 RTEMS.TASKS.WAKE_AFTER(
0397 5 * TEST_SUPPORT.TICKS_PER_SECOND,
0398 STATUS
0399 );
0400 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0401
0402 RTEMS.MESSAGE_QUEUE.DELETE( MPTEST.QUEUE_ID( 1 ), STATUS );
0403 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_DELETE" );
0404
0405 end if;
0406
0407 TEST_SUPPORT.ADA_TEST_END;
0408
0409 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0410
0411 end TEST_TASK;
0412
0413 end MPTEST;
