[multiple changes]

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* sem_type.adb, exp_attr.adb, exp_ch4.adb: Minor reformatting.

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document 'Update attribute.
	* sem_attr.adb (Analyze_Attribute, case Update): Remove call
	to S14_Attribute (S14_Attribute): removed.

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* interfac.ads: Add size clauses for IEEE_Float_32/64

2013-04-24  Claire Dross  <dross@adacore.com>

	* gnat1drv.adb (Adjust_Global_Switches): Remove
	special assignment of Use_Expression_With_Actions for SPARK_Mode.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Apply_Predicate_Check): Check for the presence
	of the dynamic predicate aspect when trying to determine if the
	predicate of a type is non-static.
	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Check
	for the presence of the dynamic predicate aspect when trying to
	determine if the predicate of a type is non- static.
	* sem_ch13.adb (Add_Call): Capture the nature of the
	inherited ancestor predicate.
	(Build_Predicate_Functions): Update comments. Rewrite the checks on
	static predicate application. Complain about the form of a non-static
	expression only when the type is static.

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb: Add guard to tree traversal.

2013-04-24  Vincent Celier  <celier@adacore.com>

	* clean.adb (Clean): Remove local variable Root_Environment,
	use Makeutl.Root_Environment instead.
	* gnatcmd.adb: Remove local variable Root_Environment, use
	Makeutl.Root_Environment instead.
	* make.adb (Gnatmake): Remove local variable Root_Environment,
	use Makeutl.Root_Environment instead.
	* prj-makr.adb: Remove local variable Root_Environment, use
	Makeutl.Root_Environment instead.

From-SVN: r198243

16 files changed, 187 insertions, 82 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3a1a5f6..3e5597a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,51 @@
+2013-04-24  Robert Dewar  <dewar@adacore.com>
+
+	* sem_type.adb, exp_attr.adb, exp_ch4.adb: Minor reformatting.
+
+2013-04-24  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Document 'Update attribute.
+	* sem_attr.adb (Analyze_Attribute, case Update): Remove call
+	to S14_Attribute (S14_Attribute): removed.
+
+2013-04-24  Robert Dewar  <dewar@adacore.com>
+
+	* interfac.ads: Add size clauses for IEEE_Float_32/64
+
+2013-04-24  Claire Dross  <dross@adacore.com>
+
+	* gnat1drv.adb (Adjust_Global_Switches): Remove
+	special assignment of Use_Expression_With_Actions for SPARK_Mode.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb (Apply_Predicate_Check): Check for the presence
+	of the dynamic predicate aspect when trying to determine if the
+	predicate of a type is non-static.
+	* sem_ch5.adb (Analyze_Loop_Parameter_Specification): Check
+	for the presence of the dynamic predicate aspect when trying to
+	determine if the predicate of a type is non- static.
+	* sem_ch13.adb (Add_Call): Capture the nature of the
+	inherited ancestor predicate.
+	(Build_Predicate_Functions): Update comments. Rewrite the checks on
+	static predicate application. Complain about the form of a non-static
+	expression only when the type is static.
+
+2013-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb: Add guard to tree traversal.
+
+2013-04-24  Vincent Celier  <celier@adacore.com>
+
+	* clean.adb (Clean): Remove local variable Root_Environment,
+	use Makeutl.Root_Environment instead.
+	* gnatcmd.adb: Remove local variable Root_Environment, use
+	Makeutl.Root_Environment instead.
+	* make.adb (Gnatmake): Remove local variable Root_Environment,
+	use Makeutl.Root_Environment instead.
+	* prj-makr.adb: Remove local variable Root_Environment, use
+	Makeutl.Root_Environment instead.
+
 2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_attr.adb (Expand_Loop_Entry_Attribute): Clarify the
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 8302b97..3cb1f95 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2499,26 +2499,30 @@ package body Checks is
               Make_Raise_Storage_Error (Sloc (N),
                 Reason => SE_Infinite_Recursion));
 
-         --  Here for normal case of predicate active.
+         --  Here for normal case of predicate active
 
          else
             --  If the predicate is a static predicate and the operand is
             --  static, the predicate must be evaluated statically. If the
             --  evaluation fails this is a static constraint error. This check
             --  is disabled in -gnatc mode, because the compiler is incapable
-            --  of evaluating static expressions in that case.
-
-            if Is_OK_Static_Expression (N) then
-               if Present (Static_Predicate (Typ)) then
-                  if Operating_Mode < Generate_Code
-                    or else Eval_Static_Predicate_Check (N, Typ)
-                  then
-                     return;
-                  else
-                     Error_Msg_NE
-                       ("static expression fails static predicate check on&",
-                        N, Typ);
-                  end if;
+            --  of evaluating static expressions in that case. Note that when
+            --  inherited predicates are involved, a type may have both static
+            --  and dynamic forms. Check the presence of a dynamic predicate
+            --  aspect.
+
+            if Is_OK_Static_Expression (N)
+              and then Present (Static_Predicate (Typ))
+              and then not Has_Dynamic_Predicate_Aspect (Typ)
+            then
+               if Operating_Mode < Generate_Code
+                 or else Eval_Static_Predicate_Check (N, Typ)
+               then
+                  return;
+               else
+                  Error_Msg_NE
+                    ("static expression fails static predicate check on&",
+                     N, Typ);
                end if;
             end if;
 
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index 0b3622c..cbaaa61 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -98,8 +98,6 @@ package body Clean is
 
    Project_Node_Tree : Project_Node_Tree_Ref;
 
-   Root_Environment : Prj.Tree.Environment;
-
    Main_Project : Prj.Project_Id := Prj.No_Project;
 
    All_Projects : Boolean := False;
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index c009222..93f9b81 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -785,8 +785,7 @@ package body Exp_Attr is
 
          --  When the related loop name appears as the argument of attribute
          --  Loop_Entry, the corresponding label construct is the generated
-         --  block statement. This happens because the expander reuses the
-         --  label.
+         --  block statement. This is because the expander reuses the label.
 
          if Nkind (Loop_Stmt) = N_Block_Statement then
             Decls := Declarations (Loop_Stmt);
@@ -797,8 +796,8 @@ package body Exp_Attr is
          else
             pragma Assert
               (Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
-                 and then Nkind (Parent (Parent (Loop_Stmt))) =
-                            N_Block_Statement);
+                and then Nkind (Parent (Parent (Loop_Stmt))) =
+                                                      N_Block_Statement);
 
             Decls := Declarations (Parent (Parent (Loop_Stmt)));
          end if;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 85a6496..12e7805 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4581,12 +4581,12 @@ package body Exp_Ch4 is
                            Expand_N_Full_Type_Declaration
                              (Parent (Base_Type (PtrT)));
 
-                        else
-                           --  If the type of the allocator is an itype,
-                           --  the master must exist in the context. This
-                           --  is the case when the allocator initializes
-                           --  an access component in an init-proc.
+                        --  The only other possibility is an itype. For this
+                        --  case, the master must exist in the context. This is
+                        --  the case when the allocator initializes an access
+                        --  component in an init-proc.
 
+                        else
                            pragma Assert (Is_Itype (PtrT));
                            Build_Master_Renaming (PtrT, N);
                         end if;
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 4f1dde7..2128680 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -387,18 +387,6 @@ procedure Gnat1drv is
 
          Debug_Flag_HH := True;
 
-         --  Disable Expressions_With_Actions nodes
-
-         --  The gnat2why backend does not deal with Expressions_With_Actions
-         --  in all places (in particular assertions). It is difficult to
-         --  determine in the frontend which cases are allowed, so we disable
-         --  Expressions_With_Actions entirely. Even in the cases where
-         --  gnat2why deals with Expressions_With_Actions, it is easier to
-         --  deal with the original constructs (quantified, conditional and
-         --  case expressions) instead of the rewritten ones.
-
-         Use_Expression_With_Actions := False;
-
          --  Enable assertions, since they give valuable extra information for
          --  formal verification.
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 023cd12..1c7133c 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -305,6 +305,7 @@ Implementation Defined Attributes
 * Unconstrained_Array::
 * Universal_Literal_String::
 * Unrestricted_Access::
+* Update::
 * Valid_Scalars::
 * VADS_Size::
 * Value_Size::
@@ -6710,6 +6711,7 @@ consideration, you should minimize the use of these attributes.
 * Unconstrained_Array::
 * Universal_Literal_String::
 * Unrestricted_Access::
+* Update::
 * Valid_Scalars::
 * VADS_Size::
 * Value_Size::
@@ -7713,6 +7715,78 @@ scope. For instance, a function cannot use @code{Unrestricted_Access}
 to create a unconstrained pointer and then return that value to the
 caller.
 
+@node Update
+@unnumberedsec Update
+@findex Update
+@noindent
+The @code{Update} attribute creates a copy of an array or record value
+with one or more modified components. The syntax is:
+
+@smallexample @c ada
+PREFIX'Update (AGGREGATE);
+@end smallexample
+
+@noindent
+where @code{PREFIX} is the name of an array or record object, and
+@code{AGGREGATE} is a named aggregate that does not contain an @code{others}
+choice. The effect is to yield a copy of the array or record value which
+is unchanged apart from the components mentioned in the aggregate, which
+are changed to the indicated value. The original value of the array or
+record value is not affected. For example:
+
+@smallexample @c ada
+type Arr is Array (1 .. 5) of Integer;
+...
+Avar1 : Arr := (1,2,3,4,5);
+Avar2 : Arr := Avar1'Update ((2 => 10, 3 .. 4 => 20));
+@end smallexample
+
+@noindent
+yields a value for @code{Avar2} of 1,10,20,20,5 with @code{Avar1}
+begin unmodified. Similarly:
+
+@smallexample @c ada
+type Rec is A, B, C : Integer;
+...
+Rvar1 : Rec := (A => 1, B => 2, C => 3);
+Rvar2 : Rec := Rvar1'Update ((B => 20));
+@end smallexample
+
+@noindent
+yields a value for @code{Rvar2} of (A => 1, B => 20, C => 3),
+with @code{Rvar1} being unmodifed.
+Note that the value of the attribute reference is computed
+completely before it is used. This means that if you write:
+
+@smallexample @c ada
+Avar1 := Avar1'Update ((1 => 10, 2 => Function_Call));
+@end smallexample
+
+@noindent
+then the value of @code{Avar1} is not modified if @code{Function_Call}
+raises an exception, unlike the effect of a series of direct assignments
+to elements of @code{Avar1}. In general this requires that
+two extra complete copies of the object are required, which should be
+kept in mind when considering efficiency.
+
+The @code{Update} attribute cannot be applied to prefixes of a limited
+type, and cannot reference discriminants in the case of a record type.
+
+In the record case, no component can be mentioned more than once. In
+the array case, two overlapping ranges can appear in the aggregate,
+in which case the modifications are processed left to right.
+
+Multi-dimensional arrays can be modified, as shown by this example:
+
+@smallexample @c ada
+A : array (1 .. 10, 1 .. 10) of Integer;
+..
+A := A'Update (1 => (2 => 20), 3 => (4 => 30));
+@end smallexample
+
+@noindent
+which changes element (1,2) to 20 and (3,4) to 30.
+
 @node Valid_Scalars
 @unnumberedsec Valid_Scalars
 @findex Valid_Scalars
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index d6fd28e..be15670 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -59,7 +59,6 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 procedure GNATCmd is
    Project_Node_Tree : Project_Node_Tree_Ref;
-   Root_Environment  : Prj.Tree.Environment;
    Project_File      : String_Access;
    Project           : Prj.Project_Id;
    Current_Verbosity : Prj.Verbosity := Prj.Default;
diff --git a/gcc/ada/interfac.ads b/gcc/ada/interfac.ads
index 810366d..57033a9 100644
--- a/gcc/ada/interfac.ads
+++ b/gcc/ada/interfac.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2002-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2013, 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 --
@@ -159,9 +159,11 @@ package Interfaces is
 
    type IEEE_Float_32 is digits 6;
    pragma Float_Representation (IEEE_Float, IEEE_Float_32);
+   for IEEE_Float_32'Size use 32;
 
    type IEEE_Float_64 is digits 15;
    pragma Float_Representation (IEEE_Float, IEEE_Float_64);
+   for IEEE_Float_64'Size use 64;
 
    --  If there is an IEEE extended float available on the machine, we assume
    --  that it is available as Long_Long_Float.
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 9b1f0e3..d9973b5 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -5475,7 +5475,6 @@ package body Make is
       --  is invoked with the -F switch to force checking of elaboration flags.
 
       Project_Node_Tree : Project_Node_Tree_Ref;
-      Root_Environment  : Prj.Tree.Environment;
 
       Stop_Compile : Boolean;
 
diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb
index de55a74..7de4369 100644
--- a/gcc/ada/prj-makr.adb
+++ b/gcc/ada/prj-makr.adb
@@ -25,6 +25,7 @@
 
 with Csets;
 with Hostparm;
+with Makeutl;  use Makeutl;
 with Opt;
 with Output;
 with Osint;    use Osint;
@@ -64,8 +65,6 @@ package body Prj.Makr is
    Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
    --  The project tree where the project file is parsed
 
-   Root_Environment : Prj.Tree.Environment;
-
    Args : Argument_List_Access;
    --  The list of arguments for calls to the compiler to get the unit names
    --  and kinds (spec or body) in the Ada sources.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 762015f..5ee023b 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -376,12 +376,6 @@ package body Sem_Attr is
       pragma No_Return (Error_Attr);
       --  Like Error_Attr, but error is posted at the start of the prefix
 
-      procedure S14_Attribute;
-      --  Called for all attributes defined for formal verification to check
-      --  that the S14_Extensions flag is set.
-      --  Bad name ???
-      --  No such thing as S14_Extensions flag ???
-
       procedure Standard_Attribute (Val : Int);
       --  Used to process attributes whose prefix is package Standard which
       --  yield values of type Universal_Integer. The attribute reference
@@ -1973,18 +1967,6 @@ package body Sem_Attr is
          Set_Etype (N, Standard_Boolean);
       end Legal_Formal_Attribute;
 
-      -------------------
-      -- S14_Attribute --
-      -------------------
-
-      procedure S14_Attribute is
-      begin
-         if not Formal_Extensions then
-            Error_Attr
-              ("attribute % requires the use of debug switch -gnatd.V", N);
-         end if;
-      end S14_Attribute;
-
       ------------------------
       -- Standard_Attribute --
       ------------------------
@@ -5667,7 +5649,6 @@ package body Sem_Attr is
       --  Start of processing for Update
 
       begin
-         S14_Attribute;
          Check_E1;
 
          if not Is_Object_Reference (P) then
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 0d32aff..709947b 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5767,7 +5767,7 @@ package body Sem_Ch13 is
 
       Dynamic_Predicate_Present : Boolean := False;
       --  Set True if a dynamic predicate is present, results in the entire
-      --  predicate being considered dynamic even if it looks static
+      --  predicate being considered dynamic even if it looks static.
 
       Static_Predicate_Present : Node_Id := Empty;
       --  Set to N_Pragma node for a static predicate if one is encountered
@@ -5783,6 +5783,12 @@ package body Sem_Ch13 is
          if Present (T) and then Present (Predicate_Function (T)) then
             Set_Has_Predicates (Typ);
 
+            --  Capture the nature of the inherited ancestor predicate
+
+            if Has_Dynamic_Predicate_Aspect (T) then
+               Dynamic_Predicate_Present := True;
+            end if;
+
             --  Build the call to the predicate function of T
 
             Exp :=
@@ -5866,6 +5872,8 @@ package body Sem_Ch13 is
             if Nkind (Ritem) = N_Pragma
               and then Pragma_Name (Ritem) = Name_Predicate
             then
+               --  Capture the nature of the predicate
+
                if Present (Corresponding_Aspect (Ritem)) then
                   case Chars (Identifier (Corresponding_Aspect (Ritem))) is
                      when Name_Dynamic_Predicate =>
@@ -6199,25 +6207,28 @@ package body Sem_Ch13 is
             end;
          end if;
 
-         --  Deal with static predicate case
+         if Is_Scalar_Type (Typ) then
 
-         --  ??? We don't currently deal with real types
-         --  ??? Why requiring that Typ is static?
+            --  Attempt to build a static predicate for a discrete or a real
+            --  subtype. This action may fail because the actual expression may
+            --  not be static.
 
-         if Ekind (Typ) in Discrete_Kind
-           and then Is_Static_Subtype (Typ)
-           and then not Dynamic_Predicate_Present
-         then
-            --  Only build the predicate for subtypes
-
-            if Ekind_In (Typ, E_Enumeration_Subtype,
+            if Ekind_In (Typ, E_Decimal_Fixed_Point_Subtype,
+                              E_Enumeration_Subtype,
+                              E_Floating_Point_Subtype,
                               E_Modular_Integer_Subtype,
+                              E_Ordinary_Fixed_Point_Subtype,
                               E_Signed_Integer_Subtype)
             then
                Build_Static_Predicate (Typ, Expr, Object_Name);
 
+               --  The predicate is categorized as static but its expression is
+               --  dynamic. Note that the predicate may become non-static when
+               --  inherited dynamic predicates are involved.
+
                if Present (Static_Predicate_Present)
-                 and No (Static_Predicate (Typ))
+                 and then No (Static_Predicate (Typ))
+                 and then not Dynamic_Predicate_Present
                then
                   Error_Msg_F
                     ("expression does not have required form for "
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 2e48721..b2ed158 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2298,11 +2298,15 @@ package body Sem_Ch5 is
             Set_Etype  (DS, Entity (DS));
          end if;
 
-         --  Attempt to iterate through non-static predicate
+         --  Attempt to iterate through non-static predicate. Note that a type
+         --  with inherited predicates may have both static and dynamic forms.
+         --  In this case it is not sufficent to check the static predicate
+         --  function only, look for a dynamic predicate aspect as well.
 
          if Is_Discrete_Type (Entity (DS))
            and then Present (Predicate_Function (Entity (DS)))
-           and then No (Static_Predicate (Entity (DS)))
+           and then (No (Static_Predicate (Entity (DS)))
+                      or else Has_Dynamic_Predicate_Aspect (Entity (DS)))
          then
             Bad_Predicated_Subtype_Use
               ("cannot use subtype& with non-static predicate for loop " &
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 0b23215..a356704 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1868,6 +1868,7 @@ package body Sem_Prag is
 
             begin
                if Is_Entity_Name (N)
+                 and then Present (Entity (N))
                  and then Is_Formal (Entity (N))
                  and then Nkind (Parent (N)) /= N_Type_Conversion
                then
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index c6ad391..78e4922 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2028,7 +2028,7 @@ package body Sem_Type is
       elsif (Nkind (N) = N_Function_Call
               and then Nkind (Name (N)) = N_Expanded_Name
               and then (Chars (Predef_Subp) /= Name_Op_Expon
-                          or else Hides_Op (User_Subp, Predef_Subp))
+                         or else Hides_Op (User_Subp, Predef_Subp))
               and then Scope (User_Subp) = Entity (Prefix (Name (N))))
         or else Hides_Op (User_Subp, Predef_Subp)
       then
@@ -2060,12 +2060,10 @@ package body Sem_Type is
               and then Nam_In (Chars (Nam1), Name_Op_Multiply, Name_Op_Divide)
               and then
                 (Ada_Version = Ada_83
-                  or else
-                   (Ada_Version >= Ada_2012
-                     and then
-                       In_Same_Declaration_List
-                         (First_Subtype (Typ),
-                            Unit_Declaration_Node (User_Subp))))
+                  or else (Ada_Version >= Ada_2012
+                            and then In_Same_Declaration_List
+                                       (First_Subtype (Typ),
+                                          Unit_Declaration_Node (User_Subp))))
             then
                if It2.Nam = Predef_Subp then
                   return It1;