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
This commit is contained in:
Janus Weil 2013-12-14 11:31:56 +01:00
parent deb1de6782
commit e575540bb4
4 changed files with 63 additions and 8 deletions

View File

@ -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

View File

@ -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);

View File

@ -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.

View File

@ -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" } }