Commit 7340e432 by Arnaud Charlet

[multiple changes]

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_User_Defined_Binary_Op): If left operand is
	overloaded and one interpretation matches the context, label the
	operand with the type of first formal.

2009-04-20  Bob Duff  <duff@adacore.com>

	* debug.ads: Minor comment fix.

	* debug.adb: Minor comment fixes.

2009-04-20  Javier Miranda  <miranda@adacore.com>

	* rtsfind.ads (RE_Null_Id): New entity of package Ada.Exceptions

	* exp_ch6.adb (Expand_Inlined_Call): Undo previous patch.

	* exp_ch11.adb (Expand_N_Raise_Statement): When the raise stmt
	is expanded into a call to Raise_Exception, avoid passing the
	exception-name'identity in runtimes in which this argument
	is not used.

From-SVN: r146416
parent bf06d37f
2009-04-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Analyze_User_Defined_Binary_Op): If left operand is
overloaded and one interpretation matches the context, label the
operand with the type of first formal.
2009-04-20 Bob Duff <duff@adacore.com>
* debug.ads: Minor comment fix.
* debug.adb: Minor comment fixes.
2009-04-20 Javier Miranda <miranda@adacore.com>
* rtsfind.ads (RE_Null_Id): New entity of package Ada.Exceptions
* exp_ch6.adb (Expand_Inlined_Call): Undo previous patch.
* exp_ch11.adb (Expand_N_Raise_Statement): When the raise stmt
is expanded into a call to Raise_Exception, avoid passing the
exception-name'identity in runtimes in which this argument
is not used.
2009-04-20 Jerome Lambourg <lambourg@adacore.com> 2009-04-20 Jerome Lambourg <lambourg@adacore.com>
* impunit.adb: Add i-cil and i-cilobj packages, now needed by the * impunit.adb: Add i-cil and i-cilobj packages, now needed by the
...@@ -191,7 +191,7 @@ package body Debug is ...@@ -191,7 +191,7 @@ package body Debug is
-- dc -- dc
-- dd -- dd
-- de -- de
-- df -- df Only output file names, not path names, in log
-- dg -- dg
-- dh -- dh
-- di -- di
...@@ -428,8 +428,6 @@ package body Debug is ...@@ -428,8 +428,6 @@ package body Debug is
-- in preelaborable packages, but this restriction is a huge pain, -- in preelaborable packages, but this restriction is a huge pain,
-- especially in the predefined library units. -- especially in the predefined library units.
-- dQ needs full documentation ???
-- dR Bypass the check for a proper version of s-rpc being present -- dR Bypass the check for a proper version of s-rpc being present
-- to use the -gnatz? switch. This allows debugging of the use -- to use the -gnatz? switch. This allows debugging of the use
-- of stubs generation without needing to have GLADE (or some -- of stubs generation without needing to have GLADE (or some
...@@ -612,6 +610,10 @@ package body Debug is ...@@ -612,6 +610,10 @@ package body Debug is
-- be listed, and is useful when diagnosing circularities introduced -- be listed, and is useful when diagnosing circularities introduced
-- by incorrect changes to the run-time library itself. -- by incorrect changes to the run-time library itself.
-- db Output debug information from Better_Choice in Binde, which uses
-- various heuristics to determine elaboration order in cases where
-- multiple orders are valid.
-- dc List units as they are chosen. As units are selected for addition to -- dc List units as they are chosen. As units are selected for addition to
-- the elaboration order, a line of output is generated showing which -- the elaboration order, a line of output is generated showing which
-- unit has been selected. -- unit has been selected.
......
...@@ -40,14 +40,13 @@ package Debug is ...@@ -40,14 +40,13 @@ package Debug is
-- Dynamic Debug Flags -- -- Dynamic Debug Flags --
------------------------- -------------------------
-- Sixty two flags that can be used to active various specialized -- Flags that can be used to active various specialized debugging output
-- debugging output information. The flags are preset to False, which -- information. The flags are preset to False, which corresponds to the
-- corresponds to the given output being suppressed. The individual -- given output being suppressed. The individual flags can be turned on
-- flags can be turned on using the undocumented switch dxxx where -- using the undocumented switch dxxx where xxx is a string of letters for
-- xxx is a string of letters for flags to be turned on. Documentation -- flags to be turned on. Documentation on the current usage of these flags
-- on the current usage of these flags is contained in the body of Debug -- is contained in the body of Debug rather than the spec, so that we don't
-- rather than the spec, so that we don't have to recompile the world -- have to recompile the world when a new debug flag is added.
-- when a new debug flag is added
Debug_Flag_A : Boolean := False; Debug_Flag_A : Boolean := False;
Debug_Flag_B : Boolean := False; Debug_Flag_B : Boolean := False;
......
...@@ -35,9 +35,9 @@ with Namet; use Namet; ...@@ -35,9 +35,9 @@ with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt; with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Restrict; use Restrict; with Restrict; use Restrict;
with Rident; use Rident; with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Sem; use Sem; with Sem; use Sem;
with Sem_Ch8; use Sem_Ch8; with Sem_Ch8; use Sem_Ch8;
with Sem_Res; use Sem_Res; with Sem_Res; use Sem_Res;
...@@ -1407,14 +1407,33 @@ package body Exp_Ch11 is ...@@ -1407,14 +1407,33 @@ package body Exp_Ch11 is
-- and there is nothing else to do. -- and there is nothing else to do.
if Present (Expression (N)) then if Present (Expression (N)) then
Rewrite (N,
Make_Procedure_Call_Statement (Loc, -- Avoid passing exception-name'identity in runtimes in which this
Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc), -- argument is not used. This avoids generating undefined references
Parameter_Associations => New_List ( -- to these exceptions when compiling with no optimization
Make_Attribute_Reference (Loc,
Prefix => Name (N), if Configurable_Run_Time_On_Target
Attribute_Name => Name_Identity), and then (Restriction_Active (No_Exception_Handlers)
Expression (N)))); or else
Restriction_Active (No_Exception_Propagation))
then
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (RTE (RE_Null_Id), Loc),
Expression (N))));
else
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Raise_Exception), Loc),
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix => Name (N),
Attribute_Name => Name_Identity),
Expression (N))));
end if;
Analyze (N); Analyze (N);
return; return;
end if; end if;
......
...@@ -3670,16 +3670,6 @@ package body Exp_Ch6 is ...@@ -3670,16 +3670,6 @@ package body Exp_Ch6 is
return; return;
end if; end if;
-- Avoid generation of temporaries for unreferenced formals
-- What is going on here ??? test below is for *PRAGMA* unreferenced
-- not for an unreferenced formal. Is this a bug fix, or simply an
-- optimization. Needs comment fix and explanation ???
if Has_Pragma_Unreferenced (F) then
goto Continue;
end if;
-- If the argument may be a controlling argument in a call within -- If the argument may be a controlling argument in a call within
-- the inlined body, we must preserve its classwide nature to insure -- the inlined body, we must preserve its classwide nature to insure
-- that dynamic dispatching take place subsequently. If the formal -- that dynamic dispatching take place subsequently. If the formal
...@@ -3800,7 +3790,6 @@ package body Exp_Ch6 is ...@@ -3800,7 +3790,6 @@ package body Exp_Ch6 is
Set_Renamed_Object (F, Temp); Set_Renamed_Object (F, Temp);
end if; end if;
<<Continue>>
Next_Formal (F); Next_Formal (F);
Next_Actual (A); Next_Actual (A);
end loop; end loop;
......
...@@ -490,6 +490,7 @@ package Rtsfind is ...@@ -490,6 +490,7 @@ package Rtsfind is
RE_Exception_Message, -- Ada.Exceptions RE_Exception_Message, -- Ada.Exceptions
RE_Exception_Name_Simple, -- Ada.Exceptions RE_Exception_Name_Simple, -- Ada.Exceptions
RE_Exception_Occurrence, -- Ada.Exceptions RE_Exception_Occurrence, -- Ada.Exceptions
RE_Null_Id, -- Ada.Exceptions
RE_Null_Occurrence, -- Ada.Exceptions RE_Null_Occurrence, -- Ada.Exceptions
RE_Poll, -- Ada.Exceptions RE_Poll, -- Ada.Exceptions
RE_Raise_Exception, -- Ada.Exceptions RE_Raise_Exception, -- Ada.Exceptions
...@@ -1652,6 +1653,7 @@ package Rtsfind is ...@@ -1652,6 +1653,7 @@ package Rtsfind is
RE_Exception_Message => Ada_Exceptions, RE_Exception_Message => Ada_Exceptions,
RE_Exception_Name_Simple => Ada_Exceptions, RE_Exception_Name_Simple => Ada_Exceptions,
RE_Exception_Occurrence => Ada_Exceptions, RE_Exception_Occurrence => Ada_Exceptions,
RE_Null_Id => Ada_Exceptions,
RE_Null_Occurrence => Ada_Exceptions, RE_Null_Occurrence => Ada_Exceptions,
RE_Poll => Ada_Exceptions, RE_Poll => Ada_Exceptions,
RE_Raise_Exception => Ada_Exceptions, RE_Raise_Exception => Ada_Exceptions,
......
...@@ -3918,6 +3918,18 @@ package body Sem_Ch4 is ...@@ -3918,6 +3918,18 @@ package body Sem_Ch4 is
then then
Add_One_Interp (N, Op_Id, Etype (Op_Id)); Add_One_Interp (N, Op_Id, Etype (Op_Id));
-- If the left operand is overloaded, indicate that the
-- current type is a viable candidate. This is redundant
-- in most cases, but for equality and comparison operators
-- where the context does not impose a type on the operands,
-- setting the proper type is necessary to avoid subsequent
-- ambiguities during resolution, when both user-defined and
-- predefined operators may be candidates.
if Is_Overloaded (Left_Opnd (N)) then
Set_Etype (Left_Opnd (N), Etype (F1));
end if;
if Debug_Flag_E then if Debug_Flag_E then
Write_Str ("user defined operator "); Write_Str ("user defined operator ");
Write_Name (Chars (Op_Id)); Write_Name (Chars (Op_Id));
......
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