From f51594897cd2915b856e57cc0a066f929ab22209 Mon Sep 17 00:00:00 2001 From: Sebastian Huber Date: Tue, 12 Nov 2019 07:08:39 +0100 Subject: ada/mptests: Make them compile clean Fix all warnings. Update #3818. --- testsuites/ada/mptests/mp01/mptest.adb | 4 +- testsuites/ada/mptests/mp03/mptest.adb | 4 +- testsuites/ada/mptests/mp04/mptest.adb | 4 +- testsuites/ada/mptests/mp05/mptest.adb | 8 ++-- testsuites/ada/mptests/mp05/mptest.ads | 1 - testsuites/ada/mptests/mp06/mptest.adb | 6 +-- testsuites/ada/mptests/mp06/mptest.ads | 1 - testsuites/ada/mptests/mp07/mptest.adb | 6 +-- testsuites/ada/mptests/mp08/mptest.adb | 7 ++-- testsuites/ada/mptests/mp09/mptest.adb | 74 +++++++++++++++++++++------------- testsuites/ada/mptests/mp09/mptest.ads | 37 +++++++++++------ testsuites/ada/mptests/mp10/mptest.adb | 19 +++++---- testsuites/ada/mptests/mp10/mptest.ads | 13 ++++++ testsuites/ada/mptests/mp11/mptest.adb | 7 ++-- testsuites/ada/mptests/mp12/mptest.adb | 3 +- testsuites/ada/mptests/mp13/mptest.adb | 20 +++++---- testsuites/ada/mptests/mp13/mptest.ads | 13 ++++++ testsuites/ada/mptests/mp14/mptest.adb | 73 +++++++++++++-------------------- testsuites/ada/mptests/mp14/mptest.ads | 22 +++++++++- 19 files changed, 195 insertions(+), 127 deletions(-) diff --git a/testsuites/ada/mptests/mp01/mptest.adb b/testsuites/ada/mptests/mp01/mptest.adb index 457a21f58e..a652428ee7 100644 --- a/testsuites/ada/mptests/mp01/mptest.adb +++ b/testsuites/ada/mptests/mp01/mptest.adb @@ -19,9 +19,7 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.CLOCK; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -35,6 +33,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); C : CHARACTER; TIME : RTEMS.TIME_OF_DAY; STATUS : RTEMS.STATUS_CODES; @@ -139,6 +138,7 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); TIME : RTEMS.TIME_OF_DAY; TID : RTEMS.ID; STATUS : RTEMS.STATUS_CODES; diff --git a/testsuites/ada/mptests/mp03/mptest.adb b/testsuites/ada/mptests/mp03/mptest.adb index 821512e175..023248ec27 100644 --- a/testsuites/ada/mptests/mp03/mptest.adb +++ b/testsuites/ada/mptests/mp03/mptest.adb @@ -15,9 +15,7 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.EVENT; -with RTEMS.TASKS; with RTEMS.TIMER; with TEST_SUPPORT; with TEXT_IO; @@ -32,6 +30,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -106,6 +105,7 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); TID : RTEMS.ID; STATUS : RTEMS.STATUS_CODES; begin diff --git a/testsuites/ada/mptests/mp04/mptest.adb b/testsuites/ada/mptests/mp04/mptest.adb index f888a4b324..a57ad56885 100644 --- a/testsuites/ada/mptests/mp04/mptest.adb +++ b/testsuites/ada/mptests/mp04/mptest.adb @@ -19,8 +19,6 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -34,6 +32,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -86,6 +85,7 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); TID : RTEMS.ID; PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY; PREVIOUS_PRIORITY_1 : RTEMS.TASKS.PRIORITY; diff --git a/testsuites/ada/mptests/mp05/mptest.adb b/testsuites/ada/mptests/mp05/mptest.adb index a5c0818594..4f3ead3d23 100644 --- a/testsuites/ada/mptests/mp05/mptest.adb +++ b/testsuites/ada/mptests/mp05/mptest.adb @@ -19,10 +19,8 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.FATAL; with RTEMS.SIGNAL; -with RTEMS.TASKS; with RTEMS.TIMER; with TEST_SUPPORT; with TEXT_IO; @@ -37,6 +35,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -139,6 +138,7 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -212,9 +212,9 @@ package body MPTEST is loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; - if MPTEST.SIGNAL_CAUGHT = TRUE then + if MPTEST.SIGNAL_CAUGHT then MPTEST.SIGNAL_CAUGHT := FALSE; MPTEST.SIGNAL_COUNT := MPTEST.SIGNAL_COUNT + 1; diff --git a/testsuites/ada/mptests/mp05/mptest.ads b/testsuites/ada/mptests/mp05/mptest.ads index 13d5ced1d6..1aecb5cc39 100644 --- a/testsuites/ada/mptests/mp05/mptest.ads +++ b/testsuites/ada/mptests/mp05/mptest.ads @@ -19,7 +19,6 @@ -- with RTEMS; -with RTEMS.SIGNAL; with RTEMS.TASKS; package MPTEST is diff --git a/testsuites/ada/mptests/mp06/mptest.adb b/testsuites/ada/mptests/mp06/mptest.adb index 378d46f8f7..9ac790e414 100644 --- a/testsuites/ada/mptests/mp06/mptest.adb +++ b/testsuites/ada/mptests/mp06/mptest.adb @@ -19,9 +19,7 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.EVENT; -with RTEMS.TASKS; with RTEMS.TIMER; with TEST_SUPPORT; with TEXT_IO; @@ -36,6 +34,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -112,6 +111,7 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); COUNT : RTEMS.UNSIGNED32; EVENT_OUT : RTEMS.EVENT_SET; EVENT_FOR_THIS_ITERATION : RTEMS.EVENT_SET; @@ -163,7 +163,7 @@ package body MPTEST is loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; EVENT_FOR_THIS_ITERATION := MPTEST.EVENT_SET_TABLE( diff --git a/testsuites/ada/mptests/mp06/mptest.ads b/testsuites/ada/mptests/mp06/mptest.ads index 5c3668d3ac..ef1f4750d9 100644 --- a/testsuites/ada/mptests/mp06/mptest.ads +++ b/testsuites/ada/mptests/mp06/mptest.ads @@ -19,7 +19,6 @@ -- with RTEMS; -with RTEMS.EVENT; with RTEMS.TASKS; package MPTEST is diff --git a/testsuites/ada/mptests/mp07/mptest.adb b/testsuites/ada/mptests/mp07/mptest.adb index 7354e56791..51e3999f2d 100644 --- a/testsuites/ada/mptests/mp07/mptest.adb +++ b/testsuites/ada/mptests/mp07/mptest.adb @@ -19,9 +19,7 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.EVENT; -with RTEMS.TASKS; with RTEMS.TIMER; with TEST_SUPPORT; with TEXT_IO; @@ -36,6 +34,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -108,6 +107,7 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); EVENT_OUT : RTEMS.EVENT_SET; STATUS : RTEMS.STATUS_CODES; begin @@ -159,7 +159,7 @@ package body MPTEST is loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; for COUNT in 1 .. MPTEST.PER_DOT loop diff --git a/testsuites/ada/mptests/mp08/mptest.adb b/testsuites/ada/mptests/mp08/mptest.adb index a812c0904d..1aef8eb905 100644 --- a/testsuites/ada/mptests/mp08/mptest.adb +++ b/testsuites/ada/mptests/mp08/mptest.adb @@ -19,10 +19,7 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; -with RTEMS.OBJECT; with RTEMS.SEMAPHORE; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -36,6 +33,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -61,6 +59,7 @@ package body MPTEST is MPTEST.SEMAPHORE_NAME( 1 ), 1, RTEMS.GLOBAL, + RTEMS.TASKS.NO_PRIORITY, MPTEST.SEMAPHORE_ID( 1 ), STATUS ); @@ -102,7 +101,7 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is - DOTS : RTEMS.UNSIGNED32; + pragma Unreferenced(ARGUMENT); COUNT : RTEMS.UNSIGNED32; STATUS : RTEMS.STATUS_CODES; begin diff --git a/testsuites/ada/mptests/mp09/mptest.adb b/testsuites/ada/mptests/mp09/mptest.adb index 742f059d9d..d3bbe48c73 100644 --- a/testsuites/ada/mptests/mp09/mptest.adb +++ b/testsuites/ada/mptests/mp09/mptest.adb @@ -19,10 +19,7 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.MESSAGE_QUEUE; -with RTEMS.OBJECT; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -36,6 +33,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -48,20 +46,15 @@ package body MPTEST is ); TEXT_IO.PUT_LINE( " ***" ); - MPTEST.RECEIVE_BUFFER := - RTEMS.TO_BUFFER_POINTER( MPTEST.RECEIVE_BUFFER_AREA'ADDRESS ); + MPTEST.RECEIVE_BUFFER := MPTEST.RECEIVE_BUFFER_AREA'ADDRESS; - MPTEST.BUFFER_1 := - RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_1'ADDRESS ); + MPTEST.BUFFER_1 := MPTEST.BUFFER_AREA_1'ADDRESS; - MPTEST.BUFFER_2 := - RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_2'ADDRESS ); + MPTEST.BUFFER_2 := MPTEST.BUFFER_AREA_2'ADDRESS; - MPTEST.BUFFER_3 := - RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_3'ADDRESS ); + MPTEST.BUFFER_3 := MPTEST.BUFFER_AREA_3'ADDRESS; - MPTEST.BUFFER_4 := - RTEMS.TO_BUFFER_POINTER( MPTEST.BUFFER_AREA_4'ADDRESS ); + MPTEST.BUFFER_4 := MPTEST.BUFFER_AREA_4'ADDRESS; MPTEST.FILL_BUFFER( "123456789012345 ", MPTEST.BUFFER_AREA_1 ); MPTEST.FILL_BUFFER( "abcdefghijklmno ", MPTEST.BUFFER_AREA_2 ); @@ -79,7 +72,8 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.CREATE( MPTEST.QUEUE_NAME( 1 ), 3, - RTEMS.GLOBAL + RTEMS.LIMIT, + 3, + RTEMS.GLOBAL, MPTEST.QUEUE_ID( 1 ), STATUS ); @@ -130,6 +124,7 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.SEND( MPTEST.QUEUE_ID( 1 ), MPTEST.BUFFER_1, + 16, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" ); @@ -148,6 +143,7 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.URGENT( MPTEST.QUEUE_ID( 1 ), MPTEST.BUFFER_2, + 16, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_URGENT" ); @@ -166,6 +162,7 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.BROADCAST( MPTEST.QUEUE_ID( 1 ), MPTEST.BUFFER_3, + 16, BROADCAST_COUNT, STATUS ); @@ -185,8 +182,8 @@ package body MPTEST is -- procedure RECEIVE_MESSAGES is - INDEX : RTEMS.UNSIGNED32; STATUS : RTEMS.STATUS_CODES; + MESSAGE_SIZE : RTEMS.SIZE := 0; begin for INDEX in 1 .. 3 @@ -198,6 +195,7 @@ package body MPTEST is MPTEST.RECEIVE_BUFFER, RTEMS.DEFAULT_OPTIONS, RTEMS.NO_TIMEOUT, + MESSAGE_SIZE, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" ); @@ -225,19 +223,37 @@ package body MPTEST is procedure FILL_BUFFER ( SOURCE : in STRING; - BUFFER : out RTEMS.BUFFER + BUFFER : out MPTEST.BUFFER ) is - SOURCE_BUFFER : RTEMS.BUFFER_POINTER; begin - SOURCE_BUFFER := RTEMS.TO_BUFFER_POINTER( - SOURCE( SOURCE'FIRST )'ADDRESS - ); + BUFFER.FIELD1 := RTEMS.BUILD_NAME( + SOURCE( SOURCE'FIRST ), + SOURCE( SOURCE'FIRST + 1 ), + SOURCE( SOURCE'FIRST + 2 ), + SOURCE( SOURCE'FIRST + 3 ) + ); + + BUFFER.FIELD2 := RTEMS.BUILD_NAME( + SOURCE( SOURCE'FIRST + 4 ), + SOURCE( SOURCE'FIRST + 5 ), + SOURCE( SOURCE'FIRST + 6 ), + SOURCE( SOURCE'FIRST + 7 ) + ); - BUFFER.FIELD1 := SOURCE_BUFFER.FIELD1; - BUFFER.FIELD2 := SOURCE_BUFFER.FIELD2; - BUFFER.FIELD3 := SOURCE_BUFFER.FIELD3; - BUFFER.FIELD4 := SOURCE_BUFFER.FIELD4; + BUFFER.FIELD3 := RTEMS.BUILD_NAME( + SOURCE( SOURCE'FIRST + 8 ), + SOURCE( SOURCE'FIRST + 9 ), + SOURCE( SOURCE'FIRST + 10 ), + SOURCE( SOURCE'FIRST + 11 ) + ); + + BUFFER.FIELD4 := RTEMS.BUILD_NAME( + SOURCE( SOURCE'FIRST + 12 ), + SOURCE( SOURCE'FIRST + 13 ), + SOURCE( SOURCE'FIRST + 14 ), + SOURCE( SOURCE'FIRST + 15 ) + ); end FILL_BUFFER; @@ -250,7 +266,7 @@ package body MPTEST is -- procedure PUT_BUFFER ( - BUFFER : in RTEMS.BUFFER + BUFFER : in MPTEST.BUFFER ) is begin @@ -268,8 +284,10 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is - COUNT : RTEMS.UNSIGNED32; - STATUS : RTEMS.STATUS_CODES; + pragma Unreferenced(ARGUMENT); + COUNT : RTEMS.UNSIGNED32; + STATUS : RTEMS.STATUS_CODES; + MESSAGE_SIZE : RTEMS.SIZE := 0; begin RTEMS.TASKS.WAKE_AFTER( 1 * TEST_SUPPORT.TICKS_PER_SECOND, STATUS ); @@ -322,6 +340,7 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.SEND( MPTEST.QUEUE_ID( 1 ), MPTEST.BUFFER_1, + 16, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" ); @@ -340,6 +359,7 @@ package body MPTEST is MPTEST.RECEIVE_BUFFER, RTEMS.DEFAULT_OPTIONS, RTEMS.NO_TIMEOUT, + MESSAGE_SIZE, STATUS ); TEST_SUPPORT.FATAL_DIRECTIVE_STATUS( diff --git a/testsuites/ada/mptests/mp09/mptest.ads b/testsuites/ada/mptests/mp09/mptest.ads index 360aebb491..c324ed08c3 100644 --- a/testsuites/ada/mptests/mp09/mptest.ads +++ b/testsuites/ada/mptests/mp09/mptest.ads @@ -23,6 +23,19 @@ with RTEMS.TASKS; package MPTEST is +-- +-- Buffer Record similar to that used by RTEMS 3.2.1. Using this +-- avoids changes to the test. +-- + + type BUFFER is + record + FIELD1 : RTEMS.NAME; -- TEMPORARY UNTIL VARIABLE LENGTH + FIELD2 : RTEMS.NAME; + FIELD3 : RTEMS.NAME; + FIELD4 : RTEMS.NAME; + end record; + -- -- These arrays contain the IDs and NAMEs of all RTEMS tasks created -- by this test. @@ -44,17 +57,17 @@ package MPTEST is -- and pointers to those buffers. -- - RECEIVE_BUFFER_AREA : RTEMS.BUFFER; - BUFFER_AREA_1 : RTEMS.BUFFER; - BUFFER_AREA_2 : RTEMS.BUFFER; - BUFFER_AREA_3 : RTEMS.BUFFER; - BUFFER_AREA_4 : RTEMS.BUFFER; + RECEIVE_BUFFER_AREA : MPTEST.BUFFER; + BUFFER_AREA_1 : MPTEST.BUFFER; + BUFFER_AREA_2 : MPTEST.BUFFER; + BUFFER_AREA_3 : MPTEST.BUFFER; + BUFFER_AREA_4 : MPTEST.BUFFER; - RECEIVE_BUFFER : RTEMS.BUFFER_POINTER; - BUFFER_1 : RTEMS.BUFFER_POINTER; - BUFFER_2 : RTEMS.BUFFER_POINTER; - BUFFER_3 : RTEMS.BUFFER_POINTER; - BUFFER_4 : RTEMS.BUFFER_POINTER; + RECEIVE_BUFFER : RTEMS.ADDRESS; + BUFFER_1 : RTEMS.ADDRESS; + BUFFER_2 : RTEMS.ADDRESS; + BUFFER_3 : RTEMS.ADDRESS; + BUFFER_4 : RTEMS.ADDRESS; -- -- This variable contains the ID of the remote task with which this @@ -119,7 +132,7 @@ package MPTEST is procedure FILL_BUFFER ( SOURCE : in STRING; - BUFFER : out RTEMS.BUFFER + BUFFER : out MPTEST.BUFFER ); -- @@ -131,7 +144,7 @@ package MPTEST is -- procedure PUT_BUFFER ( - BUFFER : in RTEMS.BUFFER + BUFFER : in MPTEST.BUFFER ); -- diff --git a/testsuites/ada/mptests/mp10/mptest.adb b/testsuites/ada/mptests/mp10/mptest.adb index a105fe8ca6..70dfcab3e8 100644 --- a/testsuites/ada/mptests/mp10/mptest.adb +++ b/testsuites/ada/mptests/mp10/mptest.adb @@ -19,10 +19,8 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.MESSAGE_QUEUE; with RTEMS.SEMAPHORE; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -36,6 +34,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -63,7 +62,8 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.CREATE( MPTEST.QUEUE_NAME( 1 ), 3, - RTEMS.GLOBAL + RTEMS.LIMIT, + 3, + RTEMS.GLOBAL, MPTEST.QUEUE_ID( 1 ), STATUS ); @@ -74,6 +74,7 @@ package body MPTEST is MPTEST.SEMAPHORE_NAME( 1 ), 0, RTEMS.GLOBAL + RTEMS.PRIORITY, + RTEMS.TASKS.NO_PRIORITY, MPTEST.SEMAPHORE_ID( 1 ), STATUS ); @@ -178,14 +179,14 @@ package body MPTEST is procedure TEST_TASK_1 ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is - COUNT : RTEMS.UNSIGNED32; - RECEIVE_BUFFER_AREA : RTEMS.BUFFER; - RECEIVE_BUFFER : RTEMS.BUFFER_POINTER; + pragma Unreferenced(ARGUMENT); + RECEIVE_BUFFER_AREA : MPTEST.BUFFER; + RECEIVE_BUFFER : RTEMS.ADDRESS; STATUS : RTEMS.STATUS_CODES; + MESSAGE_SIZE : RTEMS.SIZE := 0; begin - RECEIVE_BUFFER := - RTEMS.TO_BUFFER_POINTER( RECEIVE_BUFFER_AREA'ADDRESS ); + RECEIVE_BUFFER := RECEIVE_BUFFER_AREA'ADDRESS; TEXT_IO.PUT_LINE( "Getting QID of message queue" ); @@ -208,6 +209,7 @@ package body MPTEST is RECEIVE_BUFFER, RTEMS.DEFAULT_OPTIONS, RTEMS.NO_TIMEOUT, + MESSAGE_SIZE, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_RECEIVE" ); @@ -221,6 +223,7 @@ package body MPTEST is procedure TEST_TASK_2 ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin diff --git a/testsuites/ada/mptests/mp10/mptest.ads b/testsuites/ada/mptests/mp10/mptest.ads index 05764ebf0b..ee5c1bab65 100644 --- a/testsuites/ada/mptests/mp10/mptest.ads +++ b/testsuites/ada/mptests/mp10/mptest.ads @@ -23,6 +23,19 @@ with RTEMS.TASKS; package MPTEST is +-- +-- Buffer Record similar to that used by RTEMS 3.2.1. Using this +-- avoids changes to the test. +-- + + type BUFFER is + record + FIELD1 : RTEMS.NAME; -- TEMPORARY UNTIL VARIABLE LENGTH + FIELD2 : RTEMS.NAME; + FIELD3 : RTEMS.NAME; + FIELD4 : RTEMS.NAME; + end record; + -- -- These arrays contain the IDs and NAMEs of all RTEMS tasks created -- by this test. diff --git a/testsuites/ada/mptests/mp11/mptest.adb b/testsuites/ada/mptests/mp11/mptest.adb index 95b6904311..8f6833548a 100644 --- a/testsuites/ada/mptests/mp11/mptest.adb +++ b/testsuites/ada/mptests/mp11/mptest.adb @@ -19,11 +19,9 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.MESSAGE_QUEUE; with RTEMS.PARTITION; with RTEMS.SEMAPHORE; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -37,6 +35,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -81,7 +80,8 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.CREATE( MPTEST.QUEUE_NAME( 1 ), 3, - RTEMS.GLOBAL + RTEMS.LIMIT, + 3, + RTEMS.GLOBAL, MPTEST.QUEUE_ID( 1 ), STATUS ); @@ -99,6 +99,7 @@ package body MPTEST is MPTEST.SEMAPHORE_NAME( 1 ), 1, RTEMS.GLOBAL, + RTEMS.TASKS.NO_PRIORITY, MPTEST.SEMAPHORE_ID( 1 ), STATUS ); diff --git a/testsuites/ada/mptests/mp12/mptest.adb b/testsuites/ada/mptests/mp12/mptest.adb index 46f474fd5b..7d5a86a4c6 100644 --- a/testsuites/ada/mptests/mp12/mptest.adb +++ b/testsuites/ada/mptests/mp12/mptest.adb @@ -19,9 +19,7 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.PARTITION; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -35,6 +33,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); BUFFER_ADDRESS : RTEMS.ADDRESS; STATUS : RTEMS.STATUS_CODES; begin diff --git a/testsuites/ada/mptests/mp13/mptest.adb b/testsuites/ada/mptests/mp13/mptest.adb index a1b33551ff..b69d5ca4b6 100644 --- a/testsuites/ada/mptests/mp13/mptest.adb +++ b/testsuites/ada/mptests/mp13/mptest.adb @@ -19,10 +19,8 @@ -- with INTERFACES; use INTERFACES; -with RTEMS; with RTEMS.MESSAGE_QUEUE; with RTEMS.SEMAPHORE; -with RTEMS.TASKS; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; @@ -36,6 +34,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin @@ -61,7 +60,8 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.CREATE( MPTEST.QUEUE_NAME( 1 ), 3, - RTEMS.GLOBAL + RTEMS.LIMIT, + 3, + RTEMS.GLOBAL, MPTEST.QUEUE_ID( 1 ), STATUS ); @@ -72,6 +72,7 @@ package body MPTEST is MPTEST.SEMAPHORE_NAME( 1 ), 1, RTEMS.GLOBAL + RTEMS.PRIORITY, + RTEMS.TASKS.NO_PRIORITY, MPTEST.SEMAPHORE_ID( 1 ), STATUS ); @@ -153,14 +154,14 @@ package body MPTEST is procedure TEST_TASK_1 ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is - COUNT : RTEMS.UNSIGNED32; - RECEIVE_BUFFER_AREA : RTEMS.BUFFER; - RECEIVE_BUFFER : RTEMS.BUFFER_POINTER; + pragma Unreferenced(ARGUMENT); + RECEIVE_BUFFER_AREA : MPTEST.BUFFER; + RECEIVE_BUFFER : RTEMS.ADDRESS; STATUS : RTEMS.STATUS_CODES; + MESSAGE_SIZE : RTEMS.SIZE := 0; begin - RECEIVE_BUFFER := - RTEMS.TO_BUFFER_POINTER( RECEIVE_BUFFER_AREA'ADDRESS ); + RECEIVE_BUFFER := RECEIVE_BUFFER_AREA'ADDRESS; TEXT_IO.PUT_LINE( "Getting QID of message queue" ); @@ -185,6 +186,7 @@ package body MPTEST is RECEIVE_BUFFER, RTEMS.DEFAULT_OPTIONS, RTEMS.NO_TIMEOUT, + MESSAGE_SIZE, STATUS ); TEXT_IO.PUT_LINE( "How did I get back from here???" ); @@ -201,6 +203,7 @@ package body MPTEST is RECEIVE_BUFFER, RTEMS.DEFAULT_OPTIONS, 2 * TEST_SUPPORT.TICKS_PER_SECOND, + MESSAGE_SIZE, STATUS ); TEST_SUPPORT.FATAL_DIRECTIVE_STATUS( @@ -231,6 +234,7 @@ package body MPTEST is procedure TEST_TASK_2 ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; begin diff --git a/testsuites/ada/mptests/mp13/mptest.ads b/testsuites/ada/mptests/mp13/mptest.ads index 8caa2347c9..14246b6aef 100644 --- a/testsuites/ada/mptests/mp13/mptest.ads +++ b/testsuites/ada/mptests/mp13/mptest.ads @@ -23,6 +23,19 @@ with RTEMS.TASKS; package MPTEST is +-- +-- Buffer Record similar to that used by RTEMS 3.2.1. Using this +-- avoids changes to the test. +-- + + type BUFFER is + record + FIELD1 : RTEMS.NAME; -- TEMPORARY UNTIL VARIABLE LENGTH + FIELD2 : RTEMS.NAME; + FIELD3 : RTEMS.NAME; + FIELD4 : RTEMS.NAME; + end record; + -- -- These arrays contain the IDs and NAMEs of all RTEMS tasks created -- by this test. diff --git a/testsuites/ada/mptests/mp14/mptest.adb b/testsuites/ada/mptests/mp14/mptest.adb index 248ef9f2ad..4684c2b0bf 100644 --- a/testsuites/ada/mptests/mp14/mptest.adb +++ b/testsuites/ada/mptests/mp14/mptest.adb @@ -19,20 +19,15 @@ -- with INTERFACES; use INTERFACES; -with INTERFACES.C; -with RTEMS; with RTEMS.EVENT; with RTEMS.MESSAGE_QUEUE; with RTEMS.PARTITION; with RTEMS.SEMAPHORE; -with RTEMS.TASKS; with RTEMS.TIMER; with TEST_SUPPORT; with TEXT_IO; with UNSIGNED32_IO; -with System.Storage_Elements; use System.Storage_Elements; - package body MPTEST is -- @@ -56,15 +51,11 @@ package body MPTEST is procedure EXIT_TEST is OLD_MODE : RTEMS.MODE; STATUS : RTEMS.STATUS_CODES; - procedure BSP_MPCI_PRINT_STATISTICS; - pragma Import (C, BSP_MPCI_PRINT_STATISTICS, "MPCI_Print_statistics" ); begin RTEMS.TASKS.MODE(RTEMS.NO_PREEMPT, RTEMS.PREEMPT_MASK, OLD_MODE, STATUS); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "TASK_MODE" ); - BSP_MPCI_PRINT_STATISTICS; - RTEMS.SHUTDOWN_EXECUTIVE( 0 ); end EXIT_TEST; @@ -76,7 +67,7 @@ package body MPTEST is procedure INIT ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is - INDEX : RTEMS.UNSIGNED32; + pragma Unreferenced(ARGUMENT); STATUS : RTEMS.STATUS_CODES; PREVIOUS_PRIORITY : RTEMS.TASKS.PRIORITY; begin @@ -150,6 +141,7 @@ package body MPTEST is MPTEST.SEMAPHORE_NAME( 1 ), 1, RTEMS.GLOBAL, + RTEMS.TASKS.NO_PRIORITY, MPTEST.SEMAPHORE_ID( 1 ), STATUS ); @@ -159,6 +151,7 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.CREATE( MPTEST.QUEUE_NAME( 1 ), 1, + 1, RTEMS.GLOBAL, MPTEST.QUEUE_ID( 1 ), STATUS @@ -314,9 +307,9 @@ package body MPTEST is procedure TEST_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is + pragma Unreferenced(ARGUMENT); REMOTE_NODE : RTEMS.UNSIGNED32; REMOTE_TID : RTEMS.ID; - COUNT : RTEMS.UNSIGNED32; EVENT_OUT : RTEMS.EVENT_SET; STATUS : RTEMS.STATUS_CODES; begin @@ -356,7 +349,7 @@ package body MPTEST is TEXT_IO.PUT_LINE( "Sending events to remote task" ); loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; for COUNT in 1 .. MPTEST.EVENT_TASK_DOT_COUNT loop @@ -367,7 +360,7 @@ package body MPTEST is ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "EVENT_SEND" ); - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; end loop; @@ -380,11 +373,11 @@ package body MPTEST is TEXT_IO.PUT_LINE( "Receiving events from remote task" ); loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; for COUNT in 1 .. MPTEST.EVENT_TASK_DOT_COUNT loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; RTEMS.EVENT.RECEIVE( RTEMS.EVENT_16, @@ -416,7 +409,7 @@ package body MPTEST is procedure DELAYED_EVENTS_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is - COUNT : RTEMS.UNSIGNED32; + pragma Unreferenced(ARGUMENT); PREVIOUS_MODE : RTEMS.MODE; EVENTS_OUT : RTEMS.EVENT_SET; STATUS : RTEMS.STATUS_CODES; @@ -472,9 +465,7 @@ package body MPTEST is TEST_SUPPORT.PUT_DOT( "." ); end loop; - - MPTEST.EXIT_TEST; - + end DELAYED_EVENTS_TASK; -- @@ -488,17 +479,17 @@ package body MPTEST is procedure MESSAGE_QUEUE_TASK ( INDEX : in RTEMS.TASKS.ARGUMENT ) is - COUNT : RTEMS.UNSIGNED32; YIELD_COUNT : RTEMS.UNSIGNED32; OVERFLOW_COUNT : RTEMS.UNSIGNED32_POINTER; BUFFER_COUNT : RTEMS.UNSIGNED32_POINTER; STATUS : RTEMS.STATUS_CODES; + MESSAGE_SIZE : RTEMS.SIZE := 0; begin - MPTEST.BUFFERS( INDEX ).FIELD1 := 0; - MPTEST.BUFFERS( INDEX ).FIELD2 := 0; - MPTEST.BUFFERS( INDEX ).FIELD3 := 0; - MPTEST.BUFFERS( INDEX ).FIELD4 := 0; + MPTEST.BUFFER_AREAS( INDEX ).FIELD1 := 0; + MPTEST.BUFFER_AREAS( INDEX ).FIELD2 := 0; + MPTEST.BUFFER_AREAS( INDEX ).FIELD3 := 0; + MPTEST.BUFFER_AREAS( INDEX ).FIELD4 := 0; TEXT_IO.PUT_LINE( "Getting ID of message queue" ); @@ -521,46 +512,40 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.SEND( MPTEST.QUEUE_ID( 1 ), MPTEST.BUFFERS( INDEX ), + 4, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" ); - OVERFLOW_COUNT := RTEMS.TO_UNSIGNED32_POINTER( - MPTEST.BUFFERS( INDEX ).FIELD1'ADDRESS - ); + OVERFLOW_COUNT := MPTEST.BUFFER_AREAS( INDEX ).FIELD1'ACCESS; - BUFFER_COUNT := RTEMS.TO_UNSIGNED32_POINTER( - MPTEST.BUFFERS( INDEX ).FIELD2'ADDRESS - ); + BUFFER_COUNT := MPTEST.BUFFER_AREAS( INDEX ).FIELD2'ACCESS; else - OVERFLOW_COUNT := RTEMS.TO_UNSIGNED32_POINTER( - MPTEST.BUFFERS( INDEX ).FIELD3'ADDRESS - ); + OVERFLOW_COUNT := MPTEST.BUFFER_AREAS( INDEX ).FIELD3'ACCESS; - BUFFER_COUNT := RTEMS.TO_UNSIGNED32_POINTER( - MPTEST.BUFFERS( INDEX ).FIELD4'ADDRESS - ); + BUFFER_COUNT := MPTEST.BUFFER_AREAS( INDEX ).FIELD4'ACCESS; end if; loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; YIELD_COUNT := 100; for COUNT in 1 .. MPTEST.MESSAGE_DOT_COUNT loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; RTEMS.MESSAGE_QUEUE.RECEIVE( MPTEST.QUEUE_ID( 1 ), MPTEST.BUFFERS( INDEX ), RTEMS.DEFAULT_OPTIONS, RTEMS.NO_TIMEOUT, + MESSAGE_SIZE, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( @@ -578,6 +563,7 @@ package body MPTEST is RTEMS.MESSAGE_QUEUE.SEND( MPTEST.QUEUE_ID( 1 ), MPTEST.BUFFERS( INDEX ), + 4, STATUS ); TEST_SUPPORT.DIRECTIVE_FAILED( STATUS, "MESSAGE_QUEUE_SEND" ); @@ -621,7 +607,6 @@ package body MPTEST is procedure PARTITION_TASK ( IGNORED : in RTEMS.TASKS.ARGUMENT ) is - COUNT : RTEMS.UNSIGNED32; BUFFER : RTEMS.ADDRESS; STATUS : RTEMS.STATUS_CODES; begin @@ -644,12 +629,12 @@ package body MPTEST is loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; for COUNT in 1 .. MPTEST.PARTITION_DOT_COUNT loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; RTEMS.PARTITION.GET_BUFFER( MPTEST.PARTITION_ID( 1 ), @@ -696,7 +681,7 @@ package body MPTEST is procedure SEMAPHORE_TASK ( ARGUMENT : in RTEMS.TASKS.ARGUMENT ) is - COUNT : RTEMS.UNSIGNED32; + pragma Unreferenced(ARGUMENT); YIELD_COUNT : RTEMS.UNSIGNED32; STATUS : RTEMS.STATUS_CODES; begin @@ -721,12 +706,12 @@ package body MPTEST is YIELD_COUNT := 100; - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; for COUNT in 1 .. MPTEST.SEMAPHORE_DOT_COUNT loop - exit when MPTEST.STOP_TEST = TRUE; + exit when MPTEST.STOP_TEST; RTEMS.SEMAPHORE.OBTAIN( MPTEST.SEMAPHORE_ID( 1 ), diff --git a/testsuites/ada/mptests/mp14/mptest.ads b/testsuites/ada/mptests/mp14/mptest.ads index 1cf0b80942..d389157cd1 100644 --- a/testsuites/ada/mptests/mp14/mptest.ads +++ b/testsuites/ada/mptests/mp14/mptest.ads @@ -23,6 +23,19 @@ with RTEMS.TASKS; package MPTEST is +-- +-- Buffer Record similar to that used by RTEMS 3.2.1. Using this +-- avoids changes to the test. +-- + + type BUFFER is + record + FIELD1 : aliased RTEMS.UNSIGNED32; -- TEMPORARY UNTIL VARIABLE LENGTH + FIELD2 : aliased RTEMS.UNSIGNED32; + FIELD3 : aliased RTEMS.UNSIGNED32; + FIELD4 : aliased RTEMS.UNSIGNED32; + end record; + -- -- These arrays contain the IDs and NAMEs of all RTEMS tasks created -- by this test for passing event sets. @@ -104,7 +117,7 @@ package MPTEST is -- and pointers to those buffers. -- - BUFFER_AREAS : array ( RTEMS.UNSIGNED32 range 1 .. 4 ) of RTEMS.BUFFER; + BUFFER_AREAS : array ( RTEMS.UNSIGNED32 range 1 .. 4 ) of MPTEST.BUFFER; BUFFERS : array ( RTEMS.UNSIGNED32 range 1 .. 4 ) of RTEMS.ADDRESS; -- @@ -164,6 +177,13 @@ package MPTEST is TIMER_ID : in RTEMS.ID; IGNORED_ADDRESS : in RTEMS.ADDRESS ); + pragma Convention (C, DELAYED_SEND_EVENT); + + procedure STOP_TEST_TSR ( + IGNORED_ID : in RTEMS.ID; + IGNORED_ADDRESS : in RTEMS.ADDRESS + ); + pragma Convention (C, STOP_TEST_TSR); -- -- INIT -- cgit v1.2.3