ICE with gfortran 4.6.0

[Arjen Markus <arjen dot markus895 at gmail dot com>]

Hello,

compiling the source code below produces an ICE. I have tried to
reduce the source code, but then
the ICE disappears, which is why I reproduce it in full. I have been
able to correct the syntactical
problems, and the program is working fine, but I thought I'd report the ICE.


gfortran produces the following output on my Windows XP machine:

factory_prng_ice_gfortran.f90:27.27:

        procedure(get_next) :: get => get_uniform
                           1
Error: PROCEDURE(interface) at (1) should be declared DEFERRED
factory_prng_ice_gfortran.f90:33.27:

        procedure(get_next) :: get => get_exponential
                           1
Error: PROCEDURE(interface) at (1) should be declared DEFERRED
factory_prng_ice_gfortran.f90:68.23:

             allocate( type(prng_uniform) :: prng_create )
                       1
Error: Allocate-object at (1) is not a nonprocedure pointer or an
allocatable variable
factory_prng_ice_gfortran.f90:71.23:

             allocate( type(prng_exponential) :: prng_create )
                       1
Error: Allocate-object at (1) is not a nonprocedure pointer or an
allocatable variable
factory_prng_ice_gfortran.f90:30.43:

    type, extends(prng) :: prng_exponential
                                           1
Error: Derived-type 'prng_exponential' declared at (1) must be
ABSTRACT because 'get' is DEFERRED and not overridden
factory_prng_ice_gfortran.f90:24.39:

    type, extends(prng) :: prng_uniform
                                       1
Error: Derived-type 'prng_uniform' declared at (1) must be ABSTRACT
because 'get' is DEFERRED and not overridden
f951.exe: internal compiler error: in gfc_enforce_clean_symbol_state,
at fortran/symbol.c:3482
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.



The version of gfortran I am using is:

Built by Equation Solution <http://www.Equation.com>.
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=d:/gcc4.6/bin/../libexec/gcc/i686-pc-mingw32/4.6.0/lto-wrapper.exe
Target: i686-pc-mingw32
Thread model: win32
gcc version 4.6.0 20110101 (experimental) (GCC)


The source code is:

! factory_prng.f90 --
!     Example of a simple "factory" for pseudo-random number
!     generators (PRNG)
!
module prng_factory
    implicit none

    integer, parameter :: type_uniform     = 1
    integer, parameter :: type_exponential = 2

    type, abstract :: prng
        ! No data
    contains
        procedure(get_next), deferred :: get
    end type

    abstract interface
        real function get_next( params )
            import :: prng
            class(prng) :: params
        end function get_next
    end interface

    type, extends(prng) :: prng_uniform
        real :: xmin, xmax
    contains
        procedure(get_next) :: get => get_uniform
    end type

    type, extends(prng) :: prng_exponential
        real :: xmean
    contains
        procedure(get_next) :: get => get_exponential
    end type

contains
real function get_uniform( params )
    type(prng_uniform) :: params

    real               :: r

    call random_number( r )

    get_uniform = params%xmin + (params%xmax-params%xmin) * r

end function get_uniform

real function get_exponential( params )
    type(prng_exponential) :: params

    real               :: r

    call random_number( r )

    get_exponential = -params%xmean * log( r )

end function get_exponential

function prng_create( type, param1, param2 )
     integer              :: type
     real                 :: param1
     real, optional       :: param2

     class(prng), pointer :: prng_create

     select case (type)
         case (type_uniform)
             allocate( type(prng_uniform) :: prng_create )

         case (type_exponential)
             allocate( type(prng_exponential) :: prng_create )

         case default
             nullify( prng_create )
     end select

     select type (prng_create)
         type is (prng_uniform)
             if ( present(param2) ) then
                 prng_create%xmin = param1
                 prng_create%xmax = param2
             else
                 prng_create%xmin = 0.0
                 prng_create%xmax = param1
             endif

         type is (prng_exponential)
             prng_create%xmean = param1

     end select
end function prng_create

end module prng_factory


Regards,

Arjen