OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2016-10-12  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb (Expand_N_Delay_Relative_Statement): Add support
	for a secondary procedure in case of missing Ada.Calendar.Delays
	* rtsfind.ads (RTU_Id): Add System_Relative_Delays.
	(RE_Id): Add RO_RD_Delay_For.
	* rtsfind.adb (Output_Entity_Name): Handle correctly units RO_XX.
	* s-rident.ads: Remove No_Relative_Delays
	restriction for GNAT_Extended_Ravenscar.

2016-10-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_elab.adb (Within_Initial_Condition):  When deternining
	the context of the expression, use the original node if it is
	a pragma, because Check pragmas are rewritten as conditionals
	when assertions are not enabled.

2016-10-12  Bob Duff  <duff@adacore.com>

	* spitbol_table.ads, spitbol_table.adb (Adjust, Finalize): Add
	"overriding".

2016-10-12  Bob Duff  <duff@adacore.com>

	* a-strunb-shared.ads, a-strunb-shared.adb (Finalize):
	Make sure Finalize is idempotent.
	(Unreference): Check for
	Empty_Shared_String, in case the reference count of the empty
	string wraps around.
	Also add "not null" in various places that can't be null.

2016-10-12  Jerome Lambourg  <lambourg@adacore.com>

	* init.c: Fix sigtramp with the x86_64-vx7-vxsim target on
	Windows host.

2016-10-12  Vadim Godunko  <godunko@adacore.com>

	* s-os_lib.ads (Is_Owner_Readable_File): Renamed from
	Is_Readable_File.
	(Is_Owner_Writable_File): Renamed from Is_Writable_File.
	(Is_Readable_File): Renames Is_Read_Accessible_File.
	(Is_Writable_File): Renames Is_Write_Accessible_File.

From-SVN: r241035
This commit is contained in:
Arnaud Charlet 2016-10-12 14:27:25 +02:00
parent cfbdc34f25
commit 7504523eca
13 changed files with 136 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
gcc/ada/ChangeLog
View File

@ -1,3 +1,47 @@
2016-10-12 Tristan Gingold <gingold@adacore.com>
* exp_ch9.adb (Expand_N_Delay_Relative_Statement): Add support
for a secondary procedure in case of missing Ada.Calendar.Delays
* rtsfind.ads (RTU_Id): Add System_Relative_Delays.
(RE_Id): Add RO_RD_Delay_For.
* rtsfind.adb (Output_Entity_Name): Handle correctly units RO_XX.
* s-rident.ads: Remove No_Relative_Delays
restriction for GNAT_Extended_Ravenscar.
2016-10-12 Ed Schonberg <schonberg@adacore.com>
* sem_elab.adb (Within_Initial_Condition): When deternining
the context of the expression, use the original node if it is
a pragma, because Check pragmas are rewritten as conditionals
when assertions are not enabled.
2016-10-12 Bob Duff <duff@adacore.com>
* spitbol_table.ads, spitbol_table.adb (Adjust, Finalize): Add
"overriding".
2016-10-12 Bob Duff <duff@adacore.com>
* a-strunb-shared.ads, a-strunb-shared.adb (Finalize):
Make sure Finalize is idempotent.
(Unreference): Check for
Empty_Shared_String, in case the reference count of the empty
string wraps around.
Also add "not null" in various places that can't be null.
2016-10-12 Jerome Lambourg <lambourg@adacore.com>
* init.c: Fix sigtramp with the x86_64-vx7-vxsim target on
Windows host.
2016-10-12 Vadim Godunko <godunko@adacore.com>
* s-os_lib.ads (Is_Owner_Readable_File): Renamed from
Is_Readable_File.
(Is_Owner_Writable_File): Renamed from Is_Writable_File.
(Is_Readable_File): Renames Is_Read_Accessible_File.
(Is_Writable_File): Renames Is_Write_Accessible_File.
2016-10-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Check_Formal_Package_Instance): Skip an internal

20
gcc/ada/a-strunb-shared.adb
View File

@ -499,7 +499,9 @@ package body Ada.Strings.Unbounded is
-- Allocate --
--------------
function Allocate (Max_Length : Natural) return Shared_String_Access is
function Allocate
(Max_Length : Natural) return not null Shared_String_Access
is
begin
-- Empty string requested, return shared empty string
@ -622,7 +624,7 @@ package body Ada.Strings.Unbounded is
-------------------
function Can_Be_Reused
(Item : Shared_String_Access;
(Item : not null Shared_String_Access;
Length : Natural) return Boolean is
begin
return
@ -785,10 +787,9 @@ package body Ada.Strings.Unbounded is
--------------
procedure Finalize (Object : in out Unbounded_String) is
SR : constant Shared_String_Access := Object.Reference;
SR : constant not null Shared_String_Access := Object.Reference;
begin
if SR /= null then
if SR /= Null_Unbounded_String.Reference then
-- The same controlled object can be finalized several times for
-- some reason. As per 7.6.1(24) this should have no ill effect,
@ -2101,11 +2102,12 @@ package body Ada.Strings.Unbounded is
begin
if System.Atomic_Counters.Decrement (Aux.Counter) then
-- Reference counter of Empty_Shared_String must never reach zero
-- Reference counter of Empty_Shared_String should never reach
-- zero. We check here in case it wraps around.
pragma Assert (Aux /= Empty_Shared_String'Access);
Free (Aux);
if Aux /= Empty_Shared_String'Access then
Free (Aux);
end if;
end if;
end Unreference;

9
gcc/ada/a-strunb-shared.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@ -449,14 +449,15 @@ private
-- Decrement reference counter, deallocate Item when counter goes to zero
function Can_Be_Reused
(Item : Shared_String_Access;
(Item : not null Shared_String_Access;
Length : Natural) return Boolean;
-- Returns True if Shared_String can be reused. There are two criteria when
-- Shared_String can be reused: its reference counter must be one (thus
-- Shared_String is owned exclusively) and its size is sufficient to
-- store string with specified length effectively.
function Allocate (Max_Length : Natural) return Shared_String_Access;
function Allocate
(Max_Length : Natural) return not null Shared_String_Access;
-- Allocates new Shared_String with at least specified maximum length.
-- Actual maximum length of the allocated Shared_String can be slightly
-- greater. Returns reference to Empty_Shared_String when requested length
@ -469,7 +470,7 @@ private
-- This renames are here only to be used in the pragma Stream_Convert
type Unbounded_String is new AF.Controlled with record
Reference : Shared_String_Access := Empty_Shared_String'Access;
Reference : not null Shared_String_Access := Empty_Shared_String'Access;
end record;
pragma Stream_Convert (Unbounded_String, To_Unbounded, To_String);

16
gcc/ada/exp_ch9.adb
View File

@ -8388,11 +8388,23 @@ package body Exp_Ch9 is
-- simple delays imposed by the use of Protected Objects.
procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Loc : constant Source_Ptr := Sloc (N);
Proc : Entity_Id;
begin
if RTE_Available (RO_RD_Delay_For) then
-- Try to use System.Relative_Delays.Delay_For only if available.
-- This is the implementation used on restricted platforms when
-- Ada.Calendar is not available.
Proc := RTE (RO_RD_Delay_For);
else
-- Otherwise, use Ada.Calendar.Delays.Delay_For and emit an error
-- message if not available.
Proc := RTE (RO_CA_Delay_For);
end if;
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RO_CA_Delay_For), Loc),
Name => New_Occurrence_Of (Proc, Loc),
Parameter_Associations => New_List (Expression (N))));
Analyze (N);
end Expand_N_Delay_Relative_Statement;

6
gcc/ada/g-spitbo.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2012, AdaCore --
-- Copyright (C) 1998-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- --
@ -333,7 +333,7 @@ package body GNAT.Spitbol is
-- Adjust --
------------
procedure Adjust (Object : in out Table) is
overriding procedure Adjust (Object : in out Table) is
Ptr1 : Hash_Element_Ptr;
Ptr2 : Hash_Element_Ptr;
@ -555,7 +555,7 @@ package body GNAT.Spitbol is
-- Finalize --
--------------
procedure Finalize (Object : in out Table) is
overriding procedure Finalize (Object : in out Table) is
Ptr1 : Hash_Element_Ptr;
Ptr2 : Hash_Element_Ptr;

6
gcc/ada/g-spitbo.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2012, AdaCore --
-- Copyright (C) 1997-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- --
@ -379,12 +379,12 @@ package GNAT.Spitbol is
pragma Finalize_Storage_Only (Table);
procedure Adjust (Object : in out Table);
overriding procedure Adjust (Object : in out Table);
-- The Adjust procedure does a deep copy of the table structure
-- so that the effect of assignment is, like other assignments
-- in Ada, value-oriented.
procedure Finalize (Object : in out Table);
overriding procedure Finalize (Object : in out Table);
-- This is the finalization routine that ensures that all storage
-- associated with a table is properly released when a table object
-- is abandoned and finalized.

2
gcc/ada/init.c
View File

@ -2109,7 +2109,7 @@ __gnat_install_handler (void)
if ((strncmp (model, "Linux", 5) == 0)
|| (strncmp (model, "Windows", 7) == 0)
|| (strncmp (model, "SIMLINUX", 8) == 0) /* vx7 */
|| (strncmp (model, "SIMWINDOWS", 10) == 0)) /* ditto */
|| (strncmp (model, "SIMNT", 5) == 0)) /* ditto */
__gnat_set_is_vxsim (TRUE);
}
#endif

16
gcc/ada/rtsfind.adb
View File

@ -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- --
@ -1144,6 +1144,9 @@ package body Rtsfind is
-- M (1 .. P) is current message to be output
RE_Image : constant String := RE_Id'Image (Id);
S : Natural;
-- RE_Image (S .. RE_Image'Last) is the name of the entity without the
-- "RE_" or "RO_XX_" prefix.
begin
if Id = RE_Null then
@ -1168,8 +1171,15 @@ package body Rtsfind is
-- Add entity name and closing quote to message
Name_Len := RE_Image'Length - 3;
Name_Buffer (1 .. Name_Len) := RE_Image (4 .. RE_Image'Length);
if RE_Image (2) = 'E' then
-- Strip "RE"
S := 4;
else
-- Strip "RO_XX"
S := 7;
end if;
Name_Len := RE_Image'Length - S + 1;
Name_Buffer (1 .. Name_Len) := RE_Image (S .. RE_Image'Last);
Set_Casing (Mixed_Case);
M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len);
P := P + Name_Len;

7
gcc/ada/rtsfind.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- 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- --
@ -349,6 +349,7 @@ package Rtsfind is
System_Pool_Empty,
System_Pool_Local,
System_Pool_Size,
System_Relative_Delays,
System_RPC,
System_Scalar_Values,
System_Secondary_Stack,
@ -1403,6 +1404,8 @@ package Rtsfind is
RE_Tk_Objref, -- System.Partition_Interface
RE_Tk_Union, -- System.Partition_Interface
RO_RD_Delay_For, -- System.Relative_Delays
RE_IS_Is1, -- System.Scalar_Values
RE_IS_Is2, -- System.Scalar_Values
RE_IS_Is4, -- System.Scalar_Values
@ -2635,6 +2638,8 @@ package Rtsfind is
RE_Stack_Bounded_Pool => System_Pool_Size,
RO_RD_Delay_For => System_Relative_Delays,
RE_Do_Apc => System_RPC,
RE_Do_Rpc => System_RPC,
RE_Params_Stream_Type => System_RPC,

32
gcc/ada/s-os_lib.adb
View File

@ -1510,24 +1510,24 @@ package body System.OS_Lib is
return Is_Read_Accessible_File (F_Name'Address) /= 0;
end Is_Read_Accessible_File;
----------------------
-- Is_Readable_File --
----------------------
----------------------------
-- Is_Owner_Readable_File --
----------------------------
function Is_Readable_File (Name : C_File_Name) return Boolean is
function Is_Owner_Readable_File (Name : C_File_Name) return Boolean is
function Is_Readable_File (Name : Address) return Integer;
pragma Import (C, Is_Readable_File, "__gnat_is_readable_file");
begin
return Is_Readable_File (Name) /= 0;
end Is_Readable_File;
end Is_Owner_Readable_File;
function Is_Readable_File (Name : String) return Boolean is
function Is_Owner_Readable_File (Name : String) return Boolean is
F_Name : String (1 .. Name'Length + 1);
begin
F_Name (1 .. Name'Length) := Name;
F_Name (F_Name'Last) := ASCII.NUL;
return Is_Readable_File (F_Name'Address);
end Is_Readable_File;
return Is_Owner_Readable_File (F_Name'Address);
end Is_Owner_Readable_File;
------------------------
-- Is_Executable_File --
@ -1601,24 +1601,24 @@ package body System.OS_Lib is
return Is_Write_Accessible_File (F_Name'Address) /= 0;
end Is_Write_Accessible_File;
----------------------
-- Is_Writable_File --
----------------------
----------------------------
-- Is_Owner_Writable_File --
----------------------------
function Is_Writable_File (Name : C_File_Name) return Boolean is
function Is_Owner_Writable_File (Name : C_File_Name) return Boolean is
function Is_Writable_File (Name : Address) return Integer;
pragma Import (C, Is_Writable_File, "__gnat_is_writable_file");
begin
return Is_Writable_File (Name) /= 0;
end Is_Writable_File;
end Is_Owner_Writable_File;
function Is_Writable_File (Name : String) return Boolean is
function Is_Owner_Writable_File (Name : String) return Boolean is
F_Name : String (1 .. Name'Length + 1);
begin
F_Name (1 .. Name'Length) := Name;
F_Name (F_Name'Last) := ASCII.NUL;
return Is_Writable_File (F_Name'Address);
end Is_Writable_File;
return Is_Owner_Writable_File (F_Name'Address);
end Is_Owner_Writable_File;
----------
-- Kill --

16
gcc/ada/s-os_lib.ads
View File

@ -425,7 +425,7 @@ package System.OS_Lib is
-- not actually be readable due to some other process having exclusive
-- access.
function Is_Readable_File (Name : String) return Boolean;
function Is_Owner_Readable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is readable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
@ -449,7 +449,7 @@ package System.OS_Lib is
-- contains the name of the file to which it is linked. Symbolic links may
-- span file systems and may refer to directories.
function Is_Writable_File (Name : String) return Boolean;
function Is_Owner_Writable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is writable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
@ -465,6 +465,14 @@ package System.OS_Lib is
-- Determines if the given string, Name, is the name of an existing file
-- that is writable. Returns True if so, False otherwise.
function Is_Readable_File (Name : String) return Boolean
renames Is_Read_Accessible_File;
function Is_Writable_File (Name : String) return Boolean
renames Is_Write_Accessible_File;
-- These subprograms provided for backward compatibility and should not be
-- used. Use Is_Owner_Readable_File/Is_Owner_Writable_File or
-- Is_Read_Accessible_File/Is_Write_Accessible_File instead.
function Locate_Exec_On_Path (Exec_Name : String) return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the
-- directories listed in the environment Path. If the Exec_Name does not
@ -683,10 +691,10 @@ package System.OS_Lib is
function Is_Directory (Name : C_File_Name) return Boolean;
function Is_Executable_File (Name : C_File_Name) return Boolean;
function Is_Readable_File (Name : C_File_Name) return Boolean;
function Is_Owner_Readable_File (Name : C_File_Name) return Boolean;
function Is_Regular_File (Name : C_File_Name) return Boolean;
function Is_Symbolic_Link (Name : C_File_Name) return Boolean;
function Is_Writable_File (Name : C_File_Name) return Boolean;
function Is_Owner_Writable_File (Name : C_File_Name) return Boolean;
function Locate_Regular_File
(File_Name : C_File_Name;

1
gcc/ada/s-rident.ads
View File

@ -574,7 +574,6 @@ package System.Rident is
No_Implicit_Protected_Object_Allocations
=> True,
No_Local_Timing_Events => True,
No_Relative_Delay => True,
No_Select_Statements => True,
No_Specific_Termination_Handlers => True,
No_Task_Termination => True,

8
gcc/ada/sem_elab.adb
View File

@ -2126,6 +2126,14 @@ package body Sem_Elab is
end if;
Par := Parent (Par);
-- If assertions are not enabled, the check pragma is rewritten
-- as an if_statement in sem_prag, to generate various warnings
-- on boolean expressions. Retrieve the original pragma.
if Nkind (Original_Node (Par)) = N_Pragma then
Par := Original_Node (Par);
end if;
end loop;
return False;