From e379beb56f0b1e597c8aeb10c84813c8326197a9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 21 Apr 2016 10:11:46 +0200 Subject: [PATCH] [multiple changes] 2016-04-21 Javier Miranda * frontend.adb: Remove call to initialize Exp_Ch6. * exp_ch6.ads, exp_ch6.adb (Initialize): removed. (Unest_Entry/Unest_Bodies): Removed. (Unnest_Subprograms): Code cleanup. 2016-04-21 Arnaud Charlet * set_targ.adb (Read_Target_Dependent_Values): close target description file once its contents is read. * s-os_lib.adb (Non_Blocking_Spawn, version with Stdout_File and Stderr_File): Close local file descriptors before spawning child process. * exp_util.adb (Containing_Package_With_Ext_Axioms): Limit scope of local variables to make the code easier to understand and avoid duplicated calls to Parent and Generic_Parent. From-SVN: r235302 --- gcc/ada/ChangeLog | 18 ++++++ gcc/ada/exp_ch6.adb | 127 +++++++++++-------------------------------- gcc/ada/exp_ch6.ads | 3 - gcc/ada/exp_util.adb | 46 ++++++++-------- gcc/ada/frontend.adb | 1 - gcc/ada/s-os_lib.adb | 13 +++-- gcc/ada/set_targ.adb | 4 +- 7 files changed, 86 insertions(+), 126 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 17e8bdac36b..6c2a5c969a9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2016-04-21 Javier Miranda + + * frontend.adb: Remove call to initialize Exp_Ch6. + * exp_ch6.ads, exp_ch6.adb (Initialize): removed. + (Unest_Entry/Unest_Bodies): Removed. + (Unnest_Subprograms): Code cleanup. + +2016-04-21 Arnaud Charlet + + * set_targ.adb (Read_Target_Dependent_Values): + close target description file once its contents is read. + * s-os_lib.adb (Non_Blocking_Spawn, version with Stdout_File + and Stderr_File): Close local file descriptors before spawning + child process. + * exp_util.adb (Containing_Package_With_Ext_Axioms): Limit scope of + local variables to make the code easier to understand and avoid + duplicated calls to Parent and Generic_Parent. + 2016-04-20 Bob Duff * s-os_lib.ads: Minor comment fix. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 876aca98fd9..7a3a22f84e0 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -72,7 +72,6 @@ with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; -with Table; with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -80,33 +79,6 @@ with Validsw; use Validsw; package body Exp_Ch6 is - ------------------------------------- - -- Table for Unnesting Subprograms -- - ------------------------------------- - - -- When we expand a subprogram body, if it has nested subprograms and if - -- we are in Unnest_Subprogram_Mode, then we record the subprogram entity - -- and the body in this table, to later be passed to Unnest_Subprogram. - - -- We need this delaying mechanism, because we have to wait until all - -- instantiated bodies have been inserted before doing the unnesting. - - type Unest_Entry is record - Ent : Entity_Id; - -- Entity for subprogram to be unnested - - Bod : Node_Id; - -- Subprogram body to be unnested - end record; - - package Unest_Bodies is new Table.Table ( - Table_Component_Type => Unest_Entry, - Table_Index_Type => Nat, - Table_Low_Bound => 1, - Table_Initial => 100, - Table_Increment => 200, - Table_Name => "Unest_Bodies"); - ----------------------- -- Local Subprograms -- ----------------------- @@ -6803,15 +6775,6 @@ package body Exp_Ch6 is return False; end Has_Unconstrained_Access_Discriminants; - ---------------- - -- Initialize -- - ---------------- - - procedure Initialize is - begin - Unest_Bodies.Init; - end Initialize; - -------------------------------- -- Is_Build_In_Place_Function -- -------------------------------- @@ -8477,62 +8440,44 @@ package body Exp_Ch6 is procedure Unnest_Subprograms (N : Node_Id) is - procedure Search_Unnesting_Subprograms (N : Node_Id); - -- Search for outer level procedures with nested subprograms and append - -- them to the Unnest table. + function Search_Subprograms (N : Node_Id) return Traverse_Result; + -- Tree visitor that search for outer level procedures with nested + -- subprograms and invokes Unnest_Subprogram() - ---------------------------------- - -- Search_Unnesting_Subprograms -- - ---------------------------------- - - procedure Search_Unnesting_Subprograms (N : Node_Id) is - - function Search_Subprograms (N : Node_Id) return Traverse_Result; - -- Tree visitor that search for outer level procedures with nested - -- subprograms and adds them to the Unnest table. - - ------------------------ - -- Search_Subprograms -- - ------------------------ - - function Search_Subprograms (N : Node_Id) return Traverse_Result is - begin - if Nkind_In (N, N_Subprogram_Body, - N_Subprogram_Body_Stub) - then - declare - Spec_Id : constant Entity_Id := Unique_Defining_Entity (N); - - begin - -- We are only interested in subprograms (not generic - -- subprograms), that have nested subprograms. + ------------------------ + -- Search_Subprograms -- + ------------------------ - if Is_Subprogram (Spec_Id) - and then Has_Nested_Subprogram (Spec_Id) - and then Is_Library_Level_Entity (Spec_Id) - then - Unest_Bodies.Append ((Spec_Id, N)); - end if; - end; - end if; + function Search_Subprograms (N : Node_Id) return Traverse_Result is + begin + if Nkind_In (N, N_Subprogram_Body, + N_Subprogram_Body_Stub) + then + declare + Spec_Id : constant Entity_Id := Unique_Defining_Entity (N); - return OK; - end Search_Subprograms; + begin + -- We are only interested in subprograms (not generic + -- subprograms), that have nested subprograms. - --------------- - -- Do_Search -- - --------------- + if Is_Subprogram (Spec_Id) + and then Has_Nested_Subprogram (Spec_Id) + and then Is_Library_Level_Entity (Spec_Id) + then + Unnest_Subprogram (Spec_Id, N); + end if; + end; + end if; - procedure Do_Search is new Traverse_Proc (Search_Subprograms); - -- Subtree visitor instantiation + return OK; + end Search_Subprograms; - -- Start of processing for Search_Unnesting_Subprograms + --------------- + -- Do_Search -- + --------------- - begin - if Opt.Unnest_Subprogram_Mode then - Do_Search (N); - end if; - end Search_Unnesting_Subprograms; + procedure Do_Search is new Traverse_Proc (Search_Subprograms); + -- Subtree visitor instantiation -- Start of processing for Unnest_Subprograms @@ -8541,15 +8486,7 @@ package body Exp_Ch6 is return; end if; - Search_Unnesting_Subprograms (N); - - for J in Unest_Bodies.First .. Unest_Bodies.Last loop - declare - UBJ : Unest_Entry renames Unest_Bodies.Table (J); - begin - Unnest_Subprogram (UBJ.Ent, UBJ.Bod); - end; - end loop; + Do_Search (N); end Unnest_Subprograms; end Exp_Ch6; diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 551cb1e6af1..ec859738431 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -117,9 +117,6 @@ package Exp_Ch6 is -- The returned node is the root of the procedure body which will replace -- the original function body, which is not needed for the C program. - procedure Initialize; - -- Initialize internal tables - function Is_Build_In_Place_Function (E : Entity_Id) return Boolean; -- Ada 2005 (AI-318-02): Returns True if E denotes a function, generic -- function, or access-to-function type whose result must be built in diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 4b0f1f8fd9a..b7890763224 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1728,11 +1728,7 @@ package body Exp_Util is ---------------------------------------- function Containing_Package_With_Ext_Axioms - (E : Entity_Id) return Entity_Id - is - Decl : Node_Id; - First_Ax_Parent_Scope : Entity_Id; - + (E : Entity_Id) return Entity_Id is begin -- E is the package or generic package which is externally axiomatized @@ -1745,29 +1741,35 @@ package body Exp_Util is -- If E's scope is axiomatized, E is axiomatized if Present (Scope (E)) then - First_Ax_Parent_Scope := - Containing_Package_With_Ext_Axioms (Scope (E)); - - if Present (First_Ax_Parent_Scope) then - return First_Ax_Parent_Scope; - end if; - + declare + First_Ax_Parent_Scope : constant Entity_Id := + Containing_Package_With_Ext_Axioms (Scope (E)); + begin + if Present (First_Ax_Parent_Scope) then + return First_Ax_Parent_Scope; + end if; + end; end if; -- Otherwise, if E is a package instance, it is axiomatized if the -- corresponding generic package is axiomatized. if Ekind (E) = E_Package then - if Nkind (Parent (E)) = N_Defining_Program_Unit_Name then - Decl := Parent (Parent (E)); - else - Decl := Parent (E); - end if; + declare + Par : constant Node_Id := Parent (E); + Decl : Node_Id; + begin + if Nkind (Par) = N_Defining_Program_Unit_Name then + Decl := Parent (Par); + else + Decl := Par; + end if; - if Present (Generic_Parent (Decl)) then - return - Containing_Package_With_Ext_Axioms (Generic_Parent (Decl)); - end if; + if Present (Generic_Parent (Decl)) then + return + Containing_Package_With_Ext_Axioms (Generic_Parent (Decl)); + end if; + end; end if; return Empty; diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 8ed90b0999c..1020da70779 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -90,7 +90,6 @@ begin Checks.Initialize; Sem_Warn.Initialize; Prep.Initialize; - Exp_Ch6.Initialize; if Generate_SCIL then SCIL_LL.Initialize; diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 92745ba0097..f97bcbe79dc 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2015, AdaCore -- +-- Copyright (C) 1995-2016, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1848,6 +1848,8 @@ package body System.OS_Lib is Saved_Error : File_Descriptor; Saved_Output : File_Descriptor; + Dummy_Status : Boolean; + begin -- Do not attempt to spawn if the output files could not be created @@ -1863,9 +1865,8 @@ package body System.OS_Lib is Saved_Error := Dup (Standerr); Dup2 (Stderr_FD, Standerr); - -- Spawn the program - - Result := Non_Blocking_Spawn (Program_Name, Args); + Set_Close_On_Exec (Saved_Output, True, Dummy_Status); + Set_Close_On_Exec (Saved_Error, True, Dummy_Status); -- Close the files just created for the output, as the file descriptors -- cannot be used anywhere, being local values. It is safe to do that, @@ -1875,6 +1876,10 @@ package body System.OS_Lib is Close (Stdout_FD); Close (Stderr_FD); + -- Spawn the program + + Result := Non_Blocking_Spawn (Program_Name, Args); + -- Restore the standard output and error Dup2 (Saved_Output, Standout); diff --git a/gcc/ada/set_targ.adb b/gcc/ada/set_targ.adb index e83ccb41c4a..1020d5c1240 100755 --- a/gcc/ada/set_targ.adb +++ b/gcc/ada/set_targ.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2013-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 2013-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -698,6 +698,8 @@ package body Set_Targ is Buflen := Read (File_Desc, Buffer'Address, Buffer'Length); + Close (File_Desc); + if Buflen = Buffer'Length then Fail ("file is too long: " & File_Name); end if; -- 2.30.2