[multiple changes]

2017-04-25  Claire Dross  <dross@adacore.com>

	* exp_util.ads (Expression_Contains_Primitives_Calls_Of): New
	function used in GNATprove to know if an expression contains
	non-dispatching calls on primitives of a tagged type.

2017-04-25  Bob Duff  <duff@adacore.com>

	* rtsfind.adb (Initialize): Initialize
	First_Implicit_With. Building the compiler with Normalize_Scalars
	and validity checking finds this being used as an uninitialized
	variable.

From-SVN: r247231

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fc2de1da12cfd7295f3dc50d072b925104ec381e..add3c602571a1f4f7e6e8d3bcec573b62ca31b95 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2017-04-25  Claire Dross  <dross@adacore.com>
+
+       * exp_util.ads (Expression_Contains_Primitives_Calls_Of): New
+       function used in GNATprove to know if an expression contains
+       non-dispatching calls on primitives of a tagged type.
+
+2017-04-25  Bob Duff  <duff@adacore.com>
+
+       * rtsfind.adb (Initialize): Initialize
+       First_Implicit_With. Building the compiler with Normalize_Scalars
+       and validity checking finds this being used as an uninitialized
+       variable.
+
 2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * contracts.adb (Analyze_Entry_Or_Subprogram_Body_Contract):

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 16e33e8ebb740be6d41a44dc7997c549bcf54b18..414e9d77a5516f52e08394f75a3143618a5ae2d1 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -5187,6 +5187,65 @@ package body Exp_Util is
       end if;
    end Expand_Subtype_From_Expr;
 
+   ---------------------------------------------
+   -- Expression_Contains_Primitives_Calls_Of --
+   ---------------------------------------------
+
+   function Expression_Contains_Primitives_Calls_Of
+     (Expr : Node_Id;
+      Typ  : Entity_Id) return Boolean
+   is
+      U_Typ : constant Entity_Id := Unique_Entity (Typ);
+
+      function Search_Primitive_Calls (N : Node_Id) return Traverse_Result;
+      --  Search for non-dispatching calls to primitive functions of type Typ
+
+      ----------------------------
+      -- Search_Primitive_Calls --
+      ----------------------------
+
+      function Search_Primitive_Calls (N : Node_Id) return Traverse_Result is
+      begin
+         if Nkind (N) = N_Identifier
+           and then Present (Entity (N))
+           and then
+             (Is_Formal (Entity (N)) or else Is_Subprogram (Entity (N)))
+           and then Nkind (Parent (N)) = N_Function_Call
+         then
+            --  Do not consider dispatching calls
+
+            if Is_Subprogram (Entity (N))
+              and then Nkind (Parent (N)) = N_Function_Call
+              and then Present (Controlling_Argument (Parent (N)))
+            then
+               return OK;
+            end if;
+
+            --  If N is a function call, and E is dispatching, search for the
+            --  controlling type to see if it is Ty.
+
+            if Is_Subprogram (Entity (N))
+              and then Nkind (Parent (N)) = N_Function_Call
+              and then Is_Dispatching_Operation (Entity (N))
+              and then Present (Find_Dispatching_Type (Entity (N)))
+              and then
+                Unique_Entity (Find_Dispatching_Type (Entity (N))) = U_Typ
+            then
+               return Abandon;
+            end if;
+         end if;
+
+         return OK;
+      end Search_Primitive_Calls;
+
+      function Search_Calls is new Traverse_Func (Search_Primitive_Calls);
+
+   --  Start of processing for Expression_Contains_Primitives_Calls_Of_Type
+
+   begin
+      return Search_Calls (Expr) = Abandon;
+   end Expression_Contains_Primitives_Calls_Of;
+
    ----------------------
    -- Finalize_Address --
    ----------------------

diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 5b44d6929a2db04a2666b9a51d1fc2317a0e6d23..532cca7369390d18344db16261d38c507c7fc861 100644 (file)
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -556,6 +556,12 @@ package Exp_Util is
    --  class-wide). Set Related_Id to request an external name for the subtype
    --  rather than an internal temporary.
 
+   function Expression_Contains_Primitives_Calls_Of
+     (Expr : Node_Id;
+      Typ  : Entity_Id) return Boolean;
+   --  Return True if the expression Expr contains a non-dispatching call to a
+   --  function which is a primitive of the tagged type Typ.
+
    function Finalize_Address (Typ : Entity_Id) return Entity_Id;
    --  Locate TSS primitive Finalize_Address in type Typ. Return Empty if the
    --  subprogram is not available.

diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 0c8a3ee43c0287ebc5c925f42e8b3e7c306b6376..faeffd263b1b1d68fbba8a53edf1a6abec66be10 100644 (file)
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -642,6 +642,7 @@ package body Rtsfind is
 
       for J in RTU_Id loop
          RT_Unit_Table (J).Entity := Empty;
+         RT_Unit_Table (J).First_Implicit_With := Empty;
       end loop;
 
       for J in RE_Id loop
@@ -959,7 +960,7 @@ package body Rtsfind is
       --  from the enumeration literal name in type RTU_Id.
 
       U.Uname                := Get_Unit_Name (U_Id);
-      U. First_Implicit_With := Empty;
+      U.First_Implicit_With  := Empty;
 
       --  Now do the load call, note that setting Error_Node to Empty is
       --  a signal to Load_Unit that we will regard a failure to find the