Commit 9f8483ca by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Fix problematic overloading of operator in Ada 95 mode

The change reverts the test deciding whether an initialization procedure
can be inherited from parent to derived type to the original
implementation, which allowed inheriting a null procedure.

This prevents the creation of another null initialization procedure for
the derived type, which in turn can avoid an artificial overloading
which can wreak havoc in the analysis of private declarations of a
package.

2018-12-03  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch3.adb (Build_Record_Init_Proc): Inherit an
	initialization procedure if it is present, even if it is null.

gcc/testsuite/

	* gnat.dg/overload2.adb, gnat.dg/overload2_p.adb,
	gnat.dg/overload2_p.ads, gnat.dg/overload2_q.adb,
	gnat.dg/overload2_q.ads: New testcase.

From-SVN: r266753
parent c899d4ba
2018-12-03 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch3.adb (Build_Record_Init_Proc): Inherit an
initialization procedure if it is present, even if it is null.
2018-12-03 Patrick Bernardi <bernardi@adacore.com>
* libgnarl/s-taskin.ads (ATC_Level_Base): Redefine to span from
......
......@@ -3712,7 +3712,7 @@ package body Exp_Ch3 is
and then not Is_Unchecked_Union (Rec_Type)
and then not Has_New_Non_Standard_Rep (Rec_Type)
and then not Parent_Subtype_Renaming_Discrims
and then Has_Non_Null_Base_Init_Proc (Etype (Rec_Type))
and then Present (Base_Init_Proc (Etype (Rec_Type)))
then
Copy_TSS (Base_Init_Proc (Etype (Rec_Type)), Rec_Type);
......
2018-12-03 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/overload2.adb, gnat.dg/overload2_p.adb,
gnat.dg/overload2_p.ads, gnat.dg/overload2_q.adb,
gnat.dg/overload2_q.ads: New testcase.
2018-12-03 Fritz Reese <fritzoreese@gmail.com>
Mark Eggleston <mark.eggleston@codethink.co.uk>
......
-- { dg-do compile }
-- { dg-options "-gnat95" }
with Overload2_P; use Overload2_P;
with text_io; use text_io;
procedure overload2 is
this, that: t;
yes : boolean := this /= that;
begin
if not yes then
put_line ("FAILED");
end if;
end;
-- { dg-options "-gnat95 -gnatws" }
package body overload2_p is
function "=" (this, that: t) return boolean is begin return True; end;
this, that : t;
end;
with overload2_q;
package overload2_p is
type t is new overload2_q.t;
private
function "=" (this, that: t) return boolean;
end;
-- { dg-options "-gnat95" }
package body overload2_q is
function "=" (this, that: t) return boolean is begin return False; end;
end;
package overload2_q is
type t is null record;
function "=" (this, that: t) return boolean;
end;
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