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

testsuite/tests/gprls/closure/base/bodies/main.adb

@@ -0,0 +1,6 @@
+with Pkg;
+procedure Main is
+begin
+   Pkg.Execute;
+end Main;
+

testsuite/tests/gprls/closure/base/bodies/main2.adb

@@ -0,0 +1,6 @@
+with Pkg2;
+procedure Main2 is
+begin
+   Pkg2.Execute;
+end Main2;
+

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;
+

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;
+

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;
+

testsuite/tests/gprls/closure/base/specs/pkg.ads

@@ -0,0 +1,4 @@
+package Pkg is
+   procedure Execute;
+end Pkg;
+

testsuite/tests/gprls/closure/base/specs/pkg2.ads

@@ -0,0 +1,4 @@
+package Pkg2 is
+   procedure Execute;
+end Pkg2;
+

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
+

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"])

testsuite/tests/gprls/closure/base/test.yaml

@@ -0,0 +1,2 @@
+description: gprbuild's P323-041_gprls_closure test
+driver: python_script

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;
+

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;

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;

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;

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;

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;