From eac4741b0a4773db9a6255453be6e002e9bdd2e4 Mon Sep 17 00:00:00 2001 From: Philippe Gil Date: Wed, 14 Sep 2022 17:42:27 +0200 Subject: [PATCH] Import gprbuild's gprls closure tests Imported tests: P323-041_gprls_closure QC06-015_gprls_closure_subunits S522-016 R409-047 TN:U319-003 Change-Id: Ib8e078ba5084e41f2d164db055cdcffcc20b9af2 --- .../tests/gprls/closure/base/bodies/main.adb | 6 + .../tests/gprls/closure/base/bodies/main2.adb | 6 + .../tests/gprls/closure/base/bodies/pkg.adb | 8 ++ .../tests/gprls/closure/base/bodies/pkg2.adb | 8 ++ testsuite/tests/gprls/closure/base/prj.gpr | 6 + .../tests/gprls/closure/base/specs/pkg.ads | 4 + .../tests/gprls/closure/base/specs/pkg2.ads | 4 + testsuite/tests/gprls/closure/base/test.out | 32 +++++ testsuite/tests/gprls/closure/base/test.py | 11 ++ testsuite/tests/gprls/closure/base/test.yaml | 2 + testsuite/tests/gprls/closure/sal/base.gpr | 12 ++ .../tests/gprls/closure/sal/dash_board.adb | 53 +++++++ .../tests/gprls/closure/sal/dash_board.ads | 25 ++++ testsuite/tests/gprls/closure/sal/gauge.adb | 131 ++++++++++++++++++ testsuite/tests/gprls/closure/sal/gauge.ads | 35 +++++ testsuite/tests/gprls/closure/sal/gauges.gpr | 10 ++ testsuite/tests/gprls/closure/sal/indash.adb | 35 +++++ testsuite/tests/gprls/closure/sal/indash.ads | 28 ++++ testsuite/tests/gprls/closure/sal/test.opt | 1 + testsuite/tests/gprls/closure/sal/test.out | 10 ++ testsuite/tests/gprls/closure/sal/test.py | 7 + testsuite/tests/gprls/closure/sal/test.yaml | 2 + .../closure/short-subunit-names/aaa-aa.adb | 5 + .../closure/short-subunit-names/aaa-aaa.adb | 5 + .../closure/short-subunit-names/aaa-aaaa.adb | 5 + .../gprls/closure/short-subunit-names/aaa.adb | 20 +++ .../gprls/closure/short-subunit-names/aaa.ads | 4 + .../closure/short-subunit-names/bbbbbbbb.adb | 8 ++ .../closure/short-subunit-names/bbbbbbbb.ads | 7 + .../closure/short-subunit-names/main.adb | 6 + .../gprls/closure/short-subunit-names/p.gpr | 5 + .../closure/short-subunit-names/test.out | 12 ++ .../gprls/closure/short-subunit-names/test.py | 12 ++ .../closure/short-subunit-names/test.yaml | 2 + .../tests/gprls/closure/subunits/main.adb | 6 + .../gprls/closure/subunits/pkg-execute.adb | 7 + .../tests/gprls/closure/subunits/pkg.adb | 6 + .../tests/gprls/closure/subunits/pkg.ads | 6 + .../tests/gprls/closure/subunits/prj.gpr | 5 + .../gprls/closure/subunits/subs/pkg-sub.adb | 7 + .../tests/gprls/closure/subunits/test.out | 4 + .../tests/gprls/closure/subunits/test.py | 18 +++ .../tests/gprls/closure/subunits/test.yaml | 2 + 43 files changed, 588 insertions(+) create mode 100644 testsuite/tests/gprls/closure/base/bodies/main.adb create mode 100644 testsuite/tests/gprls/closure/base/bodies/main2.adb create mode 100644 testsuite/tests/gprls/closure/base/bodies/pkg.adb create mode 100644 testsuite/tests/gprls/closure/base/bodies/pkg2.adb create mode 100644 testsuite/tests/gprls/closure/base/prj.gpr create mode 100644 testsuite/tests/gprls/closure/base/specs/pkg.ads create mode 100644 testsuite/tests/gprls/closure/base/specs/pkg2.ads create mode 100644 testsuite/tests/gprls/closure/base/test.out create mode 100644 testsuite/tests/gprls/closure/base/test.py create mode 100644 testsuite/tests/gprls/closure/base/test.yaml create mode 100644 testsuite/tests/gprls/closure/sal/base.gpr create mode 100644 testsuite/tests/gprls/closure/sal/dash_board.adb create mode 100644 testsuite/tests/gprls/closure/sal/dash_board.ads create mode 100644 testsuite/tests/gprls/closure/sal/gauge.adb create mode 100644 testsuite/tests/gprls/closure/sal/gauge.ads create mode 100644 testsuite/tests/gprls/closure/sal/gauges.gpr create mode 100644 testsuite/tests/gprls/closure/sal/indash.adb create mode 100644 testsuite/tests/gprls/closure/sal/indash.ads create mode 100644 testsuite/tests/gprls/closure/sal/test.opt create mode 100644 testsuite/tests/gprls/closure/sal/test.out create mode 100644 testsuite/tests/gprls/closure/sal/test.py create mode 100644 testsuite/tests/gprls/closure/sal/test.yaml create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/aaa-aa.adb create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/aaa-aaa.adb create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/aaa-aaaa.adb create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/aaa.adb create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/aaa.ads create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.adb create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.ads create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/main.adb create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/p.gpr create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/test.out create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/test.py create mode 100644 testsuite/tests/gprls/closure/short-subunit-names/test.yaml create mode 100644 testsuite/tests/gprls/closure/subunits/main.adb create mode 100644 testsuite/tests/gprls/closure/subunits/pkg-execute.adb create mode 100644 testsuite/tests/gprls/closure/subunits/pkg.adb create mode 100644 testsuite/tests/gprls/closure/subunits/pkg.ads create mode 100644 testsuite/tests/gprls/closure/subunits/prj.gpr create mode 100644 testsuite/tests/gprls/closure/subunits/subs/pkg-sub.adb create mode 100644 testsuite/tests/gprls/closure/subunits/test.out create mode 100644 testsuite/tests/gprls/closure/subunits/test.py create mode 100644 testsuite/tests/gprls/closure/subunits/test.yaml diff --git a/testsuite/tests/gprls/closure/base/bodies/main.adb b/testsuite/tests/gprls/closure/base/bodies/main.adb new file mode 100644 index 000000000..b5ab1757d --- /dev/null +++ b/testsuite/tests/gprls/closure/base/bodies/main.adb @@ -0,0 +1,6 @@ +with Pkg; +procedure Main is +begin + Pkg.Execute; +end Main; + diff --git a/testsuite/tests/gprls/closure/base/bodies/main2.adb b/testsuite/tests/gprls/closure/base/bodies/main2.adb new file mode 100644 index 000000000..8bc3bd669 --- /dev/null +++ b/testsuite/tests/gprls/closure/base/bodies/main2.adb @@ -0,0 +1,6 @@ +with Pkg2; +procedure Main2 is +begin + Pkg2.Execute; +end Main2; + diff --git a/testsuite/tests/gprls/closure/base/bodies/pkg.adb b/testsuite/tests/gprls/closure/base/bodies/pkg.adb new file mode 100644 index 000000000..e475be799 --- /dev/null +++ b/testsuite/tests/gprls/closure/base/bodies/pkg.adb @@ -0,0 +1,8 @@ +with GNAT.IO; use GNAT.IO; +package body Pkg is + procedure Execute is + begin + Put_Line ("Pkg.Execute"); + end Execute; +end Pkg; + diff --git a/testsuite/tests/gprls/closure/base/bodies/pkg2.adb b/testsuite/tests/gprls/closure/base/bodies/pkg2.adb new file mode 100644 index 000000000..e50aa3259 --- /dev/null +++ b/testsuite/tests/gprls/closure/base/bodies/pkg2.adb @@ -0,0 +1,8 @@ +with GNAT.IO; use GNAT.IO; +package body Pkg2 is + procedure Execute is + begin + Put_Line ("Pkg2.Execute"); + end Execute; +end Pkg2; + diff --git a/testsuite/tests/gprls/closure/base/prj.gpr b/testsuite/tests/gprls/closure/base/prj.gpr new file mode 100644 index 000000000..4230e35a2 --- /dev/null +++ b/testsuite/tests/gprls/closure/base/prj.gpr @@ -0,0 +1,6 @@ +project Prj is + for Source_Dirs use ("specs", "bodies"); + for Object_Dir use "obj"; + for Main use ("main.adb"); +end Prj; + diff --git a/testsuite/tests/gprls/closure/base/specs/pkg.ads b/testsuite/tests/gprls/closure/base/specs/pkg.ads new file mode 100644 index 000000000..d7a26043d --- /dev/null +++ b/testsuite/tests/gprls/closure/base/specs/pkg.ads @@ -0,0 +1,4 @@ +package Pkg is + procedure Execute; +end Pkg; + diff --git a/testsuite/tests/gprls/closure/base/specs/pkg2.ads b/testsuite/tests/gprls/closure/base/specs/pkg2.ads new file mode 100644 index 000000000..bc433beeb --- /dev/null +++ b/testsuite/tests/gprls/closure/base/specs/pkg2.ads @@ -0,0 +1,4 @@ +package Pkg2 is + procedure Execute; +end Pkg2; + diff --git a/testsuite/tests/gprls/closure/base/test.out b/testsuite/tests/gprls/closure/base/test.out new file mode 100644 index 000000000..60fde840c --- /dev/null +++ b/testsuite/tests/gprls/closure/base/test.out @@ -0,0 +1,32 @@ + +Closure: + + /bodies/main.adb + /bodies/pkg.adb + /specs/pkg.ads + +Can't find ALI file for /bodies/main2.adb + +Incomplete closure: + + /bodies/main2.adb + +Can't find source for toto.adb + +Closures: + + /bodies/main.adb + /bodies/main2.adb + /bodies/pkg.adb + /bodies/pkg2.adb + /specs/pkg.ads + /specs/pkg2.ads + +Can't find source for toto.adb + +Closure: + + /bodies/main.adb + /bodies/pkg.adb + /specs/pkg.ads + diff --git a/testsuite/tests/gprls/closure/base/test.py b/testsuite/tests/gprls/closure/base/test.py new file mode 100644 index 000000000..ff79ca8c4 --- /dev/null +++ b/testsuite/tests/gprls/closure/base/test.py @@ -0,0 +1,11 @@ +from testsuite_support.builder_and_runner import BuilderAndRunner, GPRLS + +bnr = BuilderAndRunner() + +bnr.run(["gprbuild", "-p", "-q", "-Pprj.gpr"]) +bnr.call([GPRLS, "-P", "prj.gpr", "--closure"]) +bnr.call([GPRLS, "-P", "prj.gpr", "main2.adb", "--closure"]) +bnr.call([GPRLS, "-P", "prj.gpr", "toto.adb", "--closure"]) +bnr.run(["gprbuild", "-p", "-q", "-Pprj.gpr", "main2.adb"]) +bnr.call([GPRLS, "-P", "prj.gpr", "main.ali", "main2.adb", "--closure"]) +bnr.call([GPRLS, "-P", "prj.gpr", "main.adb", "toto.adb", "--closure"]) diff --git a/testsuite/tests/gprls/closure/base/test.yaml b/testsuite/tests/gprls/closure/base/test.yaml new file mode 100644 index 000000000..641e20f4e --- /dev/null +++ b/testsuite/tests/gprls/closure/base/test.yaml @@ -0,0 +1,2 @@ +description: gprbuild's P323-041_gprls_closure test +driver: python_script diff --git a/testsuite/tests/gprls/closure/sal/base.gpr b/testsuite/tests/gprls/closure/sal/base.gpr new file mode 100644 index 000000000..c2e9a66b7 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/base.gpr @@ -0,0 +1,12 @@ +project Base is + for Source_Files use + ("dash_board.ads", "dash_board.adb", "indash.ads", "indash.adb"); + for Object_Dir use "obase"; + for Library_Dir use "lbase"; + for Library_Name use "base"; + for Library_Kind use "dynamic"; + package Compiler is + for Default_Switches ("ada") use ("-g", "-gnat05"); + end Compiler; +end Base; + diff --git a/testsuite/tests/gprls/closure/sal/dash_board.adb b/testsuite/tests/gprls/closure/sal/dash_board.adb new file mode 100644 index 000000000..34a907a85 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/dash_board.adb @@ -0,0 +1,53 @@ + +with Ada.Text_IO; + +package body Dash_Board is + + -------------- + -- Register -- + -------------- + + procedure Register (Device : InDash.Any_Instrument) is + begin + Registry.Append (Device); + end Register; + + ---------------- + -- Unregister -- + ---------------- + + procedure Unregister (Device : InDash.Any_Instrument) is + begin + Registry.Delete (Registry.Find_Index (Device)); + end Unregister; + + use Instruments; + + ------------- + -- Display -- + ------------- + + procedure Display is + C : Cursor := First (Registry); + begin + while C /= No_Element loop + Element (C).Display; -- dispatches + Next (C); + end loop; + Ada.Text_IO.New_Line; + end Display; + + ------------ + -- Update -- + ------------ + + procedure Update (Millisec : Integer) is + C : Cursor := First (Registry); + begin + while C /= No_Element loop + Element (C).Update (Millisec); -- dispatches + Next (C); + end loop; + end Update; + +end Dash_Board; diff --git a/testsuite/tests/gprls/closure/sal/dash_board.ads b/testsuite/tests/gprls/closure/sal/dash_board.ads new file mode 100644 index 000000000..31e121123 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/dash_board.ads @@ -0,0 +1,25 @@ + +with Ada.Containers.Vectors; + +with InDash; + +package Dash_Board is + + procedure Display; + + procedure Register (Device : InDash.Any_Instrument); + + procedure Unregister (Device : InDash.Any_Instrument); + + procedure Update (Millisec : Integer); + +private + + use InDash; + + package Instruments is + new Ada.Containers.Vectors (Positive, Any_Instrument); + + Registry : Instruments.Vector; + +end Dash_Board; diff --git a/testsuite/tests/gprls/closure/sal/gauge.adb b/testsuite/tests/gprls/closure/sal/gauge.adb new file mode 100644 index 000000000..7d99c3744 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/gauge.adb @@ -0,0 +1,131 @@ + +with Ada.Finalization; use Ada.Finalization; +with Ada.Text_IO; use Ada.Text_IO; + +with Dash_Board; + +package body Gauge is + + use InDash; + + package Percent_IO is new Decimal_IO (Percent); + use Percent_IO; + + type Life_Controller is new Limited_Controlled with null record; + overriding procedure Initialize (LC : in out Life_Controller); + overriding procedure Finalize (LC : in out Life_Controller); + + F, W : Any_Instrument; + + ------------------------ + -- Make_Numeric_Gauge -- + ------------------------ + + function Make_Numeric_Gauge + (Name : String; Value : Percent; Rate : Float) return Any_Instrument + is + Result : Numeric_Gauge_Reference; + begin + Result := new Numeric_Gauge; + InDash.Any_Instrument(Result).Set_Name (Name); + Result.Value := Value; + Result.Rate := Rate; + return Any_Instrument (Result); + end Make_Numeric_Gauge; + + ------------------------ + -- Make_Graphic_Gauge -- + ------------------------ + + function Make_Graphic_Gauge + (Name : String; + Value : Percent; + Rate : Float; + Size : Integer; + Fill : Character := '*'; + Empty : Character := ' ') return Any_Instrument + is + Result : Graphic_Gauge_Reference; + begin + Result := new Graphic_Gauge; + InDash.Any_Instrument(Result).Set_Name (Name); + Result.Value := Value; + Result.Rate := Rate; + Result.Size := Size; + Result.Fill := Fill; + Result.Empty := Empty; + return Any_Instrument (Result); + end Make_Graphic_Gauge; + + ---------------- + -- Initialize -- + ---------------- + + overriding procedure Initialize (LC : in out Life_Controller) is + begin + F := Make_Numeric_Gauge ("Fuel", 60.0, 1.0); + Dash_Board.Register (F); + + W := Make_Graphic_Gauge ("Water", 80.0, 2.0, 20); + Dash_Board.Register (W); + + -- O := Make_Graphic_Gauge ("Oil", 40.0, 2.0, 20); + -- Dash_Board.Register (O); + end Initialize; + + -------------- + -- Finalize -- + -------------- + + overriding procedure Finalize (LC : in out Life_Controller) is + begin + Put_Line ("Unregister Gauge"); + Dash_Board.Unregister (F); + Dash_Board.Unregister (W); + -- Dash_Board.Unregister (O); + end Finalize; + + ------------- + -- Display -- + ------------- + + procedure Display (G : access Numeric_Gauge) is + begin + InDash.Instrument_Reference (G).Display; + Put (G.Value, 3); + Put (" %"); + end Display; + + ------------ + -- Update -- + ------------ + + procedure Update (G : access Numeric_Gauge; Millisec : Integer) is + Elapsed_Seconds : constant Float := Float(Millisec) / 1000.0; + Elapsed_Minutes : constant Float := Elapsed_Seconds / 60.0; + begin + G.Value := G.Value - Percent(G.Rate * Elapsed_Minutes); + end Update; + + ------------- + -- Display -- + ------------- + + procedure Display (G : access Graphic_Gauge) is + Lg : constant Integer := G.Size * Integer(G.Value) / 100; + S1 : constant String (1 .. Lg) := (others => G.Fill); + S2 : constant String (Lg + 1 .. G.Size) := (others => G.Empty); + begin + InDash.Instrument_Reference (G).Display; + Put ('<'); + Put (S1); + Put (S2); + Put ('>'); + end Display; + + -- Declared at the end to ensure all routines are elaborated before + -- calling them. + + LC : Life_Controller; + +end Gauge; diff --git a/testsuite/tests/gprls/closure/sal/gauge.ads b/testsuite/tests/gprls/closure/sal/gauge.ads new file mode 100644 index 000000000..6f9f8006e --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/gauge.ads @@ -0,0 +1,35 @@ + +with InDash; + +package Gauge is + + type Percent is delta 0.01 digits 5 range 0.0 .. 100.0; + + type Numeric_Gauge is new InDash.Instrument with private; + + type Numeric_Gauge_Reference is access all Numeric_Gauge; + + procedure Display (G : access Numeric_Gauge); + + procedure Update (G : access Numeric_Gauge; Millisec : Integer); + + type Graphic_Gauge is new Numeric_Gauge with private; + + type Graphic_Gauge_Reference is access all Graphic_Gauge; + + procedure Display (G : access Graphic_Gauge); + +private + + type Numeric_Gauge is new InDash.Instrument with record + Value : Percent; + Rate : Float; + end record; + + type Graphic_Gauge is new Numeric_Gauge with record + Size : Integer; + Fill : Character; + Empty : Character; + end record; + +end Gauge; diff --git a/testsuite/tests/gprls/closure/sal/gauges.gpr b/testsuite/tests/gprls/closure/sal/gauges.gpr new file mode 100644 index 000000000..33a80e695 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/gauges.gpr @@ -0,0 +1,10 @@ +with "base"; +project gauges is + for Source_Files use ("gauge.ads", "gauge.adb"); + for Object_Dir use "ogauge"; + for Library_Dir use "lgauge"; + for Library_Name use "plugin_gauge"; + for Library_Kind use "dynamic"; + for Library_Interface use ("gauge"); + package Compiler renames Base.Compiler; +end gauges; diff --git a/testsuite/tests/gprls/closure/sal/indash.adb b/testsuite/tests/gprls/closure/sal/indash.adb new file mode 100644 index 000000000..ae7d19ea9 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/indash.adb @@ -0,0 +1,35 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Strings.Fixed; use Ada.Strings.Fixed; + +package body InDash is + + ------------- + -- Display -- + ------------- + + procedure Display (This : access Instrument) is + begin + New_Line; + Put (Head (To_String (This.Name), 13)); + Put (" : "); + end Display; + + ---------- + -- Name -- + ---------- + + function Name (This : access Instrument) return String is + begin + return To_String (This.Name); + end Name; + + -------------- + -- Set_Name -- + -------------- + + procedure Set_Name (This : access Instrument; To : String) is + begin + This.Name := To_Unbounded_String (To); + end Set_Name; + +end InDash; diff --git a/testsuite/tests/gprls/closure/sal/indash.ads b/testsuite/tests/gprls/closure/sal/indash.ads new file mode 100644 index 000000000..6b4a114d8 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/indash.ads @@ -0,0 +1,28 @@ +with Ada.Strings.Unbounded; + +package InDash is + + type Instrument is abstract tagged private; + + type Instrument_Reference is access all Instrument; + + type Any_Instrument is access all Instrument'Class; + + function Name (This : access Instrument) return String; + + procedure Set_Name (This : access Instrument; To : String); + + procedure Display (This : access Instrument); + + procedure Update (This : access Instrument; Millisec : Integer) is abstract; + -- Update the state of the instrument after millisec has lapsed + +private + + use Ada.Strings.Unbounded; + + type Instrument is abstract tagged record + Name : Unbounded_String; + end record; + +end InDash; diff --git a/testsuite/tests/gprls/closure/sal/test.opt b/testsuite/tests/gprls/closure/sal/test.opt new file mode 100644 index 000000000..da51f6625 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/test.opt @@ -0,0 +1 @@ +Ada,shared required diff --git a/testsuite/tests/gprls/closure/sal/test.out b/testsuite/tests/gprls/closure/sal/test.out new file mode 100644 index 000000000..10e353975 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/test.out @@ -0,0 +1,10 @@ + +Closure: + + /dash_board.adb + /dash_board.ads + /gauge.adb + /gauge.ads + /indash.adb + /indash.ads + diff --git a/testsuite/tests/gprls/closure/sal/test.py b/testsuite/tests/gprls/closure/sal/test.py new file mode 100644 index 000000000..a265bda4e --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/test.py @@ -0,0 +1,7 @@ +from testsuite_support.builder_and_runner import BuilderAndRunner, GPRLS, GPRCLEAN + +bnr = BuilderAndRunner() + +bnr.run(["gprbuild", "-p", "-q", "-Pgauges"]) +bnr.call([GPRLS, "-P", "gauges", "--closure", "gauge"]) +bnr.call([GPRCLEAN, "-p", "-r", "-P", "gauges"]) diff --git a/testsuite/tests/gprls/closure/sal/test.yaml b/testsuite/tests/gprls/closure/sal/test.yaml new file mode 100644 index 000000000..d8fdb8604 --- /dev/null +++ b/testsuite/tests/gprls/closure/sal/test.yaml @@ -0,0 +1,2 @@ +description: gprbuild's S522-016 test. gprls source closure for SAL display +driver: python_script diff --git a/testsuite/tests/gprls/closure/short-subunit-names/aaa-aa.adb b/testsuite/tests/gprls/closure/short-subunit-names/aaa-aa.adb new file mode 100644 index 000000000..465b98578 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/aaa-aa.adb @@ -0,0 +1,5 @@ +separate (AAA) +procedure AA is +begin + null; +end AA; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/aaa-aaa.adb b/testsuite/tests/gprls/closure/short-subunit-names/aaa-aaa.adb new file mode 100644 index 000000000..370cf532f --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/aaa-aaa.adb @@ -0,0 +1,5 @@ +separate (AAA) +procedure AAA is +begin + null; +end AAA; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/aaa-aaaa.adb b/testsuite/tests/gprls/closure/short-subunit-names/aaa-aaaa.adb new file mode 100644 index 000000000..ea8ed1b10 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/aaa-aaaa.adb @@ -0,0 +1,5 @@ +separate (AAA) +procedure AAAA is +begin + null; +end AAAA; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/aaa.adb b/testsuite/tests/gprls/closure/short-subunit-names/aaa.adb new file mode 100644 index 000000000..0897eafd1 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/aaa.adb @@ -0,0 +1,20 @@ +package body AAA is + + procedure AAAA; + procedure AAA; + procedure AA; + + procedure Proc is + begin + AA; + AAA; + AAAA; + end Proc; + + procedure AAAA is separate; + + procedure AAA is separate; + + procedure AA is separate; + +end AAA; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/aaa.ads b/testsuite/tests/gprls/closure/short-subunit-names/aaa.ads new file mode 100644 index 000000000..5b28b45a4 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/aaa.ads @@ -0,0 +1,4 @@ +package AAA is + generic + procedure Proc; +end AAA; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.adb b/testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.adb new file mode 100644 index 000000000..2a63cfcfc --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.adb @@ -0,0 +1,8 @@ +package body BBBBBBBB is + + procedure P is + begin + null; + end P; + +end BBBBBBBB; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.ads b/testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.ads new file mode 100644 index 000000000..713440843 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/bbbbbbbb.ads @@ -0,0 +1,7 @@ +with AAA; +package BBBBBBBB is + + procedure Inst is new AAA.Proc; + + procedure P; +end BBBBBBBB; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/main.adb b/testsuite/tests/gprls/closure/short-subunit-names/main.adb new file mode 100644 index 000000000..b63aa0634 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/main.adb @@ -0,0 +1,6 @@ +with BBBBBBBB; + +procedure Main is +begin + null; +end Main; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/p.gpr b/testsuite/tests/gprls/closure/short-subunit-names/p.gpr new file mode 100644 index 000000000..cb91a288b --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/p.gpr @@ -0,0 +1,5 @@ +project P is + + for main use ("main.adb"); + +end P; diff --git a/testsuite/tests/gprls/closure/short-subunit-names/test.out b/testsuite/tests/gprls/closure/short-subunit-names/test.out new file mode 100644 index 000000000..0c170f801 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/test.out @@ -0,0 +1,12 @@ + +Closure: + + /aaa-aa.adb + /aaa-aaa.adb + /aaa-aaaa.adb + /aaa.adb + /aaa.ads + /bbbbbbbb.adb + /bbbbbbbb.ads + /main.adb + diff --git a/testsuite/tests/gprls/closure/short-subunit-names/test.py b/testsuite/tests/gprls/closure/short-subunit-names/test.py new file mode 100644 index 000000000..bf5c45833 --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/test.py @@ -0,0 +1,12 @@ +from testsuite_support.builder_and_runner import BuilderAndRunner, GPRLS + +bnr = BuilderAndRunner() + +try: + + bnr.run(["gprbuild", "-p", "-q", "-Pp.gpr"]) + bnr.call([GPRLS, "-P", "p.gpr", "--closure"]) + +except Exception as E: + # Unexpected exception. Just print the information we have. + print('*** Error: %s' % str(E)) diff --git a/testsuite/tests/gprls/closure/short-subunit-names/test.yaml b/testsuite/tests/gprls/closure/short-subunit-names/test.yaml new file mode 100644 index 000000000..4073bf44e --- /dev/null +++ b/testsuite/tests/gprls/closure/short-subunit-names/test.yaml @@ -0,0 +1,2 @@ +description: gprbuild's R409-047 test (closure computation of short subunit names) +driver: python_script diff --git a/testsuite/tests/gprls/closure/subunits/main.adb b/testsuite/tests/gprls/closure/subunits/main.adb new file mode 100644 index 000000000..b5ab1757d --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/main.adb @@ -0,0 +1,6 @@ +with Pkg; +procedure Main is +begin + Pkg.Execute; +end Main; + diff --git a/testsuite/tests/gprls/closure/subunits/pkg-execute.adb b/testsuite/tests/gprls/closure/subunits/pkg-execute.adb new file mode 100644 index 000000000..6b77cf2cc --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/pkg-execute.adb @@ -0,0 +1,7 @@ +with GNAT.IO; use GNAT.IO; +separate (Pkg) + procedure Execute is + begin + Put_Line ("Pkg.Execute"); + end Execute; + diff --git a/testsuite/tests/gprls/closure/subunits/pkg.adb b/testsuite/tests/gprls/closure/subunits/pkg.adb new file mode 100644 index 000000000..4853c44af --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/pkg.adb @@ -0,0 +1,6 @@ +package body Pkg is + procedure Execute is separate; + + procedure Sub is separate; +end Pkg; + diff --git a/testsuite/tests/gprls/closure/subunits/pkg.ads b/testsuite/tests/gprls/closure/subunits/pkg.ads new file mode 100644 index 000000000..51f279bfb --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/pkg.ads @@ -0,0 +1,6 @@ +package Pkg is + procedure Execute; + + procedure Sub; +end Pkg; + diff --git a/testsuite/tests/gprls/closure/subunits/prj.gpr b/testsuite/tests/gprls/closure/subunits/prj.gpr new file mode 100644 index 000000000..655441498 --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/prj.gpr @@ -0,0 +1,5 @@ +project Prj is + for Source_Dirs use (".", "subs"); + for Main use ("main.adb"); +end Prj; + diff --git a/testsuite/tests/gprls/closure/subunits/subs/pkg-sub.adb b/testsuite/tests/gprls/closure/subunits/subs/pkg-sub.adb new file mode 100644 index 000000000..551c78e3e --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/subs/pkg-sub.adb @@ -0,0 +1,7 @@ +with GNAT.IO; use GNAT.IO; +separate (Pkg) + procedure Sub is + begin + Put_Line ("Pkg.Sub"); + end Sub; + diff --git a/testsuite/tests/gprls/closure/subunits/test.out b/testsuite/tests/gprls/closure/subunits/test.out new file mode 100644 index 000000000..0f4bdb10f --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/test.out @@ -0,0 +1,4 @@ + /pkg-execute.adb + + /subs/pkg-sub.adb + diff --git a/testsuite/tests/gprls/closure/subunits/test.py b/testsuite/tests/gprls/closure/subunits/test.py new file mode 100644 index 000000000..d954be4ed --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/test.py @@ -0,0 +1,18 @@ +from testsuite_support.builder_and_runner import BuilderAndRunner, GPRLS + +bnr = BuilderAndRunner() + +bnr.run(["gprbuild", "-p", "-q", "-Pprj.gpr"]) + +output = "output.txt" + +status = bnr.run([GPRLS, "-P", "prj.gpr", "--closure"], + output=output).status + +for line in open("output.txt").readlines(): + if "pkg-execute.adb" in line: + print(line) + +for line in open("output.txt").readlines(): + if "pkg-sub.adb" in line: + print(line) diff --git a/testsuite/tests/gprls/closure/subunits/test.yaml b/testsuite/tests/gprls/closure/subunits/test.yaml new file mode 100644 index 000000000..8f6415345 --- /dev/null +++ b/testsuite/tests/gprls/closure/subunits/test.yaml @@ -0,0 +1,2 @@ +description: gprbuild's QC06-015_gprls_closure_subunits test +driver: python_script