with Generic_Priority_Controller;
with Test_Data;
with System;
with Ada.Text_IO;
procedure Test_Priority_Controller is
use Ada;
package Td renames Test_Data;
type Message_Priority_Type is (Urgend, Normal, Drop);
procedure Send_With_Priority (D : Td.Root_Message_Type'Class; With_P : Message_Priority_Type) is
begin
if With_P /= Drop then
Text_IO.Put_Line ("## Sending " & Message_Priority_Type'Image (With_P));
Td.Send (D);
else
Text_IO.Put_Line ("## NOT Sending " & Message_Priority_Type'Image (With_P));
end if;
end Send_With_Priority;
package Pctr is new Generic_Priority_Controller
(Data_Priority_Type => Message_Priority_Type,
Data_Type => Td.Root_Message_Type,
Handler => Send_With_Priority);
D1 : Td.Message_Type_1;
D2 : Td.Message_Type_2;
type Send_Procedure_Access_Type is access procedure;
task type Sender_Task_Type (Task_Priority : System.Priority) is
entry Start (Task_Id : Character; Send_Procedure : Send_Procedure_Access_Type);
pragma Priority (Task_Priority);
end Sender_Task_Type;
task body Sender_Task_Type is
My_Id : Character;
My_Procedure : Send_Procedure_Access_Type;
begin
accept Start (Task_Id : Character; Send_Procedure : Send_Procedure_Access_Type) do
My_Id := Task_Id;
My_Procedure := Send_Procedure;
end Start;
Text_IO.Put_Line ("## Sender starting " & My_Id);
My_Procedure.all;
Text_IO.Put_Line ("## Sender finished " & My_Id);
end Sender_Task_Type;
procedure Send1_Procedure is
begin
Pctr.Get (D1, Normal);
Pctr.Get (D1, Urgend);
Pctr.Get (D2, Urgend);
Pctr.Get (D2, Normal);
Pctr.Get (D1, Drop);
Pctr.Get (D1, Urgend);
Pctr.Get (D2, Urgend);
Pctr.Get (D2, Normal);
Pctr.Get (D2, Normal);
Pctr.Get (D1, Drop);
Pctr.Get (D2, Urgend);
Pctr.Get (D2, Drop);
Pctr.Get (D1, Normal);
end Send1_Procedure;
procedure Send2_Procedure is
begin
Pctr.Get (D1, Urgend);
Pctr.Get (D1, Urgend);
Pctr.Get (D2, Normal);
Pctr.Get (D2, Urgend);
Pctr.Get (D1, Drop);
Pctr.Get (D1, Normal);
Pctr.Get (D2, Normal);
Pctr.Get (D2, Urgend);
Pctr.Get (D2, Urgend);
Pctr.Get (D1, Drop);
Pctr.Get (D2, Urgend);
Pctr.Get (D2, Normal);
Pctr.Get (D1, Drop);
end Send2_Procedure;
procedure Send3_Procedure is
begin
Pctr.Get (D1, Urgend);
Pctr.Get (D1, Urgend);
Pctr.Get (D2, Normal);
Pctr.Get (D2, Urgend);
Pctr.Get (D1, Drop);
Pctr.Get (D1, Urgend);
Pctr.Get (D2, Normal);
Pctr.Get (D2, Urgend);
Pctr.Get (D2, Urgend);
Pctr.Get (D1, Drop);
Pctr.Get (D2, Urgend);
Pctr.Get (D2, Normal);
Pctr.Get (D1, Drop);
end Send3_Procedure;
Sender_Task_Priority : constant System.Priority := System.Default_Priority - 1;
Max_Task_Nb : constant Positive := 3;
type Task_Index_Type is new Positive range 1 .. Max_Task_Nb;
Send_Procedure_Access_Array : array (Task_Index_Type) of Send_Procedure_Access_Type :=
(1 => Send1_Procedure'Access, 2 => Send2_Procedure'Access, 3 => Send3_Procedure'Access);
Sender_Task_Array : array (Task_Index_Type) of Sender_Task_Type (Task_Priority => Sender_Task_Priority);
Sender_Task_Id_Array : array (Task_Index_Type) of Character := (1 => 'A', 2 => 'B', 3 => 'C');
begin
Text_IO.Put_Line ("## Test_Priority_Controller ...");
Pctr.Start;
for Ix in Task_Index_Type loop
Sender_Task_Array (Ix).Start
(Task_Id => Sender_Task_Id_Array (Ix),
Send_Procedure => Send_Procedure_Access_Array (Ix));
end loop;
Text_IO.Put_Line ("## Waiting for CR ...");
Text_IO.Skip_Line;
Text_IO.Put_Line ("## Test_Priority_Controller.");
end Test_Priority_Controller;