Warning, /testsuites/ada/tmtests/tmck/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 Timer Check Test 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 TIMER_DRIVER;
0041 with INTERFACES; use INTERFACES;
0042 with TEST_SUPPORT;
0043 with TEXT_IO;
0044 with TIME_TEST_SUPPORT;
0045 with UNSIGNED32_IO;
0046
0047 package body TMTEST is
0048
0049 --
0050 -- INIT
0051 --
0052
0053 procedure INIT (
0054 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0055 ) is
0056 pragma Unreferenced(ARGUMENT);
0057 STATUS : RTEMS.STATUS_CODES;
0058 begin
0059
0060 TEXT_IO.NEW_LINE( 2 );
0061 TEST_SUPPORT.ADA_TEST_BEGIN;
0062
0063 TIMER_DRIVER.SET_FIND_AVERAGE_OVERHEAD( TRUE );
0064
0065 TMTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
0066
0067 RTEMS.TASKS.CREATE(
0068 TMTEST.TASK_NAME( 1 ),
0069 1,
0070 2048,
0071 RTEMS.DEFAULT_MODES,
0072 RTEMS.DEFAULT_ATTRIBUTES,
0073 TMTEST.TASK_ID( 1 ),
0074 STATUS
0075 );
0076 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
0077
0078 RTEMS.TASKS.START(
0079 TMTEST.TASK_ID( 1 ),
0080 TMTEST.TASK_1'ACCESS,
0081 0,
0082 STATUS
0083 );
0084 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
0085
0086 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0087 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0088
0089 end INIT;
0090
0091 --
0092 -- TASK_1
0093 --
0094
0095 procedure TASK_1 (
0096 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0097 ) is
0098 pragma Unreferenced(ARGUMENT);
0099 begin
0100
0101 TMTEST.CHECK_READ_TIMER;
0102
0103 TEST_SUPPORT.PAUSE;
0104
0105 TIMER_DRIVER.INITIALIZE;
0106 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0107 TIME_TEST_SUPPORT.PUT_TIME(
0108 "NULL timer stopped at",
0109 TMTEST.END_TIME,
0110 1,
0111 0,
0112 0
0113 );
0114
0115 TIMER_DRIVER.INITIALIZE;
0116 for INDEX in 0 .. 1000
0117 loop
0118 TIMER_DRIVER.EMPTY_FUNCTION;
0119 end loop;
0120 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0121 TIME_TEST_SUPPORT.PUT_TIME(
0122 "LOOP (1000) timer stopped at",
0123 TMTEST.END_TIME,
0124 1,
0125 0,
0126 0
0127 );
0128
0129 TIMER_DRIVER.INITIALIZE;
0130 for INDEX in 0 .. 10000
0131 loop
0132 TIMER_DRIVER.EMPTY_FUNCTION;
0133 end loop;
0134 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0135 TIME_TEST_SUPPORT.PUT_TIME(
0136 "LOOP (10000) timer stopped at",
0137 TMTEST.END_TIME,
0138 1,
0139 0,
0140 0
0141 );
0142
0143 TIMER_DRIVER.INITIALIZE;
0144 for INDEX in 0 .. 50000
0145 loop
0146 TIMER_DRIVER.EMPTY_FUNCTION;
0147 end loop;
0148 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0149 TIME_TEST_SUPPORT.PUT_TIME(
0150 "LOOP (50000) timer stopped at",
0151 TMTEST.END_TIME,
0152 1,
0153 0,
0154 0
0155 );
0156
0157 TIMER_DRIVER.INITIALIZE;
0158 for INDEX in 0 .. 100000
0159 loop
0160 TIMER_DRIVER.EMPTY_FUNCTION;
0161 end loop;
0162 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0163 TIME_TEST_SUPPORT.PUT_TIME(
0164 "LOOP (100000) timer stopped at",
0165 TMTEST.END_TIME,
0166 1,
0167 0,
0168 0
0169 );
0170
0171 TEST_SUPPORT.ADA_TEST_END;
0172 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0173
0174 end TASK_1;
0175
0176 --
0177 -- CHECK_READ_TIMER
0178 --
0179
0180 procedure CHECK_READ_TIMER
0181 is
0182 TIME : RTEMS.UNSIGNED32;
0183 begin
0184
0185 for INDEX in TMTEST.DISTRIBUTION'FIRST .. TMTEST.DISTRIBUTION'LAST
0186 loop
0187 TMTEST.DISTRIBUTION( INDEX ) := 0;
0188 end loop;
0189
0190 for INDEX in 1 .. TMTEST.OPERATION_COUNT
0191 loop
0192
0193 loop
0194 TIMER_DRIVER.INITIALIZE;
0195 TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0196
0197 exit when
0198 TMTEST.END_TIME <= RTEMS.UNSIGNED32( TMTEST.DISTRIBUTION'LAST );
0199
0200 TEXT_IO.PUT( "TOO LONG (" );
0201 UNSIGNED32_IO.PUT( TMTEST.END_TIME );
0202 TEXT_IO.PUT_LINE( ")!!!" );
0203 end loop;
0204
0205 TMTEST.DISTRIBUTION( TMTEST.END_TIME ) :=
0206 TMTEST.DISTRIBUTION( TMTEST.END_TIME ) + 1;
0207
0208 end loop;
0209
0210 TEXT_IO.PUT_LINE(
0211 "Units may not be in microseconds for this test!!!"
0212 );
0213
0214 TIME := 0;
0215
0216 for INDEX in TMTEST.DISTRIBUTION'FIRST .. TMTEST.DISTRIBUTION'LAST
0217 loop
0218 if TMTEST.DISTRIBUTION( INDEX ) /= 0 then
0219 TIME := TIME + (TMTEST.DISTRIBUTION( INDEX ) * INDEX);
0220 UNSIGNED32_IO.PUT( INDEX );
0221 TEXT_IO.PUT( " " );
0222 UNSIGNED32_IO.PUT( TMTEST.DISTRIBUTION( INDEX ) );
0223 TEXT_IO.NEW_LINE;
0224 end if;
0225 end loop;
0226
0227 TEXT_IO.PUT( "Total time = " );
0228 UNSIGNED32_IO.PUT( TIME );
0229 TEXT_IO.NEW_LINE;
0230
0231 end CHECK_READ_TIMER;
0232
0233 end TMTEST;