Skip to content

R
riscv-gcc-1
Commit de4ac038 by Arnaud Charlet
Options

[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
parent d3d514a9
Showing with 181 additions and 101 deletions
gcc/ada/ChangeLog
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> 2015-01-05 Jakub Jelinek <jakub@redhat.com>
* gnat_ugn.texi: Bump @copying's copyright year. * gnat_ugn.texi: Bump @copying's copyright year.
......
gcc/ada/a-coboho.ads
...@@ -99,4 +99,9 @@ private ...@@ -99,4 +99,9 @@ private
-- the 'Address of an array points to the first element, thus losing the -- the 'Address of an array points to the first element, thus losing the
-- bounds. -- 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; end Ada.Containers.Bounded_Holders;
gcc/ada/a-cofove.adb
...@@ -45,10 +45,9 @@ is ...@@ -45,10 +45,9 @@ is
procedure Free is procedure Free is
new Ada.Unchecked_Deallocation (Elements_Array, Elements_Array_Ptr); 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; with Storage_Size => 0;
type Maximal_Array_Ptr_Const is access constant type Maximal_Array_Ptr_Const is access constant Elements_Array (Array_Index)
Elements_Array (Capacity_Range)
with Storage_Size => 0; with Storage_Size => 0;
function Elems (Container : in out Vector) return Maximal_Array_Ptr; function Elems (Container : in out Vector) return Maximal_Array_Ptr;
...@@ -111,7 +110,7 @@ is ...@@ -111,7 +110,7 @@ is
Reserve_Capacity Reserve_Capacity
(Container, (Container,
Capacity_Range'Max (Capacity (Container) * Growth_Factor, Capacity_Range'Max (Capacity (Container) * Growth_Factor,
Capacity_Range (New_Length))); Capacity_Range (New_Length)));
end if; end if;
if Container.Last = Index_Type'Last then if Container.Last = Index_Type'Last then
...@@ -381,7 +380,7 @@ is ...@@ -381,7 +380,7 @@ is
is is
procedure Sort is procedure Sort is
new Generic_Array_Sort new Generic_Array_Sort
(Index_Type => Capacity_Range, (Index_Type => Array_Index,
Element_Type => Element_Type, Element_Type => Element_Type,
Array_Type => Elements_Array, Array_Type => Elements_Array,
"<" => "<"); "<" => "<");
......
gcc/ada/a-cofove.ads
...@@ -246,7 +246,8 @@ private ...@@ -246,7 +246,8 @@ private
pragma Inline (Replace_Element); pragma Inline (Replace_Element);
pragma Inline (Contains); 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; function "=" (L, R : Elements_Array) return Boolean is abstract;
type Elements_Array_Ptr is access all Elements_Array; type Elements_Array_Ptr is access all Elements_Array;
......
gcc/ada/exp_util.adb
...@@ -2961,7 +2961,7 @@ package body Exp_Util is ...@@ -2961,7 +2961,7 @@ package body Exp_Util is
begin begin
-- If parser detected no address clause for the identifier in question, -- 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 if not Get_Name_Table_Boolean (Chars (Id)) then
return Empty; return Empty;
......
gcc/ada/frontend.adb
...@@ -339,10 +339,10 @@ begin ...@@ -339,10 +339,10 @@ begin
and then not Fatal_Error (Main_Unit) and then not Fatal_Error (Main_Unit)
then then
-- Pragmas that require some semantic activity, such as -- Pragmas that require some semantic activity, such as Interrupt_State,
-- Interrupt_State, cannot be processed until the main unit -- cannot be processed until the main unit is installed, because they
-- is installed, because they require a compilation unit on -- require a compilation unit on which to attach with_clauses, etc. So
-- which to attach with_clauses, etc. So analyze them now. -- analyze them now.
declare declare
Prag : Node_Id; Prag : Node_Id;
...@@ -350,7 +350,14 @@ begin ...@@ -350,7 +350,14 @@ begin
begin begin
Prag := First (Config_Pragmas); Prag := First (Config_Pragmas);
while Present (Prag) loop 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); Analyze_Pragma (Prag);
end if; end if;
......
gcc/ada/gnatls.adb
...@@ -1225,6 +1225,10 @@ procedure Gnatls is ...@@ -1225,6 +1225,10 @@ procedure Gnatls is
if Src_Path /= null and then Lib_Path /= null then if Src_Path /= null and then Lib_Path /= null then
Add_Search_Dirs (Src_Path, Include); Add_Search_Dirs (Src_Path, Include);
Add_Search_Dirs (Lib_Path, Objects); Add_Search_Dirs (Lib_Path, Objects);
Initialize_Default_Project_Path
(Prj_Path,
Target_Name => Sdefault.Target_Name.all,
Runtime_Name => Name);
return; return;
end if; end if;
...@@ -1237,7 +1241,9 @@ procedure Gnatls is ...@@ -1237,7 +1241,9 @@ procedure Gnatls is
-- Try to find the RTS on the project path. First setup the project path -- Try to find the RTS on the project path. First setup the project path
Initialize_Default_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); Rts_Full_Path := Get_Runtime_Path (Prj_Path, Name);
......
gcc/ada/prj-env.adb
...@@ -1873,8 +1873,9 @@ package body Prj.Env is ...@@ -1873,8 +1873,9 @@ package body Prj.Env is
------------------------------------- -------------------------------------
procedure Initialize_Default_Project_Path procedure Initialize_Default_Project_Path
(Self : in out Project_Search_Path; (Self : in out Project_Search_Path;
Target_Name : String) Target_Name : String;
Runtime_Name : String := "")
is is
Add_Default_Dir : Boolean := Target_Name /= "-"; Add_Default_Dir : Boolean := Target_Name /= "-";
First : Positive; First : Positive;
...@@ -1894,6 +1895,24 @@ package body Prj.Env is ...@@ -1894,6 +1895,24 @@ package body Prj.Env is
-- The path name(s) of directories where project files may reside. -- The path name(s) of directories where project files may reside.
-- May be empty. -- 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 begin
if Is_Initialized (Self) then if Is_Initialized (Self) then
return; return;
...@@ -2051,73 +2070,81 @@ package body Prj.Env is ...@@ -2051,73 +2070,81 @@ package body Prj.Env is
-- Set the initial value of Current_Project_Path -- Set the initial value of Current_Project_Path
if Add_Default_Dir then if Add_Default_Dir then
declare if Sdefault.Search_Dir_Prefix = null then
Prefix : String_Ptr;
begin
if Sdefault.Search_Dir_Prefix = null then
-- gprbuild case
Prefix := new String'(Executable_Prefix_Path); -- gprbuild case
else
Prefix := new String'(Sdefault.Search_Dir_Prefix.all
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator
& ".." & Dir_Separator);
end if;
if Prefix.all /= "" then Prefix := new String'(Executable_Prefix_Path);
if Target_Name /= "" then
-- $prefix/$target/lib/gnat else
Prefix := new String'(Sdefault.Search_Dir_Prefix.all
Add_Str_To_Name_Buffer & ".." & Dir_Separator
(Path_Separator & Prefix.all & Target_Name); & ".." & Dir_Separator
& ".." & Dir_Separator
-- Note: Target_Name has a trailing / when it comes from & ".." & Dir_Separator);
-- Sdefault. end if;
if Name_Buffer (Name_Len) /= '/' then
Add_Char_To_Name_Buffer (Directory_Separator);
end if;
Add_Str_To_Name_Buffer if Prefix.all /= "" then
("lib" & Directory_Separator & "gnat"); if Target_Name /= "" then
-- $prefix/$target/share/gpr if Runtime_Name /= "" then
if Base_Name (Runtime_Name) = Runtime_Name then
Add_Str_To_Name_Buffer -- $prefix/$target/$runtime/lib/gnat
(Path_Separator & Prefix.all & Target_Name); Add_Target;
Add_Str_To_Name_Buffer
(Runtime_Name & Directory_Separator &
"lib" & Directory_Separator & "gnat");
-- Note: Target_Name has a trailing / when it comes from -- $prefix/$target/$runtime/share/gpr
-- Sdefault. Add_Target;
Add_Str_To_Name_Buffer
(Runtime_Name & Directory_Separator &
"share" & Directory_Separator & "gpr");
if Name_Buffer (Name_Len) /= '/' then else
Add_Char_To_Name_Buffer (Directory_Separator); Runtime :=
new String'(Normalize_Pathname (Runtime_Name));
-- $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; end if;
Add_Str_To_Name_Buffer
("share" & Directory_Separator & "gpr");
end if; end if;
-- $prefix/share/gpr -- $prefix/$target/lib/gnat
Add_Target;
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & "share" ("lib" & Directory_Separator & "gnat");
& Directory_Separator & "gpr");
-- $prefix/lib/gnat -- $prefix/$target/share/gpr
Add_Target;
Add_Str_To_Name_Buffer Add_Str_To_Name_Buffer
(Path_Separator & Prefix.all & "lib" ("share" & Directory_Separator & "gpr");
& Directory_Separator & "gnat");
end if; end if;
Free (Prefix); -- $prefix/share/gpr
end;
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; end if;
Self.Path := new String'(Name_Buffer (1 .. Name_Len)); Self.Path := new String'(Name_Buffer (1 .. Name_Len));
......
gcc/ada/prj-env.ads
...@@ -171,14 +171,16 @@ package Prj.Env is ...@@ -171,14 +171,16 @@ package Prj.Env is
No_Project_Search_Path : constant Project_Search_Path; No_Project_Search_Path : constant Project_Search_Path;
procedure Initialize_Default_Project_Path procedure Initialize_Default_Project_Path
(Self : in out Project_Search_Path; (Self : in out Project_Search_Path;
Target_Name : String); Target_Name : String;
-- Initialize Self. It will then contain the default project path on the Runtime_Name : String := "");
-- given target (including directories specified by the environment -- Initialize Self. It will then contain the default project path on
-- variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and ADA_PROJECT_PATH). -- the given target and runtime (including directories specified by the
-- If one of the directory or Target_Name is "-", then the path contains -- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
-- only those directories specified by the environment variables (except -- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-", then
-- "-"). This does nothing if Self has already been initialized. -- 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); procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
-- Copy From into To -- Copy From into To
......
gcc/ada/s-taskin.ads
...@@ -670,7 +670,7 @@ package System.Tasking is ...@@ -670,7 +670,7 @@ package System.Tasking is
-- System-specific attributes of the task as specified by the -- System-specific attributes of the task as specified by the
-- Task_Info pragma. -- Task_Info pragma.
Analyzer : System.Stack_Usage.Stack_Analyzer; Analyzer : System.Stack_Usage.Stack_Analyzer;
-- For storing information used to measure the stack usage -- For storing information used to measure the stack usage
Global_Task_Lock_Nesting : Natural; Global_Task_Lock_Nesting : Natural;
......
gcc/ada/s-traces.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -33,8 +33,7 @@ ...@@ -33,8 +33,7 @@
-- Warning : NO dependencies to tasking should be created here -- Warning : NO dependencies to tasking should be created here
-- This package, and all its children are used to implement debug -- This package and all its children are used to implement debug information
-- information
-- A new primitive, Send_Trace_Info (Id : Trace_T; 'data') is introduced. -- A new primitive, Send_Trace_Info (Id : Trace_T; 'data') is introduced.
-- Trace_T is an event identifier, 'data' are the information to pass -- Trace_T is an event identifier, 'data' are the information to pass
...@@ -50,7 +49,7 @@ ...@@ -50,7 +49,7 @@
-- corresponding Send_Trace_Info procedure. It may be required for some -- corresponding Send_Trace_Info procedure. It may be required for some
-- target to modify Send_Trace (e.g. VxWorks). -- 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 package System.Traces is
pragma Preelaborate; pragma Preelaborate;
......
gcc/ada/sem_prag.adb
...@@ -11017,10 +11017,10 @@ package body Sem_Prag is ...@@ -11017,10 +11017,10 @@ package body Sem_Prag is
-- processing is required here. -- processing is required here.
when Pragma_Assertion_Policy => Assertion_Policy : declare when Pragma_Assertion_Policy => Assertion_Policy : declare
LocP : Source_Ptr;
Policy : Node_Id;
Arg : Node_Id; Arg : Node_Id;
Kind : Name_Id; Kind : Name_Id;
LocP : Source_Ptr;
Policy : Node_Id;
begin begin
Ada_2005_Pragma; Ada_2005_Pragma;
...@@ -11102,12 +11102,17 @@ package body Sem_Prag is ...@@ -11102,12 +11102,17 @@ package body Sem_Prag is
Check_Arg_Is_One_Of Check_Arg_Is_One_Of
(Arg, Name_Check, Name_Disable, Name_Ignore); (Arg, Name_Check, Name_Disable, Name_Ignore);
-- We rewrite the Assertion_Policy pragma as a series of -- Rewrite the Assertion_Policy pragma as a series of
-- Check_Policy pragmas: -- Check_Policy pragmas of the form:
-- Check_Policy (Kind, Policy); -- 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, Make_Pragma (LocP,
Chars => Name_Check_Policy, Chars => Name_Check_Policy,
Pragma_Argument_Associations => New_List ( Pragma_Argument_Associations => New_List (
......
gcc/ada/sem_res.adb
...@@ -4630,31 +4630,19 @@ package body Sem_Res is ...@@ -4630,31 +4630,19 @@ package body Sem_Res is
-- first place. -- first place.
if Ekind (Nam) = E_Procedure if Ekind (Nam) = E_Procedure
and then Ekind (F) = E_In_Parameter
and then Is_Entity_Name (A) and then Is_Entity_Name (A)
and then Present (Entity (A)) and then Present (Entity (A))
and then Ekind (Entity (A)) = E_Variable and then Ekind (Entity (A)) = E_Variable
then then
A_Id := Entity (A); A_Id := Entity (A);
if Ekind (F) = E_In_Parameter then if Async_Readers_Enabled (A_Id) then
if Async_Readers_Enabled (A_Id) then Property_Error (A, A_Id, Name_Async_Readers);
Property_Error (A, A_Id, Name_Async_Readers); elsif Effective_Reads_Enabled (A_Id) then
elsif Effective_Reads_Enabled (A_Id) then Property_Error (A, A_Id, Name_Effective_Reads);
Property_Error (A, A_Id, Name_Effective_Reads); elsif Effective_Writes_Enabled (A_Id) then
elsif Effective_Writes_Enabled (A_Id) then Property_Error (A, A_Id, Name_Effective_Writes);
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);
end if; end if;
end if; end if;
end if; end if;
......
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