[multiple changes]

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

	* inline.adb: Add comments to Can_Be_Inlined_In_GNATprove_Mode.

2017-09-06  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Component_Not_OK_For_Backend): The C backend
	cannot handle a type conversion of an array as an aggregate
	component.

2017-09-06  Bob Duff  <duff@adacore.com>

	* g-comlin.adb (Try_Help): Remove ".exe" so we
	get the same results on windows and unix.

2017-09-06  Justin Squirek  <squirek@adacore.com>

	* exp_imgv.adb (Expand_Image_Attribute),
	(Expand_Wide_Image_Attribute), (Expand_Wide_Wide_Image_Attribute):
	Added case to handle new-style 'Image expansion
	(Rewrite_Object_Image): Moved from exp_attr.adb
	* exp_attr.adb (Expand_N_Attribute_Reference): Modified Image
	attribute cases so that the relevant subprograms in exp_imgv.adb
	handle all expansion.
	(Rewrite_Object_Reference_Image): Moved to exp_imgv.adb
	* sem_attr.adb (Analyze_Attribute): Modified Image attribute
	cases to call common function Analyze_Image_Attribute.
	(Analyze_Image_Attribute): Created as a common path for all
	image attributes (Check_Object_Reference_Image): Removed
	* sem_util.ads, sem_util.adb (Is_Image_Applied_To_Object):
	Removed and refactored into Is_Object_Image (Is_Object_Image):
	Created as a replacement for Is_Image_Applied_To_Object

From-SVN: r251779

gcc/ada/ChangeLog

 2017-09-06  Yannick Moy  <moy@adacore.com>
 
+	* inline.adb: Add comments to Can_Be_Inlined_In_GNATprove_Mode.
+
+2017-09-06  Javier Miranda  <miranda@adacore.com>
+
+	* exp_aggr.adb (Component_Not_OK_For_Backend): The C backend
+	cannot handle a type conversion of an array as an aggregate
+	component.
+
+2017-09-06  Bob Duff  <duff@adacore.com>
+
+	* g-comlin.adb (Try_Help): Remove ".exe" so we
+	get the same results on windows and unix.
+
+2017-09-06  Justin Squirek  <squirek@adacore.com>
+
+	* exp_imgv.adb (Expand_Image_Attribute),
+	(Expand_Wide_Image_Attribute), (Expand_Wide_Wide_Image_Attribute):
+	Added case to handle new-style 'Image expansion
+	(Rewrite_Object_Image): Moved from exp_attr.adb
+	* exp_attr.adb (Expand_N_Attribute_Reference): Modified Image
+	attribute cases so that the relevant subprograms in exp_imgv.adb
+	handle all expansion.
+	(Rewrite_Object_Reference_Image): Moved to exp_imgv.adb
+	* sem_attr.adb (Analyze_Attribute): Modified Image attribute
+	cases to call common function Analyze_Image_Attribute.
+	(Analyze_Image_Attribute): Created as a common path for all
+	image attributes (Check_Object_Reference_Image): Removed
+	* sem_util.ads, sem_util.adb (Is_Image_Applied_To_Object):
+	Removed and refactored into Is_Object_Image (Is_Object_Image):
+	Created as a replacement for Is_Image_Applied_To_Object
+
+2017-09-06  Yannick Moy  <moy@adacore.com>
+
 	* sem_prag.adb (Analyze_Depends_In_Decl_Part): Add continuation
 	message for missing input.
 

gcc/ada/exp_aggr.adb

@@ -7151,6 +7151,13 @@ package body Exp_Aggr is
             then
                Static_Components := False;
                return True;
+
+            elsif Modify_Tree_For_C
+              and then Nkind (Expr_Q) = N_Type_Conversion
+              and then Is_Array_Type (Etype (Expr_Q))
+            then
+               Static_Components := False;
+               return True;
             end if;
 
             if Is_Elementary_Type (Etype (Expr_Q)) then

gcc/ada/exp_attr.adb

@@ -1594,34 +1594,10 @@ package body Exp_Attr is
       Exprs : constant List_Id      := Expressions (N);
       Id    : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N));
 
-      procedure Rewrite_Object_Reference_Image
-        (Name    : Name_Id;
-         Str_Typ : Entity_Id);
-      --  AI12-00124: Rewrite attribute 'Image when it is applied to an object
-      --  reference as an attribute applied to a type.
-
       procedure Rewrite_Stream_Proc_Call (Pname : Entity_Id);
       --  Rewrites a stream attribute for Read, Write or Output with the
       --  procedure call. Pname is the entity for the procedure to call.
 
-      ------------------------------------
-      -- Rewrite_Object_Reference_Image --
-      ------------------------------------
-
-      procedure Rewrite_Object_Reference_Image
-        (Name    : Name_Id;
-         Str_Typ : Entity_Id)
-      is
-      begin
-         Rewrite (N,
-           Make_Attribute_Reference (Loc,
-             Prefix         => New_Occurrence_Of (Ptyp, Loc),
-             Attribute_Name => Name,
-             Expressions    => New_List (Relocate_Node (Pref))));
-
-         Analyze_And_Resolve (N, Str_Typ);
-      end Rewrite_Object_Reference_Image;
-
       ------------------------------
       -- Rewrite_Stream_Proc_Call --
       ------------------------------
@@ -3637,11 +3613,6 @@ package body Exp_Attr is
       --  Image attribute is handled in separate unit Exp_Imgv
 
       when Attribute_Image =>
-         if Is_Image_Applied_To_Object (Pref, Ptyp) then
-            Rewrite_Object_Reference_Image (Name_Image, Standard_String);
-            return;
-         end if;
-
          --  Leave attribute unexpanded in CodePeer mode: the gnat2scil
          --  back-end knows how to handle this attribute directly.
 
@@ -3658,7 +3629,7 @@ package body Exp_Attr is
       --  X'Img is expanded to typ'Image (X), where typ is the type of X
 
       when Attribute_Img =>
-         Rewrite_Object_Reference_Image (Name_Image, Standard_String);
+         Exp_Imgv.Expand_Image_Attribute (N);
 
       -----------
       -- Input --
@@ -7004,12 +6975,6 @@ package body Exp_Attr is
       --  Wide_Image attribute is handled in separate unit Exp_Imgv
 
       when Attribute_Wide_Image =>
-         if Is_Image_Applied_To_Object (Pref, Ptyp) then
-            Rewrite_Object_Reference_Image
-              (Name_Wide_Image, Standard_Wide_String);
-            return;
-         end if;
-
          --  Leave attribute unexpanded in CodePeer mode: the gnat2scil
          --  back-end knows how to handle this attribute directly.
 
@@ -7026,12 +6991,6 @@ package body Exp_Attr is
       --  Wide_Wide_Image attribute is handled in separate unit Exp_Imgv
 
       when Attribute_Wide_Wide_Image =>
-         if Is_Image_Applied_To_Object (Pref, Ptyp) then
-            Rewrite_Object_Reference_Image
-              (Name_Wide_Wide_Image, Standard_Wide_Wide_String);
-            return;
-         end if;
-
          --  Leave attribute unexpanded in CodePeer mode: the gnat2scil
          --  back-end knows how to handle this attribute directly.
 

gcc/ada/exp_imgv.adb

@@ -36,6 +36,7 @@ with Opt;      use Opt;
 with Rtsfind;  use Rtsfind;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Res;  use Sem_Res;
+with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
@@ -52,6 +53,17 @@ package body Exp_Imgv is
    --  Ordinary_Fixed_Point_Type with a small that is a negative power of ten.
    --  Shouldn't this be in einfo.adb or sem_aux.adb???
 
+   procedure Rewrite_Object_Image
+     (N         : Node_Id;
+      Pref      : Entity_Id;
+      Attr_Name : Name_Id;
+      Str_Typ   : Entity_Id);
+   --  AI12-00124: Rewrite attribute 'Image when it is applied to an object
+   --  reference as an attribute applied to a type. N denotes the node to be
+   --  rewritten, Pref denotes the prefix of the 'Image attribute, and Name
+   --  and Str_Typ specify which specific string type and 'Image attribute to
+   --  apply (e.g. Name_Wide_Image and Standard_Wide_String).
+
    ------------------------------------
    -- Build_Enumeration_Image_Tables --
    ------------------------------------
@@ -254,10 +266,10 @@ package body Exp_Imgv is
       Loc       : constant Source_Ptr := Sloc (N);
       Exprs     : constant List_Id    := Expressions (N);
       Pref      : constant Node_Id    := Prefix (N);
-      Ptyp      : constant Entity_Id  := Entity (Pref);
-      Rtyp      : constant Entity_Id  := Root_Type (Ptyp);
       Expr      : constant Node_Id    := Relocate_Node (First (Exprs));
       Imid      : RE_Id;
+      Ptyp      : Entity_Id;
+      Rtyp      : Entity_Id;
       Tent      : Entity_Id;
       Ttyp      : Entity_Id;
       Proc_Ent  : Entity_Id;
@@ -273,6 +285,14 @@ package body Exp_Imgv is
       Pnn : constant Entity_Id := Make_Temporary (Loc, 'P');
 
    begin
+      if Is_Object_Image (Pref) then
+         Rewrite_Object_Image (N, Pref, Name_Image, Standard_String);
+         return;
+      end if;
+
+      Ptyp := Entity (Pref);
+      Rtyp := Root_Type (Ptyp);
+
       --  Build declarations of Snn and Pnn to be inserted
 
       Ins_List := New_List (
@@ -791,11 +811,19 @@ package body Exp_Imgv is
 
    procedure Expand_Wide_Image_Attribute (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
-      Rtyp : constant Entity_Id  := Root_Type (Entity (Prefix (N)));
-      Rnn  : constant Entity_Id := Make_Temporary (Loc, 'S');
-      Lnn  : constant Entity_Id := Make_Temporary (Loc, 'P');
+      Pref : constant Entity_Id  := Prefix (N);
+      Rnn  : constant Entity_Id  := Make_Temporary (Loc, 'S');
+      Lnn  : constant Entity_Id  := Make_Temporary (Loc, 'P');
+      Rtyp : Entity_Id;
 
    begin
+      if Is_Object_Image (Pref) then
+         Rewrite_Object_Image (N, Pref, Name_Wide_Image, Standard_Wide_String);
+         return;
+      end if;
+
+      Rtyp := Root_Type (Entity (Pref));
+
       Insert_Actions (N, New_List (
 
          --  Rnn : Wide_String (1 .. base_typ'Width);
@@ -882,12 +910,20 @@ package body Exp_Imgv is
 
    procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
-      Rtyp : constant Entity_Id  := Root_Type (Entity (Prefix (N)));
-
-      Rnn : constant Entity_Id := Make_Temporary (Loc, 'S');
-      Lnn : constant Entity_Id := Make_Temporary (Loc, 'P');
+      Pref : constant Entity_Id  := Prefix (N);
+      Rnn  : constant Entity_Id  := Make_Temporary (Loc, 'S');
+      Lnn  : constant Entity_Id  := Make_Temporary (Loc, 'P');
+      Rtyp : Entity_Id;
 
    begin
+      if Is_Object_Image (Pref) then
+         Rewrite_Object_Image
+           (N, Pref, Name_Wide_Wide_Image, Standard_Wide_Wide_String);
+         return;
+      end if;
+
+      Rtyp := Root_Type (Entity (Pref));
+
       Insert_Actions (N, New_List (
 
          --  Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width);
@@ -1373,4 +1409,23 @@ package body Exp_Imgv is
              and then Ureal_10**Aft_Value (E) * Small_Value (E) = Ureal_1);
    end Has_Decimal_Small;
 
+   --------------------------
+   -- Rewrite_Object_Image --
+   --------------------------
+
+   procedure Rewrite_Object_Image
+     (N         : Node_Id;
+      Pref      : Entity_Id;
+      Attr_Name : Name_Id;
+      Str_Typ   : Entity_Id)
+   is
+   begin
+      Rewrite (N,
+        Make_Attribute_Reference (Sloc (N),
+          Prefix         => New_Occurrence_Of (Etype (Pref), Sloc (N)),
+          Attribute_Name => Attr_Name,
+          Expressions    => New_List (Relocate_Node (Pref))));
+
+      Analyze_And_Resolve (N, Str_Typ);
+   end Rewrite_Object_Image;
 end Exp_Imgv;

gcc/ada/exp_imgv.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-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- --
@@ -70,20 +70,20 @@ package Exp_Imgv is
    --    declarations are not constructed, and the fields remain Empty.
 
    procedure Expand_Image_Attribute (N : Node_Id);
-   --  This procedure is called from Exp_Attr to expand an occurrence
-   --  of the attribute Image.
+   --  This procedure is called from Exp_Attr to expand an occurrence of the
+   --  attribute Image.
 
    procedure Expand_Wide_Image_Attribute (N : Node_Id);
-   --  This procedure is called from Exp_Attr to expand an occurrence
-   --  of the attribute Wide_Image.
+   --  This procedure is called from Exp_Attr to expand an occurrence of the
+   --  attribute Wide_Image.
 
    procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id);
-   --  This procedure is called from Exp_Attr to expand an occurrence
-   --  of the attribute Wide_Wide_Image.
+   --  This procedure is called from Exp_Attr to expand an occurrence of the
+   --  attribute Wide_Wide_Image.
 
    procedure Expand_Value_Attribute (N : Node_Id);
-   --  This procedure is called from Exp_Attr to expand an occurrence
-   --  of the attribute Value.
+   --  This procedure is called from Exp_Attr to expand an occurrence of the
+   --  attribute Value.
 
    type Atype is (Normal, Wide, Wide_Wide);
    --  Type of attribute in call to Expand_Width_Attribute

gcc/ada/g-comlin.adb

@@ -3606,7 +3606,7 @@ package body GNAT.Command_Line is
    begin
       Put_Line
         (Standard_Error,
-         "try """ & Base_Name (Ada.Command_Line.Command_Name)
+         "try """ & Base_Name (Ada.Command_Line.Command_Name, Suffix => ".exe")
          & " --help"" for more information.");
    end Try_Help;
 

gcc/ada/inline.adb

@@ -1178,8 +1178,9 @@ package body Inline is
       --  types.
 
       function Has_Some_Contract (Id : Entity_Id) return Boolean;
-      --  Returns True if subprogram Id has any contract (Pre, Post, Global,
-      --  Depends, etc.)
+      --  Returns True if subprogram Id has any contract (Pre, Post,
+      --  Global, Depends, etc.) The presence of Extensions_Visible
+      --  or Volatile_Function is also considered as a contract here.
 
       function Is_Unit_Subprogram (Id : Entity_Id) return Boolean;
       --  Returns True if subprogram Id defines a compilation unit
@@ -1272,6 +1273,11 @@ package body Inline is
          if Is_Subprogram_Or_Generic_Subprogram (Id) then
             Items := Contract (Id);
 
+            --  Note that Classifications is not Empty when Extensions_Visible
+            --  or Volatile_Function is present, which causes such subprograms
+            --  to be considered to have a contract here. This is fine as we
+            --  want to avoid inlining these too.
+
             return Present (Items)
               and then (Present (Pre_Post_Conditions (Items)) or else
                         Present (Contract_Test_Cases (Items)) or else
@@ -1365,7 +1371,8 @@ package body Inline is
          return False;
 
       --  Do not inline subprograms that have a contract on the spec or the
-      --  body. Use the contract(s) instead in GNATprove.
+      --  body. Use the contract(s) instead in GNATprove. This also prevents
+      --  inlining of subprograms with Extensions_Visible or Volatile_Function.
 
       elsif (Present (Spec_Id) and then Has_Some_Contract (Spec_Id))
                or else

gcc/ada/sem_attr.adb

@@ -261,6 +261,12 @@ package body Sem_Attr is
       --  when the above criteria are met. Spec_Id denotes the entity of the
       --  subprogram [body] or Empty if the attribute is illegal.
 
+      procedure Analyze_Image_Attribute (Str_Typ : Entity_Id);
+      --  Common processing for attributes 'Img, 'Image, 'Wide_Image, and
+      --  'Wide_Wide_Image. The routine checks that the prefix is valid and
+      --  sets the entity type to the one specified by Str_Typ (e.g.
+      --  Standard_String for 'Image and Standard_Wide_String for 'Wide_Image).
+
       procedure Bad_Attribute_For_Predicate;
       --  Output error message for use of a predicate (First, Last, Range) not
       --  allowed with a type that has predicates. If the type is a generic
@@ -363,10 +369,6 @@ package body Sem_Attr is
       procedure Check_Object_Reference (P : Node_Id);
       --  Check that P is an object reference
 
-      procedure Check_Object_Reference_Image (Str_Typ : Entity_Id);
-      --  Verify that the prefix of attribute 'Image is an object reference and
-      --  set the type of the prefix to Str_Typ.
-
       procedure Check_PolyORB_Attribute;
       --  Validity checking for PolyORB/DSA attribute
 
@@ -1427,6 +1429,82 @@ package body Sem_Attr is
          end if;
       end Analyze_Attribute_Old_Result;
 
+      -----------------------------
+      -- Analyze_Image_Attribute --
+      -----------------------------
+
+      procedure Analyze_Image_Attribute (Str_Typ : Entity_Id) is
+      begin
+         Check_SPARK_05_Restriction_On_Attribute;
+
+         --  AI12-00124: The ARG has adopted the GNAT semantics of 'Img for
+         --  scalar types, so that the prefix can be an object, a named value,
+         --  or a type, and there is no need for an argument in this case.
+
+         if Attr_Id = Attribute_Img
+           or else (Ada_Version > Ada_2005 and then Is_Object_Image (P))
+         then
+            Check_E0;
+            Set_Etype (N, Str_Typ);
+
+            if Attr_Id = Attribute_Img and then not Is_Object_Image (P) then
+               Error_Attr_P
+                 ("prefix of % attribute must be a scalar object name");
+            end if;
+         else
+            Check_E1;
+            Set_Etype (N, Str_Typ);
+
+            --  Check that the prefix type is scalar - much in the same way as
+            --  Check_Scalar_Type but with custom error messages to denote the
+            --  variants of 'Image attributes.
+
+            if Is_Entity_Name (P)
+              and then Is_Type (Entity (P))
+              and then Ekind (Entity (P)) = E_Incomplete_Type
+              and then Present (Full_View (Entity (P)))
+            then
+               P_Type := Full_View (Entity (P));
+               Set_Entity (P, P_Type);
+            end if;
+
+            if not Is_Entity_Name (P)
+              or else not Is_Type (Entity (P))
+              or else not Is_Scalar_Type (P_Type)
+            then
+               if Ada_Version > Ada_2005 then
+                  Error_Attr_P
+                    ("prefix of % attribute must be a scalar type or a scalar "
+                      & "object name");
+               else
+                  Error_Attr_P ("prefix of % attribute must be a scalar type");
+               end if;
+
+            elsif Is_Protected_Self_Reference (P) then
+               Error_Attr_P
+                 ("prefix of % attribute denotes current instance "
+                  & "(RM 9.4(21/2))");
+            end if;
+
+            Resolve (E1, P_Base_Type);
+            Validate_Non_Static_Attribute_Function_Call;
+         end if;
+
+         Check_Enum_Image;
+
+         --  Check restriction No_Fixed_IO. Note the check of Comes_From_Source
+         --  to avoid giving a duplicate message for when Image attributes
+         --  applied to object references get expanded into type-based Image
+         --  attributes.
+
+         if Restriction_Check_Required (No_Fixed_IO)
+           and then Comes_From_Source (N)
+           and then Is_Fixed_Point_Type (P_Type)
+         then
+            Check_Restriction (No_Fixed_IO, P);
+         end if;
+      end Analyze_Image_Attribute;
+
       ---------------------------------
       -- Bad_Attribute_For_Predicate --
       ---------------------------------
@@ -2164,33 +2242,6 @@ package body Sem_Attr is
          end if;
       end Check_Object_Reference;
 
-      ----------------------------------
-      -- Check_Object_Reference_Image --
-      ----------------------------------
-
-      procedure Check_Object_Reference_Image (Str_Typ : Entity_Id) is
-      begin
-         Check_E0;
-         Set_Etype (N, Str_Typ);
-
-         if not Is_Scalar_Type (P_Type)
-           or else (Is_Entity_Name (P) and then Is_Type (Entity (P)))
-         then
-            Error_Attr_P
-              ("prefix of % attribute must be scalar object name");
-         end if;
-
-         Check_Enum_Image;
-
-         --  Check restriction No_Fixed_IO
-
-         if Restriction_Check_Required (No_Fixed_IO)
-           and then Is_Fixed_Point_Type (P_Type)
-         then
-            Check_Restriction (No_Fixed_IO, P);
-         end if;
-      end Check_Object_Reference_Image;
-
       ----------------------------
       -- Check_PolyORB_Attribute --
       ----------------------------
@@ -4073,16 +4124,6 @@ package body Sem_Attr is
       -----------
 
       when Attribute_Image =>
-         Check_SPARK_05_Restriction_On_Attribute;
-
-         if Is_Image_Applied_To_Object (P, P_Type) then
-            Check_Object_Reference_Image (Standard_String);
-            return;
-         end if;
-
-         Check_Scalar_Type;
-         Set_Etype (N, Standard_String);
-
          if Is_Real_Type (P_Type) then
             if Ada_Version = Ada_83 and then Comes_From_Source (N) then
                Error_Msg_Name_1 := Aname;
@@ -4091,31 +4132,14 @@ package body Sem_Attr is
             end if;
          end if;
 
-         if Is_Enumeration_Type (P_Type) then
-            Check_Restriction (No_Enumeration_Maps, N);
-         end if;
-
-         Check_E1;
-         Resolve (E1, P_Base_Type);
-         Check_Enum_Image;
-         Validate_Non_Static_Attribute_Function_Call;
-
-         --  Check restriction No_Fixed_IO. Note the check of Comes_From_Source
-         --  to avoid giving a duplicate message for Img expanded into Image.
-
-         if Restriction_Check_Required (No_Fixed_IO)
-           and then Comes_From_Source (N)
-           and then Is_Fixed_Point_Type (P_Type)
-         then
-            Check_Restriction (No_Fixed_IO, P);
-         end if;
+         Analyze_Image_Attribute (Standard_String);
 
       ---------
       -- Img --
       ---------
 
       when Attribute_Img =>
-         Check_Object_Reference_Image (Standard_String);
+         Analyze_Image_Attribute (Standard_String);
 
       -----------
       -- Input --
@@ -6995,50 +7019,14 @@ package body Sem_Attr is
       ----------------
 
       when Attribute_Wide_Image =>
-         Check_SPARK_05_Restriction_On_Attribute;
-
-         if Is_Image_Applied_To_Object (P, P_Type) then
-            Check_Object_Reference_Image (Standard_Wide_String);
-            return;
-         end if;
-
-         Check_Scalar_Type;
-         Set_Etype (N, Standard_Wide_String);
-         Check_E1;
-         Resolve (E1, P_Base_Type);
-         Validate_Non_Static_Attribute_Function_Call;
-
-         --  Check restriction No_Fixed_IO
-
-         if Restriction_Check_Required (No_Fixed_IO)
-           and then Is_Fixed_Point_Type (P_Type)
-         then
-            Check_Restriction (No_Fixed_IO, P);
-         end if;
+         Analyze_Image_Attribute (Standard_Wide_String);
 
       ---------------------
       -- Wide_Wide_Image --
       ---------------------
 
       when Attribute_Wide_Wide_Image =>
-         if Is_Image_Applied_To_Object (P, P_Type) then
-            Check_Object_Reference_Image (Standard_Wide_Wide_String);
-            return;
-         end if;
-
-         Check_Scalar_Type;
-         Set_Etype (N, Standard_Wide_Wide_String);
-         Check_E1;
-         Resolve (E1, P_Base_Type);
-         Validate_Non_Static_Attribute_Function_Call;
-
-         --  Check restriction No_Fixed_IO
-
-         if Restriction_Check_Required (No_Fixed_IO)
-           and then Is_Fixed_Point_Type (P_Type)
-         then
-            Check_Restriction (No_Fixed_IO, P);
-         end if;
+         Analyze_Image_Attribute (Standard_Wide_Wide_String);
 
       ----------------
       -- Wide_Value --

gcc/ada/sem_util.adb

@@ -13773,21 +13773,6 @@ package body Sem_Util is
                              N_Generic_Subprogram_Declaration);
    end Is_Generic_Declaration_Or_Body;
 
-   --------------------------------
-   -- Is_Image_Applied_To_Object --
-   --------------------------------
-
-   function Is_Image_Applied_To_Object
-     (Prefix : Node_Id;
-      P_Typ  : Entity_Id) return Boolean
-   is
-   begin
-      return
-        Ada_Version > Ada_2005
-          and then Is_Object_Reference (Prefix)
-          and then Is_Scalar_Type (P_Typ);
-   end Is_Image_Applied_To_Object;
-
    ----------------------------
    -- Is_Inherited_Operation --
    ----------------------------
@@ -14139,6 +14124,27 @@ package body Sem_Util is
             or else Null_Present (Component_List (Type_Definition (Decl))));
    end Is_Null_Record_Type;
 
+   ---------------------
+   -- Is_Object_Image --
+   ---------------------
+
+   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.
+
+      if not Is_Scalar_Type (Etype (Prefix)) then
+         return False;
+      end if;
+
+      --  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
+      --  are named.
+
+      return not (Is_Entity_Name (Prefix) and then Is_Type (Entity (Prefix)));
+   end Is_Object_Image;
+
    -------------------------
    -- Is_Object_Reference --
    -------------------------
@@ -14222,9 +14228,9 @@ package body Sem_Util is
                return not Nkind_In (Original_Node (N), N_Case_Expression,
                                                        N_If_Expression);
 
-            --  A view conversion of a tagged object is an object reference
-
             when N_Type_Conversion =>
+               --  A view conversion of a tagged object is an object reference
+
                return Is_Tagged_Type (Etype (Subtype_Mark (N)))
                  and then Is_Tagged_Type (Etype (Expression (N)))
                  and then Is_Object_Reference (Expression (N));

gcc/ada/sem_util.ads

@@ -1598,18 +1598,6 @@ package Sem_Util is
    --  Determine whether arbitrary declaration Decl denotes a generic package,
    --  a generic subprogram or a generic body.
 
-   function Is_Image_Applied_To_Object
-     (Prefix : Node_Id;
-      P_Typ  : Entity_Id) return Boolean;
-   --  Returns true if an 'Image, 'Wide_Image, or 'Wide_Wide_Image attribute
-   --  can be applied to a given object-reference prefix (see AI12-00124).
-
-   --  AI12-00124: The ARG has adopted the GNAT semantics of 'Img for scalar
-   --  types, so that the prefix can be an object and not a type, and there is
-   --  no need for an argument. Given the vote of confidence from the ARG,
-   --  simplest is to transform this new usage of 'Image into a reference to
-   --  'Img.
-
    function Is_Inherited_Operation (E : Entity_Id) return Boolean;
    --  E is a subprogram. Return True is E is an implicit operation inherited
    --  by a derived type declaration.
@@ -1683,6 +1671,15 @@ package Sem_Util is
    --  Determine whether T is declared with a null record definition or a
    --  null component list.
 
+   function Is_Object_Image (Prefix : Node_Id) return Boolean;
+   --  Returns true if an 'Image, 'Wide_Image, or 'Wide_Wide_Image attribute
+   --  is applied to a given object or named value prefix (see below).
+
+   --  AI12-00124: The ARG has adopted the GNAT semantics of 'Img for scalar
+   --  types, so that the prefix of any 'Image attribute can be an object, a
+   --  named value, or a type, and there is no need for an argument in the
+   --  case it is an object reference.
+
    function Is_Object_Reference (N : Node_Id) return Boolean;
    --  Determines if the tree referenced by N represents an object. Both
    --  variable and constant objects return True (compare Is_Variable).