From: Arnaud Charlet Date: Thu, 16 Jun 2016 09:52:17 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=a8a42b933c5dc135080120d0a1d115c602a328fb;p=gcc.git [multiple changes] 2016-06-16 Javier Miranda * sem_res.adb (Resolve): Under relaxed RM semantics silently replace occurrences of null by System.Null_Address. * sem_ch4.adb (Analyze_One_Call, Operator_Check): Under relaxed RM semantics silently replace occurrences of null by System.Null_Address. * sem_util.ad[sb] (Null_To_Null_Address_Convert_OK): New subprogram. (Replace_Null_By_Null_Address): New subprogram. 2016-06-16 Bob Duff * exp_util.adb (Is_Controlled_Function_Call): This was missing the case where the call is in prefix format, with named notation, as in Obj.Func (Formal => Actual). From-SVN: r237508 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d514eaff5bc..3f33eeefc81 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2016-06-16 Javier Miranda + + * sem_res.adb (Resolve): Under relaxed RM semantics silently + replace occurrences of null by System.Null_Address. + * sem_ch4.adb (Analyze_One_Call, Operator_Check): Under + relaxed RM semantics silently replace occurrences of null by + System.Null_Address. + * sem_util.ad[sb] (Null_To_Null_Address_Convert_OK): New subprogram. + (Replace_Null_By_Null_Address): New subprogram. + +2016-06-16 Bob Duff + + * exp_util.adb (Is_Controlled_Function_Call): + This was missing the case where the call is in prefix format, + with named notation, as in Obj.Func (Formal => Actual). + 2016-06-16 Hristian Kirtchev * exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 7dbf44acfe8..6598c0b74bd 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -4720,25 +4720,41 @@ package body Exp_Util is Expr : Node_Id := Original_Node (N); begin - if Nkind (Expr) = N_Function_Call then - Expr := Name (Expr); - -- When a function call appears in Object.Operation format, the - -- original representation has two possible forms depending on the - -- availability of actual parameters: + -- original representation has three possible forms depending on the + -- availability and form of actual parameters: - -- Obj.Func_Call N_Selected_Component - -- Obj.Func_Call (Param) N_Indexed_Component + -- Obj.Func N_Selected_Component + -- Obj.Func (Actual) N_Indexed_Component + -- Obj.Func (Formal => Actual) N_Function_Call, whose Name is an + -- N_Selected_Component - else - if Nkind (Expr) = N_Indexed_Component then + case Nkind (Expr) is + when N_Function_Call => + Expr := Name (Expr); + + -- Check for "Obj.Func (Formal => Actual)" case + + if Nkind (Expr) = N_Selected_Component then + Expr := Selector_Name (Expr); + end if; + + -- "Obj.Func (Actual)" case + + when N_Indexed_Component => Expr := Prefix (Expr); - end if; - if Nkind (Expr) = N_Selected_Component then + if Nkind (Expr) = N_Selected_Component then + Expr := Selector_Name (Expr); + end if; + + -- "Obj.Func" case + + when N_Selected_Component => Expr := Selector_Name (Expr); - end if; - end if; + + when others => null; + end case; return Nkind_In (Expr, N_Expanded_Name, N_Identifier) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index a109cd0c50c..66a2acf6ca0 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3397,6 +3397,18 @@ package body Sem_Ch4 is Next_Actual (Actual); Next_Formal (Formal); + -- Under relaxed RM semantics silently replace occurrences of + -- null by System.Address_Null. We only do this if we know that + -- an error will otherwise be issued. + + elsif Null_To_Null_Address_Convert_OK (Actual, Etype (Formal)) + and then (Report and not Is_Indexed and not Is_Indirect) + then + Replace_Null_By_Null_Address (Actual); + Analyze_And_Resolve (Actual, Etype (Formal)); + Next_Actual (Actual); + Next_Formal (Formal); + -- For an Ada 2012 predicate or invariant, a call may mention -- an incomplete type, while resolution of the corresponding -- predicate function may see the full view, as a consequence @@ -6806,6 +6818,20 @@ package body Sem_Ch4 is return; end; + + -- Under relaxed RM semantics silently replace occurrences of + -- null by System.Address_Null. + + elsif Null_To_Null_Address_Convert_OK (N) then + Replace_Null_By_Null_Address (N); + + if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then + Analyze_Comparison_Op (N); + else + Analyze_Arithmetic_Op (N); + end if; + + return; end if; -- Comparisons on A'Access are common enough to deserve a @@ -6875,6 +6901,14 @@ package body Sem_Ch4 is Unchecked_Convert_To (Etype (L), Relocate_Node (R))); Analyze_Equality_Op (N); return; + + -- Under relaxed RM semantics silently replace occurrences of + -- null by System.Address_Null. + + elsif Null_To_Null_Address_Convert_OK (N) then + Replace_Null_By_Null_Address (N); + Analyze_Equality_Op (N); + return; end if; end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1d73bf462a1..595d8f954e5 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2684,6 +2684,14 @@ package body Sem_Res is Analyze_And_Resolve (N, Typ); Ghost_Mode := Save_Ghost_Mode; return; + + -- Under relaxed RM semantics silently replace occurrences of null + -- by System.Address_Null + + elsif Null_To_Null_Address_Convert_OK (N, Typ) then + Replace_Null_By_Null_Address (N); + Analyze_And_Resolve (N, Typ); + return; end if; -- That special Allow_Integer_Address check did not appply, so we diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 021ceac6a35..edcd0c528a1 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10386,6 +10386,48 @@ package body Sem_Util is return Name_Find; end Remove_Suffix; + ---------------------------------- + -- Replace_Null_By_Null_Address -- + ---------------------------------- + + procedure Replace_Null_By_Null_Address (N : Node_Id) is + begin + pragma Assert (Relaxed_RM_Semantics); + pragma Assert + (Nkind (N) = N_Null + or else Nkind_In (N, N_Op_Eq, N_Op_Ne) + or else Nkind_In (N, N_Op_Lt, N_Op_Le, N_Op_Gt, N_Op_Ge)); + + if Nkind (N) = N_Null then + Rewrite (N, + New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N))); + + else + declare + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); + + begin + -- We check the Etype of the complementary operand since the + -- N_Null node is not decorated at this stage. + + if Nkind (L) = N_Null + and then Is_Descendant_Of_Address (Etype (R)) + then + Rewrite (L, + New_Occurrence_Of (RTE (RE_Null_Address), Sloc (L))); + end if; + + if Nkind (R) = N_Null + and then Is_Descendant_Of_Address (Etype (L)) + then + Rewrite (R, + New_Occurrence_Of (RTE (RE_Null_Address), Sloc (R))); + end if; + end; + end if; + end Replace_Null_By_Null_Address; + -------------------------- -- Has_Tagged_Component -- -------------------------- @@ -12471,9 +12513,6 @@ package body Sem_Util is if Is_Entity_Name (N) then return Is_Effectively_Volatile (Entity (N)); - elsif Nkind (N) = N_Expanded_Name then - return Is_Effectively_Volatile (Entity (N)); - elsif Nkind (N) = N_Indexed_Component then return Is_Effectively_Volatile_Object (Prefix (N)); @@ -17490,6 +17529,44 @@ package body Sem_Util is end loop; end Note_Possible_Modification; + -------------------------------------- + -- Null_To_Null_Address_Convert_OK -- + -------------------------------------- + + function Null_To_Null_Address_Convert_OK + (N : Node_Id; + Typ : Entity_Id := Empty) return Boolean is + begin + if not Relaxed_RM_Semantics then + return False; + end if; + + if Nkind (N) = N_Null then + return Present (Typ) and then Is_Descendant_Of_Address (Typ); + + elsif Nkind_In (N, N_Op_Eq, N_Op_Ne) + or else Nkind_In (N, N_Op_Lt, N_Op_Le, N_Op_Gt, N_Op_Ge) + then + declare + L : constant Node_Id := Left_Opnd (N); + R : constant Node_Id := Right_Opnd (N); + + begin + -- We check the Etype of the complementary operand since the + -- N_Null node is not decorated at this stage. + + return + ((Nkind (L) = N_Null + and then Is_Descendant_Of_Address (Etype (R))) + or else + (Nkind (R) = N_Null + and then Is_Descendant_Of_Address (Etype (L)))); + end; + end if; + + return False; + end Null_To_Null_Address_Convert_OK; + ------------------------- -- Object_Access_Level -- ------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b95366962e3..b62fe77d43c 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1933,6 +1933,14 @@ package Sem_Util is -- (e.g. target of assignment, or out parameter), and to False if the -- modification is only potential (e.g. address of entity taken). + function Null_To_Null_Address_Convert_OK + (N : Node_Id; + Typ : Entity_Id := Empty) return Boolean; + -- Return True if we are compiling in relaxed RM semantics mode and: + -- 1) N is a N_Null node and Typ is a decendant of System.Address, or + -- 2) N is a comparison operator, one of the operands is null and the + -- type of the other operand is a descendant of System.Address. + function Object_Access_Level (Obj : Node_Id) return Uint; -- Return the accessibility level of the view of the object Obj. For -- convenience, qualified expressions applied to object names are also @@ -2044,6 +2052,11 @@ package Sem_Util is function Remove_Suffix (E : Entity_Id; Suffix : Character) return Name_Id; -- Returns the name of E without Suffix + procedure Replace_Null_By_Null_Address (N : Node_Id); + -- N is N_Null or a binary comparison operator, we are compiling in relaxed + -- RM semantics mode and one of the operands is null. Replace null by + -- System.Null_Address. + function Rep_To_Pos_Flag (E : Entity_Id; Loc : Source_Ptr) return Node_Id; -- This is used to construct the second argument in a call to Rep_To_Pos -- which is Standard_True if range checks are enabled (E is an entity to