[Ada] Fix problematic overloading of operator in Ada 95 mode
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 3 Dec 2018 15:49:12 +0000 (15:49 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Mon, 3 Dec 2018 15:49:12 +0000 (15:49 +0000)
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

gcc/ada/ChangeLog
gcc/ada/exp_ch3.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/overload2.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/overload2_p.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/overload2_p.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/overload2_q.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/overload2_q.ads [new file with mode: 0644]

index dae657493a095821c4c44f6de0e6a888d7879fda..481f9da53e6b09d8b0ede2f42e67b2f9a783fd5c 100644 (file)
@@ -1,3 +1,8 @@
+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
index 65f6805bb7c9212d9e8148b2be44f696fcf93ea9..35b8fe3c816602da0df16d69ff9c54022207828a 100644 (file)
@@ -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);
 
index fdb6f8b75cab449a5d70b9124cd2992b24929774..b69ad66131680fe2239491846f16d58f13e40f8f 100644 (file)
@@ -1,3 +1,9 @@
+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>
 
diff --git a/gcc/testsuite/gnat.dg/overload2.adb b/gcc/testsuite/gnat.dg/overload2.adb
new file mode 100644 (file)
index 0000000..56c8587
--- /dev/null
@@ -0,0 +1,13 @@
+--  { 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;
diff --git a/gcc/testsuite/gnat.dg/overload2_p.adb b/gcc/testsuite/gnat.dg/overload2_p.adb
new file mode 100644 (file)
index 0000000..49343cd
--- /dev/null
@@ -0,0 +1,6 @@
+--  { dg-options "-gnat95 -gnatws" }
+
+package body overload2_p is
+   function "=" (this, that: t) return boolean is begin return True; end;
+   this, that : t;
+end;
diff --git a/gcc/testsuite/gnat.dg/overload2_p.ads b/gcc/testsuite/gnat.dg/overload2_p.ads
new file mode 100644 (file)
index 0000000..8d4da74
--- /dev/null
@@ -0,0 +1,6 @@
+with overload2_q;
+package overload2_p is
+   type t is new overload2_q.t;
+private
+   function "=" (this, that: t) return boolean;
+end;
diff --git a/gcc/testsuite/gnat.dg/overload2_q.adb b/gcc/testsuite/gnat.dg/overload2_q.adb
new file mode 100644 (file)
index 0000000..55a756e
--- /dev/null
@@ -0,0 +1,5 @@
+--  { dg-options "-gnat95" }
+
+package body overload2_q is
+  function "=" (this, that: t) return boolean is begin return False; end;
+end;
diff --git a/gcc/testsuite/gnat.dg/overload2_q.ads b/gcc/testsuite/gnat.dg/overload2_q.ads
new file mode 100644 (file)
index 0000000..c4e89aa
--- /dev/null
@@ -0,0 +1,4 @@
+package overload2_q is
+  type t is null record;
+  function "=" (this, that: t) return boolean;
+end;