[multiple changes]

2010-10-07  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
	Component_Size): It is now illegal to give an incorrect component size
	clause in the case of aliased or atomic components.
	* sem_prag.adb (Analyze_Pragma, case Pack): It is now illegal to give
	an effective pragma Pack in the case of aliased or atomic components.

2010-10-07  Steve Baird  <baird@adacore.com>

	* exp_ch4.adb (Expand_N_Allocator): Do not bypass expansion
	in the case of a violation of an active No_Task_Hierarchy restriction.

2010-10-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Validate_Derived_Type_Instance): If a formal derived
	type is non-limited, an actual for it cannot be limited.

From-SVN: r165105

5 files changed, 108 insertions, 33 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 070e8e5..c1dbf98 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,23 @@
 2010-10-07  Robert Dewar  <dewar@adacore.com>
 
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
+	Component_Size): It is now illegal to give an incorrect component size
+	clause in the case of aliased or atomic components.
+	* sem_prag.adb (Analyze_Pragma, case Pack): It is now illegal to give
+	an effective pragma Pack in the case of aliased or atomic components.
+
+2010-10-07  Steve Baird  <baird@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Allocator): Do not bypass expansion
+	in the case of a violation of an active No_Task_Hierarchy restriction.
+
+2010-10-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Validate_Derived_Type_Instance): If a formal derived
+	type is non-limited, an actual for it cannot be limited.
+
+2010-10-07  Robert Dewar  <dewar@adacore.com>
+
 	* einfo.ads (No_Pool_Assigned): Update documentation.
 	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
 	Storage_Size): We only set No_Pool_Assigned if the expression is a
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 41de2b5..6b9fa57 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -3672,15 +3672,6 @@ package body Exp_Ch4 is
                if Has_Task (T) then
                   if No (Master_Id (Base_Type (PtrT))) then
 
-                     --  If we have a non-library level task with restriction
-                     --  No_Task_Hierarchy set, then no point in expanding.
-
-                     if not Is_Library_Level_Entity (T)
-                       and then Restriction_Active (No_Task_Hierarchy)
-                     then
-                        return;
-                     end if;
-
                      --  The designated type was an incomplete type, and the
                      --  access type did not get expanded. Salvage it now.
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index f05ed6e..8168024 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -9969,12 +9969,13 @@ package body Sem_Ch12 is
          --  interface then  the generic formal is not unless declared
          --  explicitly so. If not declared limited, the actual cannot be
          --  limited (see AI05-0087).
-         --  Disable check for now, limited interfaces implemented by
-         --  protected types are common, Need to update tests ???
+         --  Even though this AI is a binding interpretation, we enable the
+         --  check only in Ada2012 mode, because this improper construct
+         --  shows up in user code and in existing B-tests.
 
          if Is_Limited_Type (Act_T)
            and then not Is_Limited_Type (A_Gen_T)
-           and then False
+           and then Ada_Version >= Ada_12
          then
             Error_Msg_NE
               ("actual for non-limited & cannot be a limited type", Actual,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index bfa1373..7b9c04e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1298,6 +1298,34 @@ package body Sem_Ch13 is
             Biased   : Boolean;
             New_Ctyp : Entity_Id;
             Decl     : Node_Id;
+            Ignore   : Boolean := False;
+
+            procedure Complain_CS (T : String);
+            --  Outputs error messages for incorrect CS clause for aliased or
+            --  atomic components (T is "aliased" or "atomic");
+
+            -----------------
+            -- Complain_CS --
+            -----------------
+
+            procedure Complain_CS (T : String) is
+            begin
+               if Known_Static_Esize (Ctyp) then
+                  Error_Msg_N
+                    ("incorrect component size for " & T & " components", N);
+                  Error_Msg_Uint_1 := Esize (Ctyp);
+                  Error_Msg_N ("\only allowed value is^", N);
+
+               else
+                  Error_Msg_N
+                    ("component size cannot be given for " & T & " components",
+                     N);
+               end if;
+
+               return;
+            end Complain_CS;
+
+         --  Start of processing for Component_Size_Case
 
          begin
             if not Is_Array_Type (U_Ent) then
@@ -1315,14 +1343,25 @@ package body Sem_Ch13 is
             elsif Csize /= No_Uint then
                Check_Size (Expr, Ctyp, Csize, Biased);
 
-               if Has_Aliased_Components (Btype)
-                 and then Csize < 32
-                 and then Csize /= 8
-                 and then Csize /= 16
+               --  Case where component size has no effect
+
+               if Known_Static_Esize (Ctyp)
+                 and then Known_Static_RM_Size (Ctyp)
+                 and then Esize (Ctyp) = RM_Size (Ctyp)
+                 and then (Esize (Ctyp) = 8  or else
+                           Esize (Ctyp) = 16 or else
+                           Esize (Ctyp) = 32 or else
+                           Esize (Ctyp) = 64)
                then
-                  Error_Msg_N
-                    ("component size incorrect for aliased components", N);
-                  return;
+                  Ignore := True;
+
+               --  Cannot give component size for aliased/atomic types
+
+               elsif Has_Aliased_Components (Btype) then
+                  Complain_CS ("aliased");
+
+               elsif Has_Atomic_Components (Btype) then
+                  Complain_CS ("atomic");
                end if;
 
                --  For the biased case, build a declaration for a subtype
@@ -1385,7 +1424,10 @@ package body Sem_Ch13 is
                end if;
 
                Set_Has_Component_Size_Clause (Btype, True);
-               Set_Has_Non_Standard_Rep      (Btype, True);
+
+               if not Ignore then
+                  Set_Has_Non_Standard_Rep (Btype, True);
+               end if;
             end if;
          end Component_Size_Case;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 64724c9..5df154b 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -5912,6 +5912,7 @@ package body Sem_Prag is
             E    : Entity_Id;
             D    : Node_Id;
             K    : Node_Kind;
+            Ctyp : Entity_Id;
 
          begin
             Check_Ada_83_Warning;
@@ -5943,6 +5944,8 @@ package body Sem_Prag is
                    and then Nkind (Object_Definition (D)) =
                                        N_Constrained_Array_Definition)
             then
+               Ctyp := Component_Type (E);
+
                --  The flag is set on the object, or on the base type
 
                if Nkind (D) /= N_Object_Declaration then
@@ -5957,9 +5960,13 @@ package body Sem_Prag is
                   if Is_Packed (E) then
                      Set_Is_Packed (E, False);
 
-                     Error_Pragma_Arg
-                       ("?Pack canceled, cannot pack atomic components",
-                        Arg1);
+                     if not (Known_Static_Esize (Ctyp)
+                              and then Known_Static_RM_Size (Ctyp)
+                              and then Esize (Ctyp) = RM_Size (Ctyp))
+                     then
+                        Error_Pragma_Arg
+                          ("cannot pack atomic components", Arg1);
+                     end if;
                   end if;
                end if;
 
@@ -9869,6 +9876,8 @@ package body Sem_Prag is
             Assoc   : constant Node_Id := Arg1;
             Type_Id : Node_Id;
             Typ     : Entity_Id;
+            Ctyp    : Entity_Id;
+            Ignore  : Boolean := False;
 
          begin
             Check_No_Identifiers;
@@ -9899,18 +9908,29 @@ package body Sem_Prag is
             --  Array type
 
             elsif Is_Array_Type (Typ) then
+               Ctyp := Component_Type (Typ);
 
-               --  Pack not allowed for aliased or atomic components
+               --  Ignore pack that does nothing
 
-               if Has_Aliased_Components (Base_Type (Typ)) then
-                  Error_Pragma
-                    ("pragma% ignored, cannot pack aliased components?");
+               if Known_Static_Esize (Ctyp)
+                 and then Known_Static_RM_Size (Ctyp)
+                 and then Esize (Ctyp) = RM_Size (Ctyp)
+                 and then (Esize (Ctyp) = 8  or else
+                           Esize (Ctyp) = 16 or else
+                           Esize (Ctyp) = 32 or else
+                           Esize (Ctyp) = 64)
+               then
+                  Ignore := True;
+
+               --  Pack not allowed for aliased/atomic components
+
+               elsif Has_Aliased_Components (Base_Type (Typ)) then
+                  Error_Pragma ("cannot pack aliased components");
 
                elsif Has_Atomic_Components (Typ)
                  or else Is_Atomic (Component_Type (Typ))
                then
-                  Error_Pragma
-                    ("?pragma% ignored, cannot pack atomic components");
+                  Error_Pragma ("cannot pack atomic components");
                end if;
 
                --  If we had an explicit component size given, then we do not
@@ -9944,12 +9964,15 @@ package body Sem_Prag is
                      --  For normal non-VM target, do the packing
 
                      elsif VM_Target = No_VM then
-                        Set_Is_Packed            (Base_Type (Typ));
+                        if not Ignore then
+                           Set_Is_Packed            (Base_Type (Typ));
+                           Set_Has_Non_Standard_Rep (Base_Type (Typ));
+                        end if;
+
                         Set_Has_Pragma_Pack      (Base_Type (Typ));
-                        Set_Has_Non_Standard_Rep (Base_Type (Typ));
 
-                     --  If we ignore the pack, then warn about this, except
-                     --  that we suppress the warning in GNAT mode.
+                     --  If we ignore the pack for VM_Targets, then warn about
+                     --  this, except suppress the warning in GNAT mode.
 
                      elsif not GNAT_Mode then
                         Error_Pragma