Warning, /testsuites/ada/tmtests/tm08/tmtest.adb is written in an unsupported language. File is not indexed.
0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 -- TMTEST / BODY
0005 --
0006 -- DESCRIPTION:
0007 --
0008 -- This package is the implementation of Test 8 of the RTEMS
0009 -- Timing 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_CALLING_OVERHEAD;
0042 with TEST_SUPPORT;
0043 with TEXT_IO;
0044 with TIME_TEST_SUPPORT;
0045 with TIMER_DRIVER;
0046 with RTEMS.CLOCK;
0047
0048 package body TMTEST 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 TMTEST.TEST_INIT;
0065
0066 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0067 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0068
0069 end INIT;
0070
0071 --
0072 -- TEST_INIT
0073 --
0074
0075 procedure TEST_INIT
0076 is
0077 STATUS : RTEMS.STATUS_CODES;
0078 begin
0079
0080 RTEMS.TASKS.CREATE(
0081 1,
0082 128,
0083 1024,
0084 RTEMS.DEFAULT_OPTIONS,
0085 RTEMS.DEFAULT_ATTRIBUTES,
0086 TASK_ID,
0087 STATUS
0088 );
0089 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0090
0091 RTEMS.TASKS.START( TASK_ID, TMTEST.TEST_TASK'ACCESS, 0, STATUS );
0092 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0093
0094 RTEMS.TASKS.CREATE(
0095 1,
0096 254,
0097 1024,
0098 RTEMS.DEFAULT_OPTIONS,
0099 RTEMS.DEFAULT_ATTRIBUTES,
0100 TASK_ID,
0101 STATUS
0102 );
0103 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE" );
0104
0105 RTEMS.TASKS.START( TASK_ID, TMTEST.TEST_TASK1'ACCESS, 0, STATUS );
0106 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START" );
0107
0108 end TEST_INIT;
0109
0110 --
0111 -- TEST_TASK
0112 --
0113
0114 procedure TEST_TASK (
0115 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0116 ) is
0117 pragma Unreferenced(ARGUMENT);
0118 OVERHEAD : RTEMS.UNSIGNED32;
0119 OLD_PRIORITY : RTEMS.TASKS.PRIORITY;
0120 OLD_MODE : RTEMS.MODE;
0121 TIME : RTEMS.TIME_OF_DAY;
0122 STATUS : RTEMS.STATUS_CODES;
0123 begin
0124
0125 TIMER_DRIVER.INITIALIZE;
0126 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0127 loop
0128 TIMER_DRIVER.EMPTY_FUNCTION;
0129 end loop;
0130 OVERHEAD := TIMER_DRIVER.READ_TIMER;
0131
0132 TIMER_DRIVER.INITIALIZE;
0133 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0134 loop
0135 RTEMS.TASKS.SET_PRIORITY(
0136 TMTEST.TASK_ID,
0137 RTEMS.TASKS.CURRENT_PRIORITY,
0138 OLD_PRIORITY,
0139 STATUS
0140 );
0141 end loop;
0142 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0143 TIME_TEST_SUPPORT.PUT_TIME(
0144 "TASK_SET_PRIORITY current priority",
0145 TMTEST.END_TIME,
0146 TIME_TEST_SUPPORT.OPERATION_COUNT,
0147 OVERHEAD,
0148 RTEMS_CALLING_OVERHEAD.TASK_SET_PRIORITY
0149 );
0150
0151 TIMER_DRIVER.INITIALIZE;
0152 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0153 loop
0154 RTEMS.TASKS.SET_PRIORITY(
0155 TMTEST.TASK_ID,
0156 253,
0157 OLD_PRIORITY,
0158 STATUS
0159 );
0160 end loop;
0161 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0162 TIME_TEST_SUPPORT.PUT_TIME(
0163 "TASK_SET_PRIORITY no preempt",
0164 TMTEST.END_TIME,
0165 TIME_TEST_SUPPORT.OPERATION_COUNT,
0166 OVERHEAD,
0167 RTEMS_CALLING_OVERHEAD.TASK_SET_PRIORITY
0168 );
0169
0170 TIMER_DRIVER.INITIALIZE;
0171 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0172 loop
0173 RTEMS.TASKS.MODE(
0174 RTEMS.CURRENT_MODE,
0175 RTEMS.CURRENT_MODE,
0176 OLD_MODE,
0177 STATUS
0178 );
0179 end loop;
0180 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0181 TIME_TEST_SUPPORT.PUT_TIME(
0182 "TASK_MODE (current)",
0183 TMTEST.END_TIME,
0184 TIME_TEST_SUPPORT.OPERATION_COUNT,
0185 OVERHEAD,
0186 RTEMS_CALLING_OVERHEAD.TASK_MODE
0187 );
0188
0189 TIMER_DRIVER.INITIALIZE;
0190 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0191 loop
0192 RTEMS.TASKS.MODE(
0193 RTEMS.INTERRUPT_LEVEL( 1 ),
0194 RTEMS.INTERRUPT_MASK,
0195 OLD_MODE,
0196 STATUS
0197 );
0198 RTEMS.TASKS.MODE(
0199 RTEMS.INTERRUPT_LEVEL( 0 ),
0200 RTEMS.INTERRUPT_MASK,
0201 OLD_MODE,
0202 STATUS
0203 );
0204 end loop;
0205 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0206 TIME_TEST_SUPPORT.PUT_TIME(
0207 "TASK_MODE (no reschedule)",
0208 TMTEST.END_TIME,
0209 TIME_TEST_SUPPORT.OPERATION_COUNT * 2,
0210 OVERHEAD,
0211 RTEMS_CALLING_OVERHEAD.TASK_MODE
0212 );
0213
0214 TIMER_DRIVER.INITIALIZE;
0215 RTEMS.TASKS.MODE(
0216 RTEMS.NO_ASR,
0217 RTEMS.ASR_MASK,
0218 OLD_MODE,
0219 STATUS
0220 );
0221 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0222 TIME_TEST_SUPPORT.PUT_TIME(
0223 "TASK_MODE (reschedule)",
0224 TMTEST.END_TIME,
0225 1,
0226 0,
0227 RTEMS_CALLING_OVERHEAD.TASK_MODE
0228 );
0229
0230 RTEMS.TASKS.MODE(
0231 RTEMS.NO_PREEMPT,
0232 RTEMS.PREEMPT_MASK,
0233 OLD_MODE,
0234 STATUS
0235 );
0236 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" );
0237
0238 RTEMS.TASKS.SET_PRIORITY(
0239 TMTEST.TASK_ID,
0240 1,
0241 OLD_PRIORITY,
0242 STATUS
0243 );
0244 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SET_PRIORITY" );
0245
0246 TIMER_DRIVER.INITIALIZE;
0247 RTEMS.TASKS.MODE( -- preempted by TEST_TASK1
0248 RTEMS.PREEMPT,
0249 RTEMS.PREEMPT_MASK,
0250 OLD_MODE,
0251 STATUS
0252 );
0253
0254 TIME := (1988, 1, 1, 0, 0, 0, 0 );
0255
0256 TIMER_DRIVER.INITIALIZE;
0257 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0258 loop
0259 RTEMS.CLOCK.SET(
0260 TIME,
0261 STATUS
0262 );
0263 end loop;
0264 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0265 TIME_TEST_SUPPORT.PUT_TIME(
0266 "CLOCK_SET",
0267 TMTEST.END_TIME,
0268 TIME_TEST_SUPPORT.OPERATION_COUNT,
0269 OVERHEAD,
0270 RTEMS_CALLING_OVERHEAD.CLOCK_SET
0271 );
0272
0273 TIMER_DRIVER.INITIALIZE;
0274 for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0275 loop
0276 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0277 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0278 end loop;
0279 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0280 TIME_TEST_SUPPORT.PUT_TIME(
0281 "CLOCK_GET_TOD",
0282 TMTEST.END_TIME,
0283 TIME_TEST_SUPPORT.OPERATION_COUNT,
0284 OVERHEAD,
0285 RTEMS_CALLING_OVERHEAD.CLOCK_GET
0286 );
0287
0288 TEST_SUPPORT.ADA_TEST_END;
0289 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0290
0291 end TEST_TASK;
0292
0293 --
0294 -- TEST_TASK1
0295 --
0296
0297 procedure TEST_TASK1 (
0298 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0299 ) is
0300 pragma Unreferenced(ARGUMENT);
0301 STATUS : RTEMS.STATUS_CODES;
0302 begin
0303
0304 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0305 TIME_TEST_SUPPORT.PUT_TIME(
0306 "TASK_MODE (preemptive) ",
0307 TMTEST.END_TIME,
0308 1,
0309 0,
0310 RTEMS_CALLING_OVERHEAD.TASK_MODE
0311 );
0312
0313 RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
0314 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "DOES NOT RETURN" );
0315
0316 end TEST_TASK1;
0317
0318 end TMTEST;
