From: Pierre-Marie de Rodat Date: Fri, 15 Dec 2017 09:44:22 +0000 (+0000) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=56af86884f7795f5b77544744cd2e0ad825fcdde;p=gcc.git [multiple changes] 2017-12-15 Bob Duff * exp_ch6.adb (Expand_N_Extended_Return_Statement): If the Init_Assignment is rewritten, we need to set Assignment_OK on the new node. Otherwise, we will get spurious errors when initializing via assignment statement. 2017-12-15 Arnaud Charlet * exp_unst.adb (Visit_Node): Refine handling of 'Access to ignore non relevant nodes. (Has_Non_Null_Statements): Moved to sem_util for later reuse. 2017-12-15 Eric Botcazou * exp_attr.adb (Is_Inline_Floating_Point_Attribute): Fix comment. * libgnat/s-fatgen.adb (Model): Use Machine attribute. (Truncation): Likewise. 2017-12-15 Bob Duff * exp_ch7.adb (Expand_Cleanup_Actions): Make sure the block and handled statement sequence generated for certain extended return statements have a Sloc that is not No_Location. Otherwise, the back end doesn't set any location and ends up reading uninitialized variables. From-SVN: r255680 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 60f366cba92..9077056ae25 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2017-12-15 Bob Duff + + * exp_ch6.adb (Expand_N_Extended_Return_Statement): If the + Init_Assignment is rewritten, we need to set Assignment_OK on the new + node. Otherwise, we will get spurious errors when initializing via + assignment statement. + +2017-12-15 Arnaud Charlet + + * exp_unst.adb (Visit_Node): Refine handling of 'Access to ignore non + relevant nodes. + (Has_Non_Null_Statements): Moved to sem_util for later reuse. + +2017-12-15 Eric Botcazou + + * exp_attr.adb (Is_Inline_Floating_Point_Attribute): Fix comment. + * libgnat/s-fatgen.adb (Model): Use Machine attribute. + (Truncation): Likewise. + +2017-12-15 Bob Duff + + * exp_ch7.adb (Expand_Cleanup_Actions): Make sure the block and handled + statement sequence generated for certain extended return statements + have a Sloc that is not No_Location. Otherwise, the back end doesn't + set any location and ends up reading uninitialized variables. + 2017-12-15 Bob Duff * types.ads, exp_ch6.adb, libgnat/s-regexp.ads, opt.ads: Partly revert diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 79c6524769b..b181c1d5321 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -8274,7 +8274,7 @@ package body Exp_Attr is -- Start of processing for Is_Inline_Floating_Point_Attribute begin - -- Machine and Model can be expanded by the GCC and AAMP back ends only + -- Machine and Model can be expanded by the GCC back end only if Id = Attribute_Machine or else Id = Attribute_Model then return Is_GCC_Target; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8a3f3905c76..43731c80239 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5370,6 +5370,10 @@ package body Exp_Ch6 is Rewrite (Name (Init_Assignment), Make_Explicit_Dereference (Loc, Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc))); + pragma Assert + (Assignment_OK + (Original_Node (Name (Init_Assignment)))); + Set_Assignment_OK (Name (Init_Assignment)); Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id)); @@ -7310,7 +7314,7 @@ package body Exp_Ch6 is begin -- ???For now, enable build-in-place for a very narrow set of -- controlled types. Change "if True" to "if False" to - -- experiment more controlled types. Eventually, we would + -- experiment with more controlled types. Eventually, we might -- like to enable build-in-place for all tagged types, all -- types that need finalization, and all caller-unknown-size -- types. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 11278751670..4ce2ea1c2c0 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4310,20 +4310,6 @@ package body Exp_Ch7 is return; end if; - -- If we are generating expanded code for debugging purposes, use the - -- Sloc of the point of insertion for the cleanup code. The Sloc will be - -- updated subsequently to reference the proper line in .dg files. If we - -- are not debugging generated code, use No_Location instead, so that - -- no debug information is generated for the cleanup code. This makes - -- the behavior of the NEXT command in GDB monotonic, and makes the - -- placement of breakpoints more accurate. - - if Debug_Generated_Code then - Loc := Sloc (Scop); - else - Loc := No_Location; - end if; - -- If an extended return statement contains something like -- X := F (...); -- where F is a build-in-place function call returning a controlled @@ -4350,13 +4336,13 @@ package body Exp_Ch7 is if Nkind (N) = N_Extended_Return_Statement then declare Block : constant Node_Id := - Make_Block_Statement (Loc, + Make_Block_Statement (Sloc (N), Declarations => Empty_List, Handled_Statement_Sequence => Handled_Statement_Sequence (N)); begin Set_Handled_Statement_Sequence - (N, Make_Handled_Sequence_Of_Statements (Loc, + (N, Make_Handled_Sequence_Of_Statements (Sloc (N), Statements => New_List (Block))); Analyze (Block); end; @@ -4380,6 +4366,20 @@ package body Exp_Ch7 is Old_Poll : Boolean; begin + -- If we are generating expanded code for debugging purposes, use the + -- Sloc of the point of insertion for the cleanup code. The Sloc will + -- be updated subsequently to reference the proper line in .dg files. + -- If we are not debugging generated code, use No_Location instead, + -- so that no debug information is generated for the cleanup code. + -- This makes the behavior of the NEXT command in GDB monotonic, and + -- makes the placement of breakpoints more accurate. + + if Debug_Generated_Code then + Loc := Sloc (Scop); + else + Loc := No_Location; + end if; + -- Set polling off. The finalization and cleanup code is executed -- with aborts deferred. diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 9e5465bc6de..558e9868524 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -586,18 +586,20 @@ package body Exp_Unst is | Attribute_Unchecked_Access | Attribute_Unrestricted_Access => - Ent := Entity (Prefix (N)); + if Nkind (Prefix (N)) in N_Has_Entity then + Ent := Entity (Prefix (N)); - -- We are only interested in calls to subprograms - -- nested within Subp. + -- We are only interested in calls to subprograms + -- nested within Subp. - if Scope_Within (Ent, Subp) then - if Is_Imported (Ent) then - null; + if Scope_Within (Ent, Subp) then + if Is_Imported (Ent) then + null; - elsif Is_Subprogram (Ent) then - Append_Unique_Call - ((N, Current_Subprogram, Ent)); + elsif Is_Subprogram (Ent) then + Append_Unique_Call + ((N, Current_Subprogram, Ent)); + end if; end if; end if; diff --git a/gcc/ada/libgnat/s-fatgen.adb b/gcc/ada/libgnat/s-fatgen.adb index fdb34f2e885..f6dff9cbb67 100644 --- a/gcc/ada/libgnat/s-fatgen.adb +++ b/gcc/ada/libgnat/s-fatgen.adb @@ -394,7 +394,7 @@ package body System.Fat_Gen is function Model (X : T) return T is begin - return Machine (X); + return T'Machine (X); end Model; ---------- @@ -739,10 +739,11 @@ package body System.Fat_Gen is Result := abs X; if Result >= Radix_To_M_Minus_1 then - return Machine (X); + return T'Machine (X); else - Result := Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1; + Result := + T'Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1; if Result > abs X then Result := Result - 1.0; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ea2379c3e1a..5bdbd5b372b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10619,6 +10619,30 @@ package body Sem_Util is and then Nkind (Node (First_Elmt (Constits))) /= N_Null; end Has_Non_Null_Refinement; + ----------------------------- + -- Has_Non_Null_Statements -- + ----------------------------- + + function Has_Non_Null_Statements (L : List_Id) return Boolean is + Node : Node_Id; + + begin + if Is_Non_Empty_List (L) then + Node := First (L); + + loop + if Nkind (Node) /= N_Null_Statement then + return True; + end if; + + Next (Node); + exit when Node = Empty; + end loop; + end if; + + return False; + end Has_Non_Null_Statements; + ---------------------------------- -- Has_Non_Trivial_Precondition -- ---------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c1f421f36f5..e94515dcf07 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1290,6 +1290,9 @@ package Sem_Util is -- in pragma Refined_State. This function does not take into account the -- visible refinement region of abstract state Id. + function Has_Non_Null_Statements (L : List_Id) return Boolean; + -- Return True if L has non-null statements + function Has_Overriding_Initialize (T : Entity_Id) return Boolean; -- Predicate to determine whether a controlled type has a user-defined -- Initialize primitive (and, in Ada 2012, whether that primitive is