Back to home page

LXR

 
 

    


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;