From 617e56255d7f292007853237c1a6ab034dfca0e4 Mon Sep 17 00:00:00 2001 From: Joao Azevedo Date: Mon, 30 Jan 2023 11:08:34 +0000 Subject: [PATCH] Use explicitly withed units instead of P_Withed_Units result Add Get_Withed_Units that gets explicitly withed units instead of P_Withed_Units which now also returns the parent packages of the explicitly withed packages. --- src/laltools-common.adb | 54 +++++++++-- src/laltools-common.ads | 26 +++-- src/laltools-refactor-suppress_separate.adb | 10 +- .../gpsauto.cgpr | 97 ------------------- 4 files changed, 72 insertions(+), 115 deletions(-) delete mode 100644 testsuite/tests/refactoring_suppress_separate/T318-086/suppress_subp_w_params_from_subp_body_stub/gpsauto.cgpr diff --git a/src/laltools-common.adb b/src/laltools-common.adb index 11d11888..4f344b54 100644 --- a/src/laltools-common.adb +++ b/src/laltools-common.adb @@ -2370,13 +2370,8 @@ package body Laltools.Common is function Get_Used_Units (Node : Compilation_Unit'Class) - return Compilation_Unit_Array + return Compilation_Unit_Array is - package Compilation_Unit_Vectors is new Ada.Containers.Vectors - (Index_Type => Natural, - Element_Type => Compilation_Unit, - "=" => "="); - Used_Units : Compilation_Unit_Vectors.Vector; begin @@ -2416,6 +2411,53 @@ package body Laltools.Common is end return; end Get_Used_Units; + ---------------------- + -- Get_Withed_Units -- + ---------------------- + + function Get_Withed_Units + (Node : Compilation_Unit'Class) + return Compilation_Unit_Array + is + Used_Units : Compilation_Unit_Vectors.Vector; + + begin + if Node.Is_Null then + return []; + end if; + + for Clause of Node.F_Prelude loop + if Clause.Kind in Ada_With_Clause_Range then + for Use_Clause of Clause.As_With_Clause.F_Packages loop + declare + C_Unit : constant Compilation_Unit := + Get_Compilation_Unit (Use_Clause.P_Referenced_Decl); + begin + if not C_Unit.Is_Null then + Used_Units.Append (C_Unit); + end if; + end; + end loop; + end if; + end loop; + + -- Copy the Used_Units elements to an array + + return R : Compilation_Unit_Array + (1 .. Integer (Used_Units.Length)) + do + declare + Idx : Positive := 1; + + begin + for U of Used_Units loop + R (Idx) := U; + Idx := Idx + 1; + end loop; + end; + end return; + end Get_Withed_Units; + ------------ -- Insert -- ------------ diff --git a/src/laltools-common.ads b/src/laltools-common.ads index 9da39ed2..afe2547e 100644 --- a/src/laltools-common.ads +++ b/src/laltools-common.ads @@ -114,6 +114,13 @@ package Laltools.Common is (Element_Type => Defining_Name, "=" => "="); + package Compilation_Unit_Vectors is new Ada.Containers.Vectors + (Index_Type => Natural, + Element_Type => Compilation_Unit, + "=" => "="); + + subtype Compilation_Unit_Vector is Compilation_Unit_Vectors.Vector; + package Declarative_Part_Vectors is new Ada.Containers.Indefinite_Vectors (Index_Type => Natural, Element_Type => Declarative_Part'Class, @@ -474,13 +481,6 @@ package Laltools.Common is return Compilation_Unit; -- Returns the Compilation_Unit associated to Node - package Compilation_Unit_Vectors is new Ada.Containers.Vectors - (Index_Type => Natural, - Element_Type => Compilation_Unit, - "=" => "="); - - subtype Compilation_Unit_Vector is Compilation_Unit_Vectors.Vector; - function Get_Compilation_Units (Analysis_Unit : Libadalang.Analysis.Analysis_Unit) return Compilation_Unit_Vector; @@ -722,6 +722,18 @@ package Laltools.Common is return Declarative_Part_Vectors.Vector; -- Gets all public Declarative_Parts of the units used by Node's unit + function Get_Withed_Units + (Node : Compilation_Unit'Class) + return Compilation_Unit_Array; + -- Returns a Compilation_Unit_Array with all the Compilation_Unit + -- whose Node has a with clause for. If Node is null, then returns an empty + -- Compilation_Unit_Array. The return array does not contain null + -- Compilation_Units. This function differs from P_Withed_Units since + -- the latter will also return the parent packages of the withed + -- package. As an example, for 'with Ada.Assertions;', this function will + -- return only 'Ada.Assertions' while P_Withed_Units will return 'Ada' and + -- 'Ada.Assertions'. + function Get_Used_Units (Node : Compilation_Unit'Class) return Compilation_Unit_Array; diff --git a/src/laltools-refactor-suppress_separate.adb b/src/laltools-refactor-suppress_separate.adb index 28142661..d2f9cad5 100644 --- a/src/laltools-refactor-suppress_separate.adb +++ b/src/laltools-refactor-suppress_separate.adb @@ -252,19 +252,19 @@ package body Laltools.Refactor.Suppress_Separate is else Separate_Decl.P_Parent_Basic_Decl.As_Package_Decl); Pkg_Spec_Withed_Units : constant Compilation_Unit_Array := - Pkg_Spec.Unit.Root.As_Compilation_Unit.P_Withed_Units; + Get_Withed_Units (Pkg_Spec.Unit.Root.As_Compilation_Unit); Pkg_Spec_Used_Units : constant Compilation_Unit_Array := Get_Used_Units (Pkg_Spec.Unit.Root.As_Compilation_Unit); -- Package Body Pkg_Body_Withed_Units : constant Compilation_Unit_Array := - Separate_Stub.Unit.Root.As_Compilation_Unit.P_Withed_Units; + Get_Withed_Units (Separate_Stub.Unit.Root.As_Compilation_Unit); Pkg_Body_Used_Units : constant Compilation_Unit_Array := Get_Used_Units (Separate_Stub.Unit.Root.As_Compilation_Unit); -- Subunit Subunit_Withed_Units : constant Compilation_Unit_Array := - Separate_Body.Unit.Root.As_Compilation_Unit.P_Withed_Units; + Get_Withed_Units (Separate_Body.Unit.Root.As_Compilation_Unit); Subunit_Used_Units : constant Compilation_Unit_Array := Get_Used_Units (Separate_Body.Unit.Root.As_Compilation_Unit); @@ -274,12 +274,12 @@ package body Laltools.Refactor.Suppress_Separate is Missing_With_Clauses := (As_Compilation_Unit_Set (Subunit_Withed_Units) - (As_Compilation_Unit_Set (Pkg_Spec_Withed_Units) - or As_Compilation_Unit_Set (Pkg_Body_Withed_Units))); + or As_Compilation_Unit_Set (Pkg_Body_Withed_Units))); Missing_Used_Clauses := (As_Compilation_Unit_Set (Subunit_Used_Units) - (As_Compilation_Unit_Set (Pkg_Spec_Used_Units) - or As_Compilation_Unit_Set (Pkg_Body_Used_Units))); + or As_Compilation_Unit_Set (Pkg_Body_Used_Units))); end; -- Compute the necessary edits for the prelude ('with' and 'use' diff --git a/testsuite/tests/refactoring_suppress_separate/T318-086/suppress_subp_w_params_from_subp_body_stub/gpsauto.cgpr b/testsuite/tests/refactoring_suppress_separate/T318-086/suppress_subp_w_params_from_subp_body_stub/gpsauto.cgpr deleted file mode 100644 index d5a33ee9..00000000 --- a/testsuite/tests/refactoring_suppress_separate/T318-086/suppress_subp_w_params_from_subp_body_stub/gpsauto.cgpr +++ /dev/null @@ -1,97 +0,0 @@ -project _Auto is - - for Library_Support use "full"; - for Library_Auto_Init_Supported use "true"; - for Target use ""; - for Default_Language use "ada"; - - package Compiler is - for Driver ("ada") use "gcc"; - for Language_Kind ("ada") use "unit_based"; - for Dependency_Kind ("ada") use "ALI_File"; - for Object_File_Suffix ("html") use "-"; - for Object_File_Suffix ("xml") use "-"; - for Object_File_Suffix ("matlab") use "-"; - for Object_File_Suffix ("c#") use "-"; - for Object_File_Suffix ("asm2") use "-"; - for Object_File_Suffix ("asm_cpp") use "-"; - for Object_File_Suffix ("asm") use "-"; - for Object_File_Suffix ("gnat expanded code") use "-"; - for Object_File_Suffix ("java") use "-"; - for Object_File_Suffix ("javascript") use "-"; - for Object_File_Suffix ("tcl") use "-"; - for Object_File_Suffix ("shell") use "-"; - for Object_File_Suffix ("makefile") use "-"; - for Object_File_Suffix ("m4") use "-"; - for Object_File_Suffix ("fortran 90") use "-"; - for Object_File_Suffix ("pascal") use "-"; - for Object_File_Suffix ("perl") use "-"; - for Object_File_Suffix ("awk") use "-"; - for Object_File_Suffix ("autoconf") use "-"; - for Object_File_Suffix ("rest") use "-"; - for Object_File_Suffix ("texinfo") use "-"; - for Object_File_Suffix ("configuration pragmas file") use "-"; - for Object_File_Suffix ("project file") use "-"; - for Object_File_Suffix ("changelog") use "-"; - for Object_File_Suffix ("qgen") use "-"; - for Object_File_Suffix ("simulink") use "-"; - for Object_File_Suffix ("why") use "-"; - for Object_File_Suffix ("python") use ".pyc"; - for Object_File_Suffix ("diff") use "-"; - for Object_File_Suffix ("css") use "-"; - for Object_File_Suffix ("c++") use ".o"; - for Object_File_Suffix ("c") use ".o"; - for Object_File_Suffix ("ada") use ".o"; - end Compiler; - - package Naming is - for Spec_Suffix ("ada") use ".ads"; - for Body_Suffix ("ada") use ".adb"; - for Spec_Suffix ("c") use ".h"; - for Body_Suffix ("c") use ".c"; - for Spec_Suffix ("c++") use ".hh"; - for Body_Suffix ("c++") use ".cpp"; - for Dot_Replacement use "-"; - for Casing use "lowercase"; - for Spec_Suffix ("html") use ".html"; - for Body_Suffix ("xml") use ".xml"; - for Body_Suffix ("matlab") use ".m"; - for Spec_Suffix ("c#") use ".cs"; - for Body_Suffix ("asm2") use ".asm"; - for Body_Suffix ("asm_cpp") use ".S"; - for Body_Suffix ("asm") use ".s"; - for Body_Suffix ("gnat expanded code") use ".dg"; - for Body_Suffix ("java") use ".java"; - for Body_Suffix ("javascript") use ".js"; - for Body_Suffix ("tcl") use ".tcl"; - for Body_Suffix ("shell") use ".sh"; - for Body_Suffix ("m4") use ".m4"; - for Body_Suffix ("fortran 90") use ".f"; - for Body_Suffix ("pascal") use ".pas"; - for Body_Suffix ("perl") use ".pl"; - for Body_Suffix ("awk") use ".awk"; - for Body_Suffix ("autoconf") use "configure.in"; - for Body_Suffix ("rest") use ".rst"; - for Body_Suffix ("texinfo") use ".texi"; - for Body_Suffix ("configuration pragmas file") use ".adc"; - for Body_Suffix ("project file") use ".gpr"; - for Spec_Suffix ("changelog") use ".changelog"; - for Body_Suffix ("qgen") use ".xmi"; - for Spec_Suffix ("simulink") use ".slx"; - for Body_Suffix ("simulink") use ".mdl"; - for Body_Suffix ("why") use ".why"; - for Body_Suffix ("python") use ".py"; - for Body_Suffix ("diff") use ".diff"; - for Body_Suffix ("css") use ".css"; - for Spec_Suffix ("c++") use ".hh"; - for Body_Suffix ("c++") use ".cpp"; - for Spec_Suffix ("c") use ".h"; - for Body_Suffix ("c") use ".c"; - for Spec_Suffix ("ada") use ".ads"; - for Body_Suffix ("ada") use ".adb"; - end Naming; - - for Library_Support use "full"; - -end _Auto; -