[multiple changes]

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

	* sem_warn.adb (Check_One_Unit): Don't give unused entities
	warning for a package which is used as a generic parameter.

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

	* usage.adb (Usage): Correct documentation of
	-gnatw.f switches.

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

	* s-fileio.adb: Minor reformatting.

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

	* sem_ch12.adb (Instantiate_Object): If formal is an anonymous
	access to subprogram, replace its formals with new entities when
	building the object declaration, both if actual is present and
	when it is defaulted.

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

	* sem_ch5.adb (Analyze_Assignment): If left-hand side is a view
	conversion and type of expression has invariant, apply invariant
	check on expression.

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

	* sem_ch3.adb (Create_Constrained_Components): A call to
	Gather_Components may detect an error if an inherited discriminant
	that controls a variant is non-static.
	* sem_aggr.adb (Resolve_Record_Aggregate, Step 5): The call to
	Gather_Components may report an error if an inherited discriminant
	in a variant in non-static.
	* sem_util.adb (Gather_Components): If a non-static discriminant
	is inherited do not report error here, but let caller handle it.
	(Find_Actual): Small optimization.

From-SVN: r219297

9 files changed, 194 insertions, 56 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5b95b20..5999da1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,42 @@
+2015-01-07  Robert Dewar  <dewar@adacore.com>
+
+	* sem_warn.adb (Check_One_Unit): Don't give unused entities
+	warning for a package which is used as a generic parameter.
+
+2015-01-07  Bob Duff  <duff@adacore.com>
+
+	* usage.adb (Usage): Correct documentation of
+	-gnatw.f switches.
+
+2015-01-07  Robert Dewar  <dewar@adacore.com>
+
+	* s-fileio.adb: Minor reformatting.
+
+2015-01-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Instantiate_Object): If formal is an anonymous
+	access to subprogram, replace its formals with new entities when
+	building the object declaration, both if actual is present and
+	when it is defaulted.
+
+2015-01-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch5.adb (Analyze_Assignment): If left-hand side is a view
+	conversion and type of expression has invariant, apply invariant
+	check on expression.
+
+2015-01-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Create_Constrained_Components): A call to
+	Gather_Components may detect an error if an inherited discriminant
+	that controls a variant is non-static.
+	* sem_aggr.adb (Resolve_Record_Aggregate, Step 5): The call to
+	Gather_Components may report an error if an inherited discriminant
+	in a variant in non-static.
+	* sem_util.adb (Gather_Components): If a non-static discriminant
+	is inherited do not report error here, but let caller handle it.
+	(Find_Actual): Small optimization.
+
 2015-01-07  Bob Duff  <duff@adacore.com>
 
 	* usage.adb (Usage): Document -gnatw.f switch.
diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
index 73838bf..1d8882e 100644
--- a/gcc/ada/s-fileio.adb
+++ b/gcc/ada/s-fileio.adb
@@ -213,11 +213,12 @@ package body System.File_IO is
    -----------
 
    procedure Close (File_Ptr : access AFCB_Ptr) is
-      Close_Status : int := 0;
+      Close_Status : int     := 0;
       Dup_Strm     : Boolean := False;
-      File         : AFCB_Ptr renames File_Ptr.all;
       Errno        : Integer := 0;
 
+      File : AFCB_Ptr renames File_Ptr.all;
+
    begin
       --  Take a task lock, to protect the global data value Open_Files
 
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index e0bd5cd..f14381b 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3984,6 +3984,13 @@ package body Sem_Aggr is
                      Governed_By   => New_Assoc_List,
                      Into          => Components,
                      Report_Errors => Errors_Found);
+
+                  if Errors_Found then
+                     Error_Msg_N
+                       ("discriminant controlling variant part is not static",
+                        N);
+                     return;
+                  end if;
                end if;
             end if;
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 311161e..b7e9343 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -4690,7 +4690,10 @@ package body Sem_Ch12 is
          Set_Parent            (Act_Decl_Id, Parent (Anon_Id));
          Set_Chars             (Act_Decl_Id, Chars (Defining_Entity (N)));
          Set_Sloc              (Act_Decl_Id, Sloc (Defining_Entity (N)));
-         Set_Comes_From_Source (Act_Decl_Id, True);
+
+         --  Subprogram instance comes from source only if generic does
+
+         Set_Comes_From_Source (Act_Decl_Id, Comes_From_Source (Gen_Unit));
 
          --  The signature may involve types that are not frozen yet, but the
          --  subprogram will be frozen at the point the wrapper package is
@@ -9879,6 +9882,43 @@ package body Sem_Ch12 is
       Subt_Decl   : Node_Id             := Empty;
       Subt_Mark   : Node_Id             := Empty;
 
+      function Copy_Access_Def return Node_Id;
+      --  If formal is an anonymous access, copy access definition of formal
+      --  for generated object declaration.
+
+      ---------------------
+      -- Copy_Access_Def --
+      ---------------------
+
+      function Copy_Access_Def return Node_Id is
+      begin
+         Def := New_Copy_Tree (Acc_Def);
+
+         --  In addition, if formal is an access to subprogram we need to
+         --  generate new formals for the signature of the default, so that
+         --  the tree is properly formatted for ASIS use.
+
+         if Present (Access_To_Subprogram_Definition (Acc_Def)) then
+            declare
+               Par_Spec : Node_Id;
+            begin
+               Par_Spec :=
+                 First (Parameter_Specifications
+                          (Access_To_Subprogram_Definition (Def)));
+               while Present (Par_Spec) loop
+                  Set_Defining_Identifier (Par_Spec,
+                    Make_Defining_Identifier (Sloc (Acc_Def),
+                      Chars => Chars (Defining_Identifier (Par_Spec))));
+                  Next (Par_Spec);
+               end loop;
+            end;
+         end if;
+
+         return Def;
+      end Copy_Access_Def;
+
+   --  Start of processing for Instantiate_Object
+
    begin
       --  Formal may be an anonymous access
 
@@ -10061,7 +10101,7 @@ package body Sem_Ch12 is
             if Present (Subt_Mark) then
                Def := New_Copy_Tree (Subt_Mark);
             else pragma Assert (Present (Acc_Def));
-               Def := Copy_Separate_Tree (Acc_Def);
+               Def := Copy_Access_Def;
             end if;
 
             Decl_Node :=
@@ -10142,15 +10182,8 @@ package body Sem_Ch12 is
 
             if Present (Subt_Mark) then
                Def := New_Copy (Subt_Mark);
-
             else pragma Assert (Present (Acc_Def));
-
-               --  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 := Copy_Separate_Tree (Acc_Def);
+               Def := Copy_Access_Def;
             end if;
 
             Decl_Node :=
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 2850afc..be69b41 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -13887,19 +13887,22 @@ package body Sem_Ch3 is
       then
          Collect_Fixed_Components (Typ);
 
-         Gather_Components (
-           Typ,
-           Component_List (Type_Definition (Parent (Parent_Type))),
-           Governed_By   => Assoc_List,
-           Into          => Comp_List,
-           Report_Errors => Errors);
-         pragma Assert (not Errors);
+         Gather_Components
+           (Typ,
+            Component_List (Type_Definition (Parent (Parent_Type))),
+            Governed_By   => Assoc_List,
+            Into          => Comp_List,
+            Report_Errors => Errors);
+
+         --  Note: previously there was a check at this point that no errors
+         --  were detected. As a consequence of AI05-220 there may be an error
+         --  if an inherited discriminant that controls a variant has a non-
+         --  static constraint.
 
          --  If the tagged derivation has a type extension, collect all the
          --  new components therein.
 
-         if Present
-              (Record_Extension_Part (Type_Definition (Parent (Typ))))
+         if Present (Record_Extension_Part (Type_Definition (Parent (Typ))))
          then
             Old_C := First_Component (Typ);
             while Present (Old_C) loop
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 5cd60dd..5bac8b2 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -764,6 +764,18 @@ package body Sem_Ch5 is
          Set_Referenced_Modified (Lhs, Out_Param => False);
       end if;
 
+      --  RM 7.3.2 (12/3)  An assignment to a view conversion (from a type
+      --  to one of its ancestors) requires an invariant check. Apply check
+      --  only if expression comes from source, otherwise it will be applied
+      --  when value is assigned to source entity.
+
+      if Nkind (Lhs) = N_Type_Conversion
+        and then Has_Invariants (Etype (Expression (Lhs)))
+        and then Comes_From_Source (Expression (Lhs))
+      then
+         Insert_After (N, Make_Invariant_Call (Expression (Lhs)));
+      end if;
+
       --  Final step. If left side is an entity, then we may be able to reset
       --  the current tracked values to new safe values. We only have something
       --  to do if the left side is an entity name, and expansion has not
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 51a6738..3ba1085 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5999,6 +5999,14 @@ package body Sem_Util is
         and then Is_Overloadable (Entity (Name (Call)))
         and then not Is_Overloaded (Name (Call))
       then
+         --  If node is name in call it is not an actual
+
+         if N = Name (Call) then
+            Call := Empty;
+            Formal := Empty;
+            return;
+         end if;
+
          --  Fall here if we are definitely a parameter
 
          Actual := First_Actual (Call);
@@ -6626,10 +6634,22 @@ package body Sem_Util is
       Discrim_Value := Expression (Assoc);
 
       if not Is_OK_Static_Expression (Discrim_Value) then
-         Error_Msg_FE
-           ("value for discriminant & must be static!",
-            Discrim_Value, Discrim);
-         Why_Not_Static (Discrim_Value);
+
+         --  If the variant part is governed by a discriminant of the type
+         --  this is an error. If the variant part and the discriminant are
+         --  inherited from an ancestor this is legal (AI05-120) unless the
+         --  components are being gathered for an aggregate, in which case
+         --  the caller must check Report_Errors.
+
+         if Scope (Original_Record_Component
+                     ((Entity (First (Choices (Assoc)))))) = Typ
+         then
+            Error_Msg_FE
+              ("value for discriminant & must be static!",
+               Discrim_Value, Discrim);
+            Why_Not_Static (Discrim_Value);
+         end if;
+
          Report_Errors := True;
          return;
       end if;
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index ec3eb07..1d0cfe6 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -2457,38 +2457,61 @@ package body Sem_Warn is
                            elsif Check_System_Aux then
                               null;
 
-                           --  Else give the warning
+                           --  Else the warning may be needed
 
                            else
-                              --  Warn if we unreferenced flag set and we have
-                              --  not had serious errors. The reason we inhibit
-                              --  the message if there are errors is to prevent
-                              --  false positives from disabling expansion.
-
-                              if not Has_Unreferenced (Entity (Name (Item)))
-                                and then Serious_Errors_Detected = 0
-                              then
-                                 Error_Msg_N -- CODEFIX
-                                   ("?u?no entities of & are referenced!",
-                                    Name (Item));
-                              end if;
-
-                              --  Look for renamings of this package, and flag
-                              --  them as well. If the original package has
-                              --  warnings off, we suppress the warning on the
-                              --  renaming as well.
-
-                              Pack := Find_Package_Renaming (Munite, Lunit);
-
-                              if Present (Pack)
-                                and then not Has_Warnings_Off (Lunit)
-                                and then not Has_Unreferenced (Pack)
-                              then
-                                 Error_Msg_NE -- CODEFIX
-                                   ("?u?no entities of & are referenced!",
-                                     Unit_Declaration_Node (Pack),
-                                     Pack);
-                              end if;
+                              declare
+                                 Eitem : constant Entity_Id :=
+                                           Entity (Name (Item));
+
+                              begin
+                                 --  Warn if we unreferenced flag set and we
+                                 --  have not had serious errors. The reason we
+                                 --  inhibit the message if there are errors is
+                                 --  to prevent false positives from disabling
+                                 --  expansion.
+
+                                 if not Has_Unreferenced (Eitem)
+                                   and then Serious_Errors_Detected = 0
+                                 then
+                                    --  Get possible package renaming
+
+                                    Pack :=
+                                      Find_Package_Renaming (Munite, Lunit);
+
+                                    --  No warning if either the package or its
+                                    --  renaming is used as a generic actual.
+
+                                    if Used_As_Generic_Actual (Eitem)
+                                      or else
+                                        (Present (Pack)
+                                          and then
+                                            Used_As_Generic_Actual (Pack))
+                                    then
+                                       exit;
+                                    end if;
+
+                                    --  Here we give the warning
+
+                                    Error_Msg_N -- CODEFIX
+                                      ("?u?no entities of & are referenced!",
+                                       Name (Item));
+
+                                    --  Flag renaming of package as well. If
+                                    --  the original package has warnings off,
+                                    --  we suppress the warning on the renaming
+                                    --  as well.
+
+                                    if Present (Pack)
+                                      and then not Has_Warnings_Off (Lunit)
+                                      and then not Has_Unreferenced (Pack)
+                                    then
+                                       Error_Msg_NE -- CODEFIX
+                                         ("?u?no entities of& are referenced!",
+                                          Unit_Declaration_Node (Pack), Pack);
+                                    end if;
+                                 end if;
+                              end;
                            end if;
 
                            exit;
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 15d8ecb..803c44d 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -502,7 +502,7 @@ begin
    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 ("        .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");