Skip to content

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

[multiple changes] 

2011-08-03  Javier Miranda  <miranda@adacore.com>

	* sem_prag.adb (Process_Interface_Name): Allow duplicated export names
	in Java since they are always enclosed in a namespace that
	differentiates them, and overloaded entities are supported by the VM.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Determine_Range): If a computed bound of an operation is
	outside the range of the base type of the expression, and overflow
	checks are enabled, the result is unknown and cannot be used for any
	subsequent constant folding.
	* sem_eval.adb (Compile_Time_Compare): if the bounds of one operand are
	unknown, so is the result of the comparison.

2011-08-03  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-except-2005.adb (Raise_From_Controlled_Operation): Add new formal
	From_Abort. When finalization was triggered by an abort, propagate
	Standard'Abort_Signal rather than Program_Error.
	* a-except-2005.ads (Raise_From_Controlled_Operation): Add new formal
	From_Abort.
	* a-except.adb (Raise_From_Controlled_Operation): Add new formal
	From_Abort. When finalization was triggered by an abort, propagate
	Standard'Abort_Signal rather than Program_Error.
	* a-except.ads:(Raise_From_Controlled_Operation): Add new formal
	From_Abort.
	* exp_ch7.adb:(Build_Adjust_Or_Finalize_Statements): New local variable
	Abort_Id. Update the calls to Build_Object_Declarations and
	Build_Raise_Statement to include Abort_Id.
	(Build_Adjust_Statements): New local variable Abort_Id. Update the
	calls to Build_Object_Declarations and Build_Raise_Statement to include
	Abort_Id.
	(Build_Finalize_Statements): New local variable Abort_Id. Update the
	calls to Build_Object_Declarations and Build_Raise_Statement to include
	Abort_Id.
	(Build_Components): Create an entity for Abort_Id when exceptions are
	allowed on the target.
	(Build_Finalizer): New local variable Abort_Id.
	(Build_Initialize_Statements): New local variable Abort_Id. Update the
	calls to Build_Object_Declarations and Build_Raise_Statement to include
	Abort_Id.
	(Build_Object_Declarations): Add new formal Abort_Id. Create the
	declaration of flag Abort_Id to preserve the original abort status
	before finalization code is executed.
	(Build_Raise_Statement): Add new formal Abort_Id. Pass Abort_Id to
	runtime routine Raise_From_Controlled_Operation.
	(Create_Finalizer): Update the call to Build_Raise_Statement to include
	Abort_Id. Update the call to Build_Object_Declarations to include
	Abort_Id. Update the layout of the finalizer body.
	(Make_Handler_For_Ctrl_Operation): Add an actual for From_Abort.
	(Process_Transient_Objects): New local variable Abort_Id. Remove the
	clunky code to create all flags and objects related to
	exception propagation and replace it with a call to
	Build_Object_Declarations. Update the call to Build_Raise_Statement to
	include Abort_Id.
	* exp_ch7.ads (Build_Object_Declarations): Moved from body to spec.
	Add new formal Abort_Id and associated comment on its use.
	(Build_Raise_Statement): Add new formal Abort_Id and associated comment
	on its use.
	* exp_intr.adb (Expand_Unc_Deallocation): New local variable Abort_Id.
	Remove the clunky code to create all flags and objects related to
	exception propagation and replace it with a call to
	Build_Object_Declarations. Update the call to Build_Raise_Statement.

2011-08-03  Eric Botcazou  <ebotcazou@adacore.com>

	* s-tassta.adb: Fix minor typos.

2011-08-03  Robert Dewar  <dewar@adacore.com>

	* rtsfind.ads, makeutl.ads, prj.ads, prj.adb, make.adb,
	lib-writ.adb, makeutl.adb, s-soflin.ads, clean.adb: Minor reformatting.

From-SVN: r177283
parent 1cdfa9be
Showing with 242 additions and 144 deletions
gcc/ada/ChangeLog
2011-08-03 Javier Miranda <miranda@adacore.com>
* sem_prag.adb (Process_Interface_Name): Allow duplicated export names
in Java since they are always enclosed in a namespace that
differentiates them, and overloaded entities are supported by the VM.
2011-08-03 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Determine_Range): If a computed bound of an operation is
outside the range of the base type of the expression, and overflow
checks are enabled, the result is unknown and cannot be used for any
subsequent constant folding.
* sem_eval.adb (Compile_Time_Compare): if the bounds of one operand are
unknown, so is the result of the comparison.
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
* a-except-2005.adb (Raise_From_Controlled_Operation): Add new formal
From_Abort. When finalization was triggered by an abort, propagate
Standard'Abort_Signal rather than Program_Error.
* a-except-2005.ads (Raise_From_Controlled_Operation): Add new formal
From_Abort.
* a-except.adb (Raise_From_Controlled_Operation): Add new formal
From_Abort. When finalization was triggered by an abort, propagate
Standard'Abort_Signal rather than Program_Error.
* a-except.ads:(Raise_From_Controlled_Operation): Add new formal
From_Abort.
* exp_ch7.adb:(Build_Adjust_Or_Finalize_Statements): New local variable
Abort_Id. Update the calls to Build_Object_Declarations and
Build_Raise_Statement to include Abort_Id.
(Build_Adjust_Statements): New local variable Abort_Id. Update the
calls to Build_Object_Declarations and Build_Raise_Statement to include
Abort_Id.
(Build_Finalize_Statements): New local variable Abort_Id. Update the
calls to Build_Object_Declarations and Build_Raise_Statement to include
Abort_Id.
(Build_Components): Create an entity for Abort_Id when exceptions are
allowed on the target.
(Build_Finalizer): New local variable Abort_Id.
(Build_Initialize_Statements): New local variable Abort_Id. Update the
calls to Build_Object_Declarations and Build_Raise_Statement to include
Abort_Id.
(Build_Object_Declarations): Add new formal Abort_Id. Create the
declaration of flag Abort_Id to preserve the original abort status
before finalization code is executed.
(Build_Raise_Statement): Add new formal Abort_Id. Pass Abort_Id to
runtime routine Raise_From_Controlled_Operation.
(Create_Finalizer): Update the call to Build_Raise_Statement to include
Abort_Id. Update the call to Build_Object_Declarations to include
Abort_Id. Update the layout of the finalizer body.
(Make_Handler_For_Ctrl_Operation): Add an actual for From_Abort.
(Process_Transient_Objects): New local variable Abort_Id. Remove the
clunky code to create all flags and objects related to
exception propagation and replace it with a call to
Build_Object_Declarations. Update the call to Build_Raise_Statement to
include Abort_Id.
* exp_ch7.ads (Build_Object_Declarations): Moved from body to spec.
Add new formal Abort_Id and associated comment on its use.
(Build_Raise_Statement): Add new formal Abort_Id and associated comment
on its use.
* exp_intr.adb (Expand_Unc_Deallocation): New local variable Abort_Id.
Remove the clunky code to create all flags and objects related to
exception propagation and replace it with a call to
Build_Object_Declarations. Update the call to Build_Raise_Statement.
2011-08-03 Eric Botcazou <ebotcazou@adacore.com>
* s-tassta.adb: Fix minor typos.
2011-08-03 Robert Dewar <dewar@adacore.com>
* rtsfind.ads, makeutl.ads, prj.ads, prj.adb, make.adb,
lib-writ.adb, makeutl.adb, s-soflin.ads, clean.adb: Minor reformatting.
2011-08-03 Hristian Kirtchev <kirtchev@adacore.com> 2011-08-03 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Create_Finalizer): Treat freeze nodes in similar fashion * exp_ch7.adb (Create_Finalizer): Treat freeze nodes in similar fashion
......
gcc/ada/a-except-2005.adb
...@@ -878,21 +878,15 @@ package body Ada.Exceptions is ...@@ -878,21 +878,15 @@ package body Ada.Exceptions is
------------------------------------- -------------------------------------
procedure Raise_From_Controlled_Operation procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence) (X : Ada.Exceptions.Exception_Occurrence;
From_Abort : Boolean)
is is
Prev_Exc : constant EOA := Get_Current_Excep.all;
begin begin
-- We're raising an exception during finalization. If the finalization -- When finalization was triggered by an abort, keep propagating the
-- was triggered by an abort, as indicated by Not_Handled_By_Others, -- abort signal rather than raising Program_Error.
-- then we don't want to raise Program_Error; we want to continue with
-- the Abort_Signal exception. Note that the original exception
-- occurrence that triggered the finalization is saved before calling
-- the Finalize procedures, and then restored afterward, so in the case
-- of abort, the original Abort_Signal will be the current one.
if Prev_Exc.Id /= null and then Prev_Exc.Id.Not_Handled_By_Others then if From_Abort then
Raise_Current_Excep (Prev_Exc.Id); raise Standard'Abort_Signal;
-- Otherwise, raise Program_Error -- Otherwise, raise Program_Error
......
gcc/ada/a-except-2005.ads
...@@ -230,7 +230,8 @@ private ...@@ -230,7 +230,8 @@ private
-- system to return here rather than to the original location. -- system to return here rather than to the original location.
procedure Raise_From_Controlled_Operation procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence); (X : Ada.Exceptions.Exception_Occurrence;
From_Abort : Boolean);
pragma No_Return (Raise_From_Controlled_Operation); pragma No_Return (Raise_From_Controlled_Operation);
pragma Export pragma Export
(Ada, Raise_From_Controlled_Operation, (Ada, Raise_From_Controlled_Operation,
......
gcc/ada/a-except.adb
...@@ -850,21 +850,15 @@ package body Ada.Exceptions is ...@@ -850,21 +850,15 @@ package body Ada.Exceptions is
------------------------------------- -------------------------------------
procedure Raise_From_Controlled_Operation procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence) (X : Ada.Exceptions.Exception_Occurrence;
From_Abort : Boolean)
is is
Prev_Exc : constant EOA := Get_Current_Excep.all;
begin begin
-- We're raising an exception during finalization. If the finalization -- When finalization was triggered by an abort, keep propagating the
-- was triggered by an abort, as indicated by Not_Handled_By_Others, -- abort signal rather than raising Program_Error.
-- then we don't want to raise Program_Error; we want to continue with
-- the Abort_Signal exception. Note that the original exception
-- occurrence that triggered the finalization is saved before calling
-- the Finalize procedures, and then restored afterward, so in the case
-- of abort, the original Abort_Signal will be the current one.
if Prev_Exc.Id /= null and then Prev_Exc.Id.Not_Handled_By_Others then if From_Abort then
Raise_Current_Excep (Prev_Exc.Id); raise Standard'Abort_Signal;
-- Otherwise, raise Program_Error -- Otherwise, raise Program_Error
...@@ -873,9 +867,11 @@ package body Ada.Exceptions is ...@@ -873,9 +867,11 @@ package body Ada.Exceptions is
Prefix : constant String := "adjust/finalize raised "; Prefix : constant String := "adjust/finalize raised ";
Orig_Msg : constant String := Exception_Message (X); Orig_Msg : constant String := Exception_Message (X);
Orig_Prefix_Length : constant Natural := Orig_Prefix_Length : constant Natural :=
Integer'Min (Prefix'Length, Orig_Msg'Length); Integer'Min
(Prefix'Length, Orig_Msg'Length);
Orig_Prefix : String renames Orig_Msg Orig_Prefix : String renames Orig_Msg
(Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1); (Orig_Msg'First ..
Orig_Msg'First + Orig_Prefix_Length - 1);
begin begin
-- Message already has proper prefix, just re-reraise -- Message already has proper prefix, just re-reraise
......
gcc/ada/a-except.ads
...@@ -199,7 +199,8 @@ private ...@@ -199,7 +199,8 @@ private
-- system to return here rather than to the original location. -- system to return here rather than to the original location.
procedure Raise_From_Controlled_Operation procedure Raise_From_Controlled_Operation
(X : Ada.Exceptions.Exception_Occurrence); (X : Ada.Exceptions.Exception_Occurrence;
From_Abort : Boolean);
pragma No_Return (Raise_From_Controlled_Operation); pragma No_Return (Raise_From_Controlled_Operation);
pragma Export pragma Export
(Ada, Raise_From_Controlled_Operation, (Ada, Raise_From_Controlled_Operation,
......
gcc/ada/checks.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -3457,6 +3457,18 @@ package body Checks is ...@@ -3457,6 +3457,18 @@ package body Checks is
-- the computed expression is in the range Lor .. Hir. We can use this -- the computed expression is in the range Lor .. Hir. We can use this
-- to restrict the possible range of results. -- to restrict the possible range of results.
-- If one of the computed bounds is outside the range of the base type,
-- the expression may raise an exception and we better indicate that
-- the evaluation has failed, at least if checks are enabled.
if Enable_Overflow_Checks
and then not Is_Entity_Name (N)
and then (Lor < Lo or else Hir > Hi)
then
OK := False;
return;
end if;
if OK1 then if OK1 then
-- If the refined value of the low bound is greater than the type -- If the refined value of the low bound is greater than the type
......
gcc/ada/clean.adb
...@@ -370,9 +370,8 @@ package body Clean is ...@@ -370,9 +370,8 @@ package body Clean is
Text : Text_Buffer_Ptr; Text : Text_Buffer_Ptr;
The_ALI : ALI_Id; The_ALI : ALI_Id;
Found : Boolean;
Found : Boolean; Source : Queue.Source_Info;
Source : Queue.Source_Info;
begin begin
Queue.Initialize (Queue_Per_Obj_Dir => False); Queue.Initialize (Queue_Per_Obj_Dir => False);
...@@ -388,8 +387,8 @@ package body Clean is ...@@ -388,8 +387,8 @@ package body Clean is
for N_File in 1 .. Osint.Number_Of_Files loop for N_File in 1 .. Osint.Number_Of_Files loop
Main_Source_File := Next_Main_Source; Main_Source_File := Next_Main_Source;
Main_Lib_File := Osint.Lib_File_Name Main_Lib_File :=
(Main_Source_File, Current_File_Index); Osint.Lib_File_Name (Main_Source_File, Current_File_Index);
if Main_Lib_File /= No_File then if Main_Lib_File /= No_File then
Queue.Insert Queue.Insert
......
gcc/ada/exp_ch7.ads
...@@ -57,19 +57,39 @@ package Exp_Ch7 is ...@@ -57,19 +57,39 @@ package Exp_Ch7 is
-- Build one controlling procedure when a late body overrides one of -- Build one controlling procedure when a late body overrides one of
-- the controlling operations. -- the controlling operations.
function Build_Object_Declarations
(Loc : Source_Ptr;
Abort_Id : Entity_Id;
E_Id : Entity_Id;
Raised_Id : Entity_Id) return List_Id;
-- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
-- list containing the object declarations of boolean flag Abort_Id, the
-- exception occurrence E_Id and boolean flag Raised_Id.
--
-- Abort_Id : constant Boolean :=
-- Exception_Identity (Get_Current_Excep.all) =
-- Standard'Abort_Signal'Identity;
-- <or>
-- Abort_Id : constant Boolean := False; -- no abort
--
-- E_Id : Exception_Occurrence;
-- Raised_Id : Boolean := False;
function Build_Raise_Statement function Build_Raise_Statement
(Loc : Source_Ptr; (Loc : Source_Ptr;
E_Id : Entity_Id; Abort_Id : Entity_Id;
R_Id : Entity_Id) return Node_Id; E_Id : Entity_Id;
Raised_Id : Entity_Id) return Node_Id;
-- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_ -- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
-- Deep_Record_Body. Generate the following conditional raise statement: -- Deep_Record_Body. Generate the following conditional raise statement:
-- --
-- if R_Id then -- if Raised_Id then
-- Raise_From_Controlled_Operation (E_Id); -- Raise_From_Controlled_Operation (E_Id, Abort_Id);
-- end if; -- end if;
-- --
-- E_Id denotes the defining identifier of a local exception occurrence, -- Abort_Id is a local boolean flag which is set when the finalization was
-- R_Id is the entity of a local boolean flag. -- triggered by an abort, E_Id denotes the defining identifier of a local
-- exception occurrence, Raised_Id is the entity of a local boolean flag.
function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean; function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
-- True if T is a class-wide type, or if it has controlled parts ("part" -- True if T is a class-wide type, or if it has controlled parts ("part"
......
gcc/ada/exp_intr.adb
...@@ -884,16 +884,15 @@ package body Exp_Intr is ...@@ -884,16 +884,15 @@ package body Exp_Intr is
Pool : constant Entity_Id := Associated_Storage_Pool (Rtyp); Pool : constant Entity_Id := Associated_Storage_Pool (Rtyp);
Stmts : constant List_Id := New_List; Stmts : constant List_Id := New_List;
Blk : Node_Id := Empty; Abort_Id : Entity_Id := Empty;
Deref : Node_Id; Blk : Node_Id := Empty;
Exc_Occ_Decl : Node_Id; Deref : Node_Id;
Exc_Occ_Id : Entity_Id := Empty; E_Id : Entity_Id := Empty;
Final_Code : List_Id; Final_Code : List_Id;
Free_Arg : Node_Id; Free_Arg : Node_Id;
Free_Node : Node_Id; Free_Node : Node_Id;
Gen_Code : Node_Id; Gen_Code : Node_Id;
Raised_Decl : Node_Id; Raised_Id : Entity_Id := Empty;
Raised_Id : Entity_Id := Empty;
Arg_Known_Non_Null : constant Boolean := Known_Non_Null (N); Arg_Known_Non_Null : constant Boolean := Known_Non_Null (N);
-- This captures whether we know the argument to be non-null so that -- This captures whether we know the argument to be non-null so that
...@@ -942,38 +941,29 @@ package body Exp_Intr is ...@@ -942,38 +941,29 @@ package body Exp_Intr is
-- the later raise. -- the later raise.
-- --
-- Generate: -- Generate:
-- Raised : Boolean := False; -- Abort : constant Boolean :=
-- Exc_Occ : Exception_Occurrence; -- Exception_Occurrence (Get_Current_Excep.all.all) =
-- Standard'Abort_Signal'Identity;
-- <or>
-- Abort : constant Boolean := False; -- no abort
-- E : Exception_Occurrence;
-- Raised : Boolean := False;
-- --
-- begin -- begin
-- [Deep_]Finalize (Obj); -- [Deep_]Finalize (Obj);
-- exception -- exception
-- when others => -- when others =>
-- Raised := True; -- Raised := True;
-- Save_Occurrence (Exc_Occ, Get_Current_Excep.all.all); -- Save_Occurrence (E, Get_Current_Excep.all.all);
-- end; -- end;
Exc_Occ_Id := Make_Temporary (Loc, 'E'); Abort_Id := Make_Temporary (Loc, 'A');
Raised_Id := Make_Temporary (Loc, 'R'); E_Id := Make_Temporary (Loc, 'E');
Raised_Id := Make_Temporary (Loc, 'R');
Raised_Decl := Append_List_To (Stmts,
Make_Object_Declaration (Loc, Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id));
Defining_Identifier => Raised_Id,
Object_Definition =>
New_Reference_To (Standard_Boolean, Loc),
Expression =>
New_Reference_To (Standard_False, Loc));
Append_To (Stmts, Raised_Decl);
Exc_Occ_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Exc_Occ_Id,
Object_Definition =>
New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
Set_No_Initialization (Exc_Occ_Decl);
Append_To (Stmts, Exc_Occ_Decl);
Final_Code := New_List ( Final_Code := New_List (
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
...@@ -997,7 +987,7 @@ package body Exp_Intr is ...@@ -997,7 +987,7 @@ package body Exp_Intr is
Name => Name =>
New_Reference_To (RTE (RE_Save_Occurrence), Loc), New_Reference_To (RTE (RE_Save_Occurrence), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Reference_To (Exc_Occ_Id, Loc), New_Reference_To (E_Id, Loc),
Make_Explicit_Dereference (Loc, Make_Explicit_Dereference (Loc,
Prefix => Prefix =>
Make_Function_Call (Loc, Make_Function_Call (Loc,
...@@ -1243,14 +1233,15 @@ package body Exp_Intr is ...@@ -1243,14 +1233,15 @@ package body Exp_Intr is
-- --
-- Generate: -- Generate:
-- if Raised then -- if Raised then
-- Reraise_Occurrence (Exc_Occ); -- for .NET and -- Reraise_Occurrence (E); -- for .NET and
-- -- restricted RTS -- -- restricted RTS
-- <or> -- <or>
-- Raise_From_Controlled_Operation (Exc_Occ); -- all other cases -- Raise_From_Controlled_Operation (E, Abort); -- all other cases
-- end if; -- end if;
if Present (Raised_Id) then if Present (Raised_Id) then
Append_To (Stmts, Build_Raise_Statement (Loc, Exc_Occ_Id, Raised_Id)); Append_To (Stmts,
Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
end if; end if;
-- If we know the argument is non-null, then make a block statement -- If we know the argument is non-null, then make a block statement
......
gcc/ada/lib-writ.adb
...@@ -461,8 +461,7 @@ package body Lib.Writ is ...@@ -461,8 +461,7 @@ package body Lib.Writ is
Write_Info_Str (" O"); Write_Info_Str (" O");
Write_Info_Char (OA_Setting (Unit_Num)); Write_Info_Char (OA_Setting (Unit_Num));
if (Ekind (Uent) = E_Package if Ekind_In (Uent, E_Package, E_Package_Body)
or else Ekind (Uent) = E_Package_Body)
and then Present (Finalizer (Uent)) and then Present (Finalizer (Uent))
then then
Write_Info_Str (" PF"); Write_Info_Str (" PF");
......
gcc/ada/make.adb
...@@ -2313,8 +2313,8 @@ package body Make is ...@@ -2313,8 +2313,8 @@ package body Make is
new String'(Name_Buffer (1 .. Name_Len)); new String'(Name_Buffer (1 .. Name_Len));
Test_If_Relative_Path Test_If_Relative_Path
(New_Args (Last_New), (New_Args (Last_New),
Do_Fail => Make_Failed'Access, Do_Fail => Make_Failed'Access,
Parent => Dir_Path, Parent => Dir_Path,
Including_Non_Switch => False); Including_Non_Switch => False);
end if; end if;
...@@ -2322,10 +2322,9 @@ package body Make is ...@@ -2322,10 +2322,9 @@ package body Make is
end loop; end loop;
Add_Arguments Add_Arguments
(Configuration_Pragmas_Switch (Configuration_Pragmas_Switch (Arguments_Project)
(Arguments_Project) & & New_Args (1 .. Last_New)
New_Args (1 .. Last_New) & & The_Saved_Gcc_Switches.all);
The_Saved_Gcc_Switches.all);
end; end;
end; end;
...@@ -2341,8 +2340,8 @@ package body Make is ...@@ -2341,8 +2340,8 @@ package body Make is
(Name_Buffer (1 .. Name_Len))); (Name_Buffer (1 .. Name_Len)));
Dir_Path : constant String := Dir_Path : constant String :=
Get_Name_String Get_Name_String
(Arguments_Project. (Arguments_Project.
Directory.Display_Name); Directory.Display_Name);
begin begin
Test_If_Relative_Path Test_If_Relative_Path
...@@ -2687,11 +2686,11 @@ package body Make is ...@@ -2687,11 +2686,11 @@ package body Make is
if Add_It then if Add_It then
if not Queue.Insert if not Queue.Insert
((Format => Format_Gnatmake, ((Format => Format_Gnatmake,
File => Sfile, File => Sfile,
Unit => No_Unit_Name, Unit => No_Unit_Name,
Project => No_Project, Project => No_Project,
Index => 0)) Index => 0))
then then
if Is_In_Obsoleted (Sfile) then if Is_In_Obsoleted (Sfile) then
Executable_Obsolete := True; Executable_Obsolete := True;
...@@ -5901,10 +5900,10 @@ package body Make is ...@@ -5901,10 +5900,10 @@ package body Make is
-- except those of library projects. -- except those of library projects.
Prj.Env.Set_Ada_Paths Prj.Env.Set_Ada_Paths
(Project => Main_Project, (Project => Main_Project,
In_Tree => Project_Tree, In_Tree => Project_Tree,
Including_Libraries => False, Including_Libraries => False,
Include_Path => Use_Include_Path_File); Include_Path => Use_Include_Path_File);
-- If switch -C was specified, create a binder mapping file -- If switch -C was specified, create a binder mapping file
...@@ -6051,9 +6050,9 @@ package body Make is ...@@ -6051,9 +6050,9 @@ package body Make is
Linker_Switches.Increment_Last; Linker_Switches.Increment_Last;
Linker_Switches.Table (Linker_Switches.Last) := Linker_Switches.Table (Linker_Switches.Last) :=
new String'("-l" & new String'("-l" &
Get_Name_String Get_Name_String
(Library_Projs.Table (Index). (Library_Projs.Table (Index).
Library_Name)); Library_Name));
end if; end if;
end if; end if;
end loop; end loop;
...@@ -6421,22 +6420,23 @@ package body Make is ...@@ -6421,22 +6420,23 @@ package body Make is
Test_If_Relative_Path Test_If_Relative_Path
(Binder_Switches.Table (J), (Binder_Switches.Table (J),
Do_Fail => Make_Failed'Access, Do_Fail => Make_Failed'Access,
Parent => Dir_Path, Including_L_Switch => False); Parent => Dir_Path, Including_L_Switch => False);
end loop; end loop;
for for
J in Last_Linker_Switch + 1 .. Linker_Switches.Last J in Last_Linker_Switch + 1 .. Linker_Switches.Last
loop loop
Test_If_Relative_Path Test_If_Relative_Path
(Linker_Switches.Table (J), Parent => Dir_Path, (Linker_Switches.Table (J),
Parent => Dir_Path,
Do_Fail => Make_Failed'Access); Do_Fail => Make_Failed'Access);
end loop; end loop;
end; end;
-- We now put in the Binder_Switches and Linker_Switches -- We now put in the Binder_Switches and Linker_Switches
-- tables, the binder and linker switches of the command -- tables, the binder and linker switches of the command
-- line that have been put in the Saved_ tables. -- line that have been put in the Saved_ tables. These
-- These switches will follow the project file switches. -- switches will follow the project file switches.
for J in 1 .. Saved_Binder_Switches.Last loop for J in 1 .. Saved_Binder_Switches.Last loop
Add_Switch Add_Switch
...@@ -6461,6 +6461,7 @@ package body Make is ...@@ -6461,6 +6461,7 @@ package body Make is
if Do_Codepeer_Globalize_Step then if Do_Codepeer_Globalize_Step then
declare declare
Success : Boolean := False; Success : Boolean := False;
begin begin
Globalize (Success); Globalize (Success);
...@@ -6732,7 +6733,8 @@ package body Make is ...@@ -6732,7 +6733,8 @@ package body Make is
-- Test for trailing -D switch -- Test for trailing -D switch
elsif Object_Directory_Present elsif Object_Directory_Present
and then not Object_Directory_Seen then and then not Object_Directory_Seen
then
Make_Failed ("object directory missing after -D"); Make_Failed ("object directory missing after -D");
end if; end if;
...@@ -7382,6 +7384,7 @@ package body Make is ...@@ -7382,6 +7384,7 @@ package body Make is
for Next_Arg in 1 .. Argument_Count loop for Next_Arg in 1 .. Argument_Count loop
declare declare
Argv : constant String := Argument (Next_Arg); Argv : constant String := Argument (Next_Arg);
begin begin
if Argv'Length > 2 if Argv'Length > 2
and then Argv (1) = '-' and then Argv (1) = '-'
...@@ -7678,8 +7681,8 @@ package body Make is ...@@ -7678,8 +7681,8 @@ package body Make is
elsif Program_Args /= None then elsif Program_Args /= None then
-- Check to see if we are reading -I switches in order -- Check to see if we are reading -I switches in order to take into
-- to take into account in the src & lib search directories. -- account in the src & lib search directories.
if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
if Argv (3 .. Argv'Last) = "-" then if Argv (3 .. Argv'Last) = "-" then
......
gcc/ada/makeutl.adb
...@@ -180,8 +180,8 @@ package body Makeutl is ...@@ -180,8 +180,8 @@ package body Makeutl is
------------------------------ ------------------------------
function Check_Source_Info_In_ALI function Check_Source_Info_In_ALI
(The_ALI : ALI_Id; (The_ALI : ALI_Id;
Tree : Project_Tree_Ref) return Boolean Tree : Project_Tree_Ref) return Boolean
is is
Unit_Name : Name_Id; Unit_Name : Name_Id;
...@@ -943,8 +943,8 @@ package body Makeutl is ...@@ -943,8 +943,8 @@ package body Makeutl is
-- paths must be converted to absolute paths. -- paths must be converted to absolute paths.
Test_If_Relative_Path Test_If_Relative_Path
(Switch => Linker_Options_Buffer (Last_Linker_Option), (Switch => Linker_Options_Buffer (Last_Linker_Option),
Parent => Dir_Path, Parent => Dir_Path,
Do_Fail => Do_Fail, Do_Fail => Do_Fail,
Including_L_Switch => True); Including_L_Switch => True);
end if; end if;
...@@ -1498,7 +1498,8 @@ package body Makeutl is ...@@ -1498,7 +1498,8 @@ package body Makeutl is
procedure Extract procedure Extract
(Found : out Boolean; (Found : out Boolean;
Source : out Source_Info) is Source : out Source_Info)
is
begin begin
Found := False; Found := False;
...@@ -1565,7 +1566,8 @@ package body Makeutl is ...@@ -1565,7 +1566,8 @@ package body Makeutl is
procedure Initialize procedure Initialize
(Queue_Per_Obj_Dir : Boolean; (Queue_Per_Obj_Dir : Boolean;
Force : Boolean := False) is Force : Boolean := False)
is
begin begin
if Force or else not Q_Initialized then if Force or else not Q_Initialized then
Q_Initialized := True; Q_Initialized := True;
...@@ -1630,10 +1632,10 @@ package body Makeutl is ...@@ -1630,10 +1632,10 @@ package body Makeutl is
------------ ------------
procedure Insert (Source : Source_Info) is procedure Insert (Source : Source_Info) is
Tmp : Boolean; Discard : Boolean;
pragma Unreferenced (Tmp); pragma Unreferenced (Discard);
begin begin
Tmp := Insert (Source); Discard := Insert (Source);
end Insert; end Insert;
-------------- --------------
......
gcc/ada/makeutl.ads
...@@ -28,12 +28,13 @@ ...@@ -28,12 +28,13 @@
-- queue management. -- queue management.
with ALI; with ALI;
with GNAT.OS_Lib; use GNAT.OS_Lib; with Namet; use Namet;
with Namet; use Namet;
with Opt; with Opt;
with Prj; use Prj; with Prj; use Prj;
with Prj.Tree; with Prj.Tree;
with Types; use Types; with Types; use Types;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package Makeutl is package Makeutl is
...@@ -192,13 +193,12 @@ package Makeutl is ...@@ -192,13 +193,12 @@ package Makeutl is
Including_L_Switch : Boolean := True; Including_L_Switch : Boolean := True;
Including_Non_Switch : Boolean := True; Including_Non_Switch : Boolean := True;
Including_RTS : Boolean := False); Including_RTS : Boolean := False);
-- Test if Switch is a relative search path switch. If it is, fail if -- Test if Switch is a relative search path switch. If so, fail if Parent
-- Parent is the empty string, otherwise prepend the path with Parent. -- is the empty string, otherwise prepend the path with Parent. This
-- This subprogram is only called when using project files. For gnatbind -- subprogram is only used when using project files. For gnatbind switches,
-- switches, Including_L_Switch is False, because the argument of the -L -- Including_L_Switch is False, because the argument of the -L switch is
-- switch is not a path. If Including_RTS is True, process also switches -- not a path. If Including_RTS is True, process also switches --RTS=.
-- --RTS=. -- Do_Fail is called in case of error. Using Osint.Fail might be
-- Do_Fail is called in case of error. Using Osing.Fail might be
-- appropriate. -- appropriate.
function Path_Or_File_Name (Path : Path_Name_Type) return String; function Path_Or_File_Name (Path : Path_Name_Type) return String;
......
gcc/ada/prj.adb
...@@ -911,15 +911,14 @@ package body Prj is ...@@ -911,15 +911,14 @@ package body Prj is
begin begin
if Tree /= null then if Tree /= null then
if Tree.Is_Root_Tree then if Tree.Is_Root_Tree then
Name_List_Table.Free (Tree.Shared.Name_Lists); Name_List_Table.Free (Tree.Shared.Name_Lists);
Number_List_Table.Free (Tree.Shared.Number_Lists); Number_List_Table.Free (Tree.Shared.Number_Lists);
String_Element_Table.Free (Tree.Shared.String_Elements); String_Element_Table.Free (Tree.Shared.String_Elements);
Variable_Element_Table.Free (Tree.Shared.Variable_Elements); Variable_Element_Table.Free (Tree.Shared.Variable_Elements);
Array_Element_Table.Free (Tree.Shared.Array_Elements); Array_Element_Table.Free (Tree.Shared.Array_Elements);
Array_Table.Free (Tree.Shared.Arrays); Array_Table.Free (Tree.Shared.Arrays);
Package_Table.Free (Tree.Shared.Packages); Package_Table.Free (Tree.Shared.Packages);
Temp_Files_Table.Free (Tree.Shared.Private_Part.Temp_Files);
Temp_Files_Table.Free (Tree.Shared.Private_Part.Temp_Files);
end if; end if;
Source_Paths_Htable.Reset (Tree.Source_Paths_HT); Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
......
gcc/ada/prj.ads
...@@ -1409,7 +1409,6 @@ package Prj is ...@@ -1409,7 +1409,6 @@ package Prj is
Array_Elements : Array_Element_Table.Instance; Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance; Arrays : Array_Table.Instance;
Packages : Package_Table.Instance; Packages : Package_Table.Instance;
Private_Part : Private_Project_Tree_Data; Private_Part : Private_Project_Tree_Data;
end record; end record;
type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data; type Shared_Project_Tree_Data_Access is access all Shared_Project_Tree_Data;
......
gcc/ada/rtsfind.ads
...@@ -112,7 +112,7 @@ package Rtsfind is ...@@ -112,7 +112,7 @@ package Rtsfind is
-- package see declarations in the runtime entity table below. -- package see declarations in the runtime entity table below.
RTU_Null, RTU_Null,
-- Used as a null entry. Will cause an error if referenced. -- Used as a null entry (will cause an error if referenced)
-- Children of Ada -- Children of Ada
......
gcc/ada/s-soflin.ads
...@@ -62,7 +62,7 @@ package System.Soft_Links is ...@@ -62,7 +62,7 @@ package System.Soft_Links is
pragma Suppress_Initialization (No_Param_Proc); pragma Suppress_Initialization (No_Param_Proc);
-- Some uninitialized objects of that type are initialized by the Binder -- Some uninitialized objects of that type are initialized by the Binder
-- so it is important that such objects are not reset to null during -- so it is important that such objects are not reset to null during
-- elaboration -- elaboration.
type Addr_Param_Proc is access procedure (Addr : Address); type Addr_Param_Proc is access procedure (Addr : Address);
pragma Favor_Top_Level (Addr_Param_Proc); pragma Favor_Top_Level (Addr_Param_Proc);
...@@ -226,7 +226,7 @@ package System.Soft_Links is ...@@ -226,7 +226,7 @@ package System.Soft_Links is
Finalize_Library_Objects : No_Param_Proc; Finalize_Library_Objects : No_Param_Proc;
pragma Export (C, Finalize_Library_Objects, pragma Export (C, Finalize_Library_Objects,
"__gnat_finalize_library_objects"); "__gnat_finalize_library_objects");
-- will be initialized by the binder -- Will be initialized by the binder
Adafinal : No_Param_Proc := Adafinal_NT'Access; Adafinal : No_Param_Proc := Adafinal_NT'Access;
-- Performs the finalization of the Ada Runtime -- Performs the finalization of the Ada Runtime
......
gcc/ada/s-tassta.adb
...@@ -2011,10 +2011,10 @@ package body System.Tasking.Stages is ...@@ -2011,10 +2011,10 @@ package body System.Tasking.Stages is
-- Package elaboration code -- Package elaboration code
begin begin
-- Establish the Adafinal oftlink -- Establish the Adafinal softlink
-- This is not done inside the central RTS initialization routine -- This is not done inside the central RTS initialization routine
-- to avoid with-ing this package from System.Tasking.Initialization. -- to avoid with'ing this package from System.Tasking.Initialization.
SSL.Adafinal := Finalize_Global_Tasks'Access; SSL.Adafinal := Finalize_Global_Tasks'Access;
......
gcc/ada/sem_eval.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -964,6 +964,12 @@ package body Sem_Eval is ...@@ -964,6 +964,12 @@ package body Sem_Eval is
return Unknown; return Unknown;
end if; end if;
end if; end if;
else
-- If the range of either operand cannot be determined,
-- nothing further can be inferred.
return Unknown;
end if; end if;
end; end;
......
gcc/ada/sem_prag.adb
...@@ -4760,11 +4760,13 @@ package body Sem_Prag is ...@@ -4760,11 +4760,13 @@ package body Sem_Prag is
(Get_Base_Subprogram (Subprogram_Def), Link_Nam); (Get_Base_Subprogram (Subprogram_Def), Link_Nam);
end if; end if;
-- We allow duplicated export names in CIL, as they are always -- We allow duplicated export names in CIL/Java, as they are always
-- enclosed in a namespace that differentiates them, and overloaded -- enclosed in a namespace that differentiates them, and overloaded
-- entities are supported by the VM. -- entities are supported by the VM.
if Convention (Subprogram_Def) /= Convention_CIL then if Convention (Subprogram_Def) /= Convention_CIL
and then Convention (Subprogram_Def) /= Convention_Java
then
Check_Duplicated_Export_Name (Link_Nam); Check_Duplicated_Export_Name (Link_Nam);
end if; end if;
end Process_Interface_Name; end Process_Interface_Name;
......
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