From a6a5aae337314592759d3b5335ebb90246a00965 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 7 Oct 2010 13:21:42 +0000 Subject: [PATCH] 2010-10-07 Robert Dewar * 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 * 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 * sem_ch12.adb (Validate_Derived_Type_Instance): If a formal derived type is non-limited, an actual for it cannot be limited. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165105 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 18 ++++++++++++++++ gcc/ada/exp_ch4.adb | 9 -------- gcc/ada/sem_ch12.adb | 7 ++++--- gcc/ada/sem_ch13.adb | 58 ++++++++++++++++++++++++++++++++++++++++++++-------- gcc/ada/sem_prag.adb | 49 ++++++++++++++++++++++++++++++++------------ 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 + * 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 + + * 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 + + * 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 + * 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 -- 2.7.4