[Bug fortran/51605] internal compiler error gfc_trans_block_construct, at fortran/trans-stmt.c:984

["kargl at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

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

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |kargl at gcc dot gnu.org

--- Comment #3 from kargl at gcc dot gnu.org 2011-12-18 07:07:22 UTC ---
laptop:kargl[499] gfc4x --version
GNU Fortran (GCC) 4.7.0 20111124 (experimental)

laptop:kargl[500] gfc4x -o z coco.f90
coco.f90: In function 'process_coco_statement':
coco.f90:89:0: internal compiler error: in gfc_trans_block_construct, at
fortran/trans-stmt.c:1193


Reduced testcase.


program coco

use, intrinsic :: iso_fortran_env, only: input_unit, output_unit

implicit none

character( len= *), parameter :: string_fmt = '( a)'
character( len= *), parameter :: integer_fmt = '( a, i10)'
character( len= *), parameter :: directory_fmt = '( a, i0, a)'
character( len= *), parameter :: conversion_fmt = '(i10)'
character( len= *), parameter :: null_string = ''
character( len= *), parameter :: mark_set_file = 'following SET file'
character( len= *), parameter :: alpha_chars = 'abcdefghijklmnopqrstuvwxyz'
character( len= *), parameter :: digit_chars = '0123456789'
character( len= *), parameter :: underscore = '_'
character( len= *), parameter :: alphanum_chars =  alpha_chars // digit_chars
// underscore
character( len= *), parameter :: dot = '.'
character( len= *), parameter :: equals = '='
integer, parameter :: format_len = max(3, 12)
integer, parameter :: io_specifier_len = 16
integer, parameter :: conversion_len = 10
integer, parameter :: symbol_name_len = 31
integer, parameter :: free_form_len = 131
integer, parameter :: fixed_form_len = 72
integer, parameter :: source_line_len = 12
integer, parameter :: file_name_len = 256
integer, parameter :: max_continuations = 39

type, abstract :: symbol_t
   logical referenced
   class(symbol_t), pointer :: next
end type symbol_t

type, extends(symbol_t) :: logical_t
   logical logical_value
   type(logical_t), pointer :: next_logical
end type logical_t

type, extends(symbol_t) :: integer_t
   integer integer_value
   type(integer_t), pointer :: next_integer
end type integer_t

class( symbol_t), pointer :: first_symbol
class( symbol_t), pointer :: last_symbol

type( integer_t), pointer :: first_integer
type( integer_t), pointer :: last_integer

type( logical_t), pointer :: first_logical
type( logical_t), pointer :: last_logical

class( symbol_t), pointer :: first_sf_symbol
class( symbol_t), pointer :: last_sf_symbol

type( integer_t), pointer :: first_cl_integer
type( integer_t), pointer :: last_cl_integer

type( logical_t), pointer :: first_cl_logical
type( logical_t), pointer :: last_cl_logical

contains

subroutine process_coco_statement(coco_stmt)

   character(len= *), intent(in) :: coco_stmt

   class(symbol_t), pointer :: symbol_ptr

   type(integer_t), pointer :: integer_ptr
   type(logical_t), pointer :: logical_ptr
   integer eq_idx
   integer expr_idx

   nullify( symbol_ptr)

   eq_idx =  scan( coco_stmt( 1: symbol_name_len + len( equals)), equals)

   got_equals: if( eq_idx > 0 )then

      call seek_symbol_name( coco_stmt( 1: eq_idx - 1), symbol_ptr)

   end if got_equals

   if (associated(symbol_ptr))then

      expr_idx = eq_idx + len(equals)

      integer_or_logical: select type(symbol_ptr)
      type is(integer_t) integer_or_logical
         integer_ptr => symbol_ptr
         call process_integer_assignment( coco_stmt( expr_idx: ), integer_ptr)
      type is(logical_t) integer_or_logical
         logical_ptr => symbol_ptr
         call process_logical_assignment( coco_stmt( expr_idx: ), logical_ptr)
      class default integer_or_logical
         call msg_quit("target of assignment must ")
      end select integer_or_logical
   end if

end subroutine process_coco_statement

subroutine integer_or_logical( expr_str, flag)
character(len= *), intent(in) :: expr_str
logical, intent(out) :: flag
flag = .true.
end subroutine integer_or_logical

recursive subroutine eval_int_expr( int_expr, value)
character(len= *), intent(in) :: int_expr
integer, intent(out) :: value
value = 42
end subroutine eval_int_expr

end program coco