[multiple changes]

2014-01-24  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Expr_Known_Valid): Result of fpt operator never
	considered valid.

2014-01-24  Eric Botcazou  <ebotcazou@adacore.com>

	* back_end.adb: Minor fix in comment.

2014-01-24  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Check_Abstract_Overriding): Code reestructuration
	required to report the error in case of task types.

2014-01-24  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb: Additional index checking.

From-SVN: r207035

5 files changed, 93 insertions, 26 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 03c982d..c56b138 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2014-01-24  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Expr_Known_Valid): Result of fpt operator never
+	considered valid.
+
+2014-01-24  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* back_end.adb: Minor fix in comment.
+
+2014-01-24  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Check_Abstract_Overriding): Code reestructuration
+	required to report the error in case of task types.
+
+2014-01-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb: Additional index checking.
+
 2014-01-24  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_attr.adb (Analyze_Attribute, case 'Update): Analyze
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb
index 0b8920d..c2275df 100644
--- a/gcc/ada/back_end.adb
+++ b/gcc/ada/back_end.adb
@@ -51,7 +51,7 @@ package body Back_End is
 
    flag_stack_check : Int;
    pragma Import (C, flag_stack_check);
-   --  Indicates if stack checking is enabled, imported from decl.c
+   --  Indicates if stack checking is enabled, imported from misc.c
 
    save_argc : Nat;
    pragma Import (C, save_argc);
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index cdbe34e..51acd29 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -5308,22 +5308,26 @@ package body Checks is
       elsif Nkind_In (Expr, N_Type_Conversion, N_Qualified_Expression) then
          return Expr_Known_Valid (Expression (Expr));
 
-      --  The result of any operator is always considered valid, since we
-      --  assume the necessary checks are done by the operator. For operators
-      --  on floating-point operations, we must also check when the operation
-      --  is the right-hand side of an assignment, or is an actual in a call.
-
-      elsif Nkind (Expr) in N_Op then
-         if Is_Floating_Point_Type (Typ)
-            and then Validity_Check_Floating_Point
-            and then (Nkind_In (Parent (Expr), N_Assignment_Statement,
-                                               N_Function_Call,
-                                               N_Parameter_Association))
-         then
-            return False;
-         else
-            return True;
-         end if;
+      --  Case of expression is a non-floating-point operator. In this case we
+      --  can assume the result is valid the generated code for the operator
+      --  will include whatever checks are needed (e.g. range checks) to ensure
+      --  validity. This assumption does not hold for the floating-point case,
+      --  since floating-point operators can generate Infinite or NaN results
+      --  which are considered invalid.
+
+      --  Historical note: in older versions, the exemption of floating-point
+      --  types from this assumption was done only in cases where the parent
+      --  was an assignment, function call or parameter association. Presumably
+      --  the idea was that in other contexts, the result would be checked
+      --  elsewhere, but this list of cases was missing tests (at least the
+      --  N_Object_Declaration case, as shown by a reported missing validity
+      --  check), and it is not clear why function calls but not procedure
+      --  calls were tested for. It really seems more accurate and much
+      --  safer to recognize that expressions which are the result of a
+      --  floating-point operator can never be assumed to be valid.
+
+      elsif Nkind (Expr) in N_Op and then not Is_Floating_Point_Type (Typ) then
+         return True;
 
       --  The result of a membership test is always valid, since it is true or
       --  false, there are no other possibilities.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index b737493..f880fe6 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6097,6 +6097,52 @@ package body Sem_Attr is
                   Error_Attr
                     ("others choice not allowed in attribute %", Comp);
 
+               elsif Is_Array_Type (P_Type) then
+                  declare
+                     Index      : Node_Id;
+                     Index_Type : Entity_Id;
+
+                  begin
+                     if Nkind (First (Choices (Assoc))) /= N_Aggregate then
+
+                        --  Choices denote separate components of one-
+                        --  dimensional array.
+
+                        Index_Type := First_Index (P_Type);
+                        Index := First (Choices (Assoc));
+                        while Present (Index) loop
+                           if Nkind (Index) = N_Range then
+                              Analyze_And_Resolve (
+                                Low_Bound (Index), Etype (Index_Type));
+                              Analyze_And_Resolve (
+                               High_Bound (Index), Etype (Index_Type));
+
+                           else
+                              Analyze_And_Resolve (Index, Etype (Index_Type));
+                           end if;
+                           Next (Index);
+                        end loop;
+
+                     else
+                        --  Choice is a sequence of indices for each dimension
+
+                        Index_Type := First_Index (P_Type);
+                        Index := First (Expressions (First (Choices (Assoc))));
+                        while Present (Index_Type)
+                          and then Present (Index)
+                        loop
+                           Analyze_And_Resolve (Index, Etype (Index_Type));
+                           Next_Index (Index_Type);
+                           Next (Index);
+                        end loop;
+
+                        if Present (Index) or else Present (Index_Type) then
+                           Error_Msg_N (
+                            "dimension mismatch in index list", Assoc);
+                        end if;
+                     end if;
+                  end;
+
                elsif Is_Record_Type (P_Type) then
                   Check_Component_Reference (Comp, P_Type);
                end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 0796fb4..da315de 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9684,18 +9684,17 @@ package body Sem_Ch3 is
                elsif Is_Concurrent_Record_Type (T)
                  and then Present (Interfaces (T))
                then
-                  --  The controlling formal of Subp must be of mode "out",
-                  --  "in out" or an access-to-variable to be overridden.
+                  --  If an inherited subprogram is implemented by a protected
+                  --  procedure or an entry, then the first parameter of the
+                  --  inherited subprogram shall be of mode out or in out, or
+                  --  an access-to-variable parameter (RM 9.4(11.9/3))
 
-                  if Ekind (First_Formal (Subp)) = E_In_Parameter
+                  if Is_Protected_Type (Corresponding_Concurrent_Type (T))
+                    and then Ekind (First_Formal (Subp)) = E_In_Parameter
                     and then Ekind (Subp) /= E_Function
+                    and then not Is_Predefined_Dispatching_Operation (Subp)
                   then
-                     if not Is_Predefined_Dispatching_Operation (Subp)
-                       and then Is_Protected_Type
-                                  (Corresponding_Concurrent_Type (T))
-                     then
-                        Error_Msg_PT (T, Subp);
-                     end if;
+                     Error_Msg_PT (T, Subp);
 
                   --  Some other kind of overriding failure