Warning, /testsuites/ada/mptests/mp01/mptest.adb is written in an unsupported language. File is not indexed.
0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 -- MPTEST / BODY
0005 --
0006 -- DESCRIPTION:
0007 --
0008 -- This package is the implementation for Test 1 of the RTEMS
0009 -- Multiprocessor 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.CLOCK;
0042 with TEST_SUPPORT;
0043 with TEXT_IO;
0044 with UNSIGNED32_IO;
0045
0046 package body MPTEST is
0047
0048 --
0049 -- INIT
0050 --
0051
0052 procedure INIT (
0053 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0054 ) is
0055 pragma Unreferenced(ARGUMENT);
0056 C : CHARACTER;
0057 TIME : RTEMS.TIME_OF_DAY;
0058 STATUS : RTEMS.STATUS_CODES;
0059 begin
0060
0061 TEXT_IO.NEW_LINE( 2 );
0062 TEST_SUPPORT.ADA_TEST_BEGIN;
0063 TEXT_IO.PUT( "*** NODE " );
0064 UNSIGNED32_IO.PUT(
0065 TEST_SUPPORT.NODE,
0066 WIDTH => 1
0067 );
0068 TEXT_IO.PUT_LINE( " ***" );
0069
0070 if TEST_SUPPORT.NODE /= 1 then
0071 C := 'S';
0072 else
0073 C := 'M';
0074 end if;
0075
0076 MPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME( C, 'A', '1', ' ' );
0077 MPTEST.TASK_NAME( 2 ) := RTEMS.BUILD_NAME( C, 'A', '2', ' ' );
0078 MPTEST.TASK_NAME( 3 ) := RTEMS.BUILD_NAME( C, 'A', '3', ' ' );
0079
0080 TIME := ( 1988, 12, 31, 9, 0, 0, 0 );
0081
0082 RTEMS.CLOCK.SET( TIME, STATUS );
0083 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_SET" );
0084
0085 TEXT_IO.PUT_LINE( "Creating task 1 (Global)" );
0086
0087 RTEMS.TASKS.CREATE(
0088 MPTEST.TASK_NAME( 1 ),
0089 1,
0090 2048,
0091 RTEMS.DEFAULT_MODES,
0092 RTEMS.GLOBAL,
0093 MPTEST.TASK_ID( 1 ),
0094 STATUS
0095 );
0096 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
0097
0098 TEXT_IO.PUT_LINE( "Creating task 2 (Global)" );
0099
0100 RTEMS.TASKS.CREATE(
0101 MPTEST.TASK_NAME( 2 ),
0102 1,
0103 2048,
0104 RTEMS.TIMESLICE,
0105 RTEMS.GLOBAL,
0106 MPTEST.TASK_ID( 2 ),
0107 STATUS
0108 );
0109 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA2" );
0110
0111 TEXT_IO.PUT_LINE( "Creating task 3 (Local)" );
0112
0113 RTEMS.TASKS.CREATE(
0114 MPTEST.TASK_NAME( 3 ),
0115 1,
0116 2048,
0117 RTEMS.DEFAULT_MODES,
0118 RTEMS.DEFAULT_ATTRIBUTES,
0119 MPTEST.TASK_ID( 3 ),
0120 STATUS
0121 );
0122 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA3" );
0123
0124 RTEMS.TASKS.START(
0125 MPTEST.TASK_ID( 1 ),
0126 MPTEST.TEST_TASK'ACCESS,
0127 0,
0128 STATUS
0129 );
0130 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
0131
0132 RTEMS.TASKS.START(
0133 MPTEST.TASK_ID( 2 ),
0134 MPTEST.TEST_TASK'ACCESS,
0135 0,
0136 STATUS
0137 );
0138 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA2" );
0139
0140 RTEMS.TASKS.START(
0141 MPTEST.TASK_ID( 3 ),
0142 MPTEST.TEST_TASK'ACCESS,
0143 0,
0144 STATUS
0145 );
0146 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA3" );
0147
0148 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0149 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0150
0151 end INIT;
0152
0153 --
0154 -- TEST_TASK
0155 --
0156
0157 procedure TEST_TASK (
0158 ARGUMENT : in RTEMS.TASKS.ARGUMENT
0159 ) is
0160 pragma Unreferenced(ARGUMENT);
0161 TIME : RTEMS.TIME_OF_DAY;
0162 TID : RTEMS.ID;
0163 STATUS : RTEMS.STATUS_CODES;
0164 begin
0165
0166 RTEMS.TASKS.IDENT( RTEMS.SELF, RTEMS.SEARCH_ALL_NODES, TID, STATUS );
0167 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF SELF" );
0168
0169 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0170 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0171
0172 TEST_SUPPORT.PUT_NAME(
0173 MPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
0174 FALSE
0175 );
0176
0177 TEST_SUPPORT.PRINT_TIME( "- clock_get - ", TIME, "" );
0178 TEXT_IO.NEW_LINE;
0179
0180 RTEMS.TASKS.WAKE_AFTER(
0181 TEST_SUPPORT.TASK_NUMBER( TID ) * 5 *
0182 TEST_SUPPORT.TICKS_PER_SECOND,
0183 STATUS
0184 );
0185 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_WAKE_AFTER" );
0186
0187 RTEMS.CLOCK.GET_TOD( TIME, STATUS );
0188 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "CLOCK_GET_TOD" );
0189
0190 TEST_SUPPORT.PUT_NAME(
0191 MPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
0192 FALSE
0193 );
0194
0195 TEST_SUPPORT.PRINT_TIME( "- clock_get - ", TIME, "" );
0196 TEXT_IO.NEW_LINE;
0197
0198 if TEST_SUPPORT.TASK_NUMBER( TID ) = 1 then -- TASK 1
0199
0200 TEST_SUPPORT.PUT_NAME(
0201 MPTEST.TASK_NAME( TEST_SUPPORT.TASK_NUMBER( TID ) ),
0202 FALSE
0203 );
0204
0205 TEXT_IO.PUT_LINE( " - deleting self" );
0206
0207 RTEMS.TASKS.DELETE( RTEMS.SELF, STATUS );
0208 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF SELF" );
0209
0210 else if TEST_SUPPORT.TASK_NUMBER( TID ) = 2 then -- TASK 2
0211
0212 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( 2 ), FALSE );
0213 TEXT_IO.PUT( " - waiting to be deleted by " );
0214 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( 3 ), TRUE );
0215
0216 loop
0217 TEST_SUPPORT.DO_NOTHING; -- can't be optimized away
0218 end loop;
0219
0220 else -- TASK 3
0221
0222 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( 3 ), FALSE );
0223 TEXT_IO.PUT( " - getting TID of " );
0224 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( 2 ), TRUE );
0225
0226 RTEMS.TASKS.IDENT(
0227 MPTEST.TASK_NAME( 2 ),
0228 RTEMS.SEARCH_ALL_NODES,
0229 TID,
0230 STATUS
0231 );
0232 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_IDENT OF TA2" );
0233
0234 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( 3 ), FALSE );
0235 TEXT_IO.PUT( " - deleting " );
0236 TEST_SUPPORT.PUT_NAME( MPTEST.TASK_NAME( 2 ), TRUE );
0237
0238 RTEMS.TASKS.DELETE( TID, STATUS );
0239 TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_DELETE OF TA2" );
0240
0241 end if;
0242 end if;
0243
0244 TEST_SUPPORT.ADA_TEST_END;
0245
0246 RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0247
0248 end TEST_TASK;
0249
0250 end MPTEST;
