Warning, /testsuites/ada/sptests/sp22/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 22 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.TIMER;
0046
0047 package body SPTEST is
0048
0049 --
0050 -- INIT
0051 --
0052
0053 procedure INIT (
0054 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0055 ) is
0056 pragma Unreferenced(ARGUMENT);
0057 TIME : RTEMS.TIME_OF_DAY;
0058 STATUS : RTEMS.STATUS_CODES;
0059 begin
0060
0061 TEXT_IO.NEW_LINE( 2 );
0062 TEST_SUPPORT.ADA_TEST_BEGIN;
0063
0064 TIME := ( 1988, 12, 31, 9, 0, 0, 0 );
0065
0066 RTEMS.CLOCK.SET( TIME, STATUS );
0067 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_SET" );
0068
0069 SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
0070 SPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'M', '1', ' ' );
0071
0072 RTEMS.TASKS.CREATE(
0073 SPTEST.TASK_NAME( 1 ),
0074 1,
0075 2048,
0076 RTEMS.DEFAULT_MODES,
0077 RTEMS.DEFAULT_ATTRIBUTES,
0078 SPTEST.TASK_ID( 1 ),
0079 STATUS
0080 );
0081 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
0082
0083 RTEMS.TASKS.START(
0084 SPTEST.TASK_ID( 1 ),
0085 SPTEST.TASK_1'ACCESS,
0086 0,
0087 STATUS
0088 );
0089 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
0090
0091 TEXT_IO.PUT_LINE( "INIT - timer_create - creating timer 1" );
0092 RTEMS.TIMER.CREATE(
0093 SPTEST.TIMER_NAME( 1 ),
0094 SPTEST.TIMER_ID( 1 ),
0095 STATUS
0096 );
0097 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE OF TM1" );
0098 TEXT_IO.PUT( "INIT - timer 1 has id (" );
0099 UNSIGNED32_IO.PUT( SPTEST.TIMER_ID( 1 ), WIDTH => 8, BASE => 16 );
0100 TEXT_IO.PUT_LINE( ")" );
0101
0102 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0103 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0104
0105 end INIT;
0106
0107 --
0108 -- DELAYED_RESUME
0109 --
0110
0111 procedure DELAYED_RESUME (
0112 IGNORED_ID : in RTEMS.ID;
0113 IGNORED_ADDRESS : in RTEMS.ADDRESS
0114 ) is
0115 pragma Unreferenced(IGNORED_ID);
0116 pragma Unreferenced(IGNORED_ADDRESS);
0117 STATUS : RTEMS.STATUS_CODES;
0118 begin
0119
0120 RTEMS.TASKS.RESUME( SPTEST.TASK_ID( 1 ), STATUS );
0121 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME OF SELF" );
0122
0123 end DELAYED_RESUME;
0124
0125 --
0126 -- PRINT_TIME
0127 --
0128
0129 procedure PRINT_TIME
0130 is
0131 TIME : RTEMS.TIME_OF_DAY;
0132 STATUS : RTEMS.STATUS_CODES;
0133 begin
0134
0135 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0136 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0137
0138 TEST_SUPPORT.PUT_NAME(
0139 SPTEST.TASK_NAME( 1 ),
0140 FALSE
0141 );
0142
0143 TEST_SUPPORT.PRINT_TIME( "- clock_get - ", TIME, "" );
0144 TEXT_IO.NEW_LINE;
0145
0146 end PRINT_TIME;
0147
0148 --
0149 -- TASK_1
0150 --
0151
0152 procedure TASK_1 (
0153 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0154 ) is
0155 pragma Unreferenced(ARGUMENT);
0156 TMID : RTEMS.ID;
0157 TIME : RTEMS.TIME_OF_DAY;
0158 STATUS : RTEMS.STATUS_CODES;
0159 begin
0160
0161 -- GET ID
0162
0163 TEXT_IO.PUT_LINE( "TA1 - timer_ident - identing timer 1" );
0164 RTEMS.TIMER.IDENT( SPTEST.TIMER_NAME( 1 ), TMID, STATUS );
0165 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_IDENT OF TM1" );
0166 TEXT_IO.PUT( "TA1 - timer 1 has id (" );
0167 UNSIGNED32_IO.PUT( SPTEST.TIMER_ID( 1 ), WIDTH => 8, BASE => 16 );
0168 TEXT_IO.PUT_LINE( ")" );
0169
0170 -- AFTER WHICH IS ALLOWED TO FIRE
0171
0172 SPTEST.PRINT_TIME;
0173
0174 TEXT_IO.PUT_LINE( "TA1 - timer_after - timer 1 in 3 seconds" );
0175 RTEMS.TIMER.FIRE_AFTER(
0176 TMID,
0177 3 * TEST_SUPPORT.TICKS_PER_SECOND,
0178 SPTEST.DELAYED_RESUME'ACCESS,
0179 RTEMS.NULL_ADDRESS,
0180 STATUS
0181 );
0182 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
0183
0184 TEXT_IO.PUT_LINE( "TA1 - task_suspend( SELF )" );
0185 RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
0186 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
0187
0188 SPTEST.PRINT_TIME;
0189
0190 -- AFTER WHICH IS RESET AND ALLOWED TO FIRE
0191
0192 TEXT_IO.PUT_LINE( "TA1 - timer_after - timer 1 in 3 seconds" );
0193 RTEMS.TIMER.FIRE_AFTER(
0194 TMID,
0195 3 * TEST_SUPPORT.TICKS_PER_SECOND,
0196 SPTEST.DELAYED_RESUME'ACCESS,
0197 RTEMS.NULL_ADDRESS,
0198 STATUS
0199 );
0200 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
0201
0202 TEXT_IO.PUT_LINE( "TA1 - task_wake_after - 1 second" );
0203 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0204 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0205
0206 SPTEST.PRINT_TIME;
0207
0208 TEXT_IO.PUT_LINE( "TA1 - timer_reset - timer 1" );
0209 RTEMS.TIMER.RESET( TMID, STATUS );
0210 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_RESET" );
0211
0212 TEXT_IO.PUT_LINE( "TA1 - task_suspend( SELF )" );
0213 RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
0214 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
0215
0216 SPTEST.PRINT_TIME;
0217
0218 TEST_SUPPORT.PAUSE;
0219
0220 --
0221 -- Reset the time since we do not know how long the user waited
0222 -- before pressing <cr> at the pause. This insures that the
0223 -- actual output matches the screen.
0224 --
0225
0226 TIME := ( 1988, 12, 31, 9, 0, 7, 0 );
0227
0228 RTEMS.CLOCK.SET( TIME, STATUS );
0229 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_SET" );
0230
0231 -- after which is canceled
0232
0233 TEXT_IO.PUT_LINE( "TA1 - timer_after - timer 1 in 3 seconds" );
0234 RTEMS.TIMER.FIRE_AFTER(
0235 TMID,
0236 3 * TEST_SUPPORT.TICKS_PER_SECOND,
0237 SPTEST.DELAYED_RESUME'ACCESS,
0238 RTEMS.NULL_ADDRESS,
0239 STATUS
0240 );
0241 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
0242
0243 TEXT_IO.PUT_LINE( "TA1 - timer_cancel - timer 1" );
0244 RTEMS.TIMER.CANCEL( TMID, STATUS );
0245 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
0246
0247 -- when which is allowed to fire
0248
0249 SPTEST.PRINT_TIME;
0250
0251 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0252 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0253
0254 TIME.SECOND := TIME.SECOND + 3;
0255
0256 TEXT_IO.PUT_LINE( "TA1 - timer_when - timer 1 in 3 seconds" );
0257 RTEMS.TIMER.FIRE_WHEN(
0258 TMID,
0259 TIME,
0260 SPTEST.DELAYED_RESUME'ACCESS,
0261 RTEMS.NULL_ADDRESS,
0262 STATUS
0263 );
0264 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN" );
0265
0266 TEXT_IO.PUT_LINE( "TA1 - task_suspend( SELF )" );
0267 RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
0268 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
0269
0270 SPTEST.PRINT_TIME;
0271
0272 -- when which is canceled
0273
0274 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0275 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0276
0277 TIME.SECOND := TIME.SECOND + 3;
0278
0279 TEXT_IO.PUT_LINE( "TA1 - timer_when - timer 1 in 3 seconds" );
0280 RTEMS.TIMER.FIRE_WHEN(
0281 TMID,
0282 TIME,
0283 SPTEST.DELAYED_RESUME'ACCESS,
0284 RTEMS.NULL_ADDRESS,
0285 STATUS
0286 );
0287 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_WHEN" );
0288
0289 TEXT_IO.PUT_LINE( "TA1 - task_wake_after - 1 second" );
0290 RTEMS.TASKS.WAKE_AFTER( TEST_SUPPORT.TICKS_PER_SECOND, STATUS );
0291 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0292
0293 SPTEST.PRINT_TIME;
0294
0295 TEXT_IO.PUT_LINE( "TA1 - timer_cancel - timer 1" );
0296 RTEMS.TIMER.CANCEL( TMID, STATUS );
0297 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CANCEL" );
0298
0299 -- delete
0300
0301 TEXT_IO.PUT_LINE(
0302 "TA1 - task_wake_after - YIELD (only task at priority)"
0303 );
0304 RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
0305 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER YIELD" );
0306
0307 TEXT_IO.PUT_LINE( "TA1 - timer_delete - timer 1" );
0308 RTEMS.TIMER.DELETE( TMID, STATUS );
0309 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_DELETE" );
0310
0311 TEST_SUPPORT.ADA_TEST_END;
0312 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0313
0314 end TASK_1;
0315
0316 end SPTEST;
