From e9c12b91f480ce15810dc0be2afc174899f4eea7 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 25 Nov 2015 16:14:27 +0100 Subject: [PATCH] [multiple changes] 2015-11-25 Bob Duff * sem_elab.adb (Check_Internal_Call_Continue): Code clean ups. 2015-11-25 Eric Botcazou * sem_util.ads (Has_Compatible_Alignment): Add Layout_Done parameter. * sem_util.adb (Has_Compatible_Alignment): Likewise. (Has_Compatible_Alignment_Internal): Likewise. Do not set the result to Unknown for packed types if Layout_Done is true. * checks.adb (Apply_Address_Clause_Check): Adjust call and pass False to Has_Compatible_Alignment. * sem_ch13.adb (Validate_Address_Clauses): Likewise but pass True. From-SVN: r230877 --- gcc/ada/ChangeLog | 15 +++++++++++++++ gcc/ada/checks.adb | 11 ++++++----- gcc/ada/sem_ch13.adb | 45 ++++++++++++++++++++++---------------------- gcc/ada/sem_util.adb | 40 +++++++++++++++++++++------------------ gcc/ada/sem_util.ads | 14 +++++++++----- 5 files changed, 74 insertions(+), 51 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ea9c5e9c8ac..19ddd9f90ce 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2015-11-25 Bob Duff + + * sem_elab.adb (Check_Internal_Call_Continue): Code clean ups. + +2015-11-25 Eric Botcazou + + * sem_util.ads (Has_Compatible_Alignment): Add Layout_Done + parameter. + * sem_util.adb (Has_Compatible_Alignment): Likewise. + (Has_Compatible_Alignment_Internal): Likewise. Do not set the + result to Unknown for packed types if Layout_Done is true. + * checks.adb (Apply_Address_Clause_Check): Adjust call and + pass False to Has_Compatible_Alignment. + * sem_ch13.adb (Validate_Address_Clauses): Likewise but pass True. + 2015-11-25 Vincent Celier * gnatcmd.adb: When -gnat is called with switch -P diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 908837cd015..a3ea4770c64 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -749,14 +749,15 @@ package body Checks is end if; end; - -- If the expression has the form X'Address, then we can find out if - -- the object X has an alignment that is compatible with the object E. - -- If it hasn't or we don't know, we defer issuing the warning until - -- the end of the compilation to take into account back end annotations. + -- If the expression has the form X'Address, then we can find out if the + -- object X has an alignment that is compatible with the object E. If it + -- hasn't or we don't know, we defer issuing the warning until the end + -- of the compilation to take into account back end annotations. elsif Nkind (Expr) = N_Attribute_Reference and then Attribute_Name (Expr) = Name_Address - and then Has_Compatible_Alignment (E, Prefix (Expr)) = Known_Compatible + and then + Has_Compatible_Alignment (E, Prefix (Expr), False) = Known_Compatible then return; end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index d56bd2cde6e..688861e7e99 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -13097,16 +13097,15 @@ package body Sem_Ch13 is and then X_Size > Uint_0 and then X_Size > Y_Size then - Error_Msg_NE - ("??& overlays smaller object", ACCR.N, ACCR.X); + Error_Msg_NE ("??& overlays smaller object", ACCR.N, ACCR.X); Error_Msg_N ("\??program execution may be erroneous", ACCR.N); + Error_Msg_Uint_1 := X_Size; - Error_Msg_NE - ("\??size of & is ^", ACCR.N, ACCR.X); + Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.X); + Error_Msg_Uint_1 := Y_Size; - Error_Msg_NE - ("\??size of & is ^", ACCR.N, ACCR.Y); + Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y); -- Check for inadequate alignment, both of the base object -- and of the offset, if any. We only do this check if the @@ -13119,32 +13118,32 @@ package body Sem_Ch13 is elsif not Alignment_Checks_Suppressed (ACCR.Y) and then Y_Alignment /= Uint_0 - and then (Y_Alignment < X_Alignment - or else (ACCR.Off - and then - Nkind (Expr) = N_Attribute_Reference - and then - Attribute_Name (Expr) = Name_Address - and then - Has_Compatible_Alignment - (ACCR.X, Prefix (Expr)) - /= Known_Compatible)) + and then + (Y_Alignment < X_Alignment + or else + (ACCR.Off + and then Nkind (Expr) = N_Attribute_Reference + and then Attribute_Name (Expr) = Name_Address + and then Has_Compatible_Alignment + (ACCR.X, Prefix (Expr), True) /= + Known_Compatible)) then Error_Msg_NE - ("??specified address for& may be inconsistent " - & "with alignment", ACCR.N, ACCR.X); + ("??specified address for& may be inconsistent with " + & "alignment", ACCR.N, ACCR.X); Error_Msg_N ("\??program execution may be erroneous (RM 13.3(27))", ACCR.N); + Error_Msg_Uint_1 := X_Alignment; - Error_Msg_NE - ("\??alignment of & is ^", ACCR.N, ACCR.X); + Error_Msg_NE ("\??alignment of & is ^", ACCR.N, ACCR.X); + Error_Msg_Uint_1 := Y_Alignment; - Error_Msg_NE - ("\??alignment of & is ^", ACCR.N, ACCR.Y); + Error_Msg_NE ("\??alignment of & is ^", ACCR.N, ACCR.Y); + if Y_Alignment >= X_Alignment then Error_Msg_N - ("\??but offset is not multiple of alignment", ACCR.N); + ("\??but offset is not multiple of alignment", ACCR.N); end if; end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 8d712ef584c..cc4a4fcdede 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8368,13 +8368,15 @@ package body Sem_Util is ------------------------------ function Has_Compatible_Alignment - (Obj : Entity_Id; - Expr : Node_Id) return Alignment_Result + (Obj : Entity_Id; + Expr : Node_Id; + Layout_Done : Boolean) return Alignment_Result is function Has_Compatible_Alignment_Internal - (Obj : Entity_Id; - Expr : Node_Id; - Default : Alignment_Result) return Alignment_Result; + (Obj : Entity_Id; + Expr : Node_Id; + Layout_Done : Boolean; + Default : Alignment_Result) return Alignment_Result; -- This is the internal recursive function that actually does the work. -- There is one additional parameter, which says what the result should -- be if no alignment information is found, and there is no definite @@ -8387,9 +8389,10 @@ package body Sem_Util is --------------------------------------- function Has_Compatible_Alignment_Internal - (Obj : Entity_Id; - Expr : Node_Id; - Default : Alignment_Result) return Alignment_Result + (Obj : Entity_Id; + Expr : Node_Id; + Layout_Done : Boolean; + Default : Alignment_Result) return Alignment_Result is Result : Alignment_Result := Known_Compatible; -- Holds the current status of the result. Note that once a value of @@ -8439,14 +8442,14 @@ package body Sem_Util is then Set_Result (Has_Compatible_Alignment_Internal - (Obj, Prefix (Expr), Known_Compatible)); + (Obj, Prefix (Expr), Layout_Done, Known_Compatible)); -- In all other cases, we need a full check on the prefix else Set_Result (Has_Compatible_Alignment_Internal - (Obj, Prefix (Expr), Unknown)); + (Obj, Prefix (Expr), Layout_Done, Unknown)); end if; end Check_Prefix; @@ -8465,14 +8468,14 @@ package body Sem_Util is begin -- If Expr is a selected component, we must make sure there is no - -- potentially troublesome component clause, and that the record is - -- not packed. + -- potentially troublesome component clause and that the record is + -- not packed if the layout is not done. if Nkind (Expr) = N_Selected_Component then - -- Packed record always generate unknown alignment + -- Packing generates unknown alignment if layout is not done - if Is_Packed (Etype (Prefix (Expr))) then + if Is_Packed (Etype (Prefix (Expr))) and then not Layout_Done then Set_Result (Unknown); end if; @@ -8483,7 +8486,7 @@ package body Sem_Util is -- If Expr is an indexed component, we must make sure there is no -- potentially troublesome Component_Size clause and that the array - -- is not bit-packed. + -- is not bit-packed if the layout is not done. elsif Nkind (Expr) = N_Indexed_Component then declare @@ -8491,9 +8494,9 @@ package body Sem_Util is Ind : constant Node_Id := First_Index (Typ); begin - -- Bit packed array always generates unknown alignment + -- Packing generates unknown alignment if layout is not done - if Is_Bit_Packed_Array (Typ) then + if Is_Bit_Packed_Array (Typ) and then not Layout_Done then Set_Result (Unknown); end if; @@ -8695,7 +8698,8 @@ package body Sem_Util is -- Now do the internal call that does all the work - return Has_Compatible_Alignment_Internal (Obj, Expr, Unknown); + return + Has_Compatible_Alignment_Internal (Obj, Expr, Layout_Done, Unknown); end Has_Compatible_Alignment; ---------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index d6f104cba2c..b37402ac0e2 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -991,17 +991,21 @@ package Sem_Util is -- that the values are arranged in increasing order of problematicness. function Has_Compatible_Alignment - (Obj : Entity_Id; - Expr : Node_Id) return Alignment_Result; + (Obj : Entity_Id; + Expr : Node_Id; + Layout_Done : Boolean) return Alignment_Result; -- Obj is an object entity, and expr is a node for an object reference. If -- the alignment of the object referenced by Expr is known to be compatible -- with the alignment of Obj (i.e. is larger or the same), then the result -- is Known_Compatible. If the alignment of the object referenced by Expr -- is known to be less than the alignment of Obj, then Known_Incompatible -- is returned. If neither condition can be reliably established at compile - -- time, then Unknown is returned. This is used to determine if alignment - -- checks are required for address clauses, and also whether copies must - -- be made when objects are passed by reference. + -- time, then Unknown is returned. If Layout_Done is True, the function can + -- assume that the information on size and alignment of types and objects + -- is present in the tree. This is used to determine if alignment checks + -- are required for address clauses (Layout_Done is False in this case) as + -- well as to issue appropriate warnings for them in the post compilation + -- phase (Layout_Done is True in this case). -- -- Note: Known_Incompatible does not mean that at run time the alignment -- of Expr is known to be wrong for Obj, just that it can be determined -- 2.30.2