|
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 - downloadIndex: ┃ B T ┃
Length: 37466 (0x925a)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─ ⟦124ff5788⟧ »DATA«
└─⟦this⟧
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Action;
with Asa_Definitions;
with Calendar;
with Cmvc_Implementation_Errors;
with Database_Operations;
with Diana;
with Directory_Operations;
with Directory;
with Error_Messages;
with Hierarchy;
with Job_Segment;
with Logger;
with Profile;
with Gateway_Object;
with Relocation;
with Simple_Status;
with String_Utilities;
with System;
with Unix_Definitions;
package body Gateways is
package Asap renames Asa_Definitions.Properties;
package Asas renames Asa_Definitions.Switches;
package Cmvce renames Cmvc_Implementation_Errors;
package Cmvci renames Cmvc_Implementation;
package Dcp renames Directory.Control_Point;
package Dir renames Directory;
package Dna renames Directory.Naming;
package Doo renames Directory.Object_Operations;
package Gwo renames Gateway_Object;
package Hchy renames Hierarchy;
package Ss renames Simple_Status;
package Su renames String_Utilities;
package Unix renames Unix_Definitions;
function Creation_Message (Gateway : in Gwo.Handle) return String is
begin
return "Created gateway object " &
Dna.Get_Full_Name (Gwo.Directory_Object (Gateway)) &
" of class " &
Asa_Definitions.Gateway_Class'Image (Asap.Class (Gateway));
end Creation_Message;
function Same_Properties (Module : in Hchy.Module; Gateway : in Gwo.Handle)
return Boolean is
Same_Requirements : Boolean := True;
begin
for R in Requirements.Functional_Requirement_Number loop
if Asap.Asa_Requirement (H => Gateway, Number => R) /=
Hchy.Requirement (M => Module, Number => R) then
Same_Requirements := False;
exit;
end if;
end loop;
return Same_Requirements and then Asap.Asa_Node_Number (Gateway) =
Hchy.Node_Number (Module) and then
Asap.Asa_Comment (Gateway) = Hchy.Comment (Module);
end Same_Properties;
function Tree_Size (Rooted_At : in Hchy.Module) return Positive is
Children : Hchy.Module_Iterator := Hchy.Children_Of (Rooted_At);
Result : Positive := 1;
begin
while not Hchy.Done (Children) loop
Result := Result + Tree_Size (Hchy.Value (Children));
Hchy.Next (Children);
end loop;
return Result;
end Tree_Size;
-- ----------------
-- ( ) CMVC support
-- ----------------
function Relative_Name (Full_Name : in String; Relative_To : in String)
return String is
begin
pragma Assert (Full_Name'Length >= Relative_To'Length and then
Full_Name (Full_Name'First ..
Full_Name'First + Relative_To'Length - 1) =
Relative_To);
return Full_Name
(Full_Name'First + Relative_To'Length + 1 -- Skip the '.'
.. Full_Name'Last);
end Relative_Name;
procedure Get_Cmvc_Control (Object : in Dir.Object;
The_State : in out State;
Control : out Cmvc_Control_Kind) is
E : Dir.Error_Status;
N : Dna.Name_Status;
S : Cmvci.Error_Status;
Configuration_Object : Dir.Object;
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
The_Configuration : Cmvci.Configuration renames The_State.Configuration;
The_Element : Cmvci.Element;
The_Version_Set : Cmvci.Version_Set;
View_Object : Dir.Object;
use Cmvce;
begin
Dcp.Parent_World (The_Object => Object,
The_World => View_Object,
Status => E);
Logger.Status (E);
--
-- Make sure the configuration associated to the current view is
-- open.
--
if Cmvci.Is_Nil (The_Configuration) then
Dna.Resolve (Name => Dna.Get_Full_Name (View_Object) &
"^$$.Configurations." &
Dna.Get_Simple_Name (View_Object),
The_Object => Configuration_Object,
Status => N,
Action_Id => Action_Id);
Logger.Status (N);
The_Configuration := Database_Operations.Open_Configuration
(For_Config_Object => Configuration_Object,
S => The_State.Cmvc);
end if;
--
-- Look at the CMVC database to see if the object being operated
-- on is controlled.
--
Cmvci.Element_Operations.Open
(Element_Name =>
Relative_Name (Full_Name => Dna.Get_Full_Name (Object),
Relative_To => Dna.Get_Full_Name (View_Object)),
Elem => The_Element,
Status => S,
Db => Cmvci.Configuration_Operations.Database_Of
(The_Configuration));
if S = Cmvce.No_Such_Element then
Control := Not_Controlled;
return;
elsif Cmvci.Is_Bad (S) then
Logger.Status (S);
end if;
Cmvci.Version_Set_Operations.Open (Elem => The_Element,
Set => The_Version_Set,
Status => S,
Config => The_Configuration);
if S = Cmvce.Element_Not_In_Configuration then
Control := Not_Controlled;
elsif Cmvci.History_Operations.Is_Checked_Out (The_Version_Set) then
Control := Controlled_Checked_Out;
else
Control := Controlled_Checked_In;
end if;
end Get_Cmvc_Control;
procedure Make_Controlled (Gateway : in out Gwo.Handle;
Save_Source : in Boolean;
Comments : in String;
The_State : in out State) is
Gateway_Object : constant Dir.Object := Gwo.Directory_Object (Gateway);
begin
Database_Operations.Control_Parent (The_Object => Gateway_Object,
Set => Relocation.Null_Parameter,
The_State => The_State.Cmvc);
Database_Operations.Create_Or_Add_Element
(The_Object => Gateway_Object,
Version_Set_Name => "<AUTO_GENERATE>",
Save_Source => Save_Source,
Comments => Comments,
Command => "MAKE_CONTROLLED",
The_State => The_State.Cmvc);
exception
when Constraint_Error =>
Logger.Warning
("Gateway object " & Dna.Get_Full_Name (Gateway_Object) &
" could not be controlled because its parent isn't");
end Make_Controlled;
generic
with procedure Do_Update (Gateway : in Gwo.Handle);
procedure Updater (Gateway : in out Gwo.Handle;
Comments : in String;
The_State : in out State);
procedure Updater (Gateway : in out Gwo.Handle;
Comments : in String;
The_State : in out State) is
Gateway_Object : constant Dir.Object := Gwo.Directory_Object (Gateway);
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Gateway_Cmvc_Control : Cmvc_Control_Kind;
S : Ss.Condition;
begin
Get_Cmvc_Control (Object => Gateway_Object,
The_State => The_State,
Control => Gateway_Cmvc_Control);
if Gateway_Cmvc_Control = Controlled_Checked_In then
Database_Operations.Check_Out
(Objects => Directory_Operations.Singleton
(Gateway_Object, The_State.Cmvc),
Expected_Check_In_Time => Calendar.Clock,
Comments => Comments,
Allow_Demotion => False,
Allow_Accept_Changes => True,
The_State => The_State.Cmvc);
end if;
if not Gwo.Is_Main_Object_Open_For_Update (Gateway) then
Gwo.Close (Gateway, S);
Logger.Status (S);
Gwo.Open_Main_Object (Object => Gateway_Object,
H => Gateway,
Update => True,
Action_Id => Action_Id,
Errors => S);
Logger.Status (S);
end if;
Do_Update (Gateway);
Gwo.Close (Gateway, S);
Logger.Status (S);
if Gateway_Cmvc_Control = Controlled_Checked_In then
Database_Operations.Check_In (The_Object => Gateway_Object,
Comments => Comments,
The_State => The_State.Cmvc);
end if;
end Updater;
-- -------------------------------
-- ( ) Individual gateway creation
-- -------------------------------
procedure Create_Model_Gateway (Gateway_Name : in String;
Last_Id : in Natural;
For_Module : in Hchy.Module;
Host : in String;
Model : in String;
Update_Time : in Calendar.Time;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
S : Ss.Condition;
Gateway : Gwo.Handle;
use Asas;
begin
Gwo.Create (Name => Gateway_Name,
H => Gateway,
Gateway_Class => Asa_Definitions.Gateway_Class'Image
(Asa_Definitions.Asa_Model),
Action_Id => Action_Id,
Errors => S);
Logger.Status (S);
Asap.Set_Asa_Id (H => Gateway,
Value => 1);
Asap.Set_Asa_Last_Id (H => Gateway,
Value => Last_Id);
Asap.Set_Asa_Node_Number (H => Gateway,
Value => Hchy.Node_Number (For_Module));
Asap.Set_Asa_Comment (H => Gateway,
Value => Hchy.Comment (For_Module));
Asap.Set_Asa_Update_Time (H => Gateway,
Value => Update_Time);
Asap.Set_Data_Context (H => Gateway,
Value => Unix.Enclosing_Directory (Model));
Asap.Set_Data_Host (H => Gateway,
Value => Host);
Asap.Set_Data_Name (H => Gateway,
Value => Unix.Local_Name (Model));
for R in Requirements.Functional_Requirement_Number loop
Asap.Set_Asa_Requirement
(H => Gateway,
Number => R,
Value => Hchy.Requirement (For_Module, Number => R));
end loop;
Logger.Positive (Creation_Message (Gateway));
if Asas.Cmvc_Control_Level >= Asas.Control_Model then
Make_Controlled (Gateway => Gateway,
Save_Source => False,
Comments => Comments,
The_State => The_State);
end if;
Gwo.Close (Gateway, S);
Logger.Status (S);
end Create_Model_Gateway;
procedure Create_Module_Gateway (Gateway_Name : in String;
Parent_Name : in String;
Id : in Positive;
For_Module : in Hchy.Module;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
S : Ss.Condition;
Gateway : Gwo.Handle;
use Asas;
begin
Gwo.Create (Name => Gateway_Name,
H => Gateway,
Gateway_Class => Asa_Definitions.Gateway_Class'Image
(Asa_Definitions.Asa_Module),
Action_Id => Action_Id,
Errors => S);
Logger.Status (S);
Asap.Set_Asa_Id (H => Gateway,
Value => Id);
Asap.Set_Asa_Node_Number (H => Gateway,
Value => Hchy.Node_Number (For_Module));
Asap.Set_Asa_Comment (H => Gateway,
Value => Hchy.Comment (For_Module));
Asap.Set_Parent_Name (H => Gateway,
Value => Parent_Name);
for R in Requirements.Functional_Requirement_Number loop
Asap.Set_Asa_Requirement
(H => Gateway,
Number => R,
Value => Hchy.Requirement (For_Module, Number => R));
end loop;
Logger.Positive (Creation_Message (Gateway));
if Asas.Cmvc_Control_Level >= Asas.Control_Modules then
Make_Controlled (Gateway => Gateway,
Save_Source => False,
Comments => Comments,
The_State => The_State);
end if;
Gwo.Close (Gateway, S);
Logger.Status (S);
end Create_Module_Gateway;
procedure Create_Requirement_Gateway
(Gateway_Name : in String;
Parent_Name : in String;
Id : in Positive;
Requirement_Kind : in Requirements.Non_Functional;
Requirement_Text : in String;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
S : Ss.Condition;
Gateway : Gwo.Handle;
use Asas;
begin
Gwo.Create (Name => Gateway_Name,
H => Gateway,
Gateway_Class => Asa_Definitions.Gateway_Class'Image
(Asa_Definitions.Asa_Requirement),
Action_Id => Action_Id,
Errors => S);
Logger.Status (S);
Asap.Set_Asa_Id (H => Gateway,
Value => Id);
Asap.Set_Parent_Name (H => Gateway,
Value => Parent_Name);
Asap.Set_Asa_Requirement_Kind (H => Gateway, Value => Requirement_Kind);
Asap.Set_Asa_Requirement_Text (H => Gateway, Value => Requirement_Text);
Logger.Positive (Creation_Message (Gateway));
if Asas.Cmvc_Control_Level >= Asas.Control_All then
Make_Controlled (Gateway => Gateway,
Save_Source => True,
Comments => Comments,
The_State => The_State);
end if;
Gwo.Close (Gateway, S);
Logger.Status (S);
end Create_Requirement_Gateway;
-- --------------------
-- ( ) Module hierarchy
-- --------------------
procedure Create (For_Module : in Hchy.Module;
In_Library : in String;
Root_Id : in Positive;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Children : Hchy.Module_Iterator := Hchy.Children_Of (For_Module);
Child : Hchy.Module;
Parent : constant Hchy.Module := Hchy.Parent_Of (For_Module);
Nb_Of_Children : constant Natural := Hchy.Size (Children);
Next_Id : Positive := Root_Id + 1;
use Hierarchy;
begin
Create_Module_Gateway
(Gateway_Name => In_Library & '.' & Hchy.Full_Name (For_Module),
Parent_Name => In_Library & '.' & Hchy.Full_Name (Parent),
Id => Root_Id,
For_Module => For_Module,
Comments => Comments,
The_State => The_State);
for C in 1 .. Nb_Of_Children loop
Child := Hchy.Value (Children);
Create (For_Module => Child,
In_Library => In_Library,
Root_Id => Next_Id,
Comments => Comments,
The_State => The_State);
Next_Id := Next_Id + Tree_Size (Child);
Hchy.Next (Children);
end loop;
end Create;
procedure Augment (For_Module : in Hierarchy.Module;
In_Library : in String;
Comments : in String;
The_State : in out State) is
Gateway_Full_Name : constant String :=
In_Library & '.' & Hchy.Full_Name (For_Module);
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Children : Hchy.Module_Iterator;
Gateway : Gwo.Handle;
Root_Gateway : Gwo.Handle;
Root_Module : Hchy.Module;
Id : Positive;
S : Ss.Condition;
procedure Do_Set_Properties (Gateway : in Gwo.Handle) is
begin
Asap.Set_Asa_Node_Number (Gateway,
Value => Hchy.Node_Number (For_Module));
Asap.Set_Asa_Comment (Gateway, Value => Hchy.Comment (For_Module));
for R in Requirements.Functional_Requirement_Number loop
Asap.Set_Asa_Requirement
(H => Gateway,
Number => R,
Value => Hchy.Requirement (For_Module, Number => R));
end loop;
Logger.Positive ("Updated properties of " & In_Library &
'.' & Hchy.Full_Name (For_Module));
end Do_Set_Properties;
procedure Set_Properties is new Updater (Do_Set_Properties);
procedure Do_Set_Last_Id (Gateway : in Gwo.Handle) is
begin
Id := Asap.Asa_Last_Id (Gateway) + 1;
Asap.Set_Asa_Last_Id (H => Gateway, Value => Id);
end Do_Set_Last_Id;
procedure Set_Last_Id is new Updater (Do_Set_Last_Id);
use Hchy;
begin
Gwo.Open_Main_Object (Object => Gateway_Full_Name,
H => Gateway,
Update => False,
Action_Id => Action_Id,
Errors => S);
if Ss.Error (S) then
--
-- This is a new module. Create a gateway object to represent
-- it. Extract the id from the root and update the last id.
--
Root_Module := For_Module;
while Hchy.Parent_Of (Root_Module) /= Hchy.Nil loop
Root_Module := Hchy.Parent_Of (Root_Module);
end loop;
declare
Root_Full_Name : constant String :=
In_Library & '.' & Hchy.Full_Name (Root_Module);
begin
Gwo.Open_Main_Object (Object => Root_Full_Name,
H => Root_Gateway,
Update => False,
Action_Id => Action_Id,
Errors => S);
Logger.Status (S);
Set_Last_Id (Gateway => Root_Gateway,
Comments => Comments,
The_State => The_State);
Gwo.Close (Root_Gateway, S);
Logger.Status (S);
Create (For_Module => For_Module,
In_Library => In_Library,
Root_Id => Id,
Comments => Comments,
The_State => The_State);
end;
elsif not Same_Properties (Module => For_Module,
Gateway => Gateway) then
--
-- There is already a gateway object representing this module,
-- but same property has changed.
--
Set_Properties (Gateway => Gateway,
Comments => Comments,
The_State => The_State);
else
Gwo.Close (Gateway, S);
Logger.Status (S);
end if;
Children := Hchy.Children_Of (For_Module);
while not Hchy.Done (Children) loop
Augment (For_Module => Hchy.Value (Children),
In_Library => In_Library,
Comments => Comments,
The_State => The_State);
Hchy.Next (Children);
end loop;
end Augment;
procedure Destroy (Gateway_Object : in Dir.Object;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Change_Impact : Dir.Ada.Roots;
E : Dir.Error_Status;
Errors : Error_Messages.Errors;
Gateway_Cmvc_Control : Cmvc_Control_Kind;
Modified_Units : Diana.Temp_Seq;
begin
Get_Cmvc_Control (Object => Gateway_Object,
The_State => The_State,
Control => Gateway_Cmvc_Control);
if Gateway_Cmvc_Control >= Controlled_Checked_Out then
Database_Operations.Check_In (The_Object => Gateway_Object,
Comments => Comments,
The_State => The_State.Cmvc);
end if;
if Gateway_Cmvc_Control >= Controlled_Checked_In then
Database_Operations.Make_Uncontrolled (The_Object => Gateway_Object,
Comments => Comments,
The_State => The_State.Cmvc);
end if;
Doo.Destroy (The_Object => Gateway_Object,
Errors => Errors,
Change_Impact => Change_Impact,
Modified_Units => Modified_Units,
Status => E,
Limit_Type => Dir.Any_Object,
Action_Id => Action_Id);
Logger.Status (E);
end Destroy;
procedure Reduce (Gateway_Object : in Dir.Object;
Candidate_Modules : in out Hierarchy.Module_Iterator;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Heap : System.Segment renames The_State.Cmvc.Heap;
E : Dir.Error_Status;
N : Dna.Name_Status;
Candidate_Children : Hchy.Module_Iterator;
Candidate_Module : Hchy.Module;
Gateway_Child : Dir.Object;
Gateway_Children : Dna.Iterator;
Gateway_Object_Full_Name : constant String :=
Dna.Get_Full_Name (Gateway_Object);
Gateway_Object_Simple_Name : constant String :=
Dna.Get_Simple_Name (Gateway_Object);
Must_Remain : Boolean;
use Dna;
begin
Must_Remain := False;
while not Hchy.Done (Candidate_Modules) loop
Candidate_Module := Hchy.Value (Candidate_Modules);
if Su.Equal (Gateway_Object_Simple_Name,
Hchy.Simple_Name (Candidate_Module)) then
Must_Remain := True;
exit;
end if;
Hchy.Next (Candidate_Modules);
end loop;
if Must_Remain then
--
-- There is a module for this gateway object, so it must be
-- kept.
--
Logger.Note ("Gateway " & Gateway_Object_Full_Name &
" corresponds to module " &
Hchy.Full_Name (Candidate_Module));
Dna.Resolve (Iter => Gateway_Children,
Source => Gateway_Object_Full_Name & ".@'C(~Text)",
Status => N,
Heap => Heap,
Action_Id => Action_Id);
if N /= Dna.Undefined then
Logger.Status (N);
while not Dna.Done (Gateway_Children) loop
Candidate_Children := Hchy.Children_Of (Candidate_Module);
Dna.Get_Object (Iter => Gateway_Children,
The_Object => Gateway_Child,
Status => E);
Logger.Status (E);
Reduce (Gateway_Object => Gateway_Child,
Candidate_Modules => Candidate_Children,
Comments => Comments,
The_State => The_State);
Dna.Next (Gateway_Children);
end loop;
end if;
else
--
-- There is no longer a corresponding module for this gateway
-- object. We first check that the object has no
-- non-functional requirements, and then delete it.
--
Dna.Resolve (Iter => Gateway_Children,
Source => Gateway_Object_Full_Name & ".@'C(Text)",
Status => N,
Heap => Heap,
Action_Id => Action_Id);
if N = Dna.Undefined then
Destroy (Gateway_Object => Gateway_Object,
Comments => Comments,
The_State => The_State);
Logger.Positive
("Gateway object " & Gateway_Object_Full_Name &
" has been destroyed because it has no longer " &
"a corresponding module");
else
Logger.Warning ("The gateway object " &
Gateway_Object_Full_Name &
" couldn't be destroyed because it has " &
"subobjects representing non-functional " &
"requirements. Use Asa.Move_Requirement " &
"to move these objects, and then run " &
"Asa.Accept_Changes again to complete " &
"change propagation");
end if;
end if;
end Reduce;
-- ----------------------------------
-- ( ) Bodies of external subprograms
-- ----------------------------------
function Cmvc_Control (Gateway_Name : in String) return Cmvc_Control_Kind is
Gateway_Object : Dir.Object;
Gateway_Cmvc_Control : Cmvc_Control_Kind;
N : Dna.Name_Status;
The_Action : Action.Id;
The_State : State;
begin
The_Action := Action.Start;
Initialize (The_State => The_State,
Action_Id => The_Action,
Work_Order => "");
Dna.Resolve (Name => Gateway_Name,
The_Object => Gateway_Object,
Status => N,
Action_Id => The_Action);
Logger.Status (N);
Get_Cmvc_Control (Object => Gateway_Object,
The_State => The_State,
Control => Gateway_Cmvc_Control);
Finalize (The_State);
Action.Finish (The_Action => The_Action, Do_Commit => True);
return Gateway_Cmvc_Control;
end Cmvc_Control;
procedure Initialize (The_State : out State;
Action_Id : in Action.Id;
Work_Order : in String) is
Result : State;
The_Filter : Profile.Log_Filter := Profile.Filter;
The_Heap : constant System.Segment := Job_Segment.Get;
begin
The_Filter (Profile.Auxiliary_Msg) := False;
Result := (Cmvc => new State_Operations.State_Record,
Configuration => Cmvci.Nil);
pragma Heap (The_Heap);
Result.Cmvc.Action_Id := Action_Id;
Result.Cmvc.Heap := The_Heap;
Result.Cmvc.Current_Profile :=
Profile.Raise_Exception (Filter => The_Filter);
State_Operations.Object_To_Database.Initialize
(Result.Cmvc.Database_Map, The_Heap);
State_Operations.Object_To_String.Initialize
(Result.Cmvc.String_Map, The_Heap);
--[should open work-order]
The_State := Result;
end Initialize;
procedure Finalize (The_State : in out State) is
begin
Database_Operations.Close (The_State.Cmvc);
end Finalize;
procedure Augment (For_Module : in Hierarchy.Module;
In_Library : in String;
Host : in String;
Model : in String;
Update_Time : in Calendar.Time;
Comments : in String;
The_State : in out State) is
Gateway_Full_Name : constant String :=
In_Library & '.' & Hchy.Full_Name (For_Module);
S : Ss.Condition;
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Children : Hchy.Module_Iterator;
Gateway : Gwo.Handle;
procedure Do_Set_Update_Time_And_Properties (Gateway : in Gwo.Handle) is
begin
Asap.Set_Asa_Update_Time (Gateway, Value => Update_Time);
if not Same_Properties (Module => For_Module,
Gateway => Gateway) then
Asap.Set_Asa_Node_Number
(Gateway, Value => Hchy.Node_Number (For_Module));
Asap.Set_Asa_Comment (Gateway,
Value => Hchy.Comment (For_Module));
for R in Requirements.Functional_Requirement_Number loop
Asap.Set_Asa_Requirement
(H => Gateway,
Number => R,
Value => Hchy.Requirement (For_Module, Number => R));
end loop;
Logger.Positive ("Updated properties of " & In_Library &
'.' & Hchy.Full_Name (For_Module));
end if;
end Do_Set_Update_Time_And_Properties;
procedure Set_Update_Time_And_Properties is
new Updater (Do_Set_Update_Time_And_Properties);
use Hchy;
begin
Gwo.Open_Main_Object (Object => Gateway_Full_Name,
H => Gateway,
Update => False,
Action_Id => Action_Id,
Errors => S);
if Ss.Error (S) then
--
-- This is a new model. Create a gateway object to represent
-- it.
--
Create (For_Module => For_Module,
In_Library => In_Library,
Host => Host,
Model => Model,
Update_Time => Update_Time,
Comments => Comments,
The_State => The_State);
else
Set_Update_Time_And_Properties (Gateway => Gateway,
Comments => Comments,
The_State => The_State);
Gwo.Close (Gateway, S);
Logger.Status (S);
end if;
Children := Hchy.Children_Of (For_Module);
while not Hchy.Done (Children) loop
Augment (For_Module => Hchy.Value (M => Children),
In_Library => In_Library,
Comments => Comments,
The_State => The_State);
Hchy.Next (Children);
end loop;
end Augment;
procedure Create (For_Module : in Hierarchy.Module;
In_Library : in String;
Host : in String;
Model : in String;
Update_Time : in Calendar.Time;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Children : Hchy.Module_Iterator := Hchy.Children_Of (For_Module);
Child : Hchy.Module;
Next_Id : Positive;
Size : constant Positive := Tree_Size (For_Module);
use Hierarchy;
begin
Create_Model_Gateway
(Gateway_Name => In_Library & '.' & Hchy.Full_Name (For_Module),
Last_Id => Size,
For_Module => For_Module,
Host => Host,
Model => Model,
Update_Time => Update_Time,
Comments => Comments,
The_State => The_State);
Next_Id := 2;
for C in 1 .. Hchy.Size (Children) loop
Child := Hchy.Value (Children);
Create (For_Module => Hchy.Value (Children),
In_Library => In_Library,
Root_Id => Next_Id,
Comments => Comments,
The_State => The_State);
Next_Id := Next_Id + Tree_Size (Child);
Hchy.Next (Children);
end loop;
end Create;
procedure Create (In_Gateway : in String;
Requirement_Name : in String;
Requirement_Kind : in Requirements.Non_Functional;
Requirement_Text : in String;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
Id : Positive;
N : Dna.Name_Status;
Parent : Gwo.Handle;
Parent_Object : Dir.Object;
S : Ss.Condition;
procedure Do_Set_Last_Requirement_Id (Gateway : in Gwo.Handle) is
begin
Id := Asap.Asa_Last_Requirement_Id (Gateway) + 1;
Asap.Set_Asa_Last_Requirement_Id (H => Gateway, Value => Id);
end Do_Set_Last_Requirement_Id;
procedure Set_Last_Requirement_Id is
new Updater (Do_Set_Last_Requirement_Id);
use Asa_Definitions;
begin
Dna.Resolve (Name => In_Gateway,
The_Object => Parent_Object,
Status => N,
Action_Id => Action_Id);
Logger.Status (N);
Gwo.Open_Main_Object (Object => Parent_Object,
H => Parent,
Update => False,
Action_Id => Action_Id,
Errors => S);
Logger.Status (S);
if Asap.Class (Parent) = Asa_Definitions.Asa_Requirement then
Logger.Error ("The gateway object " &
Dna.Get_Full_Name (Parent_Object) &
" does not represent an " &
Asa_Definitions.Asa & " module, and thus " &
"cannot host non-functional requirements");
end if;
Set_Last_Requirement_Id (Gateway => Parent,
Comments => Comments,
The_State => The_State);
Gwo.Close (Parent, S);
Logger.Status (S);
declare
Parent_Full_Name : constant String :=
Dna.Get_Full_Name (Parent_Object);
begin
Create_Requirement_Gateway
(Gateway_Name => Parent_Full_Name & '.' & Requirement_Name,
Parent_Name => Parent_Full_Name,
Id => Id,
Requirement_Kind => Requirement_Kind,
Requirement_Text => Requirement_Text,
Comments => Comments,
The_State => The_State);
end;
end Create;
procedure Destroy (Gateway_Name : in String;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
N : Dna.Name_Status;
Gateway_Object : Dir.Object;
begin
Dna.Resolve (Name => Gateway_Name,
The_Object => Gateway_Object,
Status => N,
Action_Id => Action_Id);
Logger.Status (N);
Destroy (Gateway_Object => Gateway_Object,
Comments => Comments,
The_State => The_State);
end Destroy;
procedure Reduce (Gateway_Name : in String;
Candidate_Modules : in out Hierarchy.Module_Iterator;
Comments : in String;
The_State : in out State) is
Action_Id : Action.Id renames The_State.Cmvc.Action_Id;
N : Dna.Name_Status;
Gateway_Object : Dir.Object;
begin
Dna.Resolve (Name => Gateway_Name,
The_Object => Gateway_Object,
Status => N,
Action_Id => Action_Id);
Logger.Status (N);
Reduce (Gateway_Object => Gateway_Object,
Candidate_Modules => Candidate_Modules,
Comments => Comments,
The_State => The_State);
end Reduce;
end Gateways;