sptests/sp23/sptest.adb

0001 -- SPDX-License-Identifier: BSD-2-Clause
0002
0003 --
0004 --  SPTEST / BODY
0005 --
0006 --  DESCRIPTION:
0007 --
0008 --  This package is the implementation of Test 23 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 ADDRESS_IO;
0041 with TEST_SUPPORT;
0042 with TEXT_IO;
0043 with UNSIGNED32_IO;
0044 with RTEMS.PORT;
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       INTERNAL_AREA : RTEMS.ADDRESS;
0057       EXTERNAL_AREA : RTEMS.ADDRESS;
0058       STATUS        : RTEMS.STATUS_CODES;
0059    begin
0060
0061       TEXT_IO.NEW_LINE( 2 );
0062       TEST_SUPPORT.ADA_TEST_BEGIN;
0063
0064       SPTEST.TASK_NAME( 1 ) := RTEMS.BUILD_NAME(  'T', 'A', '1', ' ' );
0065
0066       RTEMS.TASKS.CREATE(
0067          SPTEST.TASK_NAME( 1 ),
0068          1,
0069          2048,
0070          RTEMS.DEFAULT_MODES,
0071          RTEMS.DEFAULT_ATTRIBUTES,
0072          SPTEST.TASK_ID( 1 ),
0073          STATUS
0074       );
0075       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_CREATE OF TA1" );
0076
0077       RTEMS.TASKS.START(
0078          SPTEST.TASK_ID( 1 ),
0079          SPTEST.TASK_1'ACCESS,
0080          0,
0081          STATUS
0082       );
0083       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_START OF TA1" );
0084
0085       SPTEST.PORT_NAME( 1 ) := RTEMS.BUILD_NAME(  'D', 'P', '1', ' ' );
0086
0087       INTERNAL_AREA := SPTEST.INTERNAL_PORT_AREA( 0 )'ADDRESS;
0088       EXTERNAL_AREA := SPTEST.EXTERNAL_PORT_AREA( 0 )'ADDRESS;
0089       RTEMS.PORT.CREATE(
0090          SPTEST.PORT_NAME( 1 ),
0091          INTERNAL_AREA,
0092          EXTERNAL_AREA,
0093          SPTEST.INTERNAL_PORT_AREA'LENGTH,
0094          SPTEST.PORT_ID( 1 ),
0095          STATUS
0096       );
0097       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "PORT_CREATE OF DP1" );
0098       TEXT_IO.PUT( "INIT - port_create - DP1 - internal = " );
0099       ADDRESS_IO.PUT( INTERNAL_AREA, WIDTH => 8, BASE => 16 );
0100       TEXT_IO.PUT( " external =  " );
0101       ADDRESS_IO.PUT( EXTERNAL_AREA, WIDTH => 8, BASE => 16 );
0102       TEXT_IO.NEW_LINE;
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 --  TASK_1
0111 --
0112
0113    procedure TASK_1 (
0114       ARGUMENT : in     RTEMS.TASKS.ARGUMENT
0115    ) is
0116       pragma Unreferenced(ARGUMENT);
0117       DPID            : RTEMS.ID;
0118       TO_BE_CONVERTED : RTEMS.ADDRESS;
0119       CONVERTED       : RTEMS.ADDRESS;
0120       STATUS          : RTEMS.STATUS_CODES;
0121    begin
0122
0123       RTEMS.PORT.IDENT( SPTEST.PORT_NAME( 1 ), DPID, STATUS );
0124       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "PORT_IDENT" );
0125       TEXT_IO.PUT( "TA1 - port_ident - " );
0126       UNSIGNED32_IO.PUT( DPID, WIDTH => 8, BASE => 16 );
0127       TEXT_IO.NEW_LINE;
0128
0129       TO_BE_CONVERTED :=  SPTEST.EXTERNAL_PORT_AREA( 16#E# )'ADDRESS;
0130       RTEMS.PORT.EXTERNAL_TO_INTERNAL(
0131          SPTEST.PORT_ID( 1 ),
0132          TO_BE_CONVERTED,
0133          CONVERTED,
0134          STATUS
0135       );
0136       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "PORT_EXTERNAL_TO_INTERNAL" );
0137       TEXT_IO.PUT( "TA1 - port_external_to_internal - external: " );
0138       ADDRESS_IO.PUT( TO_BE_CONVERTED, WIDTH => 8, BASE => 16 );
0139       TEXT_IO.PUT( " => internal: " );
0140       ADDRESS_IO.PUT( CONVERTED, WIDTH => 8, BASE => 16 );
0141       TEXT_IO.NEW_LINE;
0142
0143       TO_BE_CONVERTED :=  SPTEST.INTERNAL_PORT_AREA( 16#E# )'ADDRESS;
0144       RTEMS.PORT.INTERNAL_TO_EXTERNAL(
0145          SPTEST.PORT_ID( 1 ),
0146          TO_BE_CONVERTED,
0147          CONVERTED,
0148          STATUS
0149       );
0150       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "PORT_INTERNAL_TO_EXTERNAL" );
0151       TEXT_IO.PUT( "TA1 - port_internal_to_external - internal: " );
0152       ADDRESS_IO.PUT( TO_BE_CONVERTED, WIDTH => 8, BASE => 16 );
0153       TEXT_IO.PUT( " => external: " );
0154       ADDRESS_IO.PUT( CONVERTED, WIDTH => 8, BASE => 16 );
0155       TEXT_IO.NEW_LINE;
0156
0157       TO_BE_CONVERTED :=  SPTEST.ABOVE_PORT_AREA( 16#E# )'ADDRESS;
0158       RTEMS.PORT.EXTERNAL_TO_INTERNAL(
0159          SPTEST.PORT_ID( 1 ),
0160          TO_BE_CONVERTED,
0161          CONVERTED,
0162          STATUS
0163       );
0164       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "PORT_EXTERNAL_TO_INTERNAL" );
0165       TEXT_IO.PUT( "TA1 - port_external_to_internal - external: " );
0166       ADDRESS_IO.PUT( TO_BE_CONVERTED, WIDTH => 8, BASE => 16 );
0167       TEXT_IO.PUT( " => internal: " );
0168       ADDRESS_IO.PUT( CONVERTED, WIDTH => 8, BASE => 16 );
0169       TEXT_IO.NEW_LINE;
0170
0171       TO_BE_CONVERTED :=  SPTEST.BELOW_PORT_AREA( 16#E# )'ADDRESS;
0172       RTEMS.PORT.INTERNAL_TO_EXTERNAL(
0173          SPTEST.PORT_ID( 1 ),
0174          TO_BE_CONVERTED,
0175          CONVERTED,
0176          STATUS
0177       );
0178       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "PORT_INTERNAL_TO_EXTERNAL" );
0179       TEXT_IO.PUT( "TA1 - port_internal_to_external - internal: " );
0180       ADDRESS_IO.PUT( TO_BE_CONVERTED, WIDTH => 8, BASE => 16 );
0181       TEXT_IO.PUT( " => external: " );
0182       ADDRESS_IO.PUT( CONVERTED, WIDTH => 8, BASE => 16 );
0183       TEXT_IO.NEW_LINE;
0184
0185       TEXT_IO.PUT_LINE( "TA1 - port_delete - DP1" );
0186       RTEMS.PORT.DELETE( SPTEST.PORT_ID( 1 ), STATUS );
0187       TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "PORT_DELETE" );
0188
0189       TEST_SUPPORT.ADA_TEST_END;
0190       RTEMS.SHUTDOWN_EXECUTIVE( 0 );
0191
0192    end TASK_1;
0193
0194 end SPTEST;