(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind);
+ New_Kind : Library_Graph_Edge_Kind);
-- This is called by Add_Edge in the case where there is already a
- -- Pred-->Succ edge, to assert that the new Kind is appropriate. Raises
+ -- Pred-->Succ edge, to assert that the New_Kind is appropriate. Raises
-- Program_Error if a bug is detected. The purpose is to prevent bugs
-- where calling Add_Edge in different orders produces different output.
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind)
+ New_Kind : Library_Graph_Edge_Kind)
is
Old_Edge : constant Library_Graph_Edge_Id :=
Find_Edge (G, Pred, Succ);
- Attributes : constant Library_Graph_Edge_Attributes :=
- Get_LGE_Attributes (G, Old_Edge);
+ Old_Kind : constant Library_Graph_Edge_Kind :=
+ Get_LGE_Attributes (G, Old_Edge).Kind;
OK : Boolean;
begin
- case Kind is
- -- We call Add_Edge with Body_Before_Spec_Edge twice -- once
- -- for the spec and once for the body, but no other Kind can
- -- be spec-->body.
-
- when Body_Before_Spec_Edge =>
- if True then
- -- ????Disable this part of the assertion for now
- OK := True;
- else
- OK := Attributes.Kind = Body_Before_Spec_Edge;
- end if;
-
- -- Spec_Before_Body_Edge comes first
-
+ case New_Kind is
when Spec_Before_Body_Edge =>
OK := False;
-
- -- With clauses and forced edges come after Spec_Before_Body_Edge
+ -- Spec_Before_Body_Edge comes first, and there is never more
+ -- than one Spec_Before_Body_Edge for a given unit, so we can't
+ -- have a preexisting edge in the Spec_Before_Body_Edge case.
when With_Edge | Elaborate_Edge | Elaborate_All_Edge
- | Forced_Edge =>
- OK := Attributes.Kind <= Kind;
+ | Forced_Edge | Invocation_Edge =>
+ OK := Old_Kind <= New_Kind;
+ -- These edges are created in the order of the enumeration
+ -- type, and there can be duplicates; hence "<=".
- -- Invocation_Edge can come after anything, including another
- -- Invocation_Edge.
+ when Body_Before_Spec_Edge =>
+ OK := Old_Kind = Body_Before_Spec_Edge
+ -- We call Add_Edge with Body_Before_Spec_Edge twice -- once
+ -- for the spec and once for the body.
- when Invocation_Edge =>
- OK := True;
+ or else Old_Kind = Forced_Edge
+ or else Old_Kind = Invocation_Edge;
+ -- The old one can be Forced_Edge or Invocation_Edge, which
+ -- necessarily results in an elaboration cycle (in the static
+ -- model), but this assertion happens before cycle detection,
+ -- so we need to allow these cases.
when No_Edge =>
OK := False;
end case;
if not OK then
- raise Program_Error with Kind'Img & "-->" & Attributes.Kind'Img;
+ raise Program_Error with Old_Kind'Img & "-->" & New_Kind'Img;
end if;
end Add_Edge_Kind_Check;
No_Cycle_Kind);
- -- The following type represents the various kinds of library edges.
- -- The order is important here, and roughly corresponds to the order
- -- in which edges are added to the graph. See Add_Edge_Kind_Check for
- -- details.
+ -- The following type represents the various kinds of library edges. The
+ -- order is important here, and corresponds to the order in which edges
+ -- are added to the graph. See Add_Edge_Kind_Check for details. If
+ -- changes are made such that new edge kinds are added or similar, we
+ -- need to make sure this type matches the code in Add_Edge_Kind_Check,
+ -- and Add_Edge_Kind_Check matches the order of edge adding. Likewise,
+ -- if the edge-adding order changes, we need consistency between this
+ -- enumeration type, the edge-adding order, and Add_Edge_Kind_Check.
type Library_Graph_Edge_Kind is
- (Body_Before_Spec_Edge,
- -- Successor denotes spec, Predecessor denotes a body. This is a
- -- special edge kind used only during the discovery of components.
- -- Note that a body can never be elaborated before its spec.
-
- Spec_Before_Body_Edge,
+ (Spec_Before_Body_Edge,
-- Successor denotes a body, Predecessor denotes a spec
- With_Edge,
- -- Successor withs Predecessor
-
Elaborate_Edge,
-- Successor withs Predecessor, and has pragma Elaborate for it
Elaborate_All_Edge,
-- Successor withs Predecessor, and has pragma Elaborate_All for it
+ With_Edge,
+ -- Successor withs Predecessor
+
Forced_Edge,
-- Successor is forced to with Predecessor by virtue of an existing
-- elaboration order provided in a file.
-- An invocation construct in unit Successor invokes a target in unit
-- Predecessor.
+ Body_Before_Spec_Edge,
+ -- Successor denotes spec, Predecessor denotes a body. This is a
+ -- special edge kind used only during the discovery of components.
+ -- Note that a body can never be elaborated before its spec.
+
No_Edge);
-----------