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
