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

[multiple changes] 

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* s-taskin.ads, s-traces.ads: Minor reformatting.
	* exp_util.adb: Minor typo fix.

2015-01-06  Vincent Celier  <celier@adacore.com>

	* gnatls.adb (Search_RTS): Invoke Initialize_Default_Project_Path
	with the runtime name.
	* prj-env.adb (Initialize_Default_Project_Path): When both
	Target_Name and Runtime_Name are not empty string, add to the
	project path the two directories .../lib/gnat and .../share/gpr
	related to the runtime.
	* prj-env.ads (Initialize_Default_Project_Path): New String
	parameter Runtime_Name, defaulted to the empty string.

2015-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* frontend.adb: Guard against the case where a configuration
	pragma may be split into multiple pragmas and the original
	rewritten as a null statement.
	* sem_prag.adb (Analyze_Pragma): Insert a brand new Check_Policy
	pragma using Insert_Before rather than Insert_Action. This
	takes care of the configuration pragma case where Insert_Action
	would fail.

2015-01-06  Bob Duff  <duff@adacore.com>

	* a-coboho.ads (Element_Access): Add "pragma
	No_Strict_Aliasing (Element_Access);". This is needed because
	we are unchecked-converting from Address to Element_Access.
	* a-cofove.ads, a-cofove.adb (Elems,Elemsc): Fix bounds of the
	result to be 1.

2015-01-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Actuals): Remove the
	restriction which prohibits volatile actual parameters with
	enabled external propery Async_Writers to act appear in procedure
	calls where the corresponding formal is of mode OUT.

From-SVN: r219222
This commit is contained in:
Arnaud Charlet 2015-01-06 09:57:50 +01:00
parent d3d514a953
commit de4ac03852
13 changed files with 180 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
gcc/ada/ChangeLog
View File

@ -1,3 +1,44 @@
2015-01-06 Robert Dewar <dewar@adacore.com>
* s-taskin.ads, s-traces.ads: Minor reformatting.
* exp_util.adb: Minor typo fix.
2015-01-06 Vincent Celier <celier@adacore.com>
* gnatls.adb (Search_RTS): Invoke Initialize_Default_Project_Path
with the runtime name.
* prj-env.adb (Initialize_Default_Project_Path): When both
Target_Name and Runtime_Name are not empty string, add to the
project path the two directories .../lib/gnat and .../share/gpr
related to the runtime.
* prj-env.ads (Initialize_Default_Project_Path): New String
parameter Runtime_Name, defaulted to the empty string.
2015-01-06 Hristian Kirtchev <kirtchev@adacore.com>
* frontend.adb: Guard against the case where a configuration
pragma may be split into multiple pragmas and the original
rewritten as a null statement.
* sem_prag.adb (Analyze_Pragma): Insert a brand new Check_Policy
pragma using Insert_Before rather than Insert_Action. This
takes care of the configuration pragma case where Insert_Action
would fail.
2015-01-06 Bob Duff <duff@adacore.com>
* a-coboho.ads (Element_Access): Add "pragma
No_Strict_Aliasing (Element_Access);". This is needed because
we are unchecked-converting from Address to Element_Access.
* a-cofove.ads, a-cofove.adb (Elems,Elemsc): Fix bounds of the
result to be 1.
2015-01-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Resolve_Actuals): Remove the
restriction which prohibits volatile actual parameters with
enabled external propery Async_Writers to act appear in procedure
calls where the corresponding formal is of mode OUT.
2015-01-05 Jakub Jelinek <jakub@redhat.com>
* gnat_ugn.texi: Bump @copying's copyright year.

5
gcc/ada/a-coboho.ads
View File

@ -99,4 +99,9 @@ private
-- the 'Address of an array points to the first element, thus losing the
-- bounds.
pragma No_Strict_Aliasing (Element_Access);
-- Needed because we are unchecked-converting from Address to
-- Element_Access (see package body), which is a violation of the
-- normal aliasing rules enforced by gcc.
end Ada.Containers.Bounded_Holders;

9
gcc/ada/a-cofove.adb
View File

@ -45,10 +45,9 @@ is
procedure Free is
new Ada.Unchecked_Deallocation (Elements_Array, Elements_Array_Ptr);
type Maximal_Array_Ptr is access all Elements_Array (Capacity_Range)
type Maximal_Array_Ptr is access all Elements_Array (Array_Index)
with Storage_Size => 0;
type Maximal_Array_Ptr_Const is access constant
Elements_Array (Capacity_Range)
type Maximal_Array_Ptr_Const is access constant Elements_Array (Array_Index)
with Storage_Size => 0;
function Elems (Container : in out Vector) return Maximal_Array_Ptr;
@ -111,7 +110,7 @@ is
Reserve_Capacity
(Container,
Capacity_Range'Max (Capacity (Container) * Growth_Factor,
Capacity_Range (New_Length)));
Capacity_Range (New_Length)));
end if;
if Container.Last = Index_Type'Last then
@ -381,7 +380,7 @@ is
is
procedure Sort is
new Generic_Array_Sort
(Index_Type => Capacity_Range,
(Index_Type => Array_Index,
Element_Type => Element_Type,
Array_Type => Elements_Array,
"<" => "<");

3
gcc/ada/a-cofove.ads
View File

@ -246,7 +246,8 @@ private
pragma Inline (Replace_Element);
pragma Inline (Contains);
type Elements_Array is array (Capacity_Range range <>) of Element_Type;
subtype Array_Index is Capacity_Range range 1 .. Capacity_Range'Last;
type Elements_Array is array (Array_Index range <>) of Element_Type;
function "=" (L, R : Elements_Array) return Boolean is abstract;
type Elements_Array_Ptr is access all Elements_Array;

2
gcc/ada/exp_util.adb
View File

@ -2961,7 +2961,7 @@ package body Exp_Util is
begin
-- If parser detected no address clause for the identifier in question,
-- then then answer is a quick NO, without the need for a search.
-- then the answer is a quick NO, without the need for a search.
if not Get_Name_Table_Boolean (Chars (Id)) then
return Empty;

17
gcc/ada/frontend.adb
View File

@ -339,10 +339,10 @@ begin
and then not Fatal_Error (Main_Unit)
then
-- Pragmas that require some semantic activity, such as
-- Interrupt_State, cannot be processed until the main unit
-- is installed, because they require a compilation unit on
-- which to attach with_clauses, etc. So analyze them now.
-- Pragmas that require some semantic activity, such as Interrupt_State,
-- cannot be processed until the main unit is installed, because they
-- require a compilation unit on which to attach with_clauses, etc. So
-- analyze them now.
declare
Prag : Node_Id;
@ -350,7 +350,14 @@ begin
begin
Prag := First (Config_Pragmas);
while Present (Prag) loop
if Delay_Config_Pragma_Analyze (Prag) then
-- Guard against the case where a configuration pragma may be
-- split into multiple pragmas and the original rewritten as a
-- null statement.
if Nkind (Prag) = N_Pragma
and then Delay_Config_Pragma_Analyze (Prag)
then
Analyze_Pragma (Prag);
end if;

8
gcc/ada/gnatls.adb
View File

@ -1225,6 +1225,10 @@ procedure Gnatls is
if Src_Path /= null and then Lib_Path /= null then
Add_Search_Dirs (Src_Path, Include);
Add_Search_Dirs (Lib_Path, Objects);
Initialize_Default_Project_Path
(Prj_Path,
Target_Name => Sdefault.Target_Name.all,
Runtime_Name => Name);
return;
end if;
@ -1237,7 +1241,9 @@ procedure Gnatls is
-- Try to find the RTS on the project path. First setup the project path
Initialize_Default_Project_Path
(Prj_Path, Target_Name => Sdefault.Target_Name.all);
(Prj_Path,
Target_Name => Sdefault.Target_Name.all,
Runtime_Name => Name);
Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);

127
gcc/ada/prj-env.adb
View File

@ -1873,8 +1873,9 @@ package body Prj.Env is
-------------------------------------
procedure Initialize_Default_Project_Path
(Self : in out Project_Search_Path;
Target_Name : String)
(Self : in out Project_Search_Path;
Target_Name : String;
Runtime_Name : String := "")
is
Add_Default_Dir : Boolean := Target_Name /= "-";
First : Positive;
@ -1894,6 +1895,24 @@ package body Prj.Env is
-- The path name(s) of directories where project files may reside.
-- May be empty.
Prefix : String_Ptr;
Runtime : String_Ptr;
procedure Add_Target;
procedure Add_Target is
begin
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & Target_Name);
-- Note: Target_Name has a trailing / when it comes from
-- Sdefault.
if Name_Buffer (Name_Len) /= '/' then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
end Add_Target;
begin
if Is_Initialized (Self) then
return;
@ -2051,73 +2070,81 @@ package body Prj.Env is
-- Set the initial value of Current_Project_Path
if Add_Default_Dir then
declare
Prefix : String_Ptr;
if Sdefault.Search_Dir_Prefix = null then
begin
if Sdefault.Search_Dir_Prefix = null then
-- gprbuild case
-- gprbuild case
Prefix := new String'(Executable_Prefix_Path);
Prefix := new String'(Executable_Prefix_Path);
else
Prefix := new String'(Sdefault.Search_Dir_Prefix.all
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator);
end if;
else
Prefix := new String'(Sdefault.Search_Dir_Prefix.all
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator);
end if;
if Prefix.all /= "" then
if Target_Name /= "" then
if Prefix.all /= "" then
if Target_Name /= "" then
if Runtime_Name /= "" then
if Base_Name (Runtime_Name) = Runtime_Name then
-- $prefix/$target/lib/gnat
-- $prefix/$target/$runtime/lib/gnat
Add_Target;
Add_Str_To_Name_Buffer
(Runtime_Name & Directory_Separator &
"lib" & Directory_Separator & "gnat");
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & Target_Name);
-- $prefix/$target/$runtime/share/gpr
Add_Target;
Add_Str_To_Name_Buffer
(Runtime_Name & Directory_Separator &
"share" & Directory_Separator & "gpr");
-- Note: Target_Name has a trailing / when it comes from
-- Sdefault.
else
Runtime :=
new String'(Normalize_Pathname (Runtime_Name));
if Name_Buffer (Name_Len) /= '/' then
Add_Char_To_Name_Buffer (Directory_Separator);
-- $runtime_dir/lib/gnat
Add_Str_To_Name_Buffer
(Path_Separator & Runtime.all & Directory_Separator &
"lib" & Directory_Separator & "gnat");
-- $runtime_dir/share/gpr
Add_Str_To_Name_Buffer
(Path_Separator & Runtime.all & Directory_Separator &
"share" & Directory_Separator & "gpr");
end if;
Add_Str_To_Name_Buffer
("lib" & Directory_Separator & "gnat");
-- $prefix/$target/share/gpr
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & Target_Name);
-- Note: Target_Name has a trailing / when it comes from
-- Sdefault.
if Name_Buffer (Name_Len) /= '/' then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Add_Str_To_Name_Buffer
("share" & Directory_Separator & "gpr");
end if;
-- $prefix/share/gpr
-- $prefix/$target/lib/gnat
Add_Target;
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & "share"
& Directory_Separator & "gpr");
("lib" & Directory_Separator & "gnat");
-- $prefix/lib/gnat
-- $prefix/$target/share/gpr
Add_Target;
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & "lib"
& Directory_Separator & "gnat");
("share" & Directory_Separator & "gpr");
end if;
Free (Prefix);
end;
-- $prefix/share/gpr
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & "share"
& Directory_Separator & "gpr");
-- $prefix/lib/gnat
Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & "lib"
& Directory_Separator & "gnat");
end if;
Free (Prefix);
end if;
Self.Path := new String'(Name_Buffer (1 .. Name_Len));

18
gcc/ada/prj-env.ads
View File

@ -171,14 +171,16 @@ package Prj.Env is
No_Project_Search_Path : constant Project_Search_Path;
procedure Initialize_Default_Project_Path
(Self : in out Project_Search_Path;
Target_Name : String);
-- Initialize Self. It will then contain the default project path on the
-- given target (including directories specified by the environment
-- variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and ADA_PROJECT_PATH).
-- If one of the directory or Target_Name is "-", then the path contains
-- only those directories specified by the environment variables (except
-- "-"). This does nothing if Self has already been initialized.
(Self : in out Project_Search_Path;
Target_Name : String;
Runtime_Name : String := "");
-- Initialize Self. It will then contain the default project path on
-- the given target and runtime (including directories specified by the
-- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
-- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-", then
-- the path contains only those directories specified by the environment
-- variables (except "-"). This does nothing if Self has already been
-- initialized.
procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
-- Copy From into To

2
gcc/ada/s-taskin.ads
View File

@ -670,7 +670,7 @@ package System.Tasking is
-- System-specific attributes of the task as specified by the
-- Task_Info pragma.
Analyzer : System.Stack_Usage.Stack_Analyzer;
Analyzer : System.Stack_Usage.Stack_Analyzer;
-- For storing information used to measure the stack usage
Global_Task_Lock_Nesting : Natural;

7
gcc/ada/s-traces.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -33,8 +33,7 @@
-- Warning : NO dependencies to tasking should be created here
-- This package, and all its children are used to implement debug
-- information
-- This package and all its children are used to implement debug information
-- A new primitive, Send_Trace_Info (Id : Trace_T; 'data') is introduced.
-- Trace_T is an event identifier, 'data' are the information to pass
@ -50,7 +49,7 @@
-- corresponding Send_Trace_Info procedure. It may be required for some
-- target to modify Send_Trace (e.g. VxWorks).
-- To add a new target, just adapt System.Traces.Send to your own purposes
-- To add a new target, just adapt System.Traces.Send as needed
package System.Traces is
pragma Preelaborate;

15
gcc/ada/sem_prag.adb
View File

@ -11017,10 +11017,10 @@ package body Sem_Prag is
-- processing is required here.
when Pragma_Assertion_Policy => Assertion_Policy : declare
LocP : Source_Ptr;
Policy : Node_Id;
Arg : Node_Id;
Kind : Name_Id;
LocP : Source_Ptr;
Policy : Node_Id;
begin
Ada_2005_Pragma;
@ -11102,12 +11102,17 @@ package body Sem_Prag is
Check_Arg_Is_One_Of
(Arg, Name_Check, Name_Disable, Name_Ignore);
-- We rewrite the Assertion_Policy pragma as a series of
-- Check_Policy pragmas:
-- Rewrite the Assertion_Policy pragma as a series of
-- Check_Policy pragmas of the form:
-- Check_Policy (Kind, Policy);
Insert_Action (N,
-- Note: the insertion of the pragmas cannot be done with
-- Insert_Action because in the configuration case, there
-- are no scopes on the scope stack and the mechanism will
-- fail.
Insert_Before_And_Analyze (N,
Make_Pragma (LocP,
Chars => Name_Check_Policy,
Pragma_Argument_Associations => New_List (

26
gcc/ada/sem_res.adb
View File

@ -4630,31 +4630,19 @@ package body Sem_Res is
-- first place.
if Ekind (Nam) = E_Procedure
and then Ekind (F) = E_In_Parameter
and then Is_Entity_Name (A)
and then Present (Entity (A))
and then Ekind (Entity (A)) = E_Variable
then
A_Id := Entity (A);
if Ekind (F) = E_In_Parameter then
if Async_Readers_Enabled (A_Id) then
Property_Error (A, A_Id, Name_Async_Readers);
elsif Effective_Reads_Enabled (A_Id) then
Property_Error (A, A_Id, Name_Effective_Reads);
elsif Effective_Writes_Enabled (A_Id) then
Property_Error (A, A_Id, Name_Effective_Writes);
end if;
elsif Ekind (F) = E_Out_Parameter
and then Async_Writers_Enabled (A_Id)
then
Error_Msg_Name_1 := Name_Async_Writers;
Error_Msg_NE
("external variable & with enabled property % cannot "
& "appear as actual in procedure call "
& "(SPARK RM 7.1.3(11))", A, A_Id);
Error_Msg_N
("\\corresponding formal parameter has mode Out", A);
if Async_Readers_Enabled (A_Id) then
Property_Error (A, A_Id, Name_Async_Readers);
elsif Effective_Reads_Enabled (A_Id) then
Property_Error (A, A_Id, Name_Effective_Reads);
elsif Effective_Writes_Enabled (A_Id) then
Property_Error (A, A_Id, Name_Effective_Writes);
end if;
end if;
end if;