tmtests/tm24/tmtest.adb

0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 --  TMTEST / BODY
0005 --
0006 --  DESCRIPTION:
0007 --
0008 --  This package is the implementation of Test 24 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
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       ID         : RTEMS.ID;
0058       STATUS     : RTEMS.STATUS_CODES;
0059    begin
0060
0061       TEXT_IO.NEW_LINE( 2 );
0062       TEST_SUPPORT.ADA_TEST_BEGIN;
0063
0064       TIMER_DRIVER.INITIALIZE;
0065          for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0066          loop
0067             TIMER_DRIVER.EMPTY_FUNCTION;
0068          end loop;
0069       TMTEST.OVERHEAD := TIMER_DRIVER.READ_TIMER;
0070
0071       RTEMS.TASKS.CREATE(
0072          RTEMS.BUILD_NAME( 'H', 'I', 'G', 'H' ),
0073          10,
0074          1024,
0075          RTEMS.DEFAULT_MODES,
0076          RTEMS.DEFAULT_ATTRIBUTES,
0077          ID,
0078          STATUS
0079       );
0080       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE HIGH" );
0081
0082       RTEMS.TASKS.START( ID, TMTEST.HIGH_TASK'ACCESS, 0, STATUS );
0083       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START HIGH" );
0084
0085       for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0086       loop
0087
0088          RTEMS.TASKS.CREATE(
0089             RTEMS.BUILD_NAME( 'R', 'E', 'S', 'T' ),
0090             128,
0091             1024,
0092             RTEMS.DEFAULT_MODES,
0093             RTEMS.DEFAULT_ATTRIBUTES,
0094             ID,
0095             STATUS
0096          );
0097          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOOP" );
0098
0099          RTEMS.TASKS.START( ID, TMTEST.TASKS'ACCESS, 0, STATUS );
0100          TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
0101
0102       end loop;
0103
0104       RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0105       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0106
0107    end INIT;
0108
0109 --
0110 --  HIGH_TASK
0111 --
0112
0113    procedure HIGH_TASK (
0114       ARGUMENT : in     RTEMS.TASKS.ARGUMENT
0115    ) is
0116       pragma Unreferenced(ARGUMENT);
0117       STATUS   : RTEMS.STATUS_CODES;
0118    begin
0119
0120       TIMER_DRIVER.INITIALIZE;
0121          for INDEX in 1 .. TIME_TEST_SUPPORT.OPERATION_COUNT
0122          loop
0123             RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
0124          end loop;
0125       TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0126
0127       TIME_TEST_SUPPORT.PUT_TIME(
0128          "TASK_WAKE_AFTER (no context switch)",
0129          TMTEST.END_TIME,
0130          TIME_TEST_SUPPORT.OPERATION_COUNT,
0131          TMTEST.OVERHEAD,
0132          RTEMS_CALLING_OVERHEAD.TASK_WAKE_AFTER
0133       );
0134
0135       TMTEST.TASK_COUNT := 0;
0136
0137       RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0138       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0139
0140    end HIGH_TASK;
0141
0142 --
0143 --  TASKS
0144 --
0145
0146    procedure TASKS (
0147       ARGUMENT : in     RTEMS.TASKS.ARGUMENT
0148    ) is
0149       pragma Unreferenced(ARGUMENT);
0150       STATUS            : RTEMS.STATUS_CODES;
0151    begin
0152
0153       TMTEST.TASK_COUNT := TMTEST.TASK_COUNT + 1;
0154
0155       if TMTEST.TASK_COUNT = 1 then
0156
0157          TIMER_DRIVER.INITIALIZE;
0158
0159       elsif TMTEST.TASK_COUNT = TIME_TEST_SUPPORT.OPERATION_COUNT then
0160          TMTEST.END_TIME := TIMER_DRIVER.READ_TIMER;
0161
0162          TIME_TEST_SUPPORT.PUT_TIME(
0163             "TASK_WAKE_AFTER (context switch)",
0164             TMTEST.END_TIME,
0165             TIME_TEST_SUPPORT.OPERATION_COUNT,
0166             TMTEST.OVERHEAD,
0167          RTEMS_CALLING_OVERHEAD.TASK_WAKE_AFTER
0168          );
0169
0170       TEST_SUPPORT.ADA_TEST_END;
0171          RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0172
0173       end if;
0174
0175       RTEMS.TASKS.WAKE_AFTER( RTEMS.YIELD_PROCESSOR, STATUS );
0176       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0177
0178    end TASKS;
0179
0180 end TMTEST;