Commit 9c5719f6 by Arnaud Charlet

[multiple changes]

2017-09-08  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_util.adb (NCT_Tables_In_Use): Move to library level from...
	(New_Copy_Tree): ...there.  Reset the hash tables only if they
	were used in the previous invocation.
	* s-htable.adb: Fix typo.

2017-09-08  Bob Duff  <duff@adacore.com>

	* a-ssicst.adb (Open): Set File.Last_Op to the appropriate value.

2017-09-08  Arnaud Charlet  <charlet@adacore.com>

	* sem_aggr.adb: minor style fix.

2017-09-08  Bob Duff  <duff@adacore.com>

	* sprint.adb (Write_Corresponding_Source): Ignore if there is
	no current source file.
	(Write_Name_With_Col_Check, Write_Name_With_Col_Check_Sloc):
	Print something helpful in case N is invalid.
	* sprint.ads: Minor comment fix.

From-SVN: r251897
parent 410abeeb
2017-09-08 Eric Botcazou <ebotcazou@adacore.com> 2017-09-08 Eric Botcazou <ebotcazou@adacore.com>
* sem_util.adb (NCT_Tables_In_Use): Move to library level from...
(New_Copy_Tree): ...there. Reset the hash tables only if they
were used in the previous invocation.
* s-htable.adb: Fix typo.
2017-09-08 Bob Duff <duff@adacore.com>
* a-ssicst.adb (Open): Set File.Last_Op to the appropriate value.
2017-09-08 Arnaud Charlet <charlet@adacore.com>
* sem_aggr.adb: minor style fix.
2017-09-08 Bob Duff <duff@adacore.com>
* sprint.adb (Write_Corresponding_Source): Ignore if there is
no current source file.
(Write_Name_With_Col_Check, Write_Name_With_Col_Check_Sloc):
Print something helpful in case N is invalid.
* sprint.ads: Minor comment fix.
2017-09-08 Eric Botcazou <ebotcazou@adacore.com>
* exp_aggr.adb: (Aggr_Assignment_OK_For_Backend): Add early return for * exp_aggr.adb: (Aggr_Assignment_OK_For_Backend): Add early return for
access types. access types.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -79,6 +79,9 @@ package body Ada.Streams.Stream_IO.C_Streams is ...@@ -79,6 +79,9 @@ package body Ada.Streams.Stream_IO.C_Streams is
Creat => False, Creat => False,
Text => False, Text => False,
C_Stream => C_Stream); C_Stream => C_Stream);
File.Last_Op := (if Mode = Out_File then Op_Write else Op_Read);
-- See comment in Ada.Streams.Stream_IO.Open for the reason
end Open; end Open;
end Ada.Streams.Stream_IO.C_Streams; end Ada.Streams.Stream_IO.C_Streams;
...@@ -171,7 +171,7 @@ package body System.HTable is ...@@ -171,7 +171,7 @@ package body System.HTable is
procedure Reset is procedure Reset is
begin begin
-- Use an aggregate for efficient reasons -- Use an aggregate for efficiency reasons
Table := (others => Null_Ptr); Table := (others => Null_Ptr);
end Reset; end Reset;
......
...@@ -4048,9 +4048,7 @@ package body Sem_Aggr is ...@@ -4048,9 +4048,7 @@ package body Sem_Aggr is
end if; end if;
end Rewrite_Bound; end Rewrite_Bound;
--------------------- -- Local variables
-- Local Variables --
---------------------
Low, High : Node_Id; Low, High : Node_Id;
Disc : Entity_Id; Disc : Entity_Id;
......
...@@ -17316,6 +17316,13 @@ package body Sem_Util is ...@@ -17316,6 +17316,13 @@ package body Sem_Util is
function NCT_Table_Hash (Key : Node_Or_Entity_Id) return NCT_Table_Index; function NCT_Table_Hash (Key : Node_Or_Entity_Id) return NCT_Table_Index;
-- Obtain the hash value of node or entity Key -- Obtain the hash value of node or entity Key
NCT_Tables_In_Use : Boolean := False;
-- This flag keeps track of whether the two tables NCT_New_Entities and
-- NCT_Pending_Itypes are in use. The flag is part of an optimization
-- where certain operations are not performed if the tables are not in
-- use. This saves up to 8% of the entire compilation time spent in the
-- front end.
-------------------- --------------------
-- NCT_Table_Hash -- -- NCT_Table_Hash --
-------------------- --------------------
...@@ -17389,13 +17396,6 @@ package body Sem_Util is ...@@ -17389,13 +17396,6 @@ package body Sem_Util is
-- This counter keeps track of how many scoping constructs appear within -- This counter keeps track of how many scoping constructs appear within
-- an N_Expression_With_Actions node. -- an N_Expression_With_Actions node.
NCT_Tables_In_Use : Boolean := False;
-- This flag keeps track of whether the two tables NCT_New_Entities and
-- NCT_Pending_Itypes are in use. The flag is part of an optimization
-- where certain operations are not performed if the tables are not in
-- use. This saves up to 8% of the entire compilation time spent in the
-- front end.
procedure Add_New_Entity (Old_Id : Entity_Id; New_Id : Entity_Id); procedure Add_New_Entity (Old_Id : Entity_Id; New_Id : Entity_Id);
pragma Inline (Add_New_Entity); pragma Inline (Add_New_Entity);
-- Add an entry in the NCT_New_Entities table which maps key Old_Id to -- Add an entry in the NCT_New_Entities table which maps key Old_Id to
...@@ -18744,8 +18744,12 @@ package body Sem_Util is ...@@ -18744,8 +18744,12 @@ package body Sem_Util is
-- NCT_Pending_Itypes in case a previous call to New_Copy_Tree left some -- NCT_Pending_Itypes in case a previous call to New_Copy_Tree left some
-- data inside. -- data inside.
if NCT_Tables_In_Use then
NCT_Tables_In_Use := False;
NCT_New_Entities.Reset; NCT_New_Entities.Reset;
NCT_Pending_Itypes.Reset; NCT_Pending_Itypes.Reset;
end if;
-- Populate tables NCT_New_Entities and NCT_Pending_Itypes with data -- Populate tables NCT_New_Entities and NCT_Pending_Itypes with data
-- supplied by a linear entity map. The tables offer faster access to -- supplied by a linear entity map. The tables offer faster access to
......
...@@ -3749,9 +3749,13 @@ package body Sprint is ...@@ -3749,9 +3749,13 @@ package body Sprint is
Src : Source_Buffer_Ptr; Src : Source_Buffer_Ptr;
begin begin
-- Ignore if not in dump source text mode, or if in freeze actions -- Ignore if there is no current source file, or we're not in dump
-- source text mode, or if in freeze actions.
if Dump_Source_Text and then Freeze_Indent = 0 then if Current_Source_File /= No_Source_File
and then Dump_Source_Text
and then Freeze_Indent = 0
then
-- Ignore null string -- Ignore null string
...@@ -4504,6 +4508,15 @@ package body Sprint is ...@@ -4504,6 +4508,15 @@ package body Sprint is
L : Natural; L : Natural;
begin begin
-- Avoid crashing on invalid Name_Ids
if not Is_Valid_Name (N) then
Write_Str ("<invalid name ");
Write_Int (Int (N));
Write_Str (">");
return;
end if;
Get_Name_String (N); Get_Name_String (N);
-- Deal with -gnatdI which replaces any sequence Cnnnb where C is an -- Deal with -gnatdI which replaces any sequence Cnnnb where C is an
...@@ -4552,6 +4565,15 @@ package body Sprint is ...@@ -4552,6 +4565,15 @@ package body Sprint is
procedure Write_Name_With_Col_Check_Sloc (N : Name_Id) is procedure Write_Name_With_Col_Check_Sloc (N : Name_Id) is
begin begin
-- Avoid crashing on invalid Name_Ids
if not Is_Valid_Name (N) then
Write_Str ("<invalid name ");
Write_Int (Int (N));
Write_Str (">");
return;
end if;
Get_Name_String (N); Get_Name_String (N);
Write_Str_With_Col_Check_Sloc (Name_Buffer (1 .. Name_Len)); Write_Str_With_Col_Check_Sloc (Name_Buffer (1 .. Name_Len));
end Write_Name_With_Col_Check_Sloc; end Write_Name_With_Col_Check_Sloc;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -42,7 +42,7 @@ package Sprint is ...@@ -42,7 +42,7 @@ package Sprint is
-- When the generated tree is printed, it contains constructs that are not -- When the generated tree is printed, it contains constructs that are not
-- pure Ada. For convenience, syntactic extensions to Ada have been defined -- pure Ada. For convenience, syntactic extensions to Ada have been defined
-- purely for the purposes of this printout (they are not recognized by the -- purely for the purposes of this printout (they are not recognized by the
-- parser) -- parser).
-- Could use more documentation for all of these ??? -- Could use more documentation for all of these ???
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment