[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 6 Sep 2017 11:52:28 +0000 (13:52 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 6 Sep 2017 11:52:28 +0000 (13:52 +0200)
2017-09-06  Hristian Kirtchev  <kirtchev@adacore.com>

* a-comlin.adb, exp_aggr.adb, exp_ch6.adb, frontend.adb, gnatbind.adb,
sem_ch3.adb, sem_util.adb: Minor reformatting.

2017-09-06  Yannick Moy  <moy@adacore.com>

* freeze.adb (Check_Inherited_Conditions): Rewriting
of inherited preconditions and postconditions should only occur
in GNATprove mode, that is, when GNATprove_Mode is True, not to
be confused with SPARK_Mode being On.

2017-09-06  Yannick Moy  <moy@adacore.com>

* sem_warn.adb (Check_References): Take into
account possibility of attribute reference as original node.

2017-09-06  Yannick Moy  <moy@adacore.com>

* exp_attr.adb (Expand_N_Attribute_Reference): Protect against invalid
use of attribute.

2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>

* inline.adb (Split_Unconstrained_Function): Also set Is_Inlined
on the procedure created to encapsulate the body.
* sem_ch7.adb: Add with clause for GNAT.HTable.
(Entity_Table_Size): New constant.
(Entity_Hash): New function.
(Subprogram_Table): New instantiation of GNAT.Htable.Simple_HTable.
(Is_Subprogram_Ref): Rename into...
(Scan_Subprogram_Ref): ...this. Record references to subprograms in
the table instead of bailing out on them. Scan the value of constants
if it is not known at compile time.
(Contains_Subprograms_Refs): Rename into...
(Scan_Subprogram_Refs): ...this.
(Has_Referencer): Scan the body of all inlined subprograms. Reset the
Is_Public flag on subprograms if they are not actually referenced.
(Hide_Public_Entities): Beef up comment on the algorithm.
Reset the table of subprograms on entry.

From-SVN: r251781

13 files changed:
gcc/ada/ChangeLog
gcc/ada/a-comlin.adb
gcc/ada/exp_aggr.adb
gcc/ada/exp_attr.adb
gcc/ada/exp_ch6.adb
gcc/ada/freeze.adb
gcc/ada/frontend.adb
gcc/ada/gnatbind.adb
gcc/ada/inline.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_ch7.adb
gcc/ada/sem_util.adb
gcc/ada/sem_warn.adb

index 2d8077d..0f142f5 100644 (file)
@@ -1,3 +1,44 @@
+2017-09-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * a-comlin.adb, exp_aggr.adb, exp_ch6.adb, frontend.adb, gnatbind.adb,
+       sem_ch3.adb, sem_util.adb: Minor reformatting.
+
+2017-09-06  Yannick Moy  <moy@adacore.com>
+
+       * freeze.adb (Check_Inherited_Conditions): Rewriting
+       of inherited preconditions and postconditions should only occur
+       in GNATprove mode, that is, when GNATprove_Mode is True, not to
+       be confused with SPARK_Mode being On.
+
+2017-09-06  Yannick Moy  <moy@adacore.com>
+
+       * sem_warn.adb (Check_References): Take into
+       account possibility of attribute reference as original node.
+
+2017-09-06  Yannick Moy  <moy@adacore.com>
+
+       * exp_attr.adb (Expand_N_Attribute_Reference): Protect against invalid
+       use of attribute.
+
+2017-09-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * inline.adb (Split_Unconstrained_Function): Also set Is_Inlined
+       on the procedure created to encapsulate the body.
+       * sem_ch7.adb: Add with clause for GNAT.HTable.
+       (Entity_Table_Size): New constant.
+       (Entity_Hash): New function.
+       (Subprogram_Table): New instantiation of GNAT.Htable.Simple_HTable.
+       (Is_Subprogram_Ref): Rename into...
+       (Scan_Subprogram_Ref): ...this. Record references to subprograms in
+       the table instead of bailing out on them. Scan the value of constants
+       if it is not known at compile time.
+       (Contains_Subprograms_Refs): Rename into...
+       (Scan_Subprogram_Refs): ...this.
+       (Has_Referencer): Scan the body of all inlined subprograms. Reset the
+       Is_Public flag on subprograms if they are not actually referenced.
+       (Hide_Public_Entities): Beef up comment on the algorithm.
+       Reset the table of subprograms on entry.
+
 2017-09-06  Yannick Moy  <moy@adacore.com>
 
        * inline.adb: Add comments to Can_Be_Inlined_In_GNATprove_Mode.
index 49caca5..a555410 100644 (file)
@@ -63,7 +63,7 @@ package body Ada.Command_Line is
 
       declare
          Num : constant Positive :=
-           (if Remove_Args = null then Number else Remove_Args (Number));
+                 (if Remove_Args = null then Number else Remove_Args (Number));
          Arg : aliased String (1 .. Len_Arg (Num));
       begin
          Fill_Arg (Arg'Address, Num);
index 549be96..9ab9573 100644 (file)
@@ -644,8 +644,8 @@ package body Exp_Aggr is
             return False;
          end if;
 
-         --  Checks 11: The C code generator cannot handle aggregates that
-         --  are not part of an object declaration.
+         --  Checks 11: The C code generator cannot handle aggregates that are
+         --  not part of an object declaration.
 
          if Modify_Tree_For_C then
             declare
@@ -653,7 +653,7 @@ package body Exp_Aggr is
 
             begin
                --  Skip enclosing nested aggregates and their qualified
-               --  expressions
+               --  expressions.
 
                while Nkind (Par) = N_Aggregate
                  or else Nkind (Par) = N_Qualified_Expression
index d1908bd..60a975f 100644 (file)
@@ -6884,7 +6884,8 @@ package body Exp_Attr is
          --  are any non-valid scalar subcomponents, and call the function.
 
          elsif Is_Record_Type (Ftyp)
-            and then Nkind (Type_Definition (Declaration_Node (Ftyp))) =
+           and then Present (Declaration_Node (Ftyp))
+           and then Nkind (Type_Definition (Declaration_Node (Ftyp))) =
                                                         N_Record_Definition
          then
             Rewrite (N,
index 55831e4..0a219f5 100644 (file)
@@ -3952,9 +3952,9 @@ package body Exp_Ch6 is
                 (RTE (RE_Address), Relocate_Node (First_Actual (Call_Node))));
             return;
 
-         --  A call to a null procedure is replaced by a null statement, but
-         --  we are not allowed to ignore possible side effects of the call,
-         --  so we make sure that actuals are evaluated.
+         --  A call to a null procedure is replaced by a null statement, but we
+         --  are not allowed to ignore possible side effects of the call, so we
+         --  make sure that actuals are evaluated.
 
          elsif Is_Null_Procedure (Subp) then
             Actual := First_Actual (Call_Node);
index 42c7463..caccb7e 100644 (file)
@@ -1494,12 +1494,12 @@ package body Freeze is
 
             Analyze_Entry_Or_Subprogram_Contract (Par_Prim);
 
-            --  In SPARK mode this is where we can collect the inherited
+            --  In GNATprove mode this is where we can collect the inherited
             --  conditions, because we do not create the Check pragmas that
             --  normally convey the the modified class-wide conditions on
             --  overriding operations.
 
-            if SPARK_Mode = On then
+            if GNATprove_Mode then
                Collect_Inherited_Class_Wide_Conditions (Prim);
 
             --  Otherwise build the corresponding pragmas to check for legality
index 461c04b..378aacd 100644 (file)
@@ -133,15 +133,15 @@ begin
    --  Read and process configuration pragma files if present
 
    declare
-      Config_Pragmas : List_Id := Empty_List;
-      --  Gather configuration pragmas
-
-      Gnat_Adc : constant File_Name_Type := Name_Find ("gnat.adc");
       Dot_Gnat_Adc : constant File_Name_Type := Name_Find ("./gnat.adc");
+      Gnat_Adc     : constant File_Name_Type := Name_Find ("gnat.adc");
 
       Save_Style_Check : constant Boolean := Opt.Style_Check;
       --  Save style check mode so it can be restored later
 
+      Config_Pragmas : List_Id := Empty_List;
+      --  Gather configuration pragmas
+
       Source_Config_File : Source_File_Index;
       --  Source reference for -gnatec configuration file
 
@@ -191,19 +191,21 @@ begin
             declare
                Len : constant Natural := Config_File_Names (Index)'Length;
                Str : constant String (1 .. Len) :=
-                 Config_File_Names (Index).all;
+                       Config_File_Names (Index).all;
+
                Config_Name : constant File_Name_Type := Name_Find (Str);
-               Temp_File : constant Boolean := Len > 4
-                 and then
-                  (Str (Len - 3 .. Len) = ".TMP"
-                     or else
-                   Str (Len - 3 .. Len) = ".tmp");
+               Temp_File   : constant Boolean :=
+                               Len > 4
+                                 and then
+                                   (Str (Len - 3 .. Len) = ".TMP"
+                                      or else
+                                    Str (Len - 3 .. Len) = ".tmp");
                --  Extension indicating a temporary config file?
 
             begin
                --  Skip it if it's the default name, already loaded above.
-               --  Otherwise, we get confusing warning messages about
-               --  seeing the same thing twice.
+               --  Otherwise, we get confusing warning messages about seeing
+               --  the same thing twice.
 
                if Config_Name /= Gnat_Adc
                  and then Config_Name /= Dot_Gnat_Adc
index 63e7965..baba9fe 100644 (file)
@@ -522,10 +522,10 @@ procedure Gnatbind is
                      declare
                         Arguments : constant Argument_List :=
                           System.Response_File.Arguments_From
-                                        (Response_File_Name        =>
-                                           Next_Argv (2 .. Next_Argv'Last),
-                                         Recursive                 => True,
-                                         Ignore_Non_Existing_Files => True);
+                            (Response_File_Name        =>
+                               Next_Argv (2 .. Next_Argv'Last),
+                             Recursive                 => True,
+                             Ignore_Non_Existing_Files => True);
                      begin
                         for J in Arguments'Range loop
                            Action (Arguments (J).all);
index 0bbe9cf..f023d72 100644 (file)
@@ -1607,7 +1607,7 @@ package body Inline is
       --  N is an inlined function body that returns an unconstrained type and
       --  has a single extended return statement. Split N in two subprograms:
       --  a procedure P' and a function F'. The formals of P' duplicate the
-      --  formals of N plus an extra formal which is used return a value;
+      --  formals of N plus an extra formal which is used to return a value;
       --  its body is composed by the declarations and list of statements
       --  of the extended return statement of N.
 
@@ -1915,6 +1915,7 @@ package body Inline is
             Pop_Scope;
             Build_Procedure (Proc_Id, Decl_List);
             Insert_Actions (N, Decl_List);
+            Set_Is_Inlined (Proc_Id);
             Push_Scope (Scope);
          end;
 
index be241a4..b1ecf52 100644 (file)
@@ -16311,7 +16311,7 @@ package body Sem_Ch3 is
       then
          declare
             Partial_View : constant Entity_Id :=
-              Find_Partial_View (Parent_Type);
+                             Find_Partial_View (Parent_Type);
 
          begin
             --  If the partial view was not found then the parent type is not a
@@ -16321,9 +16321,9 @@ package body Sem_Ch3 is
             if Present (Partial_View)
               and then not Is_Tagged_Type (Partial_View)
             then
-               Error_Msg_NE ("cannot derive from & declared as "
-                             & "untagged private (SPARK RM 3.4(1))",
-                             N, Partial_View);
+               Error_Msg_NE
+                 ("cannot derive from & declared as untagged private "
+                  & "(SPARK RM 3.4(1))", N, Partial_View);
             end if;
          end;
       end if;
index e62d7e1..841aff8 100644 (file)
@@ -70,6 +70,8 @@ with Sinput;    use Sinput;
 with Style;
 with Uintp;     use Uintp;
 
+with GNAT.HTable;
+
 package body Sem_Ch7 is
 
    -----------------------------------
@@ -187,6 +189,38 @@ package body Sem_Ch7 is
       end if;
    end Analyze_Package_Body;
 
+   ------------------------------------------------------
+   -- Analyze_Package_Body_Helper Data and Subprograms --
+   ------------------------------------------------------
+
+   Entity_Table_Size : constant := 4096;
+   --  Number of headers in hash table
+
+   subtype Entity_Header_Num is Integer range 0 .. Entity_Table_Size - 1;
+   --  Range of headers in hash table
+
+   function Entity_Hash (Id : Entity_Id) return Entity_Header_Num;
+   --  Simple hash function for Entity_Ids
+
+   package Subprogram_Table is new GNAT.Htable.Simple_HTable
+     (Header_Num => Entity_Header_Num,
+      Element    => Boolean,
+      No_Element => False,
+      Key        => Entity_Id,
+      Hash       => Entity_Hash,
+      Equal      => "=");
+   --  Hash table to record which subprograms are referenced. It is declared
+   --  at library level to avoid elaborating it for every call to Analyze.
+
+   -----------------
+   -- Entity_Hash --
+   -----------------
+
+   function Entity_Hash (Id : Entity_Id) return Entity_Header_Num is
+   begin
+      return Entity_Header_Num (Id mod Entity_Table_Size);
+   end Entity_Hash;
+
    ---------------------------------
    -- Analyze_Package_Body_Helper --
    ---------------------------------
@@ -200,8 +234,8 @@ package body Sem_Ch7 is
       --  Attempt to hide all public entities found in declarative list Decls
       --  by resetting their Is_Public flag to False depending on whether the
       --  entities are not referenced by inlined or generic bodies. This kind
-      --  of processing is a conservative approximation and may still leave
-      --  certain entities externally visible.
+      --  of processing is a conservative approximation and will still leave
+      --  entities externally visible if the package is not simple enough.
 
       procedure Install_Composite_Operations (P : Entity_Id);
       --  Composite types declared in the current scope may depend on types
@@ -214,11 +248,6 @@ package body Sem_Ch7 is
       --------------------------
 
       procedure Hide_Public_Entities (Decls : List_Id) is
-         function Contains_Subprograms_Refs (N : Node_Id) return Boolean;
-         --  Subsidiary to routine Has_Referencer. Determine whether a node
-         --  contains a reference to a subprogram.
-         --  WARNING: this is a very expensive routine as it performs a full
-         --  tree traversal.
 
          function Has_Referencer
            (Decls     : List_Id;
@@ -229,76 +258,15 @@ package body Sem_Ch7 is
          --  in the range Last (Decls) .. Referencer are hidden from external
          --  visibility.
 
-         -------------------------------
-         -- Contains_Subprograms_Refs --
-         -------------------------------
-
-         function Contains_Subprograms_Refs (N : Node_Id) return Boolean is
-            Reference_Seen : Boolean := False;
-
-            function Is_Subprogram_Ref (N : Node_Id) return Traverse_Result;
-            --  Determine whether a node denotes a reference to a subprogram
-
-            -----------------------
-            -- Is_Subprogram_Ref --
-            -----------------------
-
-            function Is_Subprogram_Ref
-              (N : Node_Id) return Traverse_Result
-            is
-               Val : Node_Id;
-
-            begin
-               --  Detect a reference of the form
-               --    Subp_Call
-
-               if Nkind (N) in N_Subprogram_Call
-                 and then Is_Entity_Name (Name (N))
-               then
-                  Reference_Seen := True;
-                  return Abandon;
-
-               --  Detect a reference of the form
-               --    Subp'Some_Attribute
-
-               elsif Nkind (N) = N_Attribute_Reference
-                 and then Is_Entity_Name (Prefix (N))
-                 and then Present (Entity (Prefix (N)))
-                 and then Is_Subprogram (Entity (Prefix (N)))
-               then
-                  Reference_Seen := True;
-                  return Abandon;
-
-               --  Constants can be substituted by their value in gigi, which
-               --  may contain a reference, so be conservative for them.
-
-               elsif Is_Entity_Name (N)
-                 and then Present (Entity (N))
-                 and then Ekind (Entity (N)) = E_Constant
-               then
-                  Val := Constant_Value (Entity (N));
-
-                  if Present (Val)
-                    and then not Compile_Time_Known_Value (Val)
-                  then
-                     Reference_Seen := True;
-                     return Abandon;
-                  end if;
-               end if;
+         function Scan_Subprogram_Ref (N : Node_Id) return Traverse_Result;
+         --  Determine whether a node denotes a reference to a subprogram
 
-               return OK;
-            end Is_Subprogram_Ref;
-
-            procedure Find_Subprograms_Ref is
-              new Traverse_Proc (Is_Subprogram_Ref);
-
-         --  Start of processing for Contains_Subprograms_Refs
-
-         begin
-            Find_Subprograms_Ref (N);
-
-            return Reference_Seen;
-         end Contains_Subprograms_Refs;
+         procedure Scan_Subprogram_Refs is
+           new Traverse_Proc (Scan_Subprogram_Ref);
+         --  Subsidiary to routine Has_Referencer. Determine whether a node
+         --  contains references to a subprogram and record them.
+         --  WARNING: this is a very expensive routine as it performs a full
+         --  tree traversal.
 
          --------------------
          -- Has_Referencer --
@@ -313,10 +281,9 @@ package body Sem_Ch7 is
             Spec    : Node_Id;
 
             Has_Non_Subprograms_Referencer : Boolean := False;
-            --  Flag set if a subprogram body was detected as a referencer but
-            --  does not contain references to other subprograms. In this case,
-            --  if we still are top level, we do not return True immediately,
-            --  but keep hiding subprograms from external visibility.
+            --  Set if an inlined subprogram body was detected as a referencer.
+            --  In this case, we do not return True immediately but keep hiding
+            --  subprograms from external visibility.
 
          begin
             if No (Decls) then
@@ -402,17 +369,13 @@ package body Sem_Ch7 is
                      if Is_Inlined (Decl_Id)
                        or else Has_Pragma_Inline (Decl_Id)
                      then
+                        Has_Non_Subprograms_Referencer := True;
+
                         --  Inspect the statements of the subprogram body
                         --  to determine whether the body references other
                         --  subprograms.
 
-                        if Top_Level
-                          and then not Contains_Subprograms_Refs (Decl)
-                        then
-                           Has_Non_Subprograms_Referencer := True;
-                        else
-                           return True;
-                        end if;
+                        Scan_Subprogram_Refs (Decl);
                      end if;
 
                   --  Otherwise this is a stand alone subprogram body
@@ -420,21 +383,22 @@ package body Sem_Ch7 is
                   else
                      Decl_Id := Defining_Entity (Decl);
 
-                     --  An inlined body acts as a referencer, see above. Note
-                     --  that an inlined subprogram remains Is_Public as gigi
-                     --  requires the flag to be set.
+                     --  An inlined subprogram body acts as a referencer
 
                      if Is_Inlined (Decl_Id)
                        or else Has_Pragma_Inline (Decl_Id)
                      then
-                        if Top_Level
-                          and then not Contains_Subprograms_Refs (Decl)
-                        then
-                           Has_Non_Subprograms_Referencer := True;
-                        else
-                           return True;
-                        end if;
-                     else
+                        Has_Non_Subprograms_Referencer := True;
+
+                        --  Inspect the statements of the subprogram body
+                        --  to determine whether the body references other
+                        --  subprograms.
+
+                        Scan_Subprogram_Refs (Decl);
+
+                     --  Otherwise we can reset Is_Public right away
+
+                     elsif not Subprogram_Table.Get (Decl_Id) then
                         Set_Is_Public (Decl_Id, False);
                      end if;
                   end if;
@@ -443,9 +407,7 @@ package body Sem_Ch7 is
                --  if they are not followed by a construct which can reference
                --  and export them. The Is_Public flag is reset on top level
                --  entities only as anything nested is local to its context.
-               --  Likewise for subprograms, but we work harder for them as
-               --  their visibility can have a significant impact on inlining
-               --  decisions in the back end.
+               --  Likewise for subprograms, but we work harder for them.
 
                elsif Nkind_In (Decl, N_Exception_Declaration,
                                      N_Object_Declaration,
@@ -461,7 +423,8 @@ package body Sem_Ch7 is
                     and then No (Interface_Name (Decl_Id))
                     and then
                       (not Has_Non_Subprograms_Referencer
-                        or else Nkind (Decl) = N_Subprogram_Declaration)
+                        or else (Nkind (Decl) = N_Subprogram_Declaration
+                                  and then not Subprogram_Table.Get (Decl_Id)))
                   then
                      Set_Is_Public (Decl_Id, False);
                   end if;
@@ -473,6 +436,53 @@ package body Sem_Ch7 is
             return Has_Non_Subprograms_Referencer;
          end Has_Referencer;
 
+         -------------------------
+         -- Scan_Subprogram_Ref --
+         -------------------------
+
+         function Scan_Subprogram_Ref (N : Node_Id) return Traverse_Result is
+         begin
+            --  Detect a reference of the form
+            --    Subp_Call
+
+            if Nkind (N) in N_Subprogram_Call
+              and then Is_Entity_Name (Name (N))
+              and then Present (Entity (Name (N)))
+              and then Is_Subprogram (Entity (Name (N)))
+            then
+               Subprogram_Table.Set (Entity (Name (N)), True);
+
+            --  Detect a reference of the form
+            --    Subp'Some_Attribute
+
+            elsif Nkind (N) = N_Attribute_Reference
+              and then Is_Entity_Name (Prefix (N))
+              and then Present (Entity (Prefix (N)))
+              and then Is_Subprogram (Entity (Prefix (N)))
+            then
+               Subprogram_Table.Set (Entity (Prefix (N)), True);
+
+            --  Constants can be substituted by their value in gigi, which may
+            --  contain a reference, so scan the value recursively.
+
+            elsif Is_Entity_Name (N)
+              and then Present (Entity (N))
+              and then Ekind (Entity (N)) = E_Constant
+            then
+               declare
+                  Val : constant Node_Id := Constant_Value (Entity (N));
+               begin
+                  if Present (Val)
+                    and then not Compile_Time_Known_Value (Val)
+                  then
+                     Scan_Subprogram_Refs (Val);
+                  end if;
+               end;
+            end if;
+
+            return OK;
+         end Scan_Subprogram_Ref;
+
          --  Local variables
 
          Discard : Boolean := True;
@@ -513,6 +523,30 @@ package body Sem_Ch7 is
          --  not always be the case. The algorithm takes a conservative stance
          --  and leaves entity External_Obj public.
 
+         --  This very conservative algorithm is supplemented by a more precise
+         --  processing for inlined bodies. For them, we traverse the syntactic
+         --  tree and record which subprograms are actually referenced from it.
+         --  This makes it possible to compute a much smaller set of externally
+         --  visible subprograms, which can have a significant impact on the
+         --  inlining decisions made in the back end. We do it only for inlined
+         --  bodies because they are supposed to be reasonably small and tree
+         --  traversal is very expensive.
+
+         --  Note that even this special processing is not optimal for inlined
+         --  bodies, because we treat all inlined subprograms alike. An optimal
+         --  algorithm would require computing the transitive closure of the
+         --  inlined subprograms that can really be referenced from other units
+         --  in the source code.
+
+         --  We could extend this processing for inlined bodies and record all
+         --  entities, not just subprograms, referenced from them, which would
+         --  make it possible to compute a much smaller set of all externally
+         --  visible entities in the absence of generic bodies. But this would
+         --  mean implementing a more thorough tree traversal of the bodies,
+         --  i.e. not just syntactic, and the gain would very likely be worth
+         --  neither the hassle nor the slowdown of the compiler.
+
+         Subprogram_Table.Reset;
          Discard := Has_Referencer (Decls, Top_Level => True);
       end Hide_Public_Entities;
 
index ffbe86a..c4d09a2 100644 (file)
@@ -14131,7 +14131,7 @@ package body Sem_Util is
    function Is_Object_Image (Prefix : Node_Id) return Boolean is
    begin
       --  When the type of the prefix is not scalar then the prefix is not
-      --  valid in any senario.
+      --  valid in any scenario.
 
       if not Is_Scalar_Type (Etype (Prefix)) then
          return False;
@@ -14139,7 +14139,7 @@ package body Sem_Util is
 
       --  Here we test for the case that the prefix is not a type and assume
       --  if it is not then it must be a named value or an object reference.
-      --  This is because the parser always checks that prefix's of attributes
+      --  This is because the parser always checks that prefixes of attributes
       --  are named.
 
       return not (Is_Entity_Name (Prefix) and then Is_Type (Entity (Prefix)));
@@ -15554,7 +15554,9 @@ package body Sem_Util is
 
    begin
       case Ekind (E) is
-         when Entry_Kind | Subprogram_Kind =>
+         when Entry_Kind
+            | Subprogram_Kind
+         =>
             Scop := Scope (E);
 
             while Present (Scop) loop
index fd31316..ecc47e4 100644 (file)
@@ -1382,16 +1382,22 @@ package body Sem_Warn is
                   --  deal with case where original unset reference has been
                   --  rewritten during expansion.
 
-                  --  In some cases, the original node may be a type conversion
-                  --  or qualification, and in this case we want the object
-                  --  entity inside.
+                  --  In some cases, the original node may be a type
+                  --  conversion, a qualification or an attribute reference and
+                  --  in this case we want the object entity inside. Same for
+                  --  an expression with actions.
 
                   UR := Original_Node (UR);
                   while Nkind (UR) = N_Type_Conversion
                     or else Nkind (UR) = N_Qualified_Expression
                     or else Nkind (UR) = N_Expression_With_Actions
+                    or else Nkind (UR) = N_Attribute_Reference
                   loop
-                     UR := Expression (UR);
+                     if Nkind (UR) = N_Attribute_Reference then
+                        UR := Prefix (UR);
+                     else
+                        UR := Expression (UR);
+                     end if;
                   end loop;
 
                   --  Don't issue warning if appearing inside Initial_Condition