RTOS/rtems
1
0
Fork 0
forked from Imagelibrary/rtems
Code Pull Requests Activity

ada/mptests: Make them compile clean

Browse Source 
Fix all warnings.

Update #3818.
This commit is contained in:
Sebastian Huber
2019-11-12 07:08:39 +01:00
parent 1a48cbfa16
commit f51594897c
19 changed files with 195 additions and 127 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
testsuites/ada/mptests/mp01/mptest.adb
View File

@@ -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;

4
testsuites/ada/mptests/mp03/mptest.adb
View File

@@ -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

4
testsuites/ada/mptests/mp04/mptest.adb
View File

@@ -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;

8
testsuites/ada/mptests/mp05/mptest.adb
View File

@@ -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;

1
testsuites/ada/mptests/mp05/mptest.ads
View File

@@ -19,7 +19,6 @@
--
with RTEMS;
with RTEMS.SIGNAL;
with RTEMS.TASKS;
package MPTEST is

6
testsuites/ada/mptests/mp06/mptest.adb
View File

@@ -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(

1
testsuites/ada/mptests/mp06/mptest.ads
View File

@@ -19,7 +19,6 @@
--
with RTEMS;
with RTEMS.EVENT;
with RTEMS.TASKS;
package MPTEST is

6
testsuites/ada/mptests/mp07/mptest.adb
View File

@@ -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

7
testsuites/ada/mptests/mp08/mptest.adb
View File

@@ -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

74
testsuites/ada/mptests/mp09/mptest.adb
View File

@@ -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.FIELD1 := SOURCE_BUFFER.FIELD1;
BUFFER.FIELD2 := SOURCE_BUFFER.FIELD2;
BUFFER.FIELD3 := SOURCE_BUFFER.FIELD3;
BUFFER.FIELD4 := SOURCE_BUFFER.FIELD4;
BUFFER.FIELD2 := RTEMS.BUILD_NAME(
SOURCE( SOURCE'FIRST + 4 ),
SOURCE( SOURCE'FIRST + 5 ),
SOURCE( SOURCE'FIRST + 6 ),
SOURCE( SOURCE'FIRST + 7 )
);
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(

37
testsuites/ada/mptests/mp09/mptest.ads
View File

@@ -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
);
--

19
testsuites/ada/mptests/mp10/mptest.adb
View File

@@ -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

13
testsuites/ada/mptests/mp10/mptest.ads
View File

@@ -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.

7
testsuites/ada/mptests/mp11/mptest.adb
View File

@@ -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
);

3
testsuites/ada/mptests/mp12/mptest.adb
View File

@@ -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

20
testsuites/ada/mptests/mp13/mptest.adb
View File

@@ -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

13
testsuites/ada/mptests/mp13/mptest.ads
View File

@@ -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.

73
testsuites/ada/mptests/mp14/mptest.adb
View File

@@ -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 ),

22
testsuites/ada/mptests/mp14/mptest.ads
View File

@@ -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