[multiple changes]

2014-07-31  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Enable_Overflow_Check): More precise setting of
	Do_Overflow_Check flag for division.

2014-07-31  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject packed
	array types with implementation type.

2014-07-31  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch10.adb (Process_State): Remove local variable Name. Add
	local variable Decl. Partially declare an abstract state by
	generating an entity and storing it in the state declaration.
	* sem_prag.adb (Create_Abstract_State): Fully declare a
	semi-declared abstract state.

From-SVN: r213335

gcc/ada/ChangeLog

 2014-07-31  Robert Dewar  <dewar@adacore.com>
 
+	* checks.adb (Enable_Overflow_Check): More precise setting of
+	Do_Overflow_Check flag for division.
+
+2014-07-31  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Reject packed
+	array types with implementation type.
+
+2014-07-31  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch10.adb (Process_State): Remove local variable Name. Add
+	local variable Decl. Partially declare an abstract state by
+	generating an entity and storing it in the state declaration.
+	* sem_prag.adb (Create_Abstract_State): Fully declare a
+	semi-declared abstract state.
+
+2014-07-31  Robert Dewar  <dewar@adacore.com>
+
 	* prj-nmsc.adb: Minor reformatting.
 
 2014-07-31  Bob Duff  <duff@adacore.com>

gcc/ada/checks.adb

@@ -1795,6 +1795,8 @@ package body Checks is
          if Do_Overflow_Check (N)
            and then not Overflow_Checks_Suppressed (Etype (N))
          then
+            Set_Do_Overflow_Check (N, False);
+
             --  Test for extremely annoying case of xxx'First divided by -1
             --  for division of signed integer types (only overflow case).
 
@@ -1855,6 +1857,8 @@ package body Checks is
          --  it is a Division_Check and not an Overflow_Check.
 
          if Do_Division_Check (N) then
+            Set_Do_Division_Check (N, False);
+
             if (not ROK) or else (Rlo <= 0 and then 0 <= Rhi) then
                Insert_Action (N,
                  Make_Raise_Constraint_Error (Loc,
@@ -5110,6 +5114,8 @@ package body Checks is
       Lo   : Uint;
       Hi   : Uint;
 
+      Do_Ovflow_Check : Boolean;
+
    begin
       if Debug_Flag_CC then
          w ("Enable_Overflow_Check for node ", Int (N));
@@ -5187,10 +5193,46 @@ package body Checks is
          --   c) The alternative is a lot of special casing in this routine
          --      which would partially duplicate Determine_Range processing.
 
-         if OK
-           and then Lo > Expr_Value (Type_Low_Bound  (Typ))
-           and then Hi < Expr_Value (Type_High_Bound (Typ))
+         if OK then
+            Do_Ovflow_Check := True;
+
+            --  Note that the following checks are quite deliberately > and <
+            --  rather than >= and <= as explained above.
+
+            if  Lo > Expr_Value (Type_Low_Bound  (Typ))
+                  and then
+                Hi < Expr_Value (Type_High_Bound (Typ))
             then
+               Do_Ovflow_Check := False;
+
+            --  Despite the comments above, it is worth dealing specially with
+            --  division specially. The only case where integer division can
+            --  overflow is (largest negative number) / (-1). So we will do
+            --  an extra range analysis to see if this is possible.
+
+            elsif Nkind (N) = N_Op_Divide then
+               Determine_Range
+                 (Left_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
+
+               if OK and then Lo > Expr_Value (Type_Low_Bound (Typ)) then
+                  Do_Ovflow_Check := False;
+
+               else
+                  Determine_Range
+                    (Right_Opnd (N), OK, Lo, Hi, Assume_Valid => True);
+
+                  if OK and then (Lo > Uint_Minus_1
+                                    or else
+                                  Hi < Uint_Minus_1)
+                  then
+                     Do_Ovflow_Check := False;
+                  end if;
+               end if;
+            end if;
+
+            --  If no overflow check required, we are done
+
+            if not Do_Ovflow_Check then
                if Debug_Flag_CC then
                   w ("No overflow check required");
                end if;
@@ -5198,6 +5240,7 @@ package body Checks is
                return;
             end if;
          end if;
+      end if;
 
       --  If not in optimizing mode, set flag and we are done. We are also done
       --  (and just set the flag) if the type is not a discrete type, since it

gcc/ada/exp_aggr.adb

@@ -4039,13 +4039,15 @@ package body Exp_Aggr is
 
       --    1. N consists of a single OTHERS choice, possibly recursively
 
-      --    2. The array type has no atomic components
+      --    2. The array type is not packed
 
-      --    3. The component type is discrete
+      --    3. The array type has no atomic components
 
-      --    4. The component size is a multiple of Storage_Unit
+      --    4. The component type is discrete
 
-      --    5. The component size is Storage_Unit or the value is of the form
+      --    5. The component size is a multiple of Storage_Unit
+
+      --    6. The component size is Storage_Unit or the value is of the form
       --       M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
       --       and M in 1 .. A-1. This can also be viewed as K occurrences of
       --       the 8-bit value M, concatenated together.
@@ -4071,6 +4073,10 @@ package body Exp_Aggr is
                return False;
             end if;
 
+            if Present (Packed_Array_Impl_Type (Ctyp)) then
+               return False;
+            end if;
+
             if Has_Atomic_Components (Ctyp) then
                return False;
             end if;
@@ -4119,7 +4125,7 @@ package body Exp_Aggr is
             Value := Value - Expr_Value (Type_Low_Bound (Ctyp));
          end if;
 
-         --  0 and -1 immediately satisfy check #5
+         --  0 and -1 immediately satisfy the last check
 
          if Value = Uint_0 or else Value = Uint_Minus_1 then
             return True;

gcc/ada/sem_ch10.adb

@@ -5695,10 +5695,10 @@ package body Sem_Ch10 is
 
             procedure Process_State (State : Node_Id) is
                Loc   : constant Source_Ptr := Sloc (State);
+               Decl  : Node_Id;
+               Dummy : Entity_Id;
                Elmt  : Node_Id;
                Id    : Entity_Id;
-               Name  : Name_Id;
-               Dummy : Entity_Id;
 
             begin
                --  Multiple abstract states appear as an aggregate
@@ -5721,12 +5721,12 @@ package body Sem_Ch10 is
                --  extension aggregate.
 
                elsif Nkind (State) = N_Extension_Aggregate then
-                  Name := Chars (Ancestor_Part (State));
+                  Decl := Ancestor_Part (State);
 
                --  Simple state declaration
 
                elsif Nkind (State) = N_Identifier then
-                  Name := Chars (State);
+                  Decl := State;
 
                --  Possibly an illegal state declaration
 
@@ -5734,15 +5734,27 @@ package body Sem_Ch10 is
                   return;
                end if;
 
-               --  Construct a dummy state for the purposes of establishing a
-               --  non-limited => limited view relation. Note that the dummy
-               --  state is not added to list Abstract_States to avoid multiple
-               --  definitions.
+               --  Abstract states are elaborated when the related pragma is
+               --  elaborated. Since the withed package is not analyzed yet,
+               --  the entities of the abstract states are not available. To
+               --  overcome this complication, create the entities now and
+               --  store them in their respective declarations. The entities
+               --  are later used by routine Create_Abstract_State to declare
+               --  and enter the states into visibility.
+
+               if No (Entity (Decl)) then
+                  Id := Make_Defining_Identifier (Loc, Chars (Decl));
 
-               Id := Make_Defining_Identifier (Loc, New_External_Name (Name));
+                  Set_Entity     (Decl, Id);
                   Set_Parent     (Id, State);
                   Decorate_State (Id, Scop);
 
+               --  Otherwise the package was previously withed
+
+               else
+                  Id := Entity (Decl);
+               end if;
+
                Build_Shadow_Entity (Id, Scop, Dummy);
             end Process_State;
 

gcc/ada/sem_prag.adb

@@ -10519,11 +10519,24 @@ package body Sem_Prag is
                   Is_Null : Boolean)
                is
                begin
-                  --  The generated state abstraction reuses the same chars
-                  --  from the original state declaration. Decorate the entity.
+                  --  The abstract state may be semi-declared when the related
+                  --  package was withed through a limited with clause. In that
+                  --  case reuse the entity to fully declare the state.
 
+                  if Present (Decl) and then Present (Entity (Decl)) then
+                     State_Id := Entity (Decl);
+
+                  --  Otherwise the elaboration of pragma Abstract_State
+                  --  declares the state.
+
+                  else
                      State_Id := Make_Defining_Identifier (Loc, Nam);
 
+                     if Present (Decl) then
+                        Set_Entity (Decl, State_Id);
+                     end if;
+                  end if;
+
                   --  Null states never come from source
 
                   Set_Comes_From_Source       (State_Id, not Is_Null);