|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 35361 (0x8a21)
Types: TextFile
Names: »B«
└─⟦516dceb10⟧ Bits:30000751 8mm tape, Rational 1000, RCI_VADS
└─⟦9a14c9417⟧ »DATA«
└─⟦this⟧
with Extensions_Support;
with Library_Interface;
with Log;
with Profile;
with Rcf_Switch_Implementation;
with Remote_Command_Interface;
with String_Utilities;
package body Library_Extensions is
package Es renames Extensions_Support;
package Li renames Library_Interface;
package Naming renames Directory.Naming;
package Rci renames Remote_Command_Interface;
package Rsi renames Rcf_Switch_Implementation;
package Ss renames Simple_Status;
package Su renames String_Utilities;
Target_Key : constant String := "M68k_Sunos_Vdx";
function "=" (L, R : Directory.Error_Status) return Boolean
renames Directory."=";
function "=" (L, R : Naming.Name_Status) return Boolean renames Naming."=";
function Qt (Str : String) return String is
begin
return " => """ & Str & """";
end Qt;
procedure Check (View_Object : Directory.Object;
Caller : String;
Remote_Machine : String;
Remote_Directory : String;
Host_Only : out Boolean;
Status : in out Simple_Status.Condition) is
begin
Host_Only := False;
if Rsi.Is_Host_Only (View_Object) then
Log.Put_Line (Message => "Not executing " & Caller & ". " &
Naming.Get_Full_Name (View_Object) &
" is a Host_Only view",
Kind => Profile.Note_Msg);
Host_Only := True;
Ss.Initialize (Status);
elsif Remote_Machine = "" then
Log.Put_Line (Message =>
"Remote_Machine name for view " &
Naming.Get_Full_Name (View_Object) & " is null",
Kind => Profile.Warning_Msg);
Es.Set_Status ("Insufficient remote machine information",
Status, Ss.Problem);
elsif Remote_Directory = "" then
Log.Put_Line (Message =>
"Remote_Directory name for view " &
Naming.Get_Full_Name (View_Object) & " is null",
Kind => Profile.Warning_Msg);
Es.Set_Status ("Insufficient remote directory information",
Status, Ss.Problem);
end if;
end Check;
procedure Set_Context (Old_Context : in out Naming.Context;
View : String;
Status : in out Simple_Status.Condition) is
Error_Status : Directory.Error_Status;
New_Context : Naming.Context;
Dir_Object : Directory.Object;
Name_Status : Naming.Name_Status;
begin
Naming.Resolve (Name => View,
The_Object => Dir_Object,
Status => Name_Status);
if Name_Status /= Naming.Successful then
Es.Set_Status ("Can't resolve " & View & ". Name Status = " &
Naming.Name_Status'Image (Name_Status), Status);
return;
end if;
-- Get the current naming context for Promote_Unit.
Naming.Get_Context (The_Context => New_Context,
The_Unit => Dir_Object,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Es.Set_Status
("Can't get default context for " & View & ". Error Status = " &
Directory.Error_Status'Image (Error_Status),
Status);
return;
end if;
-- Get the job's default naming context.
Old_Context := Naming.Default_Context;
-- We must restore this context (after any errors) before we return.
-- Change the job's default context to the unit's current context.
Naming.Set_Default_Context (The_Context => New_Context,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Es.Set_Status ("Can't set default context to " &
View & ". Error Status = " &
Directory.Error_Status'Image (Error_Status), Status);
return;
end if;
end Set_Context;
procedure Reset_Context (Old_Context : Directory.Naming.Context;
Status : in out Simple_Status.Condition) is
Error_Status : Directory.Error_Status;
begin
-- Restore the job's original naming context.
Naming.Set_Default_Context (The_Context => Old_Context,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Es.Set_Status ("Can't restore default context" &
". Error Status = " &
Directory.Error_Status'Image (Error_Status), Status);
end if;
end Reset_Context;
procedure Download_File (Host_File_Name : String;
Target_File_Name : String;
Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Rci.Context;
Old_Context : Naming.Context;
Local_Status : Ss.Condition;
Fully_Qualified_Target_Name : constant String :=
Su.Strip (Remote_Directory) & "/" & Target_File_Name;
View_Obj : Directory.Object := Es.Get_View (Host_File_Name);
Trace_On : Boolean := Rsi.Trace_On (View_Obj);
begin
Log.Put_Line
(Message => "Download_File (Host_File_Name" & Qt (Host_File_Name) &
", Target_File_Name" & Qt (Target_File_Name) &
", Remote_Directory" & Qt (Remote_Directory) &
", Remote_Machine" & Qt (Remote_Machine) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Transferring " & Host_File_Name &
" to " & Fully_Qualified_Target_Name,
Kind => Profile.Debug_Msg);
Set_Context (Old_Context => Old_Context,
View => Host_File_Name,
Status => Status);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Es.Set_Status ("Download_File failed", Status);
return;
end if;
Rci.Acquire (Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Trace_On);
if Ss.Error (Status) then
if Trace_On then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't acquire connection to " & Remote_Machine, Status);
else
begin
Rci.Put (Host_File_Name => Host_File_Name,
Target_File_Name => Fully_Qualified_Target_Name,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_On);
if Ss.Error (Status) then
if Trace_On then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't transfer " & Host_File_Name & " to " &
Target_File_Name & " on " & Remote_Machine, Status);
end if;
exception
when others =>
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
raise;
end;
end if;
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Download_File");
end Download_File;
procedure Upload_File (Host_File_Name : String;
Target_File_Name : String;
Remote_Directory : String;
Remote_Machine : String;
Status : in out Simple_Status.Condition) is
Remote_Connection : Rci.Context;
Old_Context : Naming.Context;
Local_Status : Ss.Condition;
Fully_Qualified_Target_Name : constant String :=
Su.Strip (Remote_Directory) & "/" & Target_File_Name;
View_Obj : Directory.Object := Es.Get_View (Host_File_Name);
Trace_On : Boolean := Rsi.Trace_On (View_Obj);
begin
Log.Put_Line
(Message => "Upload_File (Host_File_Name" & Qt (Host_File_Name) &
", Target_File_Name" & Qt (Target_File_Name) &
", Remote_Directory" & Qt (Remote_Directory) &
", Remote_Machine" & Qt (Remote_Machine) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Uploading " & Host_File_Name & " from " &
Fully_Qualified_Target_Name,
Kind => Profile.Debug_Msg);
Set_Context (Old_Context => Old_Context,
View => Host_File_Name,
Status => Status);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Es.Set_Status ("Upload_File failed", Status);
return;
end if;
Rci.Acquire (Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Trace_On);
if Ss.Error (Status) then
if Trace_On then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't acquire connection to " & Remote_Machine, Status);
else
begin
Rci.Get (Host_File_Name => Host_File_Name,
Target_File_Name => Fully_Qualified_Target_Name,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_On);
if Ss.Error (Status) then
if Trace_On then
Log.Put_Line (Ss.Message (Status),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't upload " & Host_File_Name & " to " &
Target_File_Name & " from " & Remote_Machine, Status);
end if;
exception
when others =>
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
raise;
end;
end if;
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Upload_File");
end Upload_File;
procedure Make_Path_Preprocess (Host_Path_Name : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line (Message =>
"Make_Path_Preprocess (Host_Path_Name" &
Qt (Host_Path_Name) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Make_Path_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Make_Path_Preprocess");
end Make_Path_Preprocess;
procedure Make_Path_Postprocess (Host_Path_Name : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object := Es.Get_View (Host_Path_Name);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Stripped_Machine : constant String :=
Su.Strip (From => Remote_Machine, Filler => ' ');
Stripped_Directory : constant String :=
Su.Strip (From => Remote_Directory, Filler => ' ');
Old_Context : Naming.Context;
Local_Status : Ss.Condition;
Host_Only : Boolean;
Trace_On : Boolean := Rsi.Trace_On (View_Obj);
begin
Log.Put_Line (Message =>
"Make_Path_Postprocess (Host_Path_Name" &
Qt (View_Name) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
Check (View_Obj, "Make_Path_Postprocess", Stripped_Machine,
Stripped_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status) then
return;
end if;
Log.Put_Line (Message => "Executing Make_Path_Postprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Es.Set_Status ("Make_Path_Postprocess failed", Status);
else
-- Create the remote Ada library, after creating the remote
-- directory if it doesn't already exist.
Es.Create_Remote_Directory (Remote_Machine => Stripped_Machine,
Remote_Directory => Stripped_Directory,
Status => Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
end if;
exception
when others =>
Es.Unhandled_Exception (Status, "Make_Path_Postprocess");
end Make_Path_Postprocess;
procedure Destroy_View_Preprocess
(Host_Path_Name : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object := Es.Get_View (Host_Path_Name);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Machine_Result : constant Li.String_Result :=
Li.Remote_Machine (View => View_Name);
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
Remote_Machine : constant String := Machine_Result.Result;
Remote_Directory : constant String := Directory_Result.Result;
Old_Context : Naming.Context;
Local_Status : Ss.Condition;
Host_Only : Boolean;
Trace_On : Boolean := Rsi.Trace_On (View_Obj);
begin
Log.Put_Line (Message => "Destroy_View_Preprocess (Host_Path_Name" &
Qt (View_Name) & ")",
Kind => Profile.Sharp_Msg);
if Ss.Error (Machine_Result.Condition) then
if Trace_On then
Log.Put_Line (Ss.Message (Machine_Result.Condition),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't get remote machine name for view " & View_Name, Status);
return;
elsif Ss.Error (Directory_Result.Condition) then
if Trace_On then
Log.Put_Line (Ss.Message (Directory_Result.Condition),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
Check (View_Obj, "Destroy_View_Preprocess", Remote_Machine,
Remote_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status) then
return;
end if;
Log.Put_Line (Message => "Executing Destroy_View_Preprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Es.Set_Status ("Destroy_View_Preprocess failed", Status);
return;
end if;
-- Remove the Remote_Directory as an import on the Sparc, and then
-- destroy the remote library.
Es.Destroy_Remote_Library (For_View => View_Obj,
Remote_Directory => Remote_Directory,
Remote_Machine => Remote_Machine,
Status => Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Destroy_View_Preprocess");
end Destroy_View_Preprocess;
procedure Destroy_View_Postprocess
(Host_Path_Name : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line (Message => "Destroy_View_Postprocess (Host_Path_Name" &
Qt (Host_Path_Name) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Destroy_View_Postprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Destroy_View_Postprocess");
end Destroy_View_Postprocess;
procedure Import_Postprocess (Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object := Es.Get_View (Into_View);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Machine_Result : constant Li.String_Result :=
Li.Remote_Machine (View => View_Name);
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
Remote_Machine : constant String := Machine_Result.Result;
Remote_Directory : constant String := Directory_Result.Result;
Imported_Views : Naming.Iterator := Views_To_Import;
Old_Context : Naming.Context;
Local_Status : Ss.Condition;
Host_Only : Boolean;
Remote_Connection : Rci.Context;
Trace_On : Boolean := Rsi.Trace_On (View_Obj);
begin
Log.Put_Line (Message =>
"Import_Postprocess (Into_View" & Qt (View_Name) & ")",
Kind => Profile.Sharp_Msg);
if Ss.Error (Machine_Result.Condition) then
if Trace_On then
Log.Put_Line (Ss.Message (Machine_Result.Condition),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't get remote machine name for view " & View_Name, Status);
return;
elsif Ss.Error (Directory_Result.Condition) then
if Trace_On then
Log.Put_Line (Ss.Message (Directory_Result.Condition),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
Check (View_Obj, "Import_Postprocess", Remote_Machine,
Remote_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status) then
return;
end if;
-- Note that we need to continue even though Views_To_Import is null,
-- because we always want Add_Remote_Imports to make sure that
-- Into_View is imported into each of its referencers.
Log.Put_Line (Message => "Executing Import_Postprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Es.Set_Status ("Import_Postprocess failed", Status);
return;
end if;
Rci.Acquire (Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Trace_On);
if Ss.Error (Status) then
if Trace_On then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't acquire connection to " & Remote_Machine, Status);
else
begin
-- Add each view in Imported_Views as an import for Into_View
-- on the remote machine specified by Remote_Connection. Also
-- add as imports of Into_View the views that are imported by
-- each of the Imported_Views.
Es.Add_Remote_Imports (Imported_Views => Imported_Views,
To_View => View_Obj,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_On);
exception
when others =>
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
raise;
end;
end if;
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Import_Postprocess");
end Import_Postprocess;
procedure Import_Preprocess (Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line (Message => "Import_Preprocess (Into_View" &
Qt (Into_View) & ", Views_To_Import =>",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Import_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Import_Preprocess");
end Import_Preprocess;
procedure Remove_Import_Preprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Remove_Import_Preprocess (View_To_Remove => " &
Naming.Get_Simple_Name (View_To_Remove) &
", From_View" & Qt (From_View) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Remove_Import_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Remove_Import_Preprocess");
end Remove_Import_Preprocess;
procedure Remove_Import_Postprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object := Es.Get_View (From_View);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Machine_Result : constant Li.String_Result :=
Li.Remote_Machine (View => View_Name);
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
Remote_Machine : constant String := Machine_Result.Result;
Remote_Directory : constant String := Directory_Result.Result;
Old_Context : Naming.Context;
Local_Status : Ss.Condition;
Host_Only : Boolean;
Remote_Connection : Rci.Context;
Trace_On : Boolean := Rsi.Trace_On (View_Obj);
begin
Log.Put_Line
(Message => "Remove_Import_Postprocess (View_To_Remove => " &
Naming.Get_Simple_Name (View_To_Remove) &
", From_View" & Qt (View_Name) & ")",
Kind => Profile.Sharp_Msg);
if Ss.Error (Machine_Result.Condition) then
if Trace_On then
Log.Put_Line (Ss.Message (Machine_Result.Condition),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't get remote machine name for view " & View_Name, Status);
return;
elsif Ss.Error (Directory_Result.Condition) then
if Trace_On then
Log.Put_Line (Ss.Message (Directory_Result.Condition),
Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
Check (View_Obj, "Remove_Import_Postprocess",
Remote_Machine, Remote_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status) then
return;
end if;
Log.Put_Line (Message => "Executing Remove_Import_Postprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Ss.Error (Status) then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
Es.Set_Status ("Remove_Import_Postprocess failed", Status);
return;
end if;
Rci.Acquire (Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => Target_Key,
Remote_Machine => Remote_Machine,
Trace_Command => Trace_On);
if Ss.Error (Status) then
if Trace_On then
Log.Put_Line (Ss.Message (Status), Profile.Negative_Msg);
end if;
Es.Set_Status
("Can't acquire connection to " & Remote_Machine, Status);
else
begin
-- Remove View_To_Remove as a remote import of From_View on the
-- remote machine specified by Remote_Connection. Also remove
-- as imports of From_View the views that are imported by
-- View_To_Remove which are not otherwise needed by From_View.
-- Remove the same views, if they are not still needed, from
-- each referencer of From_View.
Es.Remove_Remote_Imports
(View_To_Remove => View_To_Remove,
From_View => View_Obj,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_On);
exception
when others =>
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
raise;
end;
end if;
Rci.Release (Remote_Connection => Remote_Connection,
Status => Local_Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context, Local_Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Remove_Import_Postprocess");
end Remove_Import_Postprocess;
procedure Release_Preprocess (From_Working_View : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Release_Preprocess (From_Working_View" &
Qt (From_Working_View) & ", Released_View" &
Qt (Released_View) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Release_Preprocess",
Kind => Profile.Note_Msg);
Make_Path_Preprocess (Host_Path_Name => Released_View,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Remote_Program_Library => Remote_Program_Library,
Status => Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Release_Preprocess");
end Release_Preprocess;
procedure Release_Postprocess (View_To_Remove : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Release_Postprocess (View_To_Remove" &
Qt (View_To_Remove) & ", Released_View" &
Qt (Released_View) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Release_Postprocess",
Kind => Profile.Note_Msg);
if not Directory.Is_Nil (Es.Get_View (Released_View)) then
Make_Path_Postprocess
(Host_Path_Name => Released_View,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Remote_Program_Library => Remote_Program_Library,
Status => Status);
end if;
exception
when others =>
Es.Unhandled_Exception (Status, "Release_Postprocess");
end Release_Postprocess;
procedure Link_Preprocess (Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Link_Preprocess (Main_Unit" & Qt (Main_Unit) &
", Executable_Name" & Qt (Executable_Name) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Link_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Link_Preprocess");
end Link_Preprocess;
procedure Link_Postprocess (Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Link_Postprocess (Main_Unit" & Qt (Main_Unit) &
", Executable_Name" & Qt (Executable_Name) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Link_Postprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Link_Postprocess");
end Link_Postprocess;
end Library_Extensions;