[Bug fortran/56261] New: seg fault call procedure pointer on polymorphic array

["abensonca at gmail dot com" <gcc-bugzilla at gcc dot gnu dot org>]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=56261

             Bug #: 56261
           Summary: seg fault call procedure pointer on polymorphic array
    Classification: Unclassified
           Product: gcc
           Version: 4.8.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned@gcc.gnu.org
        ReportedBy: abensonca@gmail.com


The following test case causes a seg fault at run time using gfortran 4.8.0 
(r195874):

module t

  type, public :: nc
     character(len=3) :: n
  end type nc

  type, public :: tn
     class(nc), allocatable, dimension(:) :: c
   contains
     procedure :: mapProcPtr  =>  doMapProcPtr
     procedure :: mapExternal =>  doMapExternal
  end type tn

contains

  subroutine doMapProcPtr(self,func)
    implicit none
    class    (tn), intent(inout) :: self       
    procedure(  ), pointer       :: func
    call func(self%c) !! This form causes segfault.                             
!    call ff(self%c)  !! This form works.                                       
    return
  end subroutine doMapProcPtr

  subroutine doMapExternal(self,func)
    implicit none
    class    (tn), intent(inout) :: self       
    external                     :: func
    call func(self%c)
    return
  end subroutine doMapExternal

  subroutine ff(self)
    implicit none
    class(nc), intent(in), dimension(:) :: self

    write (0,*) '  --> in "ff" size of self is ',size(self)
    write (0,*) '  --> content of self(1)%n) is ',self(1)%n
    return
  end subroutine ff

end module t

program p
  use t
  implicit none
  type     (tn)          :: a
  procedure(  ), pointer :: f => ff

  allocate(a%c(10))
  a%c(1)%n='abc'
  write (0,*) 'in "p" size of a%c is ',size(a%c)
  write (0,*) "directly call ff():"
  call ff(a%c)
  ! write (0,*) "call via a%mapExternal(f):" !! Using this version, which 
passes the function to call as an                          
  ! call a%mapExternal(f)                    !! EXTERNAL rather than as a 
procedure pointer also segfaults.                          
  write (0,*) "call via a%mapProcPtr(f):"
  call a%mapProcPtr(f)

end program p


$ gfortran -v
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=/home/abenson/libexec/gcc/x86_64-unknown-linux-
gnu/4.8.0/lto-wrapper
Target: x86_64-unknown-linux-gnu
Configured with: ../gcc-trunk/configure --prefix=/home/abenson --enable-
languages=c,c++,fortran --disable-multilib --with-gmp=/home/abenson
Thread model: posix
gcc version 4.8.0 20130208 (experimental) (GCC) 
$ gfortran -o bug.exe bug.F90
$ bug.exe 
 in "p" size of a%c is           10
 directly call ff():
   --> in "ff" size of self is           10
   --> content of self(1)%n) is abc
 call via a%mapProcPtr(f):
   --> in "ff" size of self is       131154

Program received signal SIGSEGV: Segmentation fault - invalid memory 
reference.

Backtrace for this error:
#0  0x2AE75E9FC387
#1  0x2AE75E9FC99E
#2  0x3D470302CF
#3  0x400BA4 in __t_MOD_ff
#4  0x400DB1 in __t_MOD_domapprocptr
#5  0x401106 in MAIN__ at bug.F90:0
Segmentation fault

The same problem happens if I use an EXTERNAL instead of a procedure pointer, 
but not if I call the subroutine directly.

If "c" in the "tn" type is a instead scalar then this works successfully.

Running this through valgrind I get:

$ valgrind bug.exe
==4488== Memcheck, a memory error detector
==4488== Copyright (C) 2002-2011, and GNU GPL'd, by Julian Seward et al.
==4488== Using Valgrind-3.7.0 and LibVEX; rerun with -h for copyright info
==4488== Command: bug.exe
==4488== 
 in "p" size of a%c is           10
 directly call ff():
   --> in "ff" size of self is           10
   --> content of self(1)%n) is abc
 call via a%mapProcPtr(f):
==4488== Invalid read of size 8
==4488==    at 0x400ADA: __t_MOD_ff (in ./bug.exe)
==4488==    by 0x400DB1: __t_MOD_domapprocptr (in ./bug.exe)
==4488==    by 0x401106: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488==  Address 0x5396368 is 10 bytes after a block of size 30 alloc'd
==4488==    at 0x4A08328: malloc (vg_replace_malloc.c:263)
==4488==    by 0x400E4E: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488== 
==4488== Invalid read of size 8
==4488==    at 0x400ADE: __t_MOD_ff (in ./bug.exe)
==4488==    by 0x400DB1: __t_MOD_domapprocptr (in ./bug.exe)
==4488==    by 0x401106: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488==  Address 0x5396360 is 2 bytes after a block of size 30 alloc'd
==4488==    at 0x4A08328: malloc (vg_replace_malloc.c:263)
==4488==    by 0x400E4E: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488== 
   --> in "ff" size of self is            1
==4488== Invalid read of size 8
==4488==    at 0x400B92: __t_MOD_ff (in ./bug.exe)
==4488==    by 0x400DB1: __t_MOD_domapprocptr (in ./bug.exe)
==4488==    by 0x401106: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488==  Address 0x5396358 is 24 bytes inside a block of size 30 alloc'd
==4488==    at 0x4A08328: malloc (vg_replace_malloc.c:263)
==4488==    by 0x400E4E: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488== 
==4488== Invalid read of size 8
==4488==    at 0x400BA0: __t_MOD_ff (in ./bug.exe)
==4488==    by 0x400DB1: __t_MOD_domapprocptr (in ./bug.exe)
==4488==    by 0x401106: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488==  Address 0x5396370 is not stack'd, malloc'd or (recently) free'd
==4488== 
==4488== Invalid read of size 4
==4488==    at 0x400BA4: __t_MOD_ff (in ./bug.exe)
==4488==    by 0x400DB1: __t_MOD_domapprocptr (in ./bug.exe)
==4488==    by 0x401106: MAIN__ (in ./bug.exe)
==4488==    by 0x401162: main (in ./bug.exe)
==4488==  Address 0x4 is not stack'd, malloc'd or (recently) free'd
==4488== 

Program received signal SIGSEGV: Segmentation fault - invalid memory 
reference.

Backtrace for this error:
#0  0x4C27387
#1  0x4C2799E
#2  0x3D470302CF
#3  0x400BA4 in __t_MOD_ff
#4  0x400DB1 in __t_MOD_domapprocptr
#5  0x401106 in MAIN__ at bug.F90:0
==4488== 
==4488== HEAP SUMMARY:
==4488==     in use at exit: 3,727 bytes in 18 blocks
==4488==   total heap usage: 18 allocs, 0 frees, 3,727 bytes allocated
==4488== 
==4488== LEAK SUMMARY:
==4488==    definitely lost: 0 bytes in 0 blocks
==4488==    indirectly lost: 0 bytes in 0 blocks
==4488==      possibly lost: 0 bytes in 0 blocks
==4488==    still reachable: 3,727 bytes in 18 blocks
==4488==         suppressed: 0 bytes in 0 blocks
==4488== Rerun with --leak-check=full to see details of leaked memory
==4488== 
==4488== For counts of detected and suppressed errors, rerun with: -v
==4488== ERROR SUMMARY: 5 errors from 5 contexts (suppressed: 4 from 4)
Segmentation fault