diff options
| -rw-r--r-- | src/directed_graphs.adb | 66 | ||||
| -rw-r--r-- | src/directed_graphs.ads | 40 | ||||
| -rw-r--r-- | test/graph_tests-search.adb | 69 | ||||
| -rw-r--r-- | test/graph_tests-search.ads | 4 |
4 files changed, 178 insertions, 1 deletions
diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb index 12916d1..bacb040 100644 --- a/src/directed_graphs.adb +++ b/src/directed_graphs.adb @@ -1019,6 +1019,12 @@ package body Directed_Graphs is Impl.Unbusy (Object.Container.Tamper_Info); end Finalize; + procedure Finalize + (Object : in out By_Iterator) is + begin + Impl.Unbusy (Object.Container.Tamper_Info); + end Finalize; + @@ -1163,6 +1169,17 @@ package body Directed_Graphs is end if; end First; + function First + (Object : in By_Iterator) + return Cursor is + begin + if Object.Filter = null or else Object.Filter (Object.Start) then + return Object.Start; + else + return Next (Object, Object.Start); + end if; + end First; + @@ -1628,6 +1645,40 @@ package body Directed_Graphs is + ---------------- + -- Iterate_By -- + ---------------- + + function Iterate_By + (Container : in Graph; + Start : in Cursor; + Chooser : in Choice_Function; + Filter : in Filter_Function := null) + return Graph_Iterator_Interfaces.Forward_Iterator'Class is + begin + if Impl.Checks then + if Start.Container /= Container'Unrestricted_Access then + raise Constraint_Error with "Cursor points to different graph"; + end if; + if not Has_Element (Start) then + raise Constraint_Error with "Start Cursor points to nothing"; + end if; + if Chooser = null then + raise Constraint_Error with "No choice function supplied"; + end if; + end if; + return It : By_Iterator do + It.Container := Container'Unrestricted_Access; + It.Start := Start; + It.Chooser := Chooser; + It.Filter := Filter; + Impl.Busy (Container.Tamper_Info'Unrestricted_Access.all); + end return; + end Iterate_By; + + + + ---------------------- -- Iterate_Subgraph -- ---------------------- @@ -2010,6 +2061,21 @@ package body Directed_Graphs is end if; end Next; + function Next + (Object : in By_Iterator; + Position : in Cursor) + return Cursor + is + Result : Cursor := Position; + begin + loop + Result := Object.Chooser (Result); + if Object.Filter = null or else Object.Filter (Result) then + return Result; + end if; + end loop; + end Next; + diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads index d31b7c7..3154f75 100644 --- a/src/directed_graphs.ads +++ b/src/directed_graphs.ads @@ -670,6 +670,21 @@ package Directed_Graphs is Position : in Cursor) return Graph_Iterator_Interfaces.Reversible_Iterator'Class; + type Choice_Function is access function + (Position : in Cursor) + return Cursor; + + type Filter_Function is access function + (Position : in Cursor) + return Boolean; + + function Iterate_By + (Container : in Graph; + Start : in Cursor; + Chooser : in Choice_Function; + Filter : in Filter_Function := null) + return Graph_Iterator_Interfaces.Forward_Iterator'Class; + function First (Container : in Graph) return Cursor; @@ -963,6 +978,31 @@ private + type By_Iterator is new Ada.Finalization.Controlled and + Graph_Iterator_Interfaces.Forward_Iterator with + record + Container : Graph_Access; + Start : Cursor; + Chooser : Choice_Function; + Filter : Filter_Function; + end record + with Disable_Controlled => not Impl.T_Check; + + overriding procedure Finalize + (Object : in out By_Iterator); + + overriding function First + (Object : in By_Iterator) + return Cursor; + + overriding function Next + (Object : in By_Iterator; + Position : in Cursor) + return Cursor; + + + + generic type Base_Type is private; type Array_Type is array (Positive range <>) of Base_Type; diff --git a/test/graph_tests-search.adb b/test/graph_tests-search.adb index 17c2cbb..d72ce67 100644 --- a/test/graph_tests-search.adb +++ b/test/graph_tests-search.adb @@ -230,6 +230,75 @@ package body Graph_Tests.Search is end Iterate_Subgraph_Check; + function Iterate_By_Check + return Test_Result + is + function Max + (Nodes : in Graphs.Node_Array) + return Node_ID + is + Current : Node_ID := 1; + begin + for N of Nodes loop + if N > Current then + Current := N; + end if; + end loop; + return Current; + end Max; + + function My_Choices + (Position : in Graphs.Cursor) + return Graphs.Cursor + is + Pick_From : Graphs.Node_Array := Graphs.Children (Position); + begin + if Pick_From'Length = 0 then + return Graphs.No_Element; + end if; + return Graphs.Cursor_To (Position, Max (Pick_From)); + end My_Choices; + + function My_Filter + (Position : in Graphs.Cursor) + return Boolean is + begin + return not Graphs.Has_Element (Position) or else + Graphs.Element (Position) mod 2 = 0; + end My_Filter; + + Index : Positive := 1; + Check_1 : Graphs.Node_Array := (1, 5, 7, 10); + Check_2 : Graphs.Node_Array := (1 => 10); + + Start : Graphs.Cursor := My_Complex_Graph.To_Cursor (1); + begin + for C in My_Complex_Graph.Iterate_By (Start, My_Choices'Unrestricted_Access) loop + if Index not in Check_1'Range or else + Graphs.Element (C) /= Check_1 (Index) + then + return Fail; + else + Index := Index + 1; + end if; + end loop; + + Index := 1; + for C in My_Complex_Graph.Iterate_By + (Start, My_Choices'Unrestricted_Access, My_Filter'Unrestricted_Access) + loop + if Index not in Check_2'Range or else + Graphs.Element (C) /= Check_2 (Index) + then + return Fail; + else + Index := Index + 1; + end if; + end loop; + return Pass; + end Iterate_By_Check; + + end Graph_Tests.Search; diff --git a/test/graph_tests-search.ads b/test/graph_tests-search.ads index d0ea2bb..63602e7 100644 --- a/test/graph_tests-search.ads +++ b/test/graph_tests-search.ads @@ -15,6 +15,7 @@ package Graph_Tests.Search is function Contains_Label_Subgraph_Check return Test_Result; function Iterate_Check return Test_Result; function Iterate_Subgraph_Check return Test_Result; + function Iterate_By_Check return Test_Result; Tests : Test_Array := @@ -25,7 +26,8 @@ package Graph_Tests.Search is (+"Contains_In_Subgraph", Contains_Subgraph_Check'Access), (+"Contains_Label_In_Subgraph", Contains_Label_Subgraph_Check'Access), (+"Iterate", Iterate_Check'Access), - (+"Iterate_Subgraph", Iterate_Subgraph_Check'Access)); + (+"Iterate_Subgraph", Iterate_Subgraph_Check'Access), + (+"Iterate_By", Iterate_By_Check'Access)); end Graph_Tests.Search; |