Warning, /testsuites/ada/sptests/sp11/sptest.adb is written in an unsupported language. File is not indexed.
0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 -- SPTEST / BODY
0005 --
0006 -- DESCRIPTION:
0007 --
0008 -- This package is the implementation of Test 11 of the RTEMS
0009 -- Single Processor 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 TEST_SUPPORT;
0042 with TEXT_IO;
0043 with UNSIGNED32_IO;
0044 with RTEMS.CLOCK;
0045 with RTEMS.EVENT;
0046 with RTEMS.TIMER;
0047
0048 package body SPTEST is
0049
0050 --
0051 -- INIT
0052 --
0053
0054 procedure INIT (
0055 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0056 ) is
0057 pragma Unreferenced(ARGUMENT);
0058 STATUS : RTEMS.STATUS_CODES;
0059 begin
0060
0061 TEXT_IO.NEW_LINE( 2 );
0062 TEST_SUPPORT.ADA_TEST_BEGIN;
0063
0064 SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
0065 SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'A', '2', ' ' );
0066
0067 RTEMS.TASKS.CREATE(
0068 SPTEST.TASK_NAME( 1 ),
0069 4,
0070 2048,
0071 RTEMS.DEFAULT_MODES,
0072 RTEMS.DEFAULT_ATTRIBUTES,
0073 SPTEST.TASK_ID( 1 ),
0074 STATUS
0075 );
0076 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
0077
0078 RTEMS.TASKS.CREATE(
0079 SPTEST.TASK_NAME( 2 ),
0080 4,
0081 2048,
0082 RTEMS.DEFAULT_MODES,
0083 RTEMS.DEFAULT_ATTRIBUTES,
0084 SPTEST.TASK_ID( 2 ),
0085 STATUS
0086 );
0087 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
0088
0089 RTEMS.TASKS.START(
0090 SPTEST.TASK_ID( 1 ),
0091 SPTEST.TASK_1'ACCESS,
0092 0,
0093 STATUS
0094 );
0095 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
0096
0097 RTEMS.TASKS.START(
0098 SPTEST.TASK_ID( 2 ),
0099 SPTEST.TASK_2'ACCESS,
0100 0,
0101 STATUS
0102 );
0103 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
0104
0105 SPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'M', '1', ' ' );
0106 SPTEST.TIMER_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'M', '2', ' ' );
0107 SPTEST.TIMER_NAME( 3 ) := RTEMS.BUILD_NAME( 'T', 'M', '3', ' ' );
0108 SPTEST.TIMER_NAME( 4 ) := RTEMS.BUILD_NAME( 'T', 'M', '4', ' ' );
0109 SPTEST.TIMER_NAME( 5 ) := RTEMS.BUILD_NAME( 'T', 'M', '5', ' ' );
0110 SPTEST.TIMER_NAME( 6 ) := RTEMS.BUILD_NAME( 'T', 'M', '6', ' ' );
0111
0112 RTEMS.TIMER.CREATE(
0113 SPTEST.TIMER_NAME( 1 ),
0114 SPTEST.TIMER_ID( 1 ),
0115 STATUS
0116 );
0117 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM1" );
0118
0119 RTEMS.TIMER.CREATE(
0120 SPTEST.TIMER_NAME( 2 ),
0121 SPTEST.TIMER_ID( 2 ),
0122 STATUS
0123 );
0124 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM2" );
0125
0126 RTEMS.TIMER.CREATE(
0127 SPTEST.TIMER_NAME( 3 ),
0128 SPTEST.TIMER_ID( 3 ),
0129 STATUS
0130 );
0131 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM3" );
0132
0133 RTEMS.TIMER.CREATE(
0134 SPTEST.TIMER_NAME( 4 ),
0135 SPTEST.TIMER_ID( 4 ),
0136 STATUS
0137 );
0138 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM4" );
0139
0140 RTEMS.TIMER.CREATE(
0141 SPTEST.TIMER_NAME( 5 ),
0142 SPTEST.TIMER_ID( 5 ),
0143 STATUS
0144 );
0145 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM5" );
0146
0147 RTEMS.TIMER.CREATE(
0148 SPTEST.TIMER_NAME( 6 ),
0149 SPTEST.TIMER_ID( 6 ),
0150 STATUS
0151 );
0152 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM6" );
0153
0154 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0155 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0156
0157 end INIT;
0158
0159 --
0160 -- TASK_1
0161 --
0162
0163 procedure TASK_1 (
0164 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0165 ) is
0166 pragma Unreferenced(ARGUMENT);
0167 EVENTOUT : RTEMS.EVENT_SET;
0168 TIME : RTEMS.TIME_OF_DAY;
0169 STATUS : RTEMS.STATUS_CODES;
0170 INDEX : RTEMS.UNSIGNED32;
0171 begin
0172
0173 TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_16 to TA2" );
0174 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_16, STATUS );
0175 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 16" );
0176
0177 TEXT_IO.PUT_LINE(
0178 "TA1 - event_receive - waiting forever on EVENT_14 and EVENT_15"
0179 );
0180 RTEMS.EVENT.RECEIVE(
0181 RTEMS.EVENT_14 + RTEMS.EVENT_15,
0182 RTEMS.DEFAULT_OPTIONS,
0183 RTEMS.NO_TIMEOUT,
0184 EVENTOUT,
0185 STATUS
0186 );
0187 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 14 and 15" );
0188 TEXT_IO.PUT( "TA1 - EVENT_14 and EVENT_15 received - eventout => ");
0189 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0190 TEXT_IO.NEW_LINE;
0191
0192 TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_18 to TA2" );
0193 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_18, STATUS );
0194 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 18" );
0195
0196 TEXT_IO.PUT_LINE(
0197 "TA1 - event_receive - waiting with 10 second timeout on EVENT_14"
0198 );
0199 RTEMS.EVENT.RECEIVE(
0200 RTEMS.EVENT_14,
0201 RTEMS.DEFAULT_OPTIONS,
0202 10 * TEST_SUPPORT.TICKS_PER_SECOND,
0203 EVENTOUT,
0204 STATUS
0205 );
0206 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 14" );
0207 TEXT_IO.PUT( "TA1 - EVENT_14 received - eventout => ");
0208 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0209 TEXT_IO.NEW_LINE;
0210
0211 TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_19 to TA2" );
0212 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_19, STATUS );
0213 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 19" );
0214
0215 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0216 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0217 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_get - ", TIME, "" );
0218 TEXT_IO.NEW_LINE;
0219
0220 TEST_SUPPORT.PAUSE;
0221
0222 TEXT_IO.PUT_LINE(
0223 "TA1 - event_send - send EVENT_18 to self after 5 seconds"
0224 );
0225 RTEMS.TIMER.FIRE_AFTER(
0226 SPTEST.TIMER_ID( 1 ),
0227 5 * TEST_SUPPORT.TICKS_PER_SECOND,
0228 SPTEST.TA1_SEND_18_TO_SELF_5_SECONDS'ACCESS,
0229 RTEMS.NULL_ADDRESS,
0230 STATUS
0231 );
0232 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 5 seconds" );
0233
0234 TEXT_IO.PUT_LINE(
0235 "TA1 - event_receive - waiting forever on EVENT_18"
0236 );
0237 RTEMS.EVENT.RECEIVE(
0238 RTEMS.EVENT_18,
0239 RTEMS.DEFAULT_OPTIONS,
0240 RTEMS.NO_TIMEOUT,
0241 EVENTOUT,
0242 STATUS
0243 );
0244 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 18" );
0245
0246 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0247 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0248
0249 TEXT_IO.PUT( "TA1 - EVENT_18 received - eventout => ");
0250 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0251 TEXT_IO.NEW_LINE;
0252
0253 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_get - ", TIME, "" );
0254 TEXT_IO.NEW_LINE;
0255
0256 TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_3 to self" );
0257 RTEMS.EVENT.SEND( RTEMS.SELF, RTEMS.EVENT_3, STATUS );
0258 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 3" );
0259
0260 TEXT_IO.PUT_LINE(
0261 "TA1 - event_receive - EVENT_3 or EVENT_22 - NO_WAIT and EVENT_ANY"
0262 );
0263 RTEMS.EVENT.RECEIVE(
0264 RTEMS.EVENT_3 + RTEMS.EVENT_22,
0265 RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
0266 RTEMS.NO_TIMEOUT,
0267 EVENTOUT,
0268 STATUS
0269 );
0270 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 3 and 22" );
0271 TEXT_IO.PUT( "TA1 - EVENT_3 received - eventout => ");
0272 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0273 TEXT_IO.NEW_LINE;
0274
0275 TEXT_IO.PUT_LINE( "TA1 - event_send - send EVENT_4 to self" );
0276 RTEMS.EVENT.SEND( RTEMS.SELF, RTEMS.EVENT_4, STATUS );
0277 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 4" );
0278
0279 TEXT_IO.PUT_LINE(
0280 "TA1 - event_receive - waiting forever on EVENT_4 or EVENT_5 - EVENT_ANY"
0281 );
0282 RTEMS.EVENT.RECEIVE(
0283 RTEMS.EVENT_4 + RTEMS.EVENT_5,
0284 RTEMS.EVENT_ANY,
0285 RTEMS.NO_TIMEOUT,
0286 EVENTOUT,
0287 STATUS
0288 );
0289 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 4 and 5" );
0290 TEXT_IO.PUT( "TA1 - EVENT_4 received - eventout => ");
0291 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0292 TEXT_IO.NEW_LINE;
0293
0294 TEST_SUPPORT.PAUSE;
0295
0296 TEXT_IO.PUT_LINE(
0297 "TA1 - event_send - send EVENT_18 to self after 5 seconds"
0298 );
0299 RTEMS.TIMER.FIRE_AFTER(
0300 SPTEST.TIMER_ID( 1 ),
0301 5 * TEST_SUPPORT.TICKS_PER_SECOND,
0302 SPTEST.TA1_SEND_18_TO_SELF_5_SECONDS'ACCESS,
0303 RTEMS.NULL_ADDRESS,
0304 STATUS
0305 );
0306 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 5 seconds" );
0307
0308 TEXT_IO.PUT_LINE(
0309 "TA1 - timer_cancel - cancelling timer for event EVENT_18"
0310 );
0311 RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
0312 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
0313
0314 TEXT_IO.PUT_LINE(
0315 "TA1 - event_send - send EVENT_8 to self after 60 seconds"
0316 );
0317 RTEMS.TIMER.FIRE_AFTER(
0318 SPTEST.TIMER_ID( 1 ),
0319 60 * TEST_SUPPORT.TICKS_PER_SECOND,
0320 SPTEST.TA1_SEND_8_TO_SELF_60_SECONDS'ACCESS,
0321 RTEMS.NULL_ADDRESS,
0322 STATUS
0323 );
0324 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 60 secs" );
0325
0326 TEXT_IO.PUT_LINE(
0327 "TA1 - event_send - send EVENT_9 to self after 60 seconds"
0328 );
0329 RTEMS.TIMER.FIRE_AFTER(
0330 SPTEST.TIMER_ID( 2 ),
0331 60 * TEST_SUPPORT.TICKS_PER_SECOND,
0332 SPTEST.TA1_SEND_9_TO_SELF_60_SECONDS'ACCESS,
0333 RTEMS.NULL_ADDRESS,
0334 STATUS
0335 );
0336 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 60 secs" );
0337
0338 TEXT_IO.PUT_LINE(
0339 "TA1 - event_send - send EVENT_10 to self after 60 seconds"
0340 );
0341 RTEMS.TIMER.FIRE_AFTER(
0342 SPTEST.TIMER_ID( 3 ),
0343 60 * TEST_SUPPORT.TICKS_PER_SECOND,
0344 SPTEST.TA1_SEND_10_TO_SELF'ACCESS,
0345 RTEMS.NULL_ADDRESS,
0346 STATUS
0347 );
0348 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 60 secs" );
0349
0350 TEXT_IO.PUT_LINE(
0351 "TA1 - timer_cancel - cancelling timer for event EVENT_8"
0352 );
0353 RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
0354 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
0355
0356 TIME := ( 1988, 2, 12, 8, 15, 0, 0 );
0357
0358 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
0359 TEXT_IO.NEW_LINE;
0360 RTEMS.CLOCK.SET( TIME, STATUS );
0361 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
0362
0363 TEXT_IO.PUT_LINE(
0364 "TA1 - event_send - send EVENT_1 every second"
0365 );
0366 RTEMS.TIMER.FIRE_AFTER(
0367 SPTEST.TIMER_ID( 1 ),
0368 TEST_SUPPORT.TICKS_PER_SECOND,
0369 SPTEST.TA1_SEND_1_TO_SELF_EVERY_SECOND'ACCESS,
0370 RTEMS.NULL_ADDRESS,
0371 STATUS
0372 );
0373 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 1 SECOND" );
0374
0375 INDEX := 0;
0376
0377 loop
0378
0379 exit when INDEX = 3;
0380
0381 RTEMS.EVENT.RECEIVE(
0382 RTEMS.EVENT_1,
0383 RTEMS.EVENT_ANY,
0384 RTEMS.NO_TIMEOUT,
0385 EVENTOUT,
0386 STATUS
0387 );
0388 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 1" );
0389
0390 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0391 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0392
0393 TEXT_IO.PUT( "TA1 - EVENT_1 received - eventout => ");
0394 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0395 TEST_SUPPORT.PRINT_TIME( " - at ", TIME, "" );
0396 TEXT_IO.NEW_LINE;
0397
0398 if INDEX < 2 then
0399 RTEMS.TIMER.RESET( SPTEST.TIMER_ID( 1 ), STATUS );
0400 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 TIMER RESET" );
0401 end if;
0402
0403 INDEX := INDEX + 1;
0404 end loop;
0405
0406 TEXT_IO.PUT_LINE(
0407 "TA1 - timer_cancel - cancelling timer for event EVENT_1"
0408 );
0409 RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
0410 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
0411
0412 TEST_SUPPORT.PAUSE;
0413
0414 TIME.DAY := 13;
0415 TEXT_IO.PUT_LINE(
0416 "TA1 - event_send - send EVENT_11 to self in 1 day"
0417 );
0418 RTEMS.TIMER.FIRE_WHEN(
0419 SPTEST.TIMER_ID( 1 ),
0420 TIME,
0421 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0422 RTEMS.NULL_ADDRESS,
0423 STATUS
0424 );
0425 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 1 day" );
0426
0427 TIME.HOUR := 7;
0428 TEXT_IO.PUT_LINE(
0429 "TA1 - event_send - send EVENT_11 to self in 1 day"
0430 );
0431 RTEMS.TIMER.FIRE_WHEN(
0432 SPTEST.TIMER_ID( 2 ),
0433 TIME,
0434 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0435 RTEMS.NULL_ADDRESS,
0436 STATUS
0437 );
0438 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 1 day" );
0439 TIME.HOUR := 8;
0440
0441 TIME.DAY := 14;
0442 TEXT_IO.PUT_LINE(
0443 "TA1 - event_send - send EVENT_11 to self in 2 days"
0444 );
0445 RTEMS.TIMER.FIRE_WHEN(
0446 SPTEST.TIMER_ID( 3 ),
0447 TIME,
0448 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0449 RTEMS.NULL_ADDRESS,
0450 STATUS
0451 );
0452 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );
0453
0454 TEXT_IO.PUT_LINE(
0455 "TA1 - timer_cancel - cancelling EVENT_11 to self in 1 day"
0456 );
0457 RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 1 ), STATUS );
0458 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
0459
0460 TEXT_IO.PUT_LINE(
0461 "TA1 - timer_cancel - cancelling EVENT_11 to self in 2 days"
0462 );
0463 RTEMS.TIMER.CANCEL( SPTEST.TIMER_ID( 3 ), STATUS );
0464 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
0465
0466 TEXT_IO.PUT_LINE(
0467 "TA1 - event_send - resending EVENT_11 to self in 2 days"
0468 );
0469 RTEMS.TIMER.FIRE_WHEN(
0470 SPTEST.TIMER_ID( 3 ),
0471 TIME,
0472 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0473 RTEMS.NULL_ADDRESS,
0474 STATUS
0475 );
0476 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );
0477
0478 TIME.DAY := 15;
0479 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
0480 TEXT_IO.NEW_LINE;
0481 RTEMS.CLOCK.SET( TIME, STATUS );
0482 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
0483 TEXT_IO.PUT_LINE(
0484 "TA1 - event_receive - waiting forever on EVENT_11"
0485 );
0486 RTEMS.EVENT.RECEIVE(
0487 RTEMS.EVENT_11,
0488 RTEMS.DEFAULT_OPTIONS,
0489 RTEMS.NO_TIMEOUT,
0490 EVENTOUT,
0491 STATUS
0492 );
0493 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 11" );
0494 TEXT_IO.PUT( "TA1 - EVENT_11 received - eventout => ");
0495 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0496 TEXT_IO.NEW_LINE;
0497
0498 TEST_SUPPORT.PAUSE;
0499
0500 -- The following code tests the case of deleting a timer ???
0501
0502 TEXT_IO.PUT_LINE( "TA1 - event_send/event_receive combination" );
0503 RTEMS.TIMER.FIRE_AFTER(
0504 SPTEST.TIMER_ID( 1 ),
0505 10,
0506 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0507 RTEMS.NULL_ADDRESS,
0508 STATUS
0509 );
0510 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 10 ticks" );
0511 RTEMS.EVENT.RECEIVE(
0512 RTEMS.EVENT_11,
0513 RTEMS.DEFAULT_OPTIONS,
0514 11,
0515 EVENTOUT,
0516 STATUS
0517 );
0518 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE" );
0519
0520 TIME := ( 1988, 2, 12, 8, 15, 0, 0 );
0521
0522 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
0523 TEXT_IO.NEW_LINE;
0524 RTEMS.CLOCK.SET( TIME, STATUS );
0525 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
0526
0527 TIME.DAY := 13;
0528 TEXT_IO.PUT_LINE(
0529 "TA1 - event_receive all outstanding events"
0530 );
0531 RTEMS.EVENT.RECEIVE(
0532 RTEMS.ALL_EVENTS,
0533 RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
0534 RTEMS.NO_TIMEOUT,
0535 EVENTOUT,
0536 STATUS
0537 );
0538 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0539 STATUS,
0540 RTEMS.UNSATISFIED,
0541 "EVENT_RECEIVE all events"
0542 );
0543
0544 TEXT_IO.PUT_LINE(
0545 "TA1 - event_send - send EVENT_10 to self in 1 day"
0546 );
0547 RTEMS.TIMER.FIRE_WHEN(
0548 SPTEST.TIMER_ID( 1 ),
0549 TIME,
0550 SPTEST.TA1_SEND_10_TO_SELF'ACCESS,
0551 RTEMS.NULL_ADDRESS,
0552 STATUS
0553 );
0554 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 1 day" );
0555
0556 TIME.DAY := 14;
0557 TEXT_IO.PUT_LINE(
0558 "TA1 - event_send - send EVENT_11 to self in 2 days"
0559 );
0560 RTEMS.TIMER.FIRE_WHEN(
0561 SPTEST.TIMER_ID( 2 ),
0562 TIME,
0563 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0564 RTEMS.NULL_ADDRESS,
0565 STATUS
0566 );
0567 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 2 days" );
0568
0569 TIME := ( 1988, 2, 12, 7, 15, 0, 0 );
0570
0571 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
0572 TEXT_IO.NEW_LINE;
0573 TEXT_IO.PUT_LINE( "TA1 - set time backwards" );
0574 RTEMS.CLOCK.SET( TIME, STATUS );
0575 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
0576
0577 RTEMS.EVENT.RECEIVE(
0578 RTEMS.ALL_EVENTS,
0579 RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
0580 RTEMS.NO_TIMEOUT,
0581 EVENTOUT,
0582 STATUS
0583 );
0584 if EVENTOUT >= RTEMS.EVENT_0 then
0585 TEXT_IO.PUT( "ERROR - " );
0586 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0587 TEXT_IO.PUT_LINE( " events received" );
0588 else
0589 TEXT_IO.PUT_LINE( "TA1 - no events received" );
0590 end if;
0591 TEST_SUPPORT.FATAL_DIRECTIVE_STATUS(
0592 STATUS,
0593 RTEMS.UNSATISFIED,
0594 "EVENT_RECEIVE all events"
0595 );
0596
0597 TIME := ( 1988, 2, 14, 7, 15, 0, 0 );
0598
0599 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_set - ", TIME, "" );
0600 TEXT_IO.NEW_LINE;
0601 TEXT_IO.PUT_LINE( "TA1 - set time forwards (leave a timer)" );
0602 RTEMS.CLOCK.SET( TIME, STATUS );
0603 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA1 CLOCK_SET" );
0604
0605 RTEMS.EVENT.RECEIVE(
0606 RTEMS.ALL_EVENTS,
0607 RTEMS.NO_WAIT + RTEMS.EVENT_ANY,
0608 RTEMS.NO_TIMEOUT,
0609 EVENTOUT,
0610 STATUS
0611 );
0612 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE all events" );
0613 if EVENTOUT = RTEMS.EVENT_10 then
0614 TEXT_IO.PUT_LINE( "TA1 - EVENT_10 received" );
0615 else
0616 TEXT_IO.PUT( "ERROR - " );
0617 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0618 TEXT_IO.PUT_LINE( " events received" );
0619 end if;
0620
0621 TEXT_IO.PUT_LINE(
0622 "TA1 - event_send - send EVENT_11 to self in 100 ticks"
0623 );
0624 RTEMS.TIMER.FIRE_AFTER(
0625 SPTEST.TIMER_ID( 1 ),
0626 100,
0627 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0628 RTEMS.NULL_ADDRESS,
0629 STATUS
0630 );
0631 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 100 ticks" );
0632
0633 TEXT_IO.PUT_LINE(
0634 "TA1 - event_send - send EVENT_11 to self in 200 ticks"
0635 );
0636 RTEMS.TIMER.FIRE_AFTER(
0637 SPTEST.TIMER_ID( 2 ),
0638 100,
0639 SPTEST.TA1_SEND_11_TO_SELF'ACCESS,
0640 RTEMS.NULL_ADDRESS,
0641 STATUS
0642 );
0643 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER 200 ticks" );
0644
0645 TEST_SUPPORT.ADA_TEST_END;
0646 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0647
0648 end TASK_1;
0649
0650 --
0651 -- TASK_2
0652 --
0653
0654 procedure TASK_2 (
0655 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0656 ) is
0657 pragma Unreferenced(ARGUMENT);
0658 EVENTOUT : RTEMS.EVENT_SET;
0659 TIME : RTEMS.TIME_OF_DAY;
0660 STATUS : RTEMS.STATUS_CODES;
0661 begin
0662
0663 RTEMS.TASKS.WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0664 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0665
0666 TEXT_IO.PUT_LINE(
0667 "TA2 - event_receive - waiting forever on EVENT_16"
0668 );
0669 RTEMS.EVENT.RECEIVE(
0670 RTEMS.EVENT_16,
0671 RTEMS.DEFAULT_OPTIONS,
0672 RTEMS.NO_TIMEOUT,
0673 EVENTOUT,
0674 STATUS
0675 );
0676 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 16" );
0677 TEXT_IO.PUT( "TA2 - EVENT_16 received - eventout => ");
0678 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0679 TEXT_IO.NEW_LINE;
0680
0681 TEXT_IO.PUT_LINE(
0682 "TA2 - event_send - send EVENT_14 and EVENT_15 to TA1"
0683 );
0684 RTEMS.EVENT.SEND(
0685 SPTEST.TASK_ID( 1 ),
0686 RTEMS.EVENT_14 + RTEMS.EVENT_15,
0687 STATUS
0688 );
0689 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 14 and 15" );
0690
0691 TEXT_IO.PUT_LINE(
0692 "TA2 - event_receive - waiting forever on EVENT_17 or EVENT_18 - EVENT_ANY"
0693 );
0694 RTEMS.EVENT.RECEIVE(
0695 RTEMS.EVENT_17 + RTEMS.EVENT_18,
0696 RTEMS.EVENT_ANY,
0697 RTEMS.NO_TIMEOUT,
0698 EVENTOUT,
0699 STATUS
0700 );
0701 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 17 and 18" );
0702 TEXT_IO.PUT( "TA2 - EVENT_17 or EVENT_18 received - eventout => ");
0703 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0704 TEXT_IO.NEW_LINE;
0705
0706 TEXT_IO.PUT_LINE(
0707 "TA2 - event_send - send EVENT_14 to TA1"
0708 );
0709 RTEMS.EVENT.SEND(
0710 SPTEST.TASK_ID( 1 ),
0711 RTEMS.EVENT_14,
0712 STATUS
0713 );
0714 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 14" );
0715
0716 TIME := ( 1988, 2, 12, 8, 15, 0, 0 );
0717
0718 TEST_SUPPORT.PRINT_TIME( "TA2 - clock_set - ", TIME, "" );
0719 TEXT_IO.NEW_LINE;
0720 RTEMS.CLOCK.SET( TIME, STATUS );
0721 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TA2 CLOCK_SET" );
0722
0723 TIME.SECOND := TIME.SECOND + 5;
0724 TEXT_IO.PUT_LINE(
0725 "TA2 - event_send - sending EVENT_10 to self after 5 seconds"
0726 );
0727 RTEMS.TIMER.FIRE_WHEN(
0728 SPTEST.TIMER_ID( 5 ),
0729 TIME,
0730 SPTEST.TA2_SEND_10_TO_SELF'ACCESS,
0731 RTEMS.NULL_ADDRESS,
0732 STATUS
0733 );
0734 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN 5 SECONDS" );
0735
0736 TEXT_IO.PUT_LINE(
0737 "TA2 - event_receive - waiting forever on EVENT_10"
0738 );
0739 RTEMS.EVENT.RECEIVE(
0740 RTEMS.EVENT_10,
0741 RTEMS.DEFAULT_OPTIONS,
0742 RTEMS.NO_TIMEOUT,
0743 EVENTOUT,
0744 STATUS
0745 );
0746 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
0747
0748 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0749 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0750
0751 TEXT_IO.PUT( "TA2 - EVENT_10 received - eventout => ");
0752 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0753 TEXT_IO.NEW_LINE;
0754
0755 TEST_SUPPORT.PRINT_TIME( "TA1 - clock_get - ", TIME, "" );
0756 TEXT_IO.NEW_LINE;
0757
0758 TEXT_IO.PUT_LINE( "TA2 - event_receive - PENDING_EVENTS" );
0759 RTEMS.EVENT.RECEIVE(
0760 RTEMS.PENDING_EVENTS,
0761 RTEMS.DEFAULT_OPTIONS,
0762 RTEMS.NO_TIMEOUT,
0763 EVENTOUT,
0764 STATUS
0765 );
0766 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
0767 TEXT_IO.PUT( "TA2 - eventout => ");
0768 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0769 TEXT_IO.NEW_LINE;
0770
0771 TEXT_IO.PUT_LINE(
0772 "TA2 - event_receive - EVENT_19 - NO_WAIT"
0773 );
0774 RTEMS.EVENT.RECEIVE(
0775 RTEMS.EVENT_19,
0776 RTEMS.NO_WAIT,
0777 RTEMS.NO_TIMEOUT,
0778 EVENTOUT,
0779 STATUS
0780 );
0781 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_RECEIVE of 10" );
0782 TEXT_IO.PUT( "TA2 - EVENT_19 received - eventout => ");
0783 UNSIGNED32_IO.PUT( EVENTOUT, BASE => 16, WIDTH => 8 );
0784 TEXT_IO.NEW_LINE;
0785
0786 TEXT_IO.PUT_LINE( "TA2 - task_delete - deletes self" );
0787 RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 2 ), STATUS );
0788 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE of TA2" );
0789
0790 end TASK_2;
0791
0792 --
0793 -- TA1_SEND_18_TO_SELF_5_SECONDS
0794 --
0795
0796 procedure TA1_SEND_18_TO_SELF_5_SECONDS (
0797 IGNORED_ID : in RTEMS.ID;
0798 IGNORED_ADDRESS : in RTEMS.ADDRESS
0799 )
0800 is
0801 pragma Unreferenced(IGNORED_ID);
0802 pragma Unreferenced(IGNORED_ADDRESS);
0803 STATUS : RTEMS.STATUS_CODES;
0804 begin
0805
0806 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_18, STATUS );
0807 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 18" );
0808
0809 end TA1_SEND_18_TO_SELF_5_SECONDS;
0810
0811 --
0812 -- TA1_SEND_8_TO_SELF_60_SECONDS
0813 --
0814
0815 procedure TA1_SEND_8_TO_SELF_60_SECONDS (
0816 IGNORED_ID : in RTEMS.ID;
0817 IGNORED_ADDRESS : in RTEMS.ADDRESS
0818 )
0819 is
0820 pragma Unreferenced(IGNORED_ID);
0821 pragma Unreferenced(IGNORED_ADDRESS);
0822 STATUS : RTEMS.STATUS_CODES;
0823 begin
0824
0825 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_8, STATUS );
0826 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 8" );
0827
0828 end TA1_SEND_8_TO_SELF_60_SECONDS;
0829
0830 --
0831 -- TA1_SEND_9_TO_SELF_60_SECONDS
0832 --
0833
0834 procedure TA1_SEND_9_TO_SELF_60_SECONDS (
0835 IGNORED_ID : in RTEMS.ID;
0836 IGNORED_ADDRESS : in RTEMS.ADDRESS
0837 )
0838 is
0839 pragma Unreferenced(IGNORED_ID);
0840 pragma Unreferenced(IGNORED_ADDRESS);
0841 STATUS : RTEMS.STATUS_CODES;
0842 begin
0843
0844 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_9, STATUS );
0845 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 9" );
0846
0847 end TA1_SEND_9_TO_SELF_60_SECONDS;
0848
0849 --
0850 -- TA1_SEND_10_TO_SELF
0851 --
0852
0853 procedure TA1_SEND_10_TO_SELF (
0854 IGNORED_ID : in RTEMS.ID;
0855 IGNORED_ADDRESS : in RTEMS.ADDRESS
0856 )
0857 is
0858 pragma Unreferenced(IGNORED_ID);
0859 pragma Unreferenced(IGNORED_ADDRESS);
0860 STATUS : RTEMS.STATUS_CODES;
0861 begin
0862
0863 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_10, STATUS );
0864 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 10" );
0865
0866 end TA1_SEND_10_TO_SELF;
0867
0868 --
0869 -- TA1_SEND_1_TO_SELF_EVERY_SECOND
0870 --
0871
0872 procedure TA1_SEND_1_TO_SELF_EVERY_SECOND (
0873 IGNORED_ID : in RTEMS.ID;
0874 IGNORED_ADDRESS : in RTEMS.ADDRESS
0875 )
0876 is
0877 pragma Unreferenced(IGNORED_ID);
0878 pragma Unreferenced(IGNORED_ADDRESS);
0879 STATUS : RTEMS.STATUS_CODES;
0880 begin
0881
0882 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_1, STATUS );
0883 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 1" );
0884
0885 end TA1_SEND_1_TO_SELF_EVERY_SECOND;
0886
0887 --
0888 -- TA1_SEND_11_TO_SELF
0889 --
0890
0891 procedure TA1_SEND_11_TO_SELF (
0892 IGNORED_ID : in RTEMS.ID;
0893 IGNORED_ADDRESS : in RTEMS.ADDRESS
0894 )
0895 is
0896 pragma Unreferenced(IGNORED_ID);
0897 pragma Unreferenced(IGNORED_ADDRESS);
0898 STATUS : RTEMS.STATUS_CODES;
0899 begin
0900
0901 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 1 ), RTEMS.EVENT_11, STATUS );
0902 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 11" );
0903
0904 end TA1_SEND_11_TO_SELF;
0905
0906 --
0907 -- TA2_SEND_10_TO_SELF
0908 --
0909
0910 procedure TA2_SEND_10_TO_SELF (
0911 IGNORED_ID : in RTEMS.ID;
0912 IGNORED_ADDRESS : in RTEMS.ADDRESS
0913 )
0914 is
0915 pragma Unreferenced(IGNORED_ID);
0916 pragma Unreferenced(IGNORED_ADDRESS);
0917 STATUS : RTEMS.STATUS_CODES;
0918 begin
0919
0920 RTEMS.EVENT.SEND( SPTEST.TASK_ID( 2 ), RTEMS.EVENT_10, STATUS );
0921 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND of 10" );
0922
0923 end TA2_SEND_10_TO_SELF;
0924
0925 end SPTEST;
