Commit 0f4972a2 authored by yoogx's avatar yoogx

* Implement a "+" operator for string for concatenation, as

          the regular "&" operator for concatenation is not (yet)
          supported by GNATProve as of version GPL2013
parent a3094c89
...@@ -51,7 +51,7 @@ package body Ping is ...@@ -51,7 +51,7 @@ package body Ping is
begin begin
Order := not Order; Order := not Order;
Data_Source := Order; Data_Source := Order;
Put_Line (Normal, "Sending ORDER: " & Opaque_Type'Image (Order)); Put_Line (Normal, "Sending ORDER: " + Opaque_Type'Image (Order));
end Do_Ping_Spg; end Do_Ping_Spg;
-------------------- --------------------
...@@ -63,14 +63,14 @@ package body Ping is ...@@ -63,14 +63,14 @@ package body Ping is
Data_Source : out Simple_type) Data_Source : out Simple_type)
is is
begin begin
Put_Line (Normal, "ORDER: " & Opaque_Type'Image (Data_Sink)); Put_Line (Normal, "ORDER: " + Opaque_Type'Image (Data_Sink));
if Data_Sink then if Data_Sink then
Var := Var + 1; Var := Var + 1;
Put_Line (Normal, "Sending (+1) PING" & Simple_Type'Image (Var)); Put_Line (Normal, "Sending (+1) PING" + Simple_Type'Image (Var));
else else
Var := Var + 5; Var := Var + 5;
Put_Line (Normal, "Sending (+5) PING" & Simple_Type'Image (Var)); Put_Line (Normal, "Sending (+5) PING" + Simple_Type'Image (Var));
end if; end if;
Data_Source := Var; Data_Source := Var;
......
...@@ -64,8 +64,8 @@ package body PolyORB_HI.Aperiodic_Task is ...@@ -64,8 +64,8 @@ package body PolyORB_HI.Aperiodic_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Aperiodic Task " "Aperiodic Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": Wait initialization")); + ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity)); Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time; delay until System_Startup_Time;
...@@ -73,7 +73,7 @@ package body PolyORB_HI.Aperiodic_Task is ...@@ -73,7 +73,7 @@ package body PolyORB_HI.Aperiodic_Task is
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"Aperiodic task initialized for entity " "Aperiodic task initialized for entity "
& Entity_Image (Entity))); + Entity_Image (Entity)));
-- Main task loop -- Main task loop
...@@ -83,8 +83,8 @@ package body PolyORB_HI.Aperiodic_Task is ...@@ -83,8 +83,8 @@ package body PolyORB_HI.Aperiodic_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Aperiodic Task " "Aperiodic Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": New Dispatch")); + ": New Dispatch"));
-- Block until an event is received -- Block until an event is received
...@@ -94,8 +94,8 @@ package body PolyORB_HI.Aperiodic_Task is ...@@ -94,8 +94,8 @@ package body PolyORB_HI.Aperiodic_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Aperiodic Task " "Aperiodic Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": received event")); + ": received event"));
-- Execute the job -- Execute the job
......
...@@ -63,8 +63,8 @@ package body PolyORB_HI.Background_Task is ...@@ -63,8 +63,8 @@ package body PolyORB_HI.Background_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Background Task " "Background Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": Wait initialization")); + ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity)); Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time; delay until System_Startup_Time;
...@@ -72,14 +72,14 @@ package body PolyORB_HI.Background_Task is ...@@ -72,14 +72,14 @@ package body PolyORB_HI.Background_Task is
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"Background task initialized for entity " "Background task initialized for entity "
& Entity_Image (Entity))); + Entity_Image (Entity)));
pragma Debug pragma Debug
(Put_Line (Put_Line
(Verbose, (Verbose,
"Background Task " "Background Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": Run job")); + ": Run job"));
Error := Job; Error := Job;
......
...@@ -65,8 +65,8 @@ package body PolyORB_HI.Hybrid_Task is ...@@ -65,8 +65,8 @@ package body PolyORB_HI.Hybrid_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Hybrid Task " "Hybrid Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": Wait initialization")); + ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity)); Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time; delay until System_Startup_Time;
...@@ -74,7 +74,7 @@ package body PolyORB_HI.Hybrid_Task is ...@@ -74,7 +74,7 @@ package body PolyORB_HI.Hybrid_Task is
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"Hybrid task initialized for entity " "Hybrid task initialized for entity "
& Entity_Image (Entity))); + Entity_Image (Entity)));
-- Run the initialize entrypoint (if any) -- Run the initialize entrypoint (if any)
...@@ -87,8 +87,8 @@ package body PolyORB_HI.Hybrid_Task is ...@@ -87,8 +87,8 @@ package body PolyORB_HI.Hybrid_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Hybrid Task " "Hybrid Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": New Dispatch")); + ": New Dispatch"));
-- Block until an event is received -- Block until an event is received
...@@ -98,8 +98,8 @@ package body PolyORB_HI.Hybrid_Task is ...@@ -98,8 +98,8 @@ package body PolyORB_HI.Hybrid_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Hybrid Task " "Hybrid Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": received event")); + ": received event"));
-- Calculate the next deadline according to the minimal -- Calculate the next deadline according to the minimal
-- inter-arrival time. -- inter-arrival time.
......
...@@ -104,7 +104,7 @@ package body PolyORB_HI.Hybrid_Task_Driver is ...@@ -104,7 +104,7 @@ package body PolyORB_HI.Hybrid_Task_Driver is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Hybrid thread driver: Triggering task: " "Hybrid thread driver: Triggering task: "
& Entity_Image (T.The_Task))); + Entity_Image (T.The_Task)));
Trigger (T); Trigger (T);
end if; end if;
...@@ -144,7 +144,7 @@ package body PolyORB_HI.Hybrid_Task_Driver is ...@@ -144,7 +144,7 @@ package body PolyORB_HI.Hybrid_Task_Driver is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Hybrid thread driver: Eligible task: " "Hybrid thread driver: Eligible task: "
& Entity_Image (T.The_Task))); + Entity_Image (T.The_Task)));
T.Eligible := True; T.Eligible := True;
end if; end if;
......
...@@ -39,12 +39,23 @@ with System; ...@@ -39,12 +39,23 @@ with System;
package body PolyORB_HI.Output is package body PolyORB_HI.Output is
use Ada.Real_Time; use Ada.Real_Time;
procedure Unprotected_Put_Line (Text : in String);
-- Not thread-safe Put_Line function
procedure Unprotected_Put (Text : in String);
-- Not thread-safe Put function
----------
-- Lock --
----------
protected Lock is protected Lock is
-- This lock has been defined to guarantee thread-safe output
-- display
procedure Put (Text : in String); procedure Put (Text : in String);
-- To guarantee thread-safe output display
procedure Put_Line (Text : in String); procedure Put_Line (Text : in String);
-- To guarantee thread-safe output display
private private
pragma Priority (System.Priority'Last); pragma Priority (System.Priority'Last);
...@@ -180,4 +191,17 @@ package body PolyORB_HI.Output is ...@@ -180,4 +191,17 @@ package body PolyORB_HI.Output is
Put_Line (Mode, Output); Put_Line (Mode, Output);
end Dump; end Dump;
---------
-- "+" --
---------
function "+" (S1 : String; S2 : String) return String is
S : String (1 .. S1'Length + S2'Length);
begin
S (1 .. S1'Length) := S1 (S1'First .. S1'Last);
S (S1'Length + 1 .. S'Last) := S2 (S2'First .. S2'Last);
return S;
end "+";
end PolyORB_HI.Output; end PolyORB_HI.Output;
...@@ -63,25 +63,20 @@ package PolyORB_HI.Output is ...@@ -63,25 +63,20 @@ package PolyORB_HI.Output is
procedure Put_Line (Text : in String); procedure Put_Line (Text : in String);
-- As above but always displays the message -- As above but always displays the message
procedure Unprotected_Put_Line (Text : in String);
-- As above but this routine is not thread-safe
procedure Put (Mode : in Verbosity := Normal; Text : in String); procedure Put (Mode : in Verbosity := Normal; Text : in String);
-- Display Text iff Mode is greater than Current_Mode. This -- Display Text iff Mode is greater than Current_Mode. This
-- routine is thread-safe. -- routine is thread-safe.
procedure Put (Text : in String); procedure Put (Text : in String);
-- As above but displays the message reguards less the mode -- As above but always displays the message
procedure Unprotected_Put (Text : in String);
-- As above but this routine is not thread-safe
procedure Dump (Stream : Stream_Element_Array; Mode : Verbosity := Verbose); procedure Dump (Stream : Stream_Element_Array; Mode : Verbosity := Verbose);
-- Dump the content of Stream in an hexadecimal format -- Dump the content of Stream in an hexadecimal format
function "+" (S1 : String; S2 : String) return String;
private private
pragma Inline (Put_Line); pragma Inline (Put_Line);
pragma Inline (Unprotected_Put_Line);
end PolyORB_HI.Output; end PolyORB_HI.Output;
...@@ -63,8 +63,8 @@ package body PolyORB_HI.Periodic_Task is ...@@ -63,8 +63,8 @@ package body PolyORB_HI.Periodic_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Periodic Task " "Periodic Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": Wait initialization")); + ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity)); Suspend_Until_True (Task_Suspension_Objects (Entity));
Next_Start := System_Startup_Time + Dispatch_Offset; Next_Start := System_Startup_Time + Dispatch_Offset;
...@@ -81,7 +81,7 @@ package body PolyORB_HI.Periodic_Task is ...@@ -81,7 +81,7 @@ package body PolyORB_HI.Periodic_Task is
pragma Debug pragma Debug
(Put_Line (Put_Line
(Verbose, (Verbose,
"Periodic Task " & Entity_Image (Entity) & ": New Cycle")); "Periodic Task " + Entity_Image (Entity) + ": New Cycle"));
-- Execute the task's job -- Execute the task's job
...@@ -94,8 +94,8 @@ package body PolyORB_HI.Periodic_Task is ...@@ -94,8 +94,8 @@ package body PolyORB_HI.Periodic_Task is
-- T := Ada.Real_Time.Clock; -- T := Ada.Real_Time.Clock;
-- if T > Next_Start then -- if T > Next_Start then
-- Put_Line (Normal, "***** Overload detected in task " -- Put_Line (Normal, "***** Overload detected in task "
-- & Entity_Image (Entity) & " *****"); -- + Entity_Image (Entity) + " *****");
-- Put_Line (Normal, "Lag: " & -- Put_Line (Normal, "Lag: " +
-- Duration'Image (To_Duration (Next_Start - T))); -- Duration'Image (To_Duration (Next_Start - T)));
-- end if; -- end if;
......
...@@ -67,8 +67,8 @@ package body PolyORB_HI.Sporadic_Task is ...@@ -67,8 +67,8 @@ package body PolyORB_HI.Sporadic_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Sporadic Task " "Sporadic Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": Wait initialization")); + ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity)); Suspend_Until_True (Task_Suspension_Objects (Entity));
-- delay until System_Startup_Time; -- delay until System_Startup_Time;
...@@ -76,7 +76,7 @@ package body PolyORB_HI.Sporadic_Task is ...@@ -76,7 +76,7 @@ package body PolyORB_HI.Sporadic_Task is
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"Sporadic task initialized for entity " "Sporadic task initialized for entity "
& Entity_Image (Entity))); + Entity_Image (Entity)));
-- Main task loop -- Main task loop
...@@ -86,8 +86,8 @@ package body PolyORB_HI.Sporadic_Task is ...@@ -86,8 +86,8 @@ package body PolyORB_HI.Sporadic_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Sporadic Task " "Sporadic Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": New Dispatch")); + ": New Dispatch"));
-- Block until an event is received -- Block until an event is received
...@@ -97,8 +97,8 @@ package body PolyORB_HI.Sporadic_Task is ...@@ -97,8 +97,8 @@ package body PolyORB_HI.Sporadic_Task is
(Put_Line (Put_Line
(Verbose, (Verbose,
"Sporadic Task " "Sporadic Task "
& Entity_Image (Entity) + Entity_Image (Entity)
& ": received event")); + ": received event"));
-- Calculate the next start time according to the minimal -- Calculate the next start time according to the minimal
-- inter-arrival time. -- inter-arrival time.
......
...@@ -72,15 +72,15 @@ package body PolyORB_HI.Suspenders is ...@@ -72,15 +72,15 @@ package body PolyORB_HI.Suspenders is
pragma Debug pragma Debug
(Put_Line (Put_Line
(Verbose, "Unblocking task " (Verbose, "Unblocking task "
& PolyORB_HI_Generated.Deployment.Entity_Image (J))); + PolyORB_HI_Generated.Deployment.Entity_Image (J)));
Set_True (Task_Suspension_Objects (J)); Set_True (Task_Suspension_Objects (J));
pragma Debug pragma Debug
(Put_Line (Put_Line
(Verbose, "Task " (Verbose, "Task "
& PolyORB_HI_Generated.Deployment.Entity_Image (J) + PolyORB_HI_Generated.Deployment.Entity_Image (J)
& " unblocked")); + " unblocked"));
end loop; end loop;
end Unblock_All_Tasks; end Unblock_All_Tasks;
......
This diff is collapsed.
...@@ -158,7 +158,7 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -158,7 +158,7 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"Local socket created for " "Local socket created for "
& Image (Nodes (My_Node).Address))); + Image (Nodes (My_Node).Address)));
end if; end if;
-- Start the protocol handler task -- Start the protocol handler task
...@@ -179,7 +179,7 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -179,7 +179,7 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug pragma Debug
(Put_Line (Put_Line
(Verbose, (Verbose,
"Try to connect to " & Image (Nodes (N).Address))); "Try to connect to " + Image (Nodes (N).Address)));
delay until Next_Time; delay until Next_Time;
...@@ -198,14 +198,14 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -198,14 +198,14 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"Connected to " & Image (Nodes (N).Address))); "Connected to " + Image (Nodes (N).Address)));
end if; end if;
end loop; end loop;
Suspend_Until_True (Other_Nodes_Init); Suspend_Until_True (Other_Nodes_Init);
pragma Debug (Put_Line (Verbose, "Initialization of socket subsystem" pragma Debug (Put_Line (Verbose, "Initialization of socket subsystem"
& " is complete")); + " is complete"));
-- Unblock the receiver task -- Unblock the receiver task
...@@ -244,7 +244,7 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -244,7 +244,7 @@ package body PolyORB_HI.Transport_Low_Level is
if Nodes (My_Node).Address.Addr /= No_Inet_Addr then if Nodes (My_Node).Address.Addr /= No_Inet_Addr then
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, "Waiting on " (Verbose, "Waiting on "
& Image (Nodes (My_Node).Address))); + Image (Nodes (My_Node).Address)));
for N in Nodes'Range loop for N in Nodes'Range loop
if N /= My_Node then if N /= My_Node then
...@@ -262,7 +262,7 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -262,7 +262,7 @@ package body PolyORB_HI.Transport_Low_Level is
Node := Corresponding_Node (Unsigned_8 (SEC (SEC'First))); Node := Corresponding_Node (Unsigned_8 (SEC (SEC'First)));
Nodes (Node).Socket_Receive := Socket; Nodes (Node).Socket_Receive := Socket;
pragma Debug (Put_Line (Verbose, "Connection from node " pragma Debug (Put_Line (Verbose, "Connection from node "
& Node_Image (Node))); + Node_Image (Node)));
end if; end if;
end loop; end loop;
...@@ -304,15 +304,15 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -304,15 +304,15 @@ package body PolyORB_HI.Transport_Low_Level is
-- Receive message length -- Receive message length
Receive_Socket (Nodes (N).Socket_Receive, SEL, SEO); Receive_Socket (Nodes (N).Socket_Receive, SEL, SEO);
pragma Debug (Put_Line (Verbose, "SEL " & SEL'Length'Img pragma Debug (Put_Line (Verbose, "SEL " + SEL'Length'Img
& "MLS" & Message_Length_Size'Img)); + "MLS" + Message_Length_Size'Img));
-- Receiving zero byte means that peer is dead -- Receiving zero byte means that peer is dead
if SEO = 0 then if SEO = 0 then
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"Node " & Node_Image (N) "Node " + Node_Image (N)
& " is dead")); + " is dead"));
exit Main_Loop; exit Main_Loop;
end if; end if;
...@@ -321,8 +321,8 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -321,8 +321,8 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug (Put_Line pragma Debug (Put_Line
(Verbose, (Verbose,
"received" "received"
& AS.Stream_Element_Offset'Image (SEO) + AS.Stream_Element_Offset'Image (SEO)
& " bytes from node " & Node_Image (N))); + " bytes from node " + Node_Image (N)));
-- Get the message and preserve message length to keep -- Get the message and preserve message length to keep
-- compatible with a local message delivery. -- compatible with a local message delivery.
...@@ -346,10 +346,10 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -346,10 +346,10 @@ package body PolyORB_HI.Transport_Low_Level is
when E : others => when E : others =>
pragma Debug (Put_Line pragma Debug (Put_Line
(Normal, "Exception " (Normal, "Exception "
& Ada.Exceptions.Exception_Name (E))); + Ada.Exceptions.Exception_Name (E)));
pragma Debug (Put_Line pragma Debug (Put_Line
(Normal, "Message " (Normal, "Message "
& Ada.Exceptions.Exception_Message (E))); + Ada.Exceptions.Exception_Message (E)));
null; null;
end Receiver_Task; end Receiver_Task;
...@@ -373,7 +373,7 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -373,7 +373,7 @@ package body PolyORB_HI.Transport_Low_Level is
for Msg'Address use Message'Address; for Msg'Address use Message'Address;
begin begin
pragma Debug (Put_Line (Verbose, "Sending message, size:" & L'Img)); pragma Debug (Put_Line (Verbose, "Sending message, size:" + L'Img));
Send_Socket (Nodes (Node).Socket_Send, Msg, L); Send_Socket (Nodes (Node).Socket_Send, Msg, L);
return Error_Kind'(Error_None); return Error_Kind'(Error_None);
...@@ -381,10 +381,10 @@ package body PolyORB_HI.Transport_Low_Level is ...@@ -381,10 +381,10 @@ package body PolyORB_HI.Transport_Low_Level is
when E : others => when E : others =>
pragma Debug (Put_Line pragma Debug (Put_Line
(Normal, "Exception " (Normal, "Exception "
& Ada.Exceptions.Exception_Name (E))); + Ada.Exceptions.Exception_Name (E)));
pragma Debug (Put_Line pragma Debug (Put_Line
(Normal, "Message " (Normal, "Message "
& Ada.Exceptions.Exception_Message (E))); + Ada.Exceptions.Exception_Message (E)));
return Error_Kind'(Error_Transport); return Error_Kind'(Error_Transport);
end Send; end Send;
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment