[multiple changes]

2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Remove extra
	spaces from error messages.

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Check_Large_Modular_Array): New procedure,
	subsidiary to Expand_N_Object_ Declaration, to compute a guard on
	an object declaration for an array type with a modular index type
	with the size of Long_Long_Integer. Special processing is needed
	in this case to compute reliably the size of the object, and
	eventually  to raise Storage_Error, when wrap-around arithmetic
	might compute a meangingless size for the object.

2017-01-23  Justin Squirek  <squirek@adacore.com>

	* a-wtenau.adb, par-endh.adb, sem_prag.adb,
	sem_type.adb: Code cleanups.

From-SVN: r244775

7 files changed, 87 insertions, 11 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e482e85..76ee520 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2017-01-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Remove extra
+	spaces from error messages.
+
+2017-01-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch3.adb (Check_Large_Modular_Array): New procedure,
+	subsidiary to Expand_N_Object_ Declaration, to compute a guard on
+	an object declaration for an array type with a modular index type
+	with the size of Long_Long_Integer. Special processing is needed
+	in this case to compute reliably the size of the object, and
+	eventually  to raise Storage_Error, when wrap-around arithmetic
+	might compute a meangingless size for the object.
+
+2017-01-23  Justin Squirek  <squirek@adacore.com>
+
+	* a-wtenau.adb, par-endh.adb, sem_prag.adb,
+	sem_type.adb: Code cleanups.
+
 2017-01-23  Bob Duff  <duff@adacore.com>
 
 	* sem_res.adb (Resolve_Call): In the part of the code where
diff --git a/gcc/ada/a-wtenau.adb b/gcc/ada/a-wtenau.adb
index d09306b..709703e 100644
--- a/gcc/ada/a-wtenau.adb
+++ b/gcc/ada/a-wtenau.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -307,8 +307,6 @@ package body Ada.Wide_Text_IO.Enumeration_Aux is
                 and then
                   not Is_Letter (To_Character (WC))
                 and then
-                  not Is_Letter (To_Character (WC))
-                and then
                   (WC /= '_' or else From (Stop - 1) = '_');
 
             Stop := Stop + 1;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 0acd94f..4024349 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5465,6 +5465,13 @@ package body Exp_Ch3 is
       --  value, it may be possible to build an equivalent aggregate instead,
       --  and prevent an actual call to the initialization procedure.
 
+      procedure Check_Large_Modular_Array;
+      --  Check that the size of the array can be computed without overflow,
+      --  and generate a Storage_Error otherwise. This is only relevant for
+      --  array types whose index in a (mod 2**64) type, where wrap-around
+      --  arithmetic might yield a meaningless value for the length of the
+      --  array, or its corresponding attribute.
+
       procedure Default_Initialize_Object (After : Node_Id);
       --  Generate all default initialization actions for object Def_Id. Any
       --  new code is inserted after node After.
@@ -5603,6 +5610,58 @@ package body Exp_Ch3 is
       end Build_Equivalent_Aggregate;
 
       -------------------------------
+      -- Check_Large_Modular_Array --
+      -------------------------------
+
+      procedure Check_Large_Modular_Array is
+         Index_Typ : Entity_Id;
+
+      begin
+         if Is_Array_Type (Typ)
+           and then Is_Modular_Integer_Type (Etype (First_Index (Typ)))
+         then
+            --  To prevent arithmetic overflow with large values, we
+            --  raise Storage_Error under the following guard:
+            --
+            --  (Arr'Last / 2 - Arr'First / 2) > (Typ'Last - 1) / 2
+
+            --  This takes care of the boundary case, but it is preferable
+            --  to use a smaller limit, because even on 64-bit architectures
+            --  an array of more than 2 ** 30 bytes is likely to raise
+            --  Storage_Error.
+
+            Index_Typ := Etype (First_Index (Typ));
+            if RM_Size (Index_Typ) = RM_Size (Standard_Long_Long_Integer) then
+               Insert_Action (N,
+                  Make_Raise_Storage_Error (Loc,
+                   Condition =>
+                     Make_Op_Ge (Loc,
+                       Left_Opnd  =>
+                         Make_Op_Subtract (Loc,
+                           Left_Opnd =>
+                             Make_Op_Divide (Loc,
+                               Left_Opnd =>
+                                 Make_Attribute_Reference (Loc,
+                                   Prefix => New_Occurrence_Of (Typ, Loc),
+                                 Attribute_Name => Name_Last),
+                                Right_Opnd =>
+                                  Make_Integer_Literal (Loc, Uint_2)),
+                           Right_Opnd =>
+                             Make_Op_Divide (Loc,
+                               Left_Opnd =>
+                                 Make_Attribute_Reference (Loc,
+                                   Prefix => New_Occurrence_Of (Typ, Loc),
+                                   Attribute_Name => Name_First),
+                                Right_Opnd =>
+                                  Make_Integer_Literal (Loc, Uint_2))),
+                       Right_Opnd =>
+                         Make_Integer_Literal (Loc,  (Uint_2 ** 30))),
+                   Reason    => SE_Object_Too_Large));
+            end if;
+         end if;
+      end Check_Large_Modular_Array;
+
+      -------------------------------
       -- Default_Initialize_Object --
       -------------------------------
 
@@ -6012,6 +6071,8 @@ package body Exp_Ch3 is
          Build_Master_Entity (Def_Id);
       end if;
 
+      Check_Large_Modular_Array;
+
       --  Default initialization required, and no expression present
 
       if No (Expr) then
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index d2772ca..2ae495e 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -9038,13 +9038,12 @@ package body Exp_Ch9 is
                            & "violate restriction "
                            & "No_Implicit_Heap_Allocations??", Priv, Prot_Typ);
                      else
-
                         --  Object will be non-static if discriminants are
 
                         Error_Msg_NE
                           ("creation of protected object of type& with "
-                           &  "non-static discriminants  will violate"
-                           & " restriction No_Implicit_Heap_Allocations??",
+                           & "non-static discriminants will violate "
+                           & "restriction No_Implicit_Heap_Allocations??",
                            Priv, Prot_Typ);
                      end if;
 
@@ -9068,7 +9067,7 @@ package body Exp_Ch9 is
 
                         Error_Msg_NE
                           ("creation of protected object of type& with "
-                           & "non-static discriminants  will violate "
+                           & "non-static discriminants will violate "
                            & "restriction "
                            & "No_Implicit_Protected_Object_Allocations??",
                            Priv, Prot_Typ);
diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index 3c065ec..bbcbff9 100644
--- a/gcc/ada/par-endh.adb
+++ b/gcc/ada/par-endh.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -576,7 +576,6 @@ package body Endh is
          --  Cases of normal tokens following an END
 
           (Token = Tok_Case   or else
-           Token = Tok_For    or else
            Token = Tok_If     or else
            Token = Tok_Loop   or else
            Token = Tok_Record or else
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f1520d5..f34e2ff 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -23951,7 +23951,7 @@ package body Sem_Prag is
             --  Attribute 'Result matches attribute 'Result
 
             elsif Is_Attribute_Result (Dep_Item)
-              and then Is_Attribute_Result (Dep_Item)
+               and then Is_Attribute_Result (Ref_Item)
             then
                Matched := True;
 
diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb
index 555184a..26415ae 100644
--- a/gcc/ada/sem_type.adb
+++ b/gcc/ada/sem_type.adb
@@ -2578,7 +2578,6 @@ package body Sem_Type is
 
          loop
             if Present (Interfaces (E))
-              and then Present (Interfaces (E))
               and then not Is_Empty_Elmt_List (Interfaces (E))
             then
                Elmt := First_Elmt (Interfaces (E));