[multiple changes]

2014-06-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Contract): Do not attempt
	analysis if error has been posted on subprogram body.

2014-06-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality
	rule given in RM 13.1 (8/1) for operational attributes to stream
	attributes: the attribute must apply to a first subtype. Fixes
	missing errors in ACATS test bdd2004.

2014-06-11  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Build_Record_Init_Proc): Don't build for variant
	record type if restriction No_Implicit_Conditionals is active.
	(Expand_N_Object_Declaration): Don't allow default initialization
	for variant record type if restriction No_Implicit_Condition is active.
	(Build_Variant_Record_Equality): Don't build for variant
	record type if restriction No_Implicit_Conditionals is active.
	* exp_ch4.adb (Expand_N_Op_Eq): Error if variant records with
	No_Implicit_Conditionals.
	* sem_aux.ads, sem_aux.adb (Has_Variant_Part): New function.

2014-06-11  Ramon Fernandez  <fernandez@adacore.com>

	* i-cstrin.ads: Update comments.

2014-06-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Selected_Component): Handle properly a
	selected component whose prefix is overloaded, when none of the
	interpretations matches the expected type.

2014-06-11  Bob Duff  <duff@adacore.com>

	* make.adb (Wait_For_Available_Slot): Give a more
	informative error message; if the ALI file is not found, print
	the full path of what it's looking for.

From-SVN: r211456

gcc/ada/ChangeLog

+2014-06-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Subprogram_Body_Contract): Do not attempt
+	analysis if error has been posted on subprogram body.
+
+2014-06-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality
+	rule given in RM 13.1 (8/1) for operational attributes to stream
+	attributes: the attribute must apply to a first subtype. Fixes
+	missing errors in ACATS test bdd2004.
+
+2014-06-11  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch3.adb (Build_Record_Init_Proc): Don't build for variant
+	record type if restriction No_Implicit_Conditionals is active.
+	(Expand_N_Object_Declaration): Don't allow default initialization
+	for variant record type if restriction No_Implicit_Condition is active.
+	(Build_Variant_Record_Equality): Don't build for variant
+	record type if restriction No_Implicit_Conditionals is active.
+	* exp_ch4.adb (Expand_N_Op_Eq): Error if variant records with
+	No_Implicit_Conditionals.
+	* sem_aux.ads, sem_aux.adb (Has_Variant_Part): New function.
+
+2014-06-11  Ramon Fernandez  <fernandez@adacore.com>
+
+	* i-cstrin.ads: Update comments.
+
+2014-06-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_res.adb (Resolve_Selected_Component): Handle properly a
+	selected component whose prefix is overloaded, when none of the
+	interpretations matches the expected type.
+
+2014-06-11  Bob Duff  <duff@adacore.com>
+
+	* make.adb (Wait_For_Available_Slot): Give a more
+	informative error message; if the ALI file is not found, print
+	the full path of what it's looking for.
+
 2014-06-11  Sergey Rybin  <rybin@adacore.com frybin>
 
 	* gnat_ugn.texi, vms_data.ads: add description of gnatstub -W<par>

gcc/ada/exp_ch3.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -3484,6 +3484,18 @@ package body Exp_Ch3 is
          Rec_Type := Underlying_Type (Rec_Type);
       end if;
 
+      --  If we have a variant record with restriction No_Implicit_Conditionals
+      --  in effect, then we skip building the procedure. This is safe because
+      --  if we can see the restriction, so can any caller, calls to initialize
+      --  such records are not allowed for variant records if this restriction
+      --  is active.
+
+      if Has_Variant_Part (Rec_Type)
+        and then Restriction_Active (No_Implicit_Conditionals)
+      then
+         return;
+      end if;
+
       --  If there are discriminants, build the discriminant map to replace
       --  discriminants by their discriminals in complex bound expressions.
       --  These only arise for the corresponding records of synchronized types.
@@ -4316,6 +4328,16 @@ package body Exp_Ch3 is
       Pspecs : constant List_Id := New_List;
 
    begin
+      --  If we have a variant record with restriction No_Implicit_Conditionals
+      --  in effect, then we skip building the procedure. This is safe because
+      --  if we can see the restriction, so can any caller, calls to equality
+      --  test routines are not allowed for variant records if this restriction
+      --  is active.
+
+      if Restriction_Active (No_Implicit_Conditionals) then
+         return;
+      end if;
+
       --  Derived Unchecked_Union types no longer inherit the equality function
       --  of their parent.
 
@@ -4431,11 +4453,8 @@ package body Exp_Ch3 is
 
       else
          Append_To (Stmts,
-           Make_Eq_If (Typ,
-             Discriminant_Specifications (Def)));
-
-         Append_List_To (Stmts,
-           Make_Eq_Case (Typ, Comps));
+           Make_Eq_If (Typ, Discriminant_Specifications (Def)));
+         Append_List_To (Stmts, Make_Eq_Case (Typ, Comps));
       end if;
 
       Append_To (Stmts,
@@ -4838,6 +4857,7 @@ package body Exp_Ch3 is
       Def_Id   : constant Entity_Id  := Defining_Identifier (N);
       Expr     : constant Node_Id    := Expression (N);
       Loc      : constant Source_Ptr := Sloc (N);
+      Obj_Def  : constant Node_Id    := Object_Definition (N);
       Typ      : constant Entity_Id  := Etype (Def_Id);
       Base_Typ : constant Entity_Id  := Base_Type (Typ);
       Expr_Q   : Node_Id;
@@ -4999,7 +5019,7 @@ package body Exp_Ch3 is
            and then Is_Entity_Name (Expr_Q)
            and then Ekind (Entity (Expr_Q)) = E_Variable
            and then OK_To_Rename (Entity (Expr_Q))
-           and then Is_Entity_Name (Object_Definition (N));
+           and then Is_Entity_Name (Obj_Def);
       end Rewrite_As_Renaming;
 
    --  Start of processing for Expand_N_Object_Declaration
@@ -5065,6 +5085,26 @@ package body Exp_Ch3 is
 
       if No (Expr) then
 
+         --  If we have a type with a variant part, the initialization proc
+         --  will contain implicit tests of the discriminant values, which
+         --  counts as a violation of the restriction No_Implicit_Conditionals.
+
+         if Has_Variant_Part (Typ) then
+            declare
+               Msg : Boolean;
+
+            begin
+               Check_Restriction (Msg, No_Implicit_Conditionals, Obj_Def);
+
+               if Msg then
+                  Error_Msg_N
+                    ("\initialization of variant record tests discriminants",
+                     Obj_Def);
+                  return;
+               end if;
+            end;
+         end if;
+
          --  For the default initialization case, if we have a private type
          --  with invariants, and invariant checks are enabled, then insert an
          --  invariant check after the object declaration. Note that it is OK
@@ -5305,9 +5345,9 @@ package body Exp_Ch3 is
            --  then we've done it already and must not do it again.
 
            and then not
-             (Nkind (Object_Definition (N)) = N_Identifier
+             (Nkind (Obj_Def) = N_Identifier
                and then
-                 Present (Equivalent_Type (Entity (Object_Definition (N)))))
+                 Present (Equivalent_Type (Entity (Obj_Def))))
          then
             pragma Assert (Is_Class_Wide_Type (Typ));
 
@@ -5416,7 +5456,7 @@ package body Exp_Ch3 is
                      Expand_Subtype_From_Expr
                        (N             => N,
                         Unc_Type      => Typ,
-                        Subtype_Indic => Object_Definition (N),
+                        Subtype_Indic => Obj_Def,
                         Exp           => Expr_N);
 
                      if not Is_Interface (Etype (Expr_N)) then
@@ -5427,7 +5467,7 @@ package body Exp_Ch3 is
 
                      else
                         New_Expr :=
-                          Unchecked_Convert_To (Etype (Object_Definition (N)),
+                          Unchecked_Convert_To (Etype (Obj_Def),
                             Make_Explicit_Dereference (Loc,
                               Unchecked_Convert_To (RTE (RE_Tag_Ptr),
                                 Make_Attribute_Reference (Loc,
@@ -5442,8 +5482,7 @@ package body Exp_Ch3 is
                           Make_Object_Declaration (Loc,
                             Defining_Identifier => Obj_Id,
                             Object_Definition   =>
-                              New_Occurrence_Of
-                                (Etype (Object_Definition (N)), Loc),
+                              New_Occurrence_Of (Etype (Obj_Def), Loc),
                             Expression => New_Expr));
 
                      --  Rename limited type object since they cannot be copied
@@ -5455,11 +5494,10 @@ package body Exp_Ch3 is
                           Make_Object_Renaming_Declaration (Loc,
                             Defining_Identifier => Obj_Id,
                             Subtype_Mark        =>
-                              New_Occurrence_Of
-                                (Etype (Object_Definition (N)), Loc),
+                              New_Occurrence_Of (Etype (Obj_Def), Loc),
                             Name                =>
                               Unchecked_Convert_To
-                                (Etype (Object_Definition (N)), New_Expr)));
+                                (Etype (Obj_Def), New_Expr)));
                      end if;
 
                      --  Dynamically reference the tag associated with the
@@ -5744,7 +5782,7 @@ package body Exp_Ch3 is
             Rewrite (N,
               Make_Object_Renaming_Declaration (Loc,
                 Defining_Identifier => Defining_Identifier (N),
-                Subtype_Mark        => Object_Definition (N),
+                Subtype_Mark        => Obj_Def,
                 Name                => Expr_Q));
 
             --  We do not analyze this renaming declaration, because all its
@@ -5778,7 +5816,7 @@ package body Exp_Ch3 is
       end if;
 
       if Nkind (N) = N_Object_Declaration
-        and then Nkind (Object_Definition (N)) = N_Access_Definition
+        and then Nkind (Obj_Def) = N_Access_Definition
         and then not Is_Local_Anonymous_Access (Etype (Def_Id))
       then
          --  An Ada 2012 stand-alone object of an anonymous access type
@@ -5810,12 +5848,14 @@ package body Exp_Ch3 is
                Level_Expr := Dynamic_Accessibility_Level (Expr);
             end if;
 
-            Level_Decl := Make_Object_Declaration (Loc,
-             Defining_Identifier => Level,
-             Object_Definition => New_Occurrence_Of (Standard_Natural, Loc),
-             Expression => Level_Expr,
-             Constant_Present => Constant_Present (N),
-             Has_Init_Expression => True);
+            Level_Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Level,
+                Object_Definition   =>
+                  New_Occurrence_Of (Standard_Natural, Loc),
+                Expression          => Level_Expr,
+                Constant_Present    => Constant_Present (N),
+                Has_Init_Expression => True);
 
             Insert_Action_After (Init_After, Level_Decl);
 
@@ -8641,6 +8681,7 @@ package body Exp_Ch3 is
             if Chars (Discr) = External_Name (Node (Elm)) then
                return Node (Elm);
             end if;
+
             Next_Elmt (Elm);
          end loop;
 
@@ -8676,14 +8717,12 @@ package body Exp_Ch3 is
       end if;
 
       Alt_List := New_List;
-
       while Present (Variant) loop
          Append_To (Alt_List,
            Make_Case_Statement_Alternative (Loc,
              Discrete_Choices => New_Copy_List (Discrete_Choices (Variant)),
              Statements =>
                Make_Eq_Case (E, Component_List (Variant), Discrs)));
-
          Next_Non_Pragma (Variant);
       end loop;
 
@@ -8785,7 +8824,7 @@ package body Exp_Ch3 is
          else
             return
               Make_Implicit_If_Statement (E,
-                Condition => Cond,
+                Condition       => Cond,
                 Then_Statements => New_List (
                   Make_Simple_Return_Statement (Loc,
                     Expression => New_Occurrence_Of (Standard_False, Loc))));
@@ -8793,9 +8832,9 @@ package body Exp_Ch3 is
       end if;
    end Make_Eq_If;
 
-   --------------------
-   --  Make_Neq_Body --
-   --------------------
+   -------------------
+   -- Make_Neq_Body --
+   -------------------
 
    function Make_Neq_Body (Tag_Typ : Entity_Id) return Node_Id is
 

gcc/ada/exp_ch4.adb

@@ -6674,6 +6674,8 @@ package body Exp_Ch4 is
          R_Exp   : Node_Id := Relocate_Node (Rhs);
 
       begin
+         --  Adjust operands if necessary to comparison type
+
          if Base_Type (Op_Type) /= Base_Type (A_Typ)
            and then not Is_Class_Wide_Type (A_Typ)
          then
@@ -6771,8 +6773,7 @@ package body Exp_Ch4 is
                   --  formal is that of the discriminant, with added suffix,
                   --  see Exp_Ch3.Build_Record_Equality for details.
 
-                  if Is_Unchecked_Union
-                       (Scope (Entity (Selector_Name (Lhs))))
+                  if Is_Unchecked_Union (Scope (Entity (Selector_Name (Lhs))))
                   then
                      Discr :=
                        First_Discriminant
@@ -7074,6 +7075,25 @@ package body Exp_Ch4 is
 
       Typl := Base_Type (Typl);
 
+      --  Equality between variant records results in a call to a routine
+      --  that has conditional tests of the discriminant value(s), and hence
+      --  violates the No_Implicit_Conditionals restriction.
+
+      if Has_Variant_Part (Typl) then
+         declare
+            Msg : Boolean;
+
+         begin
+            Check_Restriction (Msg, No_Implicit_Conditionals, N);
+
+            if Msg then
+               Error_Msg_N
+                 ("\comparison of variant records tests discriminants", N);
+               return;
+            end if;
+         end;
+      end if;
+
       --  Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
       --  means we no longer have a comparison operation, we are all done.
 

gcc/ada/i-cstrin.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1993-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1993-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -60,6 +60,8 @@ package Interfaces.C.Strings is
    function New_String (Str : String) return chars_ptr;
 
    procedure Free (Item : in out chars_ptr);
+   --  When deallocation is prohibited (eg: cert runtimes) this routine
+   --  will raise Program_Error
 
    Dereference_Error : exception;
 

gcc/ada/make.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -3728,6 +3728,13 @@ package body Make is
                      Inform
                        (Data.Lib_File,
                         "WARNING: ALI or object file not found after compile");
+
+                     if not Is_Regular_File
+                       (Get_Name_String (Name_Id (Data.Full_Lib_File)))
+                     then
+                        Inform (Data.Full_Lib_File, "not found");
+                     end if;
+
                      Record_Failure (Data.Full_Source_File, Data.Source_Unit);
                   end if;
                end if;

gcc/ada/sem_aux.adb

@@ -666,6 +666,51 @@ package body Sem_Aux is
       end if;
    end Has_Unconstrained_Elements;
 
+   ----------------------
+   -- Has_Variant_Part --
+   ----------------------
+
+   function Has_Variant_Part (Typ : Entity_Id) return Boolean is
+      FSTyp : Entity_Id;
+      Decl  : Node_Id;
+      TDef  : Node_Id;
+      CList : Node_Id;
+
+   begin
+      if not Is_Type (Typ) then
+         return False;
+      end if;
+
+      FSTyp := First_Subtype (Typ);
+
+      if not Has_Discriminants (FSTyp) then
+         return False;
+      end if;
+
+      --  Proceed with cautious checks here, return False if tree is not
+      --  as expected (may be caused by prior errors).
+
+      Decl := Declaration_Node (FSTyp);
+
+      if Nkind (Decl) /= N_Full_Type_Declaration then
+         return False;
+      end if;
+
+      TDef := Type_Definition (Decl);
+
+      if Nkind (TDef) /= N_Record_Definition then
+         return False;
+      end if;
+
+      CList := Component_List (TDef);
+
+      if Nkind (CList) /= N_Component_List then
+         return False;
+      else
+         return Present (Variant_Part (CList));
+      end if;
+   end Has_Variant_Part;
+
    ---------------------
    -- In_Generic_Body --
    ---------------------

gcc/ada/sem_aux.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -255,6 +255,10 @@ package Sem_Aux is
    --  True if T has discriminants and is unconstrained, or is an array type
    --  whose element type Has_Unconstrained_Elements.
 
+   function Has_Variant_Part (Typ : Entity_Id) return Boolean;
+   --  Return True if the first subtype of Typ is a discriminated record type
+   --  which has a variant part. False otherwise.
+
    function In_Generic_Body (Id : Entity_Id) return Boolean;
    --  Determine whether entity Id appears inside a generic body
 

gcc/ada/sem_ch13.adb

@@ -3132,8 +3132,23 @@ package body Sem_Ch13 is
                Typ := Etype (Subp);
             end if;
 
-            return Base_Type (Typ) = Base_Type (Ent)
-              and then No (Next_Formal (F));
+            --  Verify that the prefix of the attribute and the local name
+            --  for the type of the formal match.
+
+            if Base_Type (Typ) /= Base_Type (Ent)
+              or else Present ((Next_Formal (F)))
+            then
+               return False;
+
+            elsif not Is_Scalar_Type (Typ)
+              and then not Is_First_Subtype (Typ)
+              and then not Is_Class_Wide_Type (Typ)
+            then
+               return False;
+
+            else
+               return True;
+            end if;
          end Has_Good_Profile;
 
       --  Start of processing for Analyze_Stream_TSS_Definition
@@ -3144,6 +3159,10 @@ package body Sem_Ch13 is
          if not Is_Type (U_Ent) then
             Error_Msg_N ("local name must be a subtype", Nam);
             return;
+
+         elsif not Is_First_Subtype (U_Ent) then
+            Error_Msg_N ("local name must be a first subtype", Nam);
+            return;
          end if;
 
          Pnam := TSS (Base_Type (U_Ent), TSS_Nam);

gcc/ada/sem_ch6.adb

@@ -2040,9 +2040,9 @@ package body Sem_Ch6 is
    begin
       --  When a subprogram body declaration is illegal, its defining entity is
       --  left unanalyzed. There is nothing left to do in this case because the
-      --  body lacks a contract.
+      --  body lacks a contract, or even a proper Ekind.
 
-      if No (Contract (Body_Id)) then
+      if Ekind (Body_Id) = E_Void then
          return;
       end if;
 

gcc/ada/sem_res.adb

@@ -9159,7 +9159,7 @@ package body Sem_Res is
                Comp := First_Entity (T);
                while Present (Comp) loop
                   if Chars (Comp) = Chars (S)
-                    and then Covers (Etype (Comp), Typ)
+                    and then Covers (Typ, Etype (Comp))
                   then
                      if not Found then
                         Found := True;
@@ -9213,6 +9213,9 @@ package body Sem_Res is
             Get_Next_Interp (I, It);
          end loop Search;
 
+         --  There must be a legal interpreations at this point.
+
+         pragma Assert (Found);
          Resolve (P, It1.Typ);
          Set_Etype (N, Typ);
          Set_Entity_With_Checks (S, Comp1);
@@ -9240,6 +9243,7 @@ package body Sem_Res is
       if Is_Access_Type (Etype (P)) then
          T := Designated_Type (Etype (P));
          Check_Fully_Declared_Prefix (T, P);
+
       else
          T := Etype (P);
       end if;