[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:
parent
cfbdc34f25
commit
7504523eca
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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,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,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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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 --
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue