From: Janus Weil <janus@gcc.gnu.org>
Date: Sat, 14 Dec 2013 10:31:56 +0000 (+0100)
Subject: re PR fortran/59450 ([OOP] ICE for type-bound-procedure expression in module procedur... 
X-Git-Tag: releases/gcc-4.9.0~2084
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=e575540bb45f3cf9f82e557d6459fa59c998013b;p=thirdparty%2Fgcc.git

re PR fortran/59450 ([OOP] ICE for type-bound-procedure expression in module procedure interface)

2013-12-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/59450
	* module.c (mio_expr): Handle type-bound function expressions.


2013-12-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/59450
	* gfortran.dg/typebound_proc_31.f90: New.

From-SVN: r205983
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9d8f1ba4127a..197b890c47c3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2013-12-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/59450
+	* module.c (mio_expr): Handle type-bound function expressions.
+
 2013-12-12  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/59440
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 0cd480185770..98e22df99633 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3358,12 +3358,24 @@ mio_expr (gfc_expr **ep)
 	{
 	  e->value.function.name
 	    = mio_allocated_string (e->value.function.name);
-	  flag = e->value.function.esym != NULL;
-	  mio_integer (&flag);
-	  if (flag)
-	    mio_symbol_ref (&e->value.function.esym);
+	  if (e->value.function.esym)
+	    flag = 1;
+	  else if (e->ref)
+	    flag = 2;
 	  else
-	    write_atom (ATOM_STRING, e->value.function.isym->name);
+	    flag = 0;
+	  mio_integer (&flag);
+	  switch (flag)
+	    {
+	    case 1:
+	      mio_symbol_ref (&e->value.function.esym);
+	      break;
+	    case 2:
+	      mio_ref_list (&e->ref);
+	      break;
+	    default:
+	      write_atom (ATOM_STRING, e->value.function.isym->name);
+	    }
 	}
       else
 	{
@@ -3372,10 +3384,15 @@ mio_expr (gfc_expr **ep)
 	  free (atom_string);
 
 	  mio_integer (&flag);
-	  if (flag)
-	    mio_symbol_ref (&e->value.function.esym);
-	  else
+	  switch (flag)
 	    {
+	    case 1:
+	      mio_symbol_ref (&e->value.function.esym);
+	      break;
+	    case 2:
+	      mio_ref_list (&e->ref);
+	      break;
+	    default:
 	      require_atom (ATOM_STRING);
 	      e->value.function.isym = gfc_find_function (atom_string);
 	      free (atom_string);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 351bef618180..91dcb335bb14 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-12-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/59450
+	* gfortran.dg/typebound_proc_31.f90: New.
+
 2013-12-13  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 	* g++.dg/cilk-plus/cilk-plus.exp: Properly set ld_library_path.
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_31.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_31.f90
new file mode 100644
index 000000000000..d83a9cdb4d0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_31.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR 59450: [OOP] ICE for type-bound-procedure expression in module procedure interface
+!
+! Contributed by <bugs@miller-mohr.de>
+
+module classes
+
+  implicit none
+
+  type :: base_class
+   contains
+     procedure, nopass :: get_num
+  end type
+
+contains
+
+  pure integer function get_num()
+  end function
+
+  function get_array( this ) result(array)
+    class(base_class), intent(in) :: this
+    integer, dimension( this%get_num() ) :: array
+  end function
+
+end module
+
+! { dg-final { cleanup-modules "classes" } }