[Ada] Move routine for detecting special Text_IO packages from GNATprove

2020-06-05  Piotr Trojanek  <trojanek@adacore.com>

gcc/ada/

	* rtsfind.ads, rtsfind.adb (Is_Text_IO_Special_Package): Moved
	from the GNATprove backend to the frontend.

diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 5983ba9..c43561c 100644 (file)
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -759,6 +759,37 @@ package body Rtsfind is
       return Present (E) and then E = Ent;
    end Is_RTU;
 
+   --------------------------------
+   -- Is_Text_IO_Special_Package --
+   --------------------------------
+
+   function Is_Text_IO_Special_Package (E : Entity_Id) return Boolean is
+   begin
+      pragma Assert (Is_Package_Or_Generic_Package (E));
+
+      --  ??? detection with a scope climbing might be more efficient
+
+      for U in Ada_Text_IO_Child loop
+         if Is_RTU (E, U) then
+            return True;
+         end if;
+      end loop;
+
+      for U in Ada_Wide_Text_IO_Child loop
+         if Is_RTU (E, U) then
+            return True;
+         end if;
+      end loop;
+
+      for U in Ada_Wide_Wide_Text_IO_Child loop
+         if Is_RTU (E, U) then
+            return True;
+         end if;
+      end loop;
+
+      return False;
+   end Is_Text_IO_Special_Package;
+
    -----------------------------
    -- Is_Text_IO_Special_Unit --
    -----------------------------

diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index a86b98e..13d2253 100644 (file)
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -3188,6 +3188,12 @@ package Rtsfind is
    --  Wide_Wide_Text_IO.xxx, where xxx is one of the subpackages of Text_IO
    --  that is specially handled as described for Check_Text_IO_Special_Unit.
 
+   function Is_Text_IO_Special_Package (E : Entity_Id) return Boolean;
+   --  Return True iff E is one of the special generic Text_IO packages, which
+   --  Ada RM defines to be nested in Ada.Text_IO, but GNAT defines as its
+   --  private children. This is similar to Is_Text_IO_Special_Unit, but is
+   --  meant to be used on a fully resolved AST, especially in the backends.
+
    function RTE (E : RE_Id) return Entity_Id;
    --  Given the entity defined in the above tables, as identified by the
    --  corresponding value in the RE_Id enumeration type, returns the Id of the