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>
* 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
access types.
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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
Creat => False,
Text => False,
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 Ada.Streams.Stream_IO.C_Streams;
......@@ -171,7 +171,7 @@ package body System.HTable is
procedure Reset is
begin
-- Use an aggregate for efficient reasons
-- Use an aggregate for efficiency reasons
Table := (others => Null_Ptr);
end Reset;
......
......@@ -4048,9 +4048,7 @@ package body Sem_Aggr is
end if;
end Rewrite_Bound;
---------------------
-- Local Variables --
---------------------
-- Local variables
Low, High : Node_Id;
Disc : Entity_Id;
......
......@@ -17316,6 +17316,13 @@ package body Sem_Util is
function NCT_Table_Hash (Key : Node_Or_Entity_Id) return NCT_Table_Index;
-- 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 --
--------------------
......@@ -17389,13 +17396,6 @@ package body Sem_Util is
-- This counter keeps track of how many scoping constructs appear within
-- 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);
pragma Inline (Add_New_Entity);
-- Add an entry in the NCT_New_Entities table which maps key Old_Id to
......@@ -18744,8 +18744,12 @@ package body Sem_Util is
-- NCT_Pending_Itypes in case a previous call to New_Copy_Tree left some
-- data inside.
NCT_New_Entities.Reset;
NCT_Pending_Itypes.Reset;
if NCT_Tables_In_Use then
NCT_Tables_In_Use := False;
NCT_New_Entities.Reset;
NCT_Pending_Itypes.Reset;
end if;
-- Populate tables NCT_New_Entities and NCT_Pending_Itypes with data
-- supplied by a linear entity map. The tables offer faster access to
......
......@@ -3749,9 +3749,13 @@ package body Sprint is
Src : Source_Buffer_Ptr;
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
......@@ -4504,6 +4508,15 @@ package body Sprint is
L : Natural;
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);
-- Deal with -gnatdI which replaces any sequence Cnnnb where C is an
......@@ -4552,6 +4565,15 @@ package body Sprint is
procedure Write_Name_With_Col_Check_Sloc (N : Name_Id) is
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);
Write_Str_With_Col_Check_Sloc (Name_Buffer (1 .. Name_Len));
end Write_Name_With_Col_Check_Sloc;
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -42,7 +42,7 @@ package Sprint is
-- When the generated tree is printed, it contains constructs that are not
-- pure Ada. For convenience, syntactic extensions to Ada have been defined
-- purely for the purposes of this printout (they are not recognized by the
-- parser)
-- parser).
-- 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