Warning, /testsuites/ada/sptests/sp24/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 24 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 RTEMS.CLOCK;
0044 with RTEMS.TIMER;
0045
0046 package body SPTEST is
0047
0048 --
0049 -- INIT
0050 --
0051
0052 procedure INIT (
0053 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0054 ) is
0055 pragma Unreferenced(ARGUMENT);
0056 TIME : RTEMS.TIME_OF_DAY;
0057 STATUS : RTEMS.STATUS_CODES;
0058 begin
0059
0060 TEXT_IO.NEW_LINE( 2 );
0061 TEST_SUPPORT.ADA_TEST_BEGIN;
0062
0063 TIME := ( 1988, 12, 31, 9, 0, 0, 0 );
0064
0065 RTEMS.CLOCK.SET( TIME, STATUS );
0066 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_SET" );
0067
0068 SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'A', '1', ' ' );
0069 SPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'A', '2', ' ' );
0070 SPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME( 'T', 'A', '3', ' ' );
0071
0072 SPTEST.TIMER_NAME( 1 ) := RTEMS.BUILD_NAME( 'T', 'M', '1', ' ' );
0073 SPTEST.TIMER_NAME( 2 ) := RTEMS.BUILD_NAME( 'T', 'M', '2', ' ' );
0074 SPTEST.TIMER_NAME( 3 ) := RTEMS.BUILD_NAME( 'T', 'M', '3', ' ' );
0075
0076 for INDEX in 1 .. 3
0077 loop
0078
0079 RTEMS.TASKS.CREATE(
0080 SPTEST.TASK_NAME( INDEX ),
0081 1,
0082 2048,
0083 RTEMS.DEFAULT_MODES,
0084 RTEMS.DEFAULT_ATTRIBUTES,
0085 SPTEST.TASK_ID( INDEX ),
0086 STATUS
0087 );
0088 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE LOOP" );
0089
0090 RTEMS.TIMER.CREATE(
0091 SPTEST.TIMER_NAME( INDEX ),
0092 SPTEST.TIMER_ID( INDEX ),
0093 STATUS
0094 );
0095 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_CREATE LOOP" );
0096
0097 end loop;
0098
0099 for INDEX in 1 .. 3
0100 loop
0101
0102 RTEMS.TASKS.START(
0103 SPTEST.TASK_ID( INDEX ),
0104 SPTEST.TASK_1_THROUGH_3'ACCESS,
0105 RTEMS.TASKS.ARGUMENT( INDEX ),
0106 STATUS
0107 );
0108 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START LOOP" );
0109
0110 end loop;
0111
0112 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0113 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0114
0115 end INIT;
0116
0117 --
0118 -- RESUME_TASK
0119 --
0120
0121 procedure RESUME_TASK (
0122 TIMER_ID : in RTEMS.ID;
0123 IGNORED_ADDRESS : in RTEMS.ADDRESS
0124 ) is
0125 pragma Unreferenced(IGNORED_ADDRESS);
0126 TASK_TO_RESUME : RTEMS.ID;
0127 STATUS : RTEMS.STATUS_CODES;
0128 begin
0129
0130 TASK_TO_RESUME := SPTEST.TASK_ID(INTEGER( RTEMS.GET_INDEX( TIMER_ID ) ));
0131 RTEMS.TASKS.RESUME( TASK_TO_RESUME, STATUS );
0132 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_RESUME" );
0133
0134 end RESUME_TASK;
0135
0136 --
0137 -- TASK_1_THROUGH_3
0138 --
0139
0140 procedure TASK_1_THROUGH_3 (
0141 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0142 ) is
0143 TID : RTEMS.ID;
0144 TIME : RTEMS.TIME_OF_DAY;
0145 STATUS : RTEMS.STATUS_CODES;
0146 begin
0147
0148 RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
0149 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
0150
0151 loop
0152
0153 RTEMS.TIMER.FIRE_AFTER(
0154 SPTEST.TIMER_ID( INTEGER( ARGUMENT ) ),
0155 TEST_SUPPORT.TASK_NUMBER( TID ) * 5 *
0156 TEST_SUPPORT.TICKS_PER_SECOND,
0157 SPTEST.RESUME_TASK'ACCESS,
0158 RTEMS.NULL_ADDRESS,
0159 STATUS
0160 );
0161 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TIMER_FIRE_AFTER" );
0162
0163 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0164 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0165
0166 if TIME.SECOND >= 35 then
0167 TEST_SUPPORT.ADA_TEST_END;
0168 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0169 end if;
0170
0171 TEST_SUPPORT.PUT_NAME(
0172 SPTEST.TASK_NAME( INTEGER( TEST_SUPPORT.TASK_NUMBER( TID ) ) ),
0173 FALSE
0174 );
0175
0176 TEST_SUPPORT.PRINT_TIME( " - clock_get - ", TIME, "" );
0177 TEXT_IO.NEW_LINE;
0178
0179 RTEMS.TASKS.SUSPEND( RTEMS.SELF, STATUS );
0180 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_SUSPEND" );
0181
0182 end loop;
0183
0184 end TASK_1_THROUGH_3;
0185
0186 end SPTEST;
