gnatcoll_25.0.0_d7d84483/testsuite/tests/directed_graph/test.adb

with GNATCOLL.Directed_Graph; use GNATCOLL.Directed_Graph;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Assertions; use Ada.Assertions;
with Test_Assert;

function Test return Integer is

   package A renames Test_Assert;
   use Node_Vectors;
   use Node_Sets;

   G : Directed_Graph;
   N1, N2, N3, N4, N5 : Node_Id;
   N : Node_Id;
   S : Node_Set;
begin
   --  Test Add_node method
   N1 := G.Add_Node;
   A.Assert (G.Contains (N1));

   --  Check that we cannot add a node with predecessor including itself
   --  This test makes assumption about how Node_Id are allocated
   begin
      N2 := G.Add_Node (Predecessors => (1 => 2));
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error =>
         A.Assert (True);
      when others =>
         A.Assert (False, "Unknown exception");
   end;

   begin
      S.Clear;
      S.Include (2);
      N2 := G.Add_Node (Predecessors => S);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error =>
         A.Assert (True);
      when others =>
         A.Assert (False, "Unknown exception");
   end;

   --  Check that we cannot add non existing nodes as predecessors
   begin
      N2 := G.Add_Node (Predecessors => (5, 6));
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error =>
         A.Assert (True);
      when others =>
         A.Assert (False, "Unknown exception");
   end;

   begin
      S.Clear;
      S.Include (5);
      S.Include (6);
      N2 := G.Add_Node (Predecessors => S);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error =>
         A.Assert (True);
      when others =>
         A.Assert (False, "Unknown exception");
   end;

   --  At this all node additions have failed except the first one. A failure
   --  on this test probably means that the pre-condition checks are done after
   --  allocating a new node.
   A.Assert (G.Length, 1);

   --  Add nodes with valid dependencies with both array and sets
   N2 := G.Add_Node (Predecessors => (1 => N1));
   N3 := G.Add_Node (Predecessors => (1 => N2));

   S.Clear;
   S.Include (N3);
   N4 := G.Add_Node (Predecessors => S);
   A.Assert (G.Contains (N4));

   --  Test Add_Predecessor(s) functions
   N5 := G.Add_Node;

   --  Cannot add a node in its own predecessors
   begin
      S.Clear;
      S.Include (N5);
      G.Add_Predecessors (N5, S);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error =>
         A.Assert (True);
      when others =>
         A.Assert (False, "Unknown exception");
   end;

   begin
      G.Add_Predecessor (N5, N5);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error =>
         A.Assert (True);
      when others =>
         A.Assert (False, "Unknown exception");
   end;

   --  Cannot add No_Node as predecessors
   begin
      S.Clear;
      S.Include (No_Node);
      S.Include (N4);
      G.Add_Predecessors (N5, S);
      A.Assert (False, "Exception not raised");
   exception
      when E : DG_Error =>
         A.Assert (True, Exception_Message (E));
      when others =>
         A.Assert (False, "Unknown exception");
   end;

   --  All nodes should exist
   begin
      G.Add_Predecessor (N5, 10);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error | Assertion_Error =>
         A.Assert (True);
      when E : others =>
         A.Assert (False, "Unknown exception: " &
                   Exception_Name (E) & " " & Exception_Message (E));
   end;

   begin
      G.Add_Predecessor (10, N5);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error | Assertion_Error =>
         A.Assert (True);
      when E : others =>
         A.Assert (False, "Unknown exception: " & Exception_Message (E));
   end;

   --  All nodes should exist
   declare
      Predecessors : Node_Set := Empty_Node_Set;
   begin
      Predecessors.Include (10);
      G.Add_Predecessors (N5, Predecessors);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error | Assertion_Error =>
         A.Assert (True);
      when E : others =>
         A.Assert (False, "Unknown exception: " &
                   Exception_Name (E) & " " & Exception_Message (E));
   end;

   declare
      Predecessors : Node_Set := Empty_Node_Set;
   begin
      Predecessors.Include (N5);
      G.Add_Predecessors (10, Predecessors);
      A.Assert (False, "Exception not raised");
   exception
      when DG_Error | Assertion_Error =>
         A.Assert (True);
      when E : others =>
         A.Assert (False, "Unknown exception: " & Exception_Message (E));
   end;

   declare
      Predecessors : Node_Set := Empty_Node_Set;
   begin
      Predecessors.Include (N4);
      G.Add_Predecessors (N5, Predecessors);
   end;

   --  N1 -> N2 -> N3 -> N4 -> N5
   A.Assert (not G.Has_Cycle);
   A.Assert (G.Shortest_Cycle = Empty_Node_Vector);

   declare
      Expected : constant Node_Vector := N1 & N2 & N3 & N4 & N5;
   begin
      --  Topological view

      A.Assert (Expected = G.Topological_Sort);
   end;

   G.Start_Iterator (False);
   A.Assert (G.Next (N) and then N = N1);
   A.Assert (G.Next (N) and then N = N2);
   A.Assert (G.Next (N) and then N = N3);
   A.Assert (G.Next (N) and then N = N4);
   A.Assert (G.Next (N) and then N = N5);
   A.Assert (not G.Next (N) and then N = No_Node);

   G.Start_Iterator (False);
   A.Assert (G.Next = N1);
   A.Assert (G.Next = N2);
   A.Assert (G.Next = N3);
   A.Assert (G.Next = N4);
   A.Assert (G.Next = N5);
   A.Assert (G.Next = No_Node);

   declare
      Iter : DAG_Iterator;
   begin
      Iter.Start_Iterator (G, False);
      G.Start_Iterator (False);
      A.Assert (Iter.Next (G) = N1);
      A.Assert (Iter.Next (G) = N2);
      A.Assert (Iter.Next (G) = N3);
      A.Assert (Iter.Next (G) = N4);
      A.Assert (Iter.Next (G) = N5);
      A.Assert (Iter.Next (G) = No_Node);
   end;

   --  Create a loop in the graph
   --  N1 -> N2 -> N3 -> N4 -> N1
   --                       -> N5

   declare
      Cycle : Node_Vector;
      S : Node_Set;
      Expected_Short_Cycle : Node_Set;
   begin
      Expected_Short_Cycle.Include (N1);
      Expected_Short_Cycle.Include (N2);
      Expected_Short_Cycle.Include (N3);
      Expected_Short_Cycle.Include (N4);

      G.Add_Predecessor (N1, N4);

      A.Assert (G.Has_Cycle);
      A.Assert (G.Topological_Sort = Node_Vectors.Empty_Vector);
      Cycle := G.Shortest_Cycle;
      for N of Cycle loop
         S.Include (N);
      end loop;
      A.Assert (S = Expected_Short_Cycle);
   end;

   --  When Enable_Visiting_State is not set, cycles are also detected during
   --  the graph iteration.

   begin
      declare
         Node : Node_Id;
         Status : Boolean;
      begin

         G.Start_Iterator (False);
         Status := G.Next (Node);

         --  Exception shall have been raised during the previous Next

         A.Assert (False, "Next returned " & Status'Img  & "Node=" & Node'Img);
      end;
   exception
      when others =>
         A.Assert (True);

   end;

   --  Reset the graph
   G.Clear;

   --    ->N2--
   --   /      \
   --  N1      N4
   --   \      /
   --    ->N3--

   N1 := G.Add_Node;
   N2 := G.Add_Node (Predecessors => (1 => N1));
   N3 := G.Add_Node (Predecessors => (1 => N1));
   N4 := G.Add_Node (Predecessors => (N3, N2));

   --  Visiting state disabled

   declare
      Node   : Node_Id;
      Status : Boolean;
   begin
      A.Assert (not G.Iterator_Started);
      G.Start_Iterator (False);
      A.Assert (G.Iterator_Started);

      A.Assert (G.Next (Node) and then Node = N1);
      A.Assert (G.Visiting_Nodes = Node_Sets.Empty_Set);

      for Unused in 1 .. 2 loop
         Status := G.Next (Node);
         A.Assert (Status and then (Node = N2 or else Node = N3));
      end loop;

      A.Assert (G.Next (Node) and then Node = N4);
      A.Assert (not G.Next (Node) and then Node = No_Node);
   end;

   --  Visiting state enabled

   declare
      Save_1, Save_2, Node : Node_Id;
      Status : Boolean;
   begin

      G.Start_Iterator (True);

      A.Assert (G.Next (Node) and then Node = N1);

      A.Assert (G.Next (Node) and Node = No_Node);
      G.Complete_Visit (N1);

      --  Check that we can not complete a non-visited node

      begin
         G.Complete_Visit (N4);
         A.Assert (False, "Exception not raised");
      exception
      when DG_Error | Assertion_Error =>
         A.Assert (True);
      when E : others =>
         A.Assert (False, "Unknown exception: " & Exception_Message (E));
      end;

      Status := G.Next (Save_1);
      A.Assert (Status and then (Save_1 = N2 or else Save_1 = N3));
      Status := G.Next (Save_2);
      A.Assert (Status and then (Save_2 = N2 or else Save_2 = N3));

      for Visiting_Node of G.Visiting_Nodes loop
         A.Assert (Visiting_Node = N2 or else Visiting_Node = N3);
      end loop;

      --  Visiting nodes need to be left

      A.Assert (G.Next (Node) and then Node = No_Node);
      G.Complete_Visit (Save_1);
      A.Assert (G.Next (Node) and then Node = No_Node);
      A.Assert (G.Visiting_Nodes.First_Element = Save_2);

      G.Complete_Visit (Save_2);
      A.Assert (G.Visiting_Nodes = Node_Sets.Empty_Set);

      --  Check that completing an already visited node has no effect

      G.Complete_Visit (Save_2);

      --  Last job is now available

      A.Assert (G.Next (Node) and then Node = N4);
      A.Assert (not G.Next (Node) and then Node = No_Node);
   end;

   --  Test node addition during an iteration

   declare
      Node   : Node_Id;
   begin
      G.Clear;

      --  N1 --> N2 --> N3
      --   \
      --    ---> N4

      N1 := G.Add_Node;
      N2 := G.Add_Node (Predecessors => (1 => N1));
      N3 := G.Add_Node (Predecessors => (1 => N2));
      N4 := G.Add_Node (Predecessors => (1 => N1));

      G.Start_Iterator (True);

      A.Assert (G.Next (Node) and then Node = N1);
      G.Complete_Visit (N1);
      A.Assert (G.Next (Node) and then Node = N2);
      G.Complete_Visit (N2);

      --  N1 --> N2 -------> N3
      --   |\--> N4 ------/
      --   |     \       /
      --    \-----> N5 -/

      N5 := G.Add_Node (Predecessors => (N1, N4));
      G.Add_Predecessor (N3, N5);

      A.Assert (G.Next (Node) and then Node = N4);
      A.Assert (G.Next (Node) and then Node = No_Node);
      G.Complete_Visit (N4);

      A.Assert (G.Next (Node) and then Node = N5);
      A.Assert (G.Next (Node) and then Node = No_Node);
      G.Complete_Visit (N5);

      A.Assert (G.Next (Node) and then Node = N3);
      G.Complete_Visit (N3);

      A.Assert (not G.Next (Node) and then Node = No_Node);
   end;

   --  Test shortest path

   G.Clear;

   --  N1 ----------> N2 --> N3
   --   \             /
   --    ---> N4 -> N5

   N1 := G.Add_Node;
   N4 := G.Add_Node (Predecessors => (1 => N1));
   N5 := G.Add_Node (Predecessors => (1 => N4));
   N2 := G.Add_Node (Predecessors => (N1, N5));
   N3 := G.Add_Node (Predecessors => (1 => N2));

   declare
      Expected : constant Node_Vector := N1 & N2 & N3;
   begin
      A.Assert (Expected = G.Shortest_Path (N1, N3));
   end;

   A.Assert (G.Shortest_Path (N3, N1) = Empty_Node_Vector);

   declare
      Node : Node_Id;
   begin
      G.Clear;
      N1 := G.Add_Node;
      N2 := G.Add_Node (Predecessors => (1 => N1));
      N3 := G.Add_Node (Predecessors => (1 => N2));

      G.Start_Iterator (True);
      A.Assert (G.Next (Node) and then Node = N1);
      G.Complete_Visit (N1);
      G.Add_Predecessor (N3, N1);
      A.Assert (G.Next (Node) and then Node = N2);
      G.Complete_Visit (N2);
      A.Assert (G.Next (Node) and then Node = N3);
   end;

   return A.Report;
end Test;