[multiple changes]
2016-04-21 Javier Miranda <miranda@adacore.com> * 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 <charlet@adacore.com> * 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
This commit is contained in:
parent
2e9bd65737
commit
e379beb56f
|
@ -1,3 +1,21 @@
|
|||
2016-04-21 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* 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 <charlet@adacore.com>
|
||||
|
||||
* 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 <duff@adacore.com>
|
||||
|
||||
* s-os_lib.ads: Minor comment fix.
|
||||
|
|
|
@ -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,19 +8440,9 @@ 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.
|
||||
|
||||
----------------------------------
|
||||
-- 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.
|
||||
-- subprograms and invokes Unnest_Subprogram()
|
||||
|
||||
------------------------
|
||||
-- Search_Subprograms --
|
||||
|
@ -8511,7 +8464,7 @@ package body Exp_Ch6 is
|
|||
and then Has_Nested_Subprogram (Spec_Id)
|
||||
and then Is_Library_Level_Entity (Spec_Id)
|
||||
then
|
||||
Unest_Bodies.Append ((Spec_Id, N));
|
||||
Unnest_Subprogram (Spec_Id, N);
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
@ -8526,14 +8479,6 @@ package body Exp_Ch6 is
|
|||
procedure Do_Search is new Traverse_Proc (Search_Subprograms);
|
||||
-- Subtree visitor instantiation
|
||||
|
||||
-- Start of processing for Search_Unnesting_Subprograms
|
||||
|
||||
begin
|
||||
if Opt.Unnest_Subprogram_Mode then
|
||||
Do_Search (N);
|
||||
end if;
|
||||
end Search_Unnesting_Subprograms;
|
||||
|
||||
-- Start of processing for Unnest_Subprograms
|
||||
|
||||
begin
|
||||
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 :=
|
||||
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));
|
||||
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 := Parent (E);
|
||||
Decl := Par;
|
||||
end if;
|
||||
|
||||
if Present (Generic_Parent (Decl)) then
|
||||
return
|
||||
Containing_Package_With_Ext_Axioms (Generic_Parent (Decl));
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
return Empty;
|
||||
|
|
|
@ -90,7 +90,6 @@ begin
|
|||
Checks.Initialize;
|
||||
Sem_Warn.Initialize;
|
||||
Prep.Initialize;
|
||||
Exp_Ch6.Initialize;
|
||||
|
||||
if Generate_SCIL then
|
||||
SCIL_LL.Initialize;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue