Warning, /testsuites/ada/sptests/sp02/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 2 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
0045 package body SPTEST is
0046
0047 --
0048 -- INIT
0049 --
0050
0051 procedure INIT (
0052 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0053 ) is
0054 pragma Unreferenced(ARGUMENT);
0055 STATUS : RTEMS.STATUS_CODES;
0056 begin
0057
0058 TEXT_IO.NEW_LINE( 2 );
0059 TEST_SUPPORT.ADA_TEST_BEGIN;
0060
0061 SPTEST.PREEMPT_TASK_NAME := RTEMS.BUILD_NAME( 'P', 'R', 'M', 'T' );
0062
0063 RTEMS.TASKS.CREATE(
0064 SPTEST.PREEMPT_TASK_NAME,
0065 1,
0066 2048,
0067 RTEMS.DEFAULT_MODES,
0068 RTEMS.DEFAULT_ATTRIBUTES,
0069 SPTEST.PREEMPT_TASK_ID,
0070 STATUS
0071 );
0072 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF PREEMPT" );
0073
0074 RTEMS.TASKS.START(
0075 SPTEST.PREEMPT_TASK_ID,
0076 SPTEST.PREEMPT_TASK'ACCESS,
0077 0,
0078 STATUS
0079 );
0080 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF PREEMPT" );
0081
0082 TEXT_IO.PUT_LINE( "INIT - task_wake_after - yielding processor" );
0083 RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
0084 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0085
0086 SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
0087 SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'A', '2', ' ' );
0088 SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME( 'T', 'A', '3', ' ' );
0089
0090 RTEMS.TASKS.CREATE(
0091 SPTEST.TASK_NAME( 1 ),
0092 3,
0093 2048,
0094 RTEMS.DEFAULT_MODES,
0095 RTEMS.DEFAULT_ATTRIBUTES,
0096 SPTEST.TASK_ID( 1 ),
0097 STATUS
0098 );
0099 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
0100
0101 RTEMS.TASKS.CREATE(
0102 SPTEST.TASK_NAME( 2 ),
0103 3,
0104 2048,
0105 RTEMS.DEFAULT_MODES,
0106 RTEMS.DEFAULT_ATTRIBUTES,
0107 SPTEST.TASK_ID( 2 ),
0108 STATUS
0109 );
0110 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
0111
0112 RTEMS.TASKS.CREATE(
0113 SPTEST.TASK_NAME( 3 ),
0114 3,
0115 2048,
0116 RTEMS.DEFAULT_MODES,
0117 RTEMS.DEFAULT_ATTRIBUTES,
0118 SPTEST.TASK_ID( 3 ),
0119 STATUS
0120 );
0121 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
0122
0123 RTEMS.TASKS.START(
0124 SPTEST.TASK_ID( 1 ),
0125 SPTEST.TASK_1'ACCESS,
0126 0,
0127 STATUS
0128 );
0129 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
0130
0131 RTEMS.TASKS.START(
0132 SPTEST.TASK_ID( 2 ),
0133 SPTEST.TASK_2'ACCESS,
0134 0,
0135 STATUS
0136 );
0137 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
0138
0139 RTEMS.TASKS.START(
0140 SPTEST.TASK_ID( 3 ),
0141 SPTEST.TASK_3'ACCESS,
0142 0,
0143 STATUS
0144 );
0145 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
0146
0147 TEXT_IO.PUT_LINE(
0148 "INIT - suspending TA2 while middle task on a ready chain"
0149 );
0150
0151 RTEMS.TASKS.SUSPEND( SPTEST.TASK_ID( 2 ), STATUS );
0152 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND OF TA2" );
0153
0154 RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 1 ), STATUS );
0155 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA1" );
0156
0157 RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 2 ), STATUS );
0158 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
0159
0160 RTEMS.TASKS.DELETE( SPTEST.TASK_ID( 3 ), STATUS );
0161 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
0162
0163 RTEMS.TASKS.CREATE(
0164 SPTEST.TASK_NAME( 1 ),
0165 1,
0166 2048,
0167 RTEMS.DEFAULT_MODES,
0168 RTEMS.DEFAULT_ATTRIBUTES,
0169 SPTEST.TASK_ID( 1 ),
0170 STATUS
0171 );
0172 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
0173
0174 RTEMS.TASKS.CREATE(
0175 SPTEST.TASK_NAME( 2 ),
0176 3,
0177 2048,
0178 RTEMS.DEFAULT_MODES,
0179 RTEMS.DEFAULT_ATTRIBUTES,
0180 SPTEST.TASK_ID( 2 ),
0181 STATUS
0182 );
0183 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
0184
0185 RTEMS.TASKS.CREATE(
0186 SPTEST.TASK_NAME( 3 ),
0187 3,
0188 2048,
0189 RTEMS.DEFAULT_MODES,
0190 RTEMS.DEFAULT_ATTRIBUTES,
0191 SPTEST.TASK_ID( 3 ),
0192 STATUS
0193 );
0194 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
0195
0196 RTEMS.TASKS.START(
0197 SPTEST.TASK_ID( 1 ),
0198 SPTEST.TASK_1'ACCESS,
0199 0,
0200 STATUS
0201 );
0202 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
0203
0204 RTEMS.TASKS.START(
0205 SPTEST.TASK_ID( 2 ),
0206 SPTEST.TASK_2'ACCESS,
0207 0,
0208 STATUS
0209 );
0210 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
0211
0212 RTEMS.TASKS.START(
0213 SPTEST.TASK_ID( 3 ),
0214 SPTEST.TASK_3'ACCESS,
0215 0,
0216 STATUS
0217 );
0218 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
0219
0220 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0221 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0222
0223 end INIT;
0224
0225 --
0226 -- PREEMPT_TASK
0227 --
0228
0229 procedure PREEMPT_TASK (
0230 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0231 ) is
0232 pragma Unreferenced(ARGUMENT);
0233 STATUS : RTEMS.STATUS_CODES;
0234 begin
0235
0236 TEXT_IO.PUT_LINE( "PREEMPT - task_delete - deleting self" );
0237 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0238 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF PREEMPT" );
0239
0240 end PREEMPT_TASK;
0241
0242 --
0243 -- TASK_1
0244 --
0245
0246 procedure TASK_1 (
0247 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0248 ) is
0249 pragma Unreferenced(ARGUMENT);
0250 TID2 : RTEMS.ID;
0251 TID3 : RTEMS.ID;
0252 STATUS : RTEMS.STATUS_CODES;
0253 PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY;
0254 begin
0255
0256 TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep 1 second" );
0257 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0258 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0259
0260 RTEMS.TASKS.IDENT(
0261 SPTEST.TASK_NAME( 2 ),
0262 RTEMS.SEARCH_ALL_NODES,
0263 TID2,
0264 STATUS
0265 );
0266 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF TA2" );
0267
0268 TEXT_IO.PUT( "TA1 - task_ident - tid of TA2 (" );
0269 UNSIGNED32_IO.PUT( TID2, WIDTH => 8, BASE => 10#16# );
0270 TEXT_IO.PUT_LINE( ")" );
0271
0272 RTEMS.TASKS.IDENT(
0273 SPTEST.TASK_NAME( 3 ),
0274 RTEMS.SEARCH_ALL_NODES,
0275 TID3,
0276 STATUS
0277 );
0278 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF TA3" );
0279
0280 TEXT_IO.PUT( "TA1 - task_ident - tid of TA3 (" );
0281 UNSIGNED32_IO.PUT( TID3, WIDTH => 8, BASE => 10#16# );
0282 TEXT_IO.PUT_LINE( ")" );
0283
0284 RTEMS.TASKS.SET_PRIORITY( TID3, 2, PREVIOUS_PRIORITY, STATUS );
0285 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
0286
0287 TEXT_IO.PUT_LINE(
0288 "TA1 - task_set_priority - set TA3's priority to 2"
0289 );
0290
0291 TEXT_IO.PUT_LINE( "TA1 - task_suspend - suspend TA2" );
0292 RTEMS.TASKS.SUSPEND( TID2, STATUS );
0293 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND OF TA2" );
0294
0295 TEXT_IO.PUT_LINE( "TA1 - task_delete - delete TA2" );
0296 RTEMS.TASKS.DELETE( TID2, STATUS );
0297 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
0298
0299 TEXT_IO.PUT_LINE( "TA1 - task_wake_after - sleep for 5 seconds" );
0300 RTEMS.TASKS.WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0301 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0302
0303 TEST_SUPPORT.ADA_TEST_END;
0304 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0305
0306 end TASK_1;
0307
0308 --
0309 -- TASK_2
0310 --
0311
0312 procedure TASK_2 (
0313 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0314 ) is
0315 pragma Unreferenced(ARGUMENT);
0316 STATUS : RTEMS.STATUS_CODES;
0317 begin
0318
0319 TEXT_IO.PUT_LINE( "TA2 - task_wake_after - sleep 1 minute" );
0320 RTEMS.TASKS.WAKE_AFTER( 60 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0321 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER IN TA2" );
0322
0323 end TASK_2;
0324
0325 --
0326 -- TASK_3
0327 --
0328
0329 procedure TASK_3 (
0330 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0331 ) is
0332 pragma Unreferenced(ARGUMENT);
0333 STATUS : RTEMS.STATUS_CODES;
0334 begin
0335
0336 TEXT_IO.PUT_LINE( "TA3 - task_wake_after - sleep 5 seconds" );
0337 RTEMS.TASKS.WAKE_AFTER( 5 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0338 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER IN TA3" );
0339
0340 TEXT_IO.PUT_LINE( "TA3 - task_delete - delete self" );
0341 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0342 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA3" );
0343
0344 end TASK_3;
0345
0346 end SPTEST;
