This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] ada: Fix crash with deeply inherited function


Regtested on i686-pc-linux-gnu.

    gcc/ada/
	PR ada/34149
	* exp_ch3.adb (Make_Controlling_Function_Wrappers): Ignore
	primitive operations that have just been created and not yet
	analyzed.

    gcc/testsuite/
	PR ada/34149
	* gnat.dg/deep_inheritance.ads, gnat.dg/deep_inheritance.adb: New
	test.
---
 gcc/ada/exp_ch3.adb                        |    1 +
 gcc/testsuite/gnat.dg/deep_inheritance.adb |   16 ++++++++++++++
 gcc/testsuite/gnat.dg/deep_inheritance.ads |   31 ++++++++++++++++++++++++++++
 3 files changed, 48 insertions(+), 0 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/deep_inheritance.adb
 create mode 100644 gcc/testsuite/gnat.dg/deep_inheritance.ads

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6be11a7..14f6b45 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6895,6 +6895,7 @@ package body Exp_Ch3 is
            or else Ekind (Subp) /= E_Function
            or else not Has_Controlling_Result (Subp)
            or else Is_Access_Type (Etype (Subp))
+           or else not Is_Subprogram (Alias (Subp))
            or else Is_Abstract_Subprogram (Alias (Subp))
            or else Is_TSS (Subp, TSS_Stream_Input)
          then
diff --git a/gcc/testsuite/gnat.dg/deep_inheritance.adb b/gcc/testsuite/gnat.dg/deep_inheritance.adb
new file mode 100644
index 0000000..01f3348
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deep_inheritance.adb
@@ -0,0 +1,16 @@
+-- { dg-do compile }
+package body Deep_Inheritance is
+
+   function Named_Item_NS
+     (Self : not null access constant Q_Dom_Named_Node_Map'Class;
+      Ns_URI : in String;
+      Local_Name : in String)
+     return Q_Dom_Node
+   is
+   begin
+      return R : Q_Dom_Node do
+         null;
+      end return;
+   end Named_Item_NS;
+
+end Deep_Inheritance;
diff --git a/gcc/testsuite/gnat.dg/deep_inheritance.ads b/gcc/testsuite/gnat.dg/deep_inheritance.ads
new file mode 100644
index 0000000..ed5e165
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deep_inheritance.ads
@@ -0,0 +1,31 @@
+package Deep_Inheritance is
+
+   type Q_Dom_Named_Node_Map is tagged private;
+
+   type Q_Dom_Node is tagged private;
+
+   type Q_Dom_Character_Data is new Q_Dom_Node with private;
+
+   type Q_Dom_Text is new Q_Dom_Character_Data with private;
+
+   type Q_Dom_CDATA_Section is new Q_Dom_Text with private;
+
+   function Named_Item_NS
+     (Self : not null access constant Q_Dom_Named_Node_Map'Class;
+      Ns_URI : in String;
+      Local_Name : in String)
+     return Q_Dom_Node;
+
+private
+
+   type Q_Dom_Named_Node_Map is tagged null record;
+
+   type Q_Dom_Node is tagged null record;
+
+   type Q_Dom_Character_Data is new Q_Dom_Node with null record;
+
+   type Q_Dom_Text is new Q_Dom_Character_Data with null record;
+
+   type Q_Dom_CDATA_Section is new Q_Dom_Text with null record;
+
+end Deep_Inheritance;
-- 
1.5.3.6


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]