[multiple changes]

2015-01-07  Bob Duff  <duff@adacore.com>

	* usage.adb (Usage): Document -gnatw.f switch.

2015-01-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb: Code clean up and minor reformatting.

2015-01-07  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_N_Type_Conversion): Add guard for
	Raise_Accessibility_Error call.
	* s-valllu.ads (Scan_Raw_Long_Long_Unsigned): Add documentation
	on handling of invalid digits in based constants.
	* s-fatgen.ads: Minor reformatting.
	* sem_attr.adb (Analyze_Attribute, case Unrestricted_Access):
	Avoid noting bogus modification for Valid test.
	* snames.ads-tmpl (Name_Attr_Long_Float): New Name.
	* einfo.ads: Minor reformatting.
	* sem_warn.adb: Minor comment clarification.
	* sem_ch12.adb: Minor reformatting.

From-SVN: r219296

gcc/ada/ChangeLog

+2015-01-07  Bob Duff  <duff@adacore.com>
+
+	* usage.adb (Usage): Document -gnatw.f switch.
+
+2015-01-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb: Code clean up and minor reformatting.
+
+2015-01-07  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Type_Conversion): Add guard for
+	Raise_Accessibility_Error call.
+	* s-valllu.ads (Scan_Raw_Long_Long_Unsigned): Add documentation
+	on handling of invalid digits in based constants.
+	* s-fatgen.ads: Minor reformatting.
+	* sem_attr.adb (Analyze_Attribute, case Unrestricted_Access):
+	Avoid noting bogus modification for Valid test.
+	* snames.ads-tmpl (Name_Attr_Long_Float): New Name.
+	* einfo.ads: Minor reformatting.
+	* sem_warn.adb: Minor comment clarification.
+	* sem_ch12.adb: Minor reformatting.
+
 2015-01-07  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch5.adb (Expand_Predicated_Loop): Handle properly loops

gcc/ada/einfo.ads

@@ -320,7 +320,7 @@ package Einfo is
 --  Other attributes are noted as applying to the [implementation base type
 --  only].  These are representation attributes which must always apply to a
 --  full non-private type, and where the attributes are always on the full
---  type.  The attribute can be referenced on a subtype (and automatically
+--  type. The attribute can be referenced on a subtype (and automatically
 --  retries the value from the implementation base type). However, it is an
 --  error to try to set the attribute on other than the implementation base
 --  type, and if assertions are enabled, an attempt to set the attribute on a

gcc/ada/exp_ch4.adb

@@ -9982,7 +9982,9 @@ package body Exp_Ch4 is
       procedure Raise_Accessibility_Error;
       --  Called when we know that an accessibility check will fail. Rewrites
       --  node N to an appropriate raise statement and outputs warning msgs.
-      --  The Etype of the raise node is set to Target_Type.
+      --  The Etype of the raise node is set to Target_Type. Note that in this
+      --  case the rest of the processing should be skipped (i.e. the call to
+      --  this procedure will be followed by "goto Done").
 
       procedure Real_Range_Check;
       --  Handles generation of range check for real target value
@@ -10518,6 +10520,7 @@ package body Exp_Ch4 is
              Type_Access_Level (Operand_Type) > Type_Access_Level (Target_Type)
          then
             Raise_Accessibility_Error;
+            goto Done;
 
          --  When the operand is a selected access discriminant the check needs
          --  to be made against the level of the object denoted by the prefix

gcc/ada/s-fatgen.ads

@@ -88,13 +88,12 @@ package System.Fat_Gen is
    function Unbiased_Rounding (X : T)                       return T;
 
    function Valid (X : not null access T) return Boolean;
-   --  This function checks if the object of type T referenced by X
-   --  is valid, and returns True/False accordingly. The parameter is
-   --  passed by reference (access) here, as the object of type T may
-   --  be an abnormal value that cannot be passed in a floating-point
-   --  register, and the whole point of 'Valid is to prevent exceptions.
-   --  Note that the object of type T must have the natural alignment
-   --  for type T.
+   --  This function checks if the object of type T referenced by X is valid,
+   --  and returns True/False accordingly. The parameter is passed by reference
+   --  (access) here, as the object of type T may be an abnormal value that
+   --  cannot be passed in a floating-point register, and the whole point of
+   --  'Valid is to prevent exceptions. Note that the object of type T must
+   --  have the natural alignment for type T.
 
    type S is new String (1 .. T'Size / Character'Size);
    type P is access all S with Storage_Size => 0;

gcc/ada/s-valllu.ads

@@ -61,7 +61,17 @@ package System.Val_LLU is
    --  Constraint_Error is raised.
    --
    --  Note: these rules correspond to the requirements for leaving the pointer
-   --  positioned in Text_IO.Get
+   --  positioned in Text_IO.Get. Note that the rules as stated in the RM would
+   --  seem to imply that for a case like
+   --
+   --    8#12345670009#
+
+   --  the pointer should be left at the first # having scanned out the longest
+   --  valid integer literal (8), but in fact in this case the pointer points
+   --  to the invalid based digit (9 in this case). Not only would the strict
+   --  reading of the RM require unlimited backup, which is unreasonable, but
+   --  in addition, the intepretation as given here is the one expected and
+   --  enforced by the ACATS tests.
    --
    --  Note: if Str is empty, i.e. if Max is less than Ptr, then this is a
    --  special case of an all-blank string, and Ptr is unchanged, and hence

gcc/ada/sem_attr.adb

@@ -9853,8 +9853,38 @@ package body Sem_Attr is
 
          Access_Attribute :
          begin
+            --  Note possible modification if we have a variable
+
             if Is_Variable (P) then
-               Note_Possible_Modification (P, Sure => False);
+               declare
+                  PN : constant Node_Id := Parent (N);
+                  Nm : Node_Id;
+
+                  Note : Boolean := True;
+                  --  Skip this for the case of Unrestricted_Access occuring in
+                  --  the context of a Valid check, since this otherwise leads
+                  --  to a missed warning (the Valid check does not really
+                  --  modify!) If this case, Note will be reset to False.
+
+               begin
+                  if Attr_Id = Attribute_Unrestricted_Access
+                    and then Nkind (PN) = N_Function_Call
+                  then
+                     Nm := Name (PN);
+
+                     if Nkind (Nm) = N_Expanded_Name
+                       and then Chars (Nm) = Name_Valid
+                       and then Nkind (Prefix (Nm)) = N_Identifier
+                       and then Chars (Prefix (Nm)) = Name_Attr_Long_Float
+                     then
+                        Note := False;
+                     end if;
+                  end if;
+
+                  if Note then
+                     Note_Possible_Modification (P, Sure => False);
+                  end if;
+               end;
             end if;
 
             --  The following comes from a query concerning improper use of

gcc/ada/sem_ch12.adb

@@ -3706,9 +3706,7 @@ package body Sem_Ch12 is
               and then not Is_Child_Unit (Gen_Unit)
             then
                Scop := Scope (Gen_Unit);
-               while Present (Scop)
-                 and then Scop /= Standard_Standard
-               loop
+               while Present (Scop) and then Scop /= Standard_Standard loop
                   if Unit_Requires_Body (Scop) then
                      Enclosing_Body_Present := True;
                      exit;
@@ -7678,7 +7676,6 @@ package body Sem_Ch12 is
          while Present (T) loop
             if In_Open_Scopes (Scope (T)) then
                return T;
-
             elsif Is_Generic_Actual_Type (T) then
                return T;
             end if;
@@ -9546,8 +9543,7 @@ package body Sem_Ch12 is
                    Name                 =>
                      New_Occurrence_Of
                        (Get_Instance_Of (Gen_Parent), Sloc (Actual)),
-                   Generic_Associations =>
-                     Generic_Associations (Formal)));
+                   Generic_Associations => Generic_Associations (Formal)));
             end;
          end if;
 
@@ -10057,12 +10053,15 @@ package body Sem_Ch12 is
       else
          --  The instantiation of a generic formal in-parameter is constant
          --  declaration. The actual is the expression for that declaration.
+         --  Its type is a full copy of the type of the formal. This may be
+         --  an access to subprogram, for which we need to generate entities
+         --  for the formals in the new signature.
 
          if Present (Actual) then
             if Present (Subt_Mark) then
-               Def := Subt_Mark;
+               Def := New_Copy_Tree (Subt_Mark);
             else pragma Assert (Present (Acc_Def));
-               Def := Acc_Def;
+               Def := Copy_Separate_Tree (Acc_Def);
             end if;
 
             Decl_Node :=
@@ -10070,7 +10069,7 @@ package body Sem_Ch12 is
                 Defining_Identifier    => New_Copy (Gen_Obj),
                 Constant_Present       => True,
                 Null_Exclusion_Present => Null_Exclusion_Present (Formal),
-                Object_Definition      => New_Copy_Tree (Def),
+                Object_Definition      => Def,
                 Expression             => Actual);
 
             Set_Corresponding_Generic_Association (Decl_Node, Act_Assoc);
@@ -10148,8 +10147,10 @@ package body Sem_Ch12 is
 
                --  If formal is an anonymous access, copy access definition of
                --  formal for object declaration.
+               --  In the case of an access to subprogram we need to
+               --  generate new formals for the signature of the default.
 
-               Def := New_Copy_Tree (Acc_Def);
+               Def := Copy_Separate_Tree (Acc_Def);
             end if;
 
             Decl_Node :=

gcc/ada/sem_warn.adb

@@ -898,7 +898,7 @@ package body Sem_Warn is
 
       procedure Output_Reference_Error (M : String) is
       begin
-         --  Never issue messages for internal names, nor for renamings
+         --  Never issue messages for internal names or renamings
 
          if Is_Internal_Name (Chars (E1))
            or else Nkind (Parent (E1)) = N_Object_Renaming_Declaration

gcc/ada/snames.ads-tmpl

@@ -676,11 +676,12 @@ package Snames is
    Name_DLL                            : constant Name_Id := N + $;
    Name_Win32                          : constant Name_Id := N + $;
 
-   --  Other special names used in processing pragmas
+   --  Other special names used in processing attributes and pragmas
 
    Name_Allow                          : constant Name_Id := N + $;
    Name_Amount                         : constant Name_Id := N + $;
    Name_As_Is                          : constant Name_Id := N + $;
+   Name_Attr_Long_Float                : constant Name_Id := N + $;
    Name_Assertion                      : constant Name_Id := N + $;
    Name_Assertions                     : constant Name_Id := N + $;
    Name_Attribute_Name                 : constant Name_Id := N + $;

gcc/ada/usage.adb

@@ -501,6 +501,8 @@ begin
                                                   "(no exceptions)");
    Write_Line ("        f+   turn on warnings for unreferenced formal");
    Write_Line ("        F*   turn off warnings for unreferenced formal");
+   Write_Line ("        .f   turn on warnings for suspicious Subp'Access");
+   Write_Line ("        .F   turn off warnings for suspicious Subp'Access");
    Write_Line ("        g*+  turn on warnings for unrecognized pragma");
    Write_Line ("        G    turn off warnings for unrecognized pragma");
    Write_Line ("        .g   turn on GNAT warnings");