public inbox for gcc-bugs@sourceware.org
help / color / mirror / Atom feed
* [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures
@ 2009-06-14 21:50 juergen dot reuter at desy dot de
2009-06-14 22:14 ` [Bug fortran/40440] " kargl at gcc dot gnu dot org
` (16 more replies)
0 siblings, 17 replies; 18+ messages in thread
From: juergen dot reuter at desy dot de @ 2009-06-14 21:50 UTC (permalink / raw)
To: gcc-bugs
In derived type structures which are themselves array-valued garbage is stored
and can produce segmentation faults. The behaviour seems erratic and not really
reproduceable. The code makes use of the module iso_varying_string.f90
which can be found here (putting it in below would have exceeded the limit of
64 kb for the description): http://www.fortran.com/iso_varying_string.f95. Just
compile the example below including iso_varying_string.o with 4.5.0 and run
the binary. It shows where you should get garbage when using 4.5.0.
I tried a stack trace and got this:
Program received signal SIGABRT, Aborted.
0x00002b51812c4ed5 in raise () from /lib/libc.so.6
Program received signal SIGABRT, Aborted.
0x00002b166f232ed5 in raise () from /lib/libc.so.6
#0 0x00002b166f232ed5 in raise () from /lib/libc.so.6
#1 0x00002b166f2343f3 in abort () from /lib/libc.so.6
#2 0x00002b166f26f3a8 in __libc_message () from /lib/libc.so.6
#3 0x00002b166f274948 in malloc_printerr () from /lib/libc.so.6
#4 0x00002b166f276a56 in free () from /lib/libc.so.6
#5 0x000000000040d380 in set_children.2047 () at syntax_rules.f90:752
#6 0x0000000000000000 in ?? ()
The output with gfortran 4.3.1 and 4.4.0 is perfectly regular.
CODE EXAMPLE:
module ifiles
use iso_varying_string, string_t => varying_string !NODEP!
implicit none
private
public :: ifile_t
public :: ifile_append
public :: ifile_get_length
public :: line_p
public :: line_init
public :: line_get_string_advance
type :: line_entry_t
private
type(line_entry_t), pointer :: previous => null ()
type(line_entry_t), pointer :: next => null ()
type(string_t) :: string
integer :: index
end type line_entry_t
type :: ifile_t
private
type(line_entry_t), pointer :: first => null ()
type(line_entry_t), pointer :: last => null ()
integer :: n_lines = 0
end type ifile_t
type :: line_p
private
type(line_entry_t), pointer :: p => null ()
end type line_p
interface ifile_append
module procedure ifile_append_from_string
module procedure ifile_append_from_char
end interface
contains
subroutine line_entry_create (line, string)
type(line_entry_t), pointer :: line
type(string_t), intent(in) :: string
allocate (line)
line%string = string
end subroutine line_entry_create
subroutine ifile_append_from_string (ifile, string)
type(ifile_t), intent(inout) :: ifile
type(string_t), intent(in) :: string
type(line_entry_t), pointer :: current
call line_entry_create (current, string)
current%index = ifile%n_lines + 1
if (associated (ifile%last)) then
current%previous => ifile%last
ifile%last%next => current
else
ifile%first => current
end if
ifile%last => current
ifile%n_lines = current%index
end subroutine ifile_append_from_string
subroutine ifile_append_from_char (ifile, char)
type(ifile_t), intent(inout) :: ifile
character(*), intent(in) :: char
call ifile_append_from_string (ifile, var_str (trim (char)))
end subroutine ifile_append_from_char
function ifile_get_length (ifile) result (length)
integer :: length
type(ifile_t), intent(in) :: ifile
length = ifile%n_lines
end function ifile_get_length
subroutine line_init (line, ifile, back)
type(line_p), intent(inout) :: line
type(ifile_t), intent(in) :: ifile
logical, intent(in), optional :: back
if (present (back)) then
if (back) then
line%p => ifile%last
else
line%p => ifile%first
end if
else
line%p => ifile%first
end if
end subroutine line_init
subroutine line_advance (line)
type(line_p), intent(inout) :: line
if (associated (line%p)) line%p => line%p%next
end subroutine line_advance
function line_get_string_advance (line) result (string)
type(string_t) :: string
type(line_p), intent(inout) :: line
if (associated (line%p)) then
string = line%p%string
call line_advance (line)
else
string = ""
end if
end function line_get_string_advance
end module ifiles
module syntax_rules
use iso_fortran_env, only: STDERR => ERROR_UNIT
use iso_varying_string, string_t => varying_string
use ifiles, only: line_p, line_init, line_get_string_advance
use ifiles, only: ifile_t, ifile_get_length
implicit none
private
character, parameter, public :: BLANK = ' ', TAB = achar(9)
character, parameter, public :: CR = achar(13), LF = achar(10)
character(*), parameter, public :: WHITESPACE_CHARS = BLANK// TAB // CR // LF
character(*), parameter, public :: LCLETTERS = "abcdefghijklmnopqrstuvwxyz"
character(*), parameter, public :: UCLETTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
character(*), parameter, public :: DIGITS = "0123456789"
character(*), parameter, public :: UNQUOTED =
"(),|_"//LCLETTERS//UCLETTERS//DIGITS
public :: S_UNKNOWN
public :: S_KEYWORD
public :: S_SEQUENCE
public :: syntax_t
public :: syntax_init
public :: syntax_get_rule_ptr
public :: stream_t
public :: lexer_t
public :: syntax_rule_t
integer, parameter :: S_UNKNOWN = 0, S_KEYWORD = 6, S_SEQUENCE = 7
integer, parameter :: T_KEYWORD = 1
integer, parameter :: T_IDENTIFIER = 2, T_QUOTED = 3, T_NUMERIC = 4
integer, parameter :: EMPTY = 0, WHITESPACE = 10
integer, parameter :: NO_MATCH = 11, IO_ERROR = 12, OVERFLOW = 13
integer, parameter :: UNMATCHED_QUOTE = 14
type :: stream_t
type(string_t), pointer :: filename => null ()
integer, pointer :: unit => null ()
type(string_t), pointer :: string => null ()
type(ifile_t), pointer :: ifile => null ()
type(line_p), pointer :: line => null ()
end type stream_t
type :: keyword_entry_t
private
type(string_t) :: string
type(keyword_entry_t), pointer :: next => null ()
end type keyword_entry_t
type :: keyword_list_t
private
type(keyword_entry_t), pointer :: first => null ()
type(keyword_entry_t), pointer :: last => null ()
end type keyword_list_t
type :: template_t
private
integer :: type
character(256) :: charset1, charset2
integer :: len1, len2
end type template_t
type :: lexer_setup_t
private
type(template_t), dimension(:), allocatable :: tt
integer, dimension(:), allocatable :: type
type(keyword_list_t), pointer :: keyword_list => null ()
end type lexer_setup_t
type :: lexeme_t
private
integer :: type = 0
type(string_t) :: s
integer :: b = 0, e = 0
end type lexeme_t
type :: lexer_t
private
type(lexer_setup_t) :: setup
type(lexeme_t) :: lexeme
type(string_t) :: line_buffer
integer :: current_line
integer :: current_column
integer :: previous_column
type(string_t) :: buffer
end type lexer_t
type :: rule_p
private
type(syntax_rule_t), pointer :: p => null ()
end type rule_p
type :: syntax_rule_t
private
integer :: type = S_UNKNOWN
logical :: used = .false.
type(string_t) :: keyword
type(string_t) :: separator
type(string_t), dimension(2) :: delimiter
type(rule_p), dimension(:), allocatable :: child
character(1) :: modifier = ""
logical :: opt = .false., rep = .false.
end type syntax_rule_t
type :: syntax_t
private
type(syntax_rule_t), dimension(:), allocatable :: rule
type(keyword_list_t) :: keyword_list
end type syntax_t
interface syntax_init
module procedure syntax_init_from_ifile
end interface
interface stream_init
module procedure stream_init_string
end interface
contains
subroutine stream_get_record (stream, string, iostat)
type(stream_t), intent(inout) :: stream
type(string_t), intent(out) :: string
integer, intent(out) :: iostat
if (associated (stream%unit)) then
call get (stream%unit, string, iostat=iostat)
if (iostat == -2) iostat = 0
else if (associated (stream%string)) then
if (len (stream%string) /= 0) then
string = stream%string
stream%string = ""
iostat = 0
else
iostat = -1
end if
else
write (STDERR, *) " Attempt to read from uninitialized input stream"
flush (STDERR)
stop
end if
end subroutine stream_get_record
pure function template_whitespace (chars) result (tt)
character(*), intent(in) :: chars
type(template_t) :: tt
tt = template_t (WHITESPACE, chars, "", len (chars), 0)
end function template_whitespace
pure function template_quoted (chars1, chars2) result (tt)
character(*), intent(in) :: chars1, chars2
type(template_t) :: tt
tt = template_t (T_QUOTED, chars1, chars2, len (chars1), len (chars2))
end function template_quoted
pure function template_numeric (chars) result (tt)
character(*), intent(in) :: chars
type(template_t) :: tt
tt = template_t (T_NUMERIC, chars, "", len (chars), 0)
end function template_numeric
pure function template_identifier (chars1, chars2) result (tt)
character(*), intent(in) :: chars1, chars2
type(template_t) :: tt
tt = template_t (T_IDENTIFIER, chars1, chars2, len(chars1), len(chars2))
end function template_identifier
function lexeme_is_break (t) result (break)
logical :: break
type(lexeme_t), intent(in) :: t
select case (t%type)
case (-1, IO_ERROR, OVERFLOW, NO_MATCH)
break = .true.
case default
break = .false.
end select
end function lexeme_is_break
subroutine lexeme_set (t, keyword_list, s, range, type)
type(lexeme_t), intent(out) :: t
type(keyword_list_t), pointer :: keyword_list
type(string_t), intent(in) :: s
integer, dimension(2), intent(in) :: range
integer, intent(in) :: type
t%type = type
if (type == T_IDENTIFIER) then
if (associated (keyword_list)) then
if (keyword_list_contains (keyword_list, s)) t%type = T_KEYWORD
end if
end if
t%s = s
t%b = range(1)
t%e = range(2)
end subroutine lexeme_set
subroutine stream_init_string (stream, string)
type(stream_t), intent(out) :: stream
type(string_t), intent(in) :: string
allocate (stream%string)
stream%string = string
end subroutine stream_init_string
subroutine stream_final (stream)
type(stream_t), intent(inout) :: stream
if (associated (stream%filename)) then
close (stream%unit)
deallocate (stream%unit)
deallocate (stream%filename)
else if (associated (stream%unit)) then
deallocate (stream%unit)
else if (associated (stream%string)) then
deallocate (stream%string)
end if
end subroutine stream_final
subroutine lexeme_clear (t)
type(lexeme_t), intent(out) :: t
t%type = 0
t%s = ""
end subroutine lexeme_clear
subroutine lexer_clear (lexer)
type(lexer_t), intent(inout) :: lexer
call lexeme_clear (lexer%lexeme)
lexer%line_buffer = ""
lexer%current_line = 0
lexer%current_column = 0
lexer%previous_column = 0
lexer%buffer = ""
end subroutine lexer_clear
function lexeme_get_string (t) result (s)
type(string_t) :: s
type(lexeme_t), intent(in) :: t
s = t%s
end function lexeme_get_string
function lexeme_get_contents (t) result (s)
type(string_t) :: s
type(lexeme_t), intent(in) :: t
s = extract (t%s, t%b, t%e)
write (STDERR, *) "lexeme_get_contents -> ", char (s)
flush (STDERR)
end function lexeme_get_contents
subroutine lexer_setup_final (setup)
type(lexer_setup_t), intent(inout) :: setup
deallocate (setup%tt, setup%type)
setup%keyword_list => null ()
end subroutine lexer_setup_final
subroutine keyword_list_add (keylist, string)
type(keyword_list_t), intent(inout) :: keylist
type(string_t), intent(in) :: string
type(keyword_entry_t), pointer :: k_entry_new
if (.not. keyword_list_contains (keylist, string)) then
allocate (k_entry_new)
k_entry_new%string = string
if (associated (keylist%first)) then
keylist%last%next => k_entry_new
else
keylist%first => k_entry_new
end if
keylist%last => k_entry_new
end if
end subroutine keyword_list_add
function keyword_list_contains (keylist, string) result (found)
type(keyword_list_t), intent(in) :: keylist
type(string_t), intent(in) :: string
logical :: found
found = .false.
call check_rec (keylist%first)
contains
recursive subroutine check_rec (k_entry)
type(keyword_entry_t), pointer :: k_entry
if (associated (k_entry)) then
if (k_entry%string /= string) then
call check_rec (k_entry%next)
else
found = .true.
end if
end if
end subroutine check_rec
end function keyword_list_contains
subroutine lex (lexeme, lexer, stream)
type(lexeme_t), intent(out) :: lexeme
type(lexer_t), intent(inout) :: lexer
type(stream_t), intent(inout) :: stream
integer :: iostat1, iostat2
integer :: pos
integer, dimension(2) :: range
integer :: template_index, type
GET_LEXEME: do while (lexeme_get_type (lexer%lexeme) == 0)
if (len (lexer%buffer) /= 0) then
iostat1 = 0
else
call lexer_read_line (lexer, stream, iostat1)
end if
select case (iostat1)
case (0)
MATCH_BUFFER: do
call match (lexer%setup%tt, char (lexer%buffer), &
pos, range, template_index)
if (pos >= 0) then
type = lexer%setup%type(template_index)
exit MATCH_BUFFER
else
pos = 0
call lexer_read_line (lexer, stream, iostat2)
select case (iostat2)
case (-1); type = UNMATCHED_QUOTE; exit MATCH_BUFFER
case (1); type = IO_ERROR; exit MATCH_BUFFER
case (2); type = OVERFLOW; exit MATCH_BUFFER
end select
end if
end do MATCH_BUFFER
case (-1); type = -1
case (1); type = IO_ERROR
case (2); type = OVERFLOW
end select
call lexeme_set (lexer%lexeme, lexer%setup%keyword_list, &
extract (lexer%buffer, finish=pos), range, type)
lexer%buffer = remove (lexer%buffer, finish=pos)
lexer%previous_column = max (lexer%current_column, 0)
lexer%current_column = lexer%current_column + pos
end do GET_LEXEME
lexeme = lexer%lexeme
call lexeme_clear (lexer%lexeme)
end subroutine lex
function lexeme_get_type (t) result (type)
integer :: type
type(lexeme_t), intent(in) :: t
type = t%type
end function lexeme_get_type
subroutine lexer_setup_init (setup, &
comment_chars, quote_chars, quote_match, &
single_chars, special_class, &
keyword_list)
type(lexer_setup_t), intent(inout) :: setup
character(*), intent(in) :: comment_chars
character(*), intent(in) :: quote_chars, quote_match
character(*), intent(in) :: single_chars
character(*), dimension(:), intent(in) :: special_class
type(keyword_list_t), pointer :: keyword_list
integer :: n, i
n = 1 + len (comment_chars) + len (quote_chars) + 1 &
+ len (single_chars) + size (special_class) + 1
write (STDERR, *) "n :", n
flush (STDERR)
allocate (setup%tt(n))
allocate (setup%type(0:n))
n = 0
setup%type(n) = NO_MATCH
n = n + 1
setup%tt(n) = template_whitespace (WHITESPACE_CHARS)
setup%type(n) = EMPTY
forall (i = 1:len(comment_chars))
setup%tt(n+i) = template_quoted (comment_chars(i:i), LF)
setup%type(n+i) = EMPTY
end forall
n = n + len (comment_chars)
forall (i = 1:len(quote_chars))
setup%tt(n+i) = template_quoted (quote_chars(i:i), quote_match(i:i))
setup%type(n+i) = T_QUOTED
end forall
n = n + len (quote_chars)
setup%tt(n+1) = template_numeric ("EeDd")
setup%type(n+1) = T_NUMERIC
n = n + 1
forall (i = 1:len (single_chars))
setup%tt(n+i) = template_identifier (single_chars(i:i), "")
setup%type(n+i) = T_IDENTIFIER
end forall
n = n + len (single_chars)
forall (i = 1:size (special_class))
setup%tt(n+i) = template_identifier &
(trim (special_class(i)), trim (special_class(i)))
setup%type(n+i) = T_IDENTIFIER
end forall
n = n + size (special_class)
setup%tt(n+1) = template_identifier &
(LCLETTERS//UCLETTERS, LCLETTERS//DIGITS//"_"//UCLETTERS)
setup%type(n+1) = T_IDENTIFIER
n = n + 1
if (n /= size (setup%tt)) then
write (STDERR, *) "Size mismatch in lexer setup"
flush (STDERR)
endif
setup%keyword_list => keyword_list
end subroutine lexer_setup_init
subroutine lexer_init (lexer, &
comment_chars, quote_chars, quote_match, &
single_chars, special_class, &
keyword_list)
type(lexer_t), intent(inout) :: lexer
character(*), intent(in) :: comment_chars
character(*), intent(in) :: quote_chars, quote_match
character(*), intent(in) :: single_chars
character(*), dimension(:), intent(in) :: special_class
type(keyword_list_t), pointer :: keyword_list
call lexer_setup_init (lexer%setup, &
comment_chars = comment_chars, &
quote_chars = quote_chars, &
quote_match = quote_match, &
single_chars = single_chars, &
special_class = special_class, &
keyword_list = keyword_list)
call lexer_clear (lexer)
end subroutine lexer_init
subroutine lexer_read_line (lexer, stream, iostat)
type(lexer_t), intent(inout) :: lexer
type(stream_t), intent(inout) :: stream
integer, intent(out) :: iostat
call stream_get_record (stream, lexer%line_buffer, iostat)
lexer%current_line = lexer%current_line + 1
if (iostat == 0) then
lexer%buffer = lexer%buffer // lexer%line_buffer // LF
end if
end subroutine lexer_read_line
subroutine match_numeric (tt, s, n)
type(template_t), intent(in) :: tt
character(*), intent(in) :: s
integer, intent(out) :: n
integer :: i, n0
character(10), parameter :: digits = "0123456789"
character(2), parameter :: signs = "-+"
n = verify (s, digits) - 1
if (n < 0) then
n = 0
return
else if (s(n+1:n+1) == ".") then
i = verify (s(n+2:), digits) - 1
if (i < 0) then
n = len (s)
return
else if (i > 0 .or. n > 0) then
n = n + 1 + i
end if
end if
n0 = n
if (n > 0) then
if (verify (s(n+1:n+1), tt%charset1(1:tt%len1)) == 0) then
n = n + 1
if (verify (s(n+1:n+1), signs) == 0) n = n + 1
i = verify (s(n+1:), digits) - 1
if (i < 0) then
n = len (s)
else if (i == 0) then
n = n0
else
n = n + i
end if
end if
end if
end subroutine match_numeric
subroutine match_identifier (tt, s, n)
type(template_t), intent(in) :: tt
character(*), intent(in) :: s
integer, intent(out) :: n
if (verify (s(1:1), tt%charset1(1:tt%len1)) == 0) then
n = verify (s(2:), tt%charset2(1:tt%len2))
if (n == 0) n = len (s)
else
n = 0
end if
end subroutine match_identifier
subroutine match_template (tt, s, n, range)
type(template_t), intent(in) :: tt
character(*), intent(in) :: s
integer, intent(out) :: n
integer, dimension(2), intent(out) :: range
select case (tt%type)
case (WHITESPACE)
call match_whitespace (tt, s, n)
range = 0
case (T_IDENTIFIER)
call match_identifier (tt, s, n)
range(1) = 1
range(2) = len_trim (s)
case (T_QUOTED)
call match_quoted (tt, s, n, range)
case (T_NUMERIC)
call match_numeric (tt, s, n)
range(1) = 1
range(2) = len_trim (s)
case default
write (STDERR, *) "Invalid lexeme template encountered"
flush (STDERR)
stop
end select
end subroutine match_template
subroutine match_quoted (tt, s, n, range)
type(template_t), intent(in) :: tt
character(*), intent(in) :: s
integer, intent(out) :: n
integer, dimension(2), intent(out) :: range
character(tt%len1) :: ch1
character(tt%len2) :: ch2
integer :: i
ch1 = tt%charset1
if (s(1:tt%len1) == ch1) then
ch2 = tt%charset2
do i = tt%len1 + 1, len (s) - tt%len2 + 1
if (s(i:i+tt%len2-1) == ch2) then
n = i + tt%len2 - 1
range(1) = tt%len1 + 1
range(2) = i - 1
return
end if
end do
n = -1
range = 0
else
n = 0
range = 0
end if
end subroutine match_quoted
subroutine match (tt, s, n, range, ii)
type(template_t), dimension(:), intent(in) :: tt
character(*), intent(in) :: s
integer, intent(out) :: n
integer, dimension(2), intent(out) :: range
integer, intent(out) :: ii
integer :: i
do i = 1, size (tt)
call match_template (tt(i), s, n, range)
if (n /= 0) then
ii = i
return
end if
end do
n = 0
ii = 0
end subroutine match
subroutine match_whitespace (tt, s, n)
type(template_t), intent(in) :: tt
character(*), intent(in) :: s
integer, intent(out) :: n
n = verify (s, tt%charset1(1:tt%len1)) - 1
if (n < 0) n = len (s)
end subroutine match_whitespace
elemental function rule_is_associated (rp) result (ok)
logical :: ok
type (rule_p), intent(in) :: rp
ok = associated (rp%p)
end function rule_is_associated
subroutine syntax_rule_init (rule, key, type)
type(syntax_rule_t), intent(inout) :: rule
type(string_t), intent(in) :: key
integer, intent(in) :: type
rule%keyword = key
rule%type = type
end subroutine syntax_rule_init
function is_modifier (string) result (ok)
logical :: ok
type(string_t), intent(in) :: string
select case (char (string))
case (" ", "?", "*", "+"); ok = .true.
case default; ok = .false.
end select
end function is_modifier
subroutine syntax_rule_set_sub (rule, i, sub)
type(syntax_rule_t), intent(inout) :: rule
integer, intent(in) :: i
type(syntax_rule_t), intent(in), target :: sub
write (STDERR, *) "entering syntax_rule_set_sub, i = ", i
flush (STDERR)
rule%child(i)%p => sub
write (STDERR, *) "exiting syntax_rule_set_sub"
flush (STDERR)
return
end subroutine syntax_rule_set_sub
subroutine syntax_init_from_ifile (syntax, ifile)
type(syntax_t), intent(out), target :: syntax
type(ifile_t), intent(in) :: ifile
type(lexer_t) :: lexer
type(line_p) :: line
type(string_t) :: string
integer :: n_token
integer :: i
call lexer_init (lexer, &
comment_chars = "", &
quote_chars = "<'""", &
quote_match = ">'""", &
single_chars = "*+|=,()", &
special_class = (/ "." /), &
keyword_list = null ())
allocate (syntax%rule (ifile_get_length (ifile)))
call line_init (line, ifile)
do i = 1, size (syntax%rule)
string = line_get_string_advance (line)
call set_rule_type_and_key (syntax%rule(i), string, lexer)
end do
call line_init (line, ifile)
write (STDERR, *) "size syntax rule", size (syntax%rule)
flush (STDERR)
do i = 1, size (syntax%rule)
write (STDERR, *) "### Loop index i:", i, "of ", size(syntax%rule)
flush (STDERR)
string = line_get_string_advance (line)
write (STDERR, *) "string ", char(string), " ###"
flush (STDERR)
write (STDERR, *) "do loop syntax rule, string:", i, syntax%rule(i)%type
flush (STDERR)
select case (syntax%rule(i)%type)
case (S_SEQUENCE)
n_token = get_n_token (string, lexer)
write (STDERR, *) "ntoken = ", n_token
flush (STDERR)
call set_rule_contents &
(syntax%rule(i), syntax, n_token, string, lexer)
end select
write (STDERR, *) "after the select"
flush (STDERR)
end do
end subroutine syntax_init_from_ifile
subroutine set_rule_type_and_key (rule, string, lexer)
type(syntax_rule_t), intent(inout) :: rule
type(string_t), intent(in) :: string
type(lexer_t), intent(inout) :: lexer
type(stream_t) :: stream
type(lexeme_t) :: lexeme
type(string_t) :: key
character(2) :: type
call lexer_clear (lexer)
call stream_init (stream, string)
call lex (lexeme, lexer, stream)
type = lexeme_get_string (lexeme)
call lex (lexeme, lexer, stream)
key = lexeme_get_contents (lexeme)
call stream_final (stream)
if (trim (key) /= "") then
select case (type)
case ("KE"); call syntax_rule_init (rule, key, S_KEYWORD)
case ("SE"); call syntax_rule_init (rule, key, S_SEQUENCE)
case default
write (STDERR, *) " Syntax definition: unknown type '" // type // "'"
flush (STDERR)
stop
end select
else
write (STDERR, *) char (string)
flush (STDERR)
write (STDERR, *) " Syntax definition: empty rule key"
flush (STDERR)
stop
end if
end subroutine set_rule_type_and_key
function get_n_token (string, lexer) result (n)
integer :: n
type(string_t), intent(in) :: string
type(lexer_t), intent(inout) :: lexer
type(stream_t) :: stream
type(lexeme_t) :: lexeme
integer :: i
call stream_init (stream, string)
call lexer_clear (lexer)
i = 0
do
call lex (lexeme, lexer, stream)
if (lexeme_is_break (lexeme)) exit
i = i + 1
end do
n = i
call stream_final (stream)
end function get_n_token
subroutine set_rule_contents (rule, syntax, n_token, string, lexer)
type(syntax_rule_t), intent(inout) :: rule
type(syntax_t), intent(in), target :: syntax
integer, intent(in) :: n_token
type(string_t), intent(in) :: string
type(lexer_t), intent(inout) :: lexer
type(stream_t) :: stream
type(lexeme_t), dimension(n_token) :: lexeme
integer :: i, n_children
write (STDERR, *) "entering set_rule_contents, n_token = ", n_token
flush (STDERR)
call lexer_clear (lexer)
call stream_init (stream, string)
do i = 1, n_token
call lex (lexeme(i), lexer, stream)
end do
call stream_final (stream)
n_children = get_n_children ()
write (STDERR, *) "n_children = ", n_children
flush (STDERR)
if (n_children > 0) call set_children
write (STDERR, *) "exiting set_rule_contents"
flush (STDERR)
contains
function get_n_children () result (n)
integer :: n
select case (rule%type)
case (S_SEQUENCE)
write (STDERR, *) "in select case of get_n_children: S_SEQUENCE"
flush (STDERR)
if (is_modifier (lexeme_get_string (lexeme(n_token)))) then
write (STDERR, *) "unexpected is_modifier"
flush (STDERR)
stop
else
if (n_token <= 3) then
write (STDERR, *) "Broken rule"
flush (STDERR)
end if
n = n_token - 3
write (STDERR, *) "children, token (n<=3)", n, n_token
flush (STDERR)
end if
end select
end function get_n_children
subroutine set_children
write (STDERR, *) "entering set_children, n_children = ", n_children
flush (STDERR)
allocate (rule%child(n_children))
write (STDERR, *) "allocated rule%child"
flush (STDERR)
do i = 1, size (lexeme)
write (STDERR, *) "lexeme(", i, ") = ", char(lexeme(i)%s)
flush (STDERR)
end do
select case (rule%type)
case (S_SEQUENCE)
do i = 1, n_children
call monitor_syntax_rules (syntax)
write (STDERR, *) "before syntax_rule_set_sub, i = ", i
flush (STDERR)
call syntax_rule_set_sub (rule, i, syntax_get_rule_ptr (syntax, &
lexeme_get_contents (lexeme(i+3))))
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!! WHY DO WE NEVER GET HERE ??? syntax_rule_set_sub claims to exit !!!
!!!! WHY IS syntax_get_rule_ptr CALLED MULTIPLE TIMES ???
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
write (STDERR, *) "after syntax_rule_set_sub", i
flush (STDERR)
end do
end select
write (STDERR, *) "exiting set_children"
flush (STDERR)
end subroutine set_children
end subroutine set_rule_contents
function syntax_get_rule_ptr (syntax, key) result (rule)
type(syntax_rule_t), pointer :: rule
type(syntax_t), intent(in), target :: syntax
type(string_t), intent(in) :: key
integer :: i
write (STDERR, *) "entering syntax_get_rule_ptr, size(syntax%rule) = ",
size(syntax%rule)
flush (STDERR)
call monitor_syntax_rules (syntax)
do i = 1, size (syntax%rule)
if (syntax%rule(i)%keyword == key) then
rule => syntax%rule(i)
write (STDERR, *) "exiting syntax_get_rule_ptr"
flush (STDERR)
return
end if
end do
write (STDERR, *) " Syntax table: Rule " // char (key) // " not found"
flush (STDERR)
end function syntax_get_rule_ptr
subroutine monitor_syntax_rules (syntax)
type(syntax_t), intent(in), target :: syntax
integer :: i
write (STDERR, *) "entering monitor_syntax_rules, size(syntax%rule) = ",
size(syntax%rule)
flush (STDERR)
do i = 1, size (syntax%rule)
write (STDERR, *) "syntax%rule(", i, ")%keyword = ",
char(syntax%rule(i)%keyword), &
" (this will become garbage, eventually ...)"
flush (STDERR)
end do
write (STDERR, *) "exiting monitor_syntax_rules"
flush (STDERR)
end subroutine monitor_syntax_rules
end module syntax_rules
program main
use iso_fortran_env, only: STDERR => ERROR_UNIT
use ifiles
use syntax_rules
type(ifile_t) :: ifile
type(syntax_t), target, save :: syntax_model_file
write (STDERR, *) "Starting to load ifile"
flush (STDERR)
call ifile_append (ifile, "SEQ aaaaaaaaaa = bbbbbbbbbb")
call ifile_append (ifile, "KEY bbbbbbbbbb")
write (STDERR, *) "Starting to interpret ifile"
flush (STDERR)
call syntax_init (syntax_model_file, ifile)
write (STDERR, *) "Test finished"
flush (STDERR)
end program main
--
Summary: [4.5.0 Regression] Garbage or segmentation fault in
allocatable array derived type structures
Product: gcc
Version: 4.5.0
Status: UNCONFIRMED
Severity: major
Priority: P3
Component: fortran
AssignedTo: unassigned at gcc dot gnu dot org
ReportedBy: juergen dot reuter at desy dot de
GCC host triplet: both MAC OS X Darwin 9.7.0 and Linux Debian Edge
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
@ 2009-06-14 22:14 ` kargl at gcc dot gnu dot org
2009-06-14 22:19 ` juergen dot reuter at desy dot de
` (15 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: kargl at gcc dot gnu dot org @ 2009-06-14 22:14 UTC (permalink / raw)
To: gcc-bugs
------- Comment #1 from kargl at gcc dot gnu dot org 2009-06-14 22:14 -------
Please add your code as an attachment.
The severity of fortran bugs are never major unless the bug
breaks bootstrap. Adjusted severity to normal.
--
kargl at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
Severity|major |normal
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
2009-06-14 22:14 ` [Bug fortran/40440] " kargl at gcc dot gnu dot org
@ 2009-06-14 22:19 ` juergen dot reuter at desy dot de
2009-06-15 8:52 ` [Bug fortran/40440] [4.4/4.5 " burnus at gcc dot gnu dot org
` (14 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: juergen dot reuter at desy dot de @ 2009-06-14 22:19 UTC (permalink / raw)
To: gcc-bugs
------- Comment #2 from juergen dot reuter at desy dot de 2009-06-14 22:18 -------
Created an attachment (id=17996)
--> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=17996&action=view)
contains modules iso_varying_string, ifiles, syntax_rules and main test program
COmplete code for the test case including the module iso_varying_string
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] [4.4/4.5 Regression] Garbage or segmentation fault in allocatable array derived type structures
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
2009-06-14 22:14 ` [Bug fortran/40440] " kargl at gcc dot gnu dot org
2009-06-14 22:19 ` juergen dot reuter at desy dot de
@ 2009-06-15 8:52 ` burnus at gcc dot gnu dot org
2009-06-15 12:17 ` burnus at gcc dot gnu dot org
` (13 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: burnus at gcc dot gnu dot org @ 2009-06-15 8:52 UTC (permalink / raw)
To: gcc-bugs
------- Comment #3 from burnus at gcc dot gnu dot org 2009-06-15 08:52 -------
(In reply to comment #2)
> COmplete code for the test case including the module iso_varying_string
Works with: gfortran 4.3.3, ifort 11, sunf95, NAG f95 5.1 (w/o flush
statements)
Fails (abort) with gfortran 4.4.1/4.5
Valgrind shows several uninitialized accesses (gfortran 4.3.3, 4.4, and 4.5),
but no errors with NAG f95 or ifort. Interestingly, it runs through with
valgrind + gfortran 4.5, which means that it could be no regression and working
in 4.3.3 only by chance.
valgrind finds essentially the following two errors with gfortran 4.5:
Invalid read of size 1
at 0x4091FC: __iso_varying_string_MOD_char_auto (foo.f90:868)
by 0x40B73F: __syntax_rules_MOD_monitor_syntax_rules (foo.f90:3450)
by 0x40B8F5: __syntax_rules_MOD_syntax_get_rule_ptr (foo.f90:3431)
by 0x40C242: set_children.6490 (foo.f90:3410)
by 0x40C933: __syntax_rules_MOD_set_rule_contents (foo.f90:3366)
by 0x40E9E5: __syntax_rules_MOD_syntax_init_from_ifile (foo.f90:3287)
by 0x412C6E: MAIN__ (foo.f90:3472)
Use of uninitialised value of size 8
at 0x40C261: set_children.6490 (foo.f90:3410)
by 0x40C933: __syntax_rules_MOD_set_rule_contents (foo.f90:3366)
by 0x40E9E5: __syntax_rules_MOD_syntax_init_from_ifile (foo.f90:3287)
by 0x412C6E: MAIN__ (foo.f90:3472)
by 0x412D09: main (foo.f90:3462)
--
burnus at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
Keywords| |wrong-code
Known to fail| |4.4.1 4.5.0
Known to work| |4.3.3
Summary|[4.5.0 Regression] Garbage |[4.4/4.5 Regression] Garbage
|or segmentation fault in |or segmentation fault in
|allocatable array derived |allocatable array derived
|type structures |type structures
Target Milestone|--- |4.4.1
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] [4.4/4.5 Regression] Garbage or segmentation fault in allocatable array derived type structures
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (2 preceding siblings ...)
2009-06-15 8:52 ` [Bug fortran/40440] [4.4/4.5 " burnus at gcc dot gnu dot org
@ 2009-06-15 12:17 ` burnus at gcc dot gnu dot org
2009-06-15 13:09 ` [Bug fortran/40440] Automatic deallocation component of DT function return value burnus at gcc dot gnu dot org
` (12 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: burnus at gcc dot gnu dot org @ 2009-06-15 12:17 UTC (permalink / raw)
To: gcc-bugs
------- Comment #4 from burnus at gcc dot gnu dot org 2009-06-15 12:16 -------
Note: syntax_get_rule_ptr is defined as:
function syntax_get_rule_ptr (syntax, key) result (rule)
type(syntax_rule_t), pointer :: rule
type(syntax_t), intent(in), target :: syntax
type(string_t), intent(in) :: key
and "syntax_rule_set_sub" is defined as follows where "sub" is the relevant
argument:
subroutine syntax_rule_set_sub (rule, i, sub)
type(syntax_rule_t), intent(inout) :: rule
integer, intent(in) :: i
type(syntax_rule_t), intent(in), target :: sub
If one looks at the dump for the following line in set_rule_contents
call syntax_rule_set_sub (rule, i, syntax_get_rule_ptr (syntax, &
lexeme_get_contents (lexeme(i+3))))
one finds:
integer(kind=8) S.297;
struct varying_string D.6550;
D.6550 = lexeme_get_contents (&(*lexeme)[(integer(kind=8)) (i + 3) + -1]);
syntax_rule_set_sub ((struct syntax_rule_t *) rule, &i,
syntax_get_rule_ptr ((struct syntax_t *) syntax, &D.6550));
which looks OK. But then it continues:
if (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->keyword.chars.data != 0B)
__builtin_free (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->keyword.chars.data);
syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->keyword.chars.data = 0B;
if (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->separator.chars.data != 0B)
__builtin_free (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->separator.chars.data);
syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->separator.chars.data = 0B;
S.297 = 0;
while (1)
{
if (S.297 > 1) goto L.27;
if (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->delimiter[S.297].chars.data != 0B)
__builtin_free (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->delimiter[S.297].chars.data);
syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->delimiter[S.297].chars.data = 0B;
S.297 = S.297 + 1;
}
L.27:;
if (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->child.data != 0B)
__builtin_free (syntax_get_rule_ptr ((struct syntax_t *) syntax,
&D.6550)->child.data);
syntax_get_rule_ptr ((struct syntax_t *) syntax, &D.6550)->child.data = 0B;
if (D.6550.chars.data != 0B)
__builtin_free (D.6550.chars.data);
D.6550.chars.data = 0B;
Thus the problem seems to be that "syntax_get_rule_ptr" is treated as variable
and not as function call.
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (3 preceding siblings ...)
2009-06-15 12:17 ` burnus at gcc dot gnu dot org
@ 2009-06-15 13:09 ` burnus at gcc dot gnu dot org
2009-06-18 9:44 ` pault at gcc dot gnu dot org
` (11 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: burnus at gcc dot gnu dot org @ 2009-06-15 13:09 UTC (permalink / raw)
To: gcc-bugs
------- Comment #5 from burnus at gcc dot gnu dot org 2009-06-15 13:09 -------
Juergen: Thanks for the report, but it is not a regression - it might not crash
with 4.3 (or your 4.4) but I think that's just by chance.
Paul, I think also this bug touches code for which you have the expertise.
The problem is the automatic deallocation of an allocatable component. The DT
with this component is returned by a function but treated as variable and not
as function. The crucial part is that the return value is a pointer! If I don't
use a pointer, the dump looks as follows:
D.1558 = func ();
sub (&D.1558);
if (D.1558.a.data != 0B)
__builtin_free (D.1558.a.data);
D.1558.a.data = 0B;
with POINTER:
sub (func ());
if (func ()->a.data != 0B)
__builtin_free (func ()->a.data);
func ()->a.data = 0B;
Testcase:
!--------------------------------------------
implicit none
type t
integer, allocatable :: A(:)
end type t
call sub(func())
contains
function func()
type(t),pointer :: func
integer :: i = 0
if (i /= 0) call abort()
i = i + 1
end function func
subroutine sub(a)
type(t), intent(IN),target :: a
end subroutine sub
end
--
burnus at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |pault at gcc dot gnu dot
| |org, burnus at gcc dot gnu
| |dot org
Status|UNCONFIRMED |NEW
Ever Confirmed|0 |1
GCC host triplet|both MAC OS X Darwin 9.7.0 |
|and Linux Debian Edge |
Known to fail|4.4.1 4.5.0 |4.4.1 4.5.0 4.3.3
Known to work|4.3.3 |
Last reconfirmed|0000-00-00 00:00:00 |2009-06-15 13:09:45
date| |
Summary|[4.4/4.5 Regression] Garbage|Automatic deallocation
|or segmentation fault in |component of DT function
|allocatable array derived |return value
|type structures |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (4 preceding siblings ...)
2009-06-15 13:09 ` [Bug fortran/40440] Automatic deallocation component of DT function return value burnus at gcc dot gnu dot org
@ 2009-06-18 9:44 ` pault at gcc dot gnu dot org
2009-06-18 13:33 ` juergen dot reuter at desy dot de
` (10 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-06-18 9:44 UTC (permalink / raw)
To: gcc-bugs
------- Comment #6 from pault at gcc dot gnu dot org 2009-06-18 09:44 -------
(In reply to comment #5)
> Juergen: Thanks for the report, but it is not a regression - it might not crash
> with 4.3 (or your 4.4) but I think that's just by chance.
>
> Paul, I think also this bug touches code for which you have the expertise.
>
> The problem is the automatic deallocation of an allocatable component. The DT
> with this component is returned by a function but treated as variable and not
> as function. The crucial part is that the return value is a pointer! If I
Yeeees.... there is a bug there somewhere. I shall have to think this through.
I am not sure that your testcase should be allowed at all! I am not sure that
I understand what it means.
Paul
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (5 preceding siblings ...)
2009-06-18 9:44 ` pault at gcc dot gnu dot org
@ 2009-06-18 13:33 ` juergen dot reuter at desy dot de
2009-06-18 14:45 ` burnus at gcc dot gnu dot org
` (9 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: juergen dot reuter at desy dot de @ 2009-06-18 13:33 UTC (permalink / raw)
To: gcc-bugs
------- Comment #7 from juergen dot reuter at desy dot de 2009-06-18 13:33 -------
(In reply to comment #6)
> (In reply to comment #5)
The crucial part is that the return value is a pointer! If I
>
> Yeeees.... there is a bug there somewhere. I shall have to think this through.
> I am not sure that your testcase should be allowed at all! I am not sure that
> I understand what it means.
>
> Paul
Dear Paul,
if you need any help please let me know. It might also be possible that we
wrote
some code contradicting conventions, which would be valuable to know. I'm still
convinced that this is a problem of the compiler, since it works with the NAG
and Intel compilers.
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (6 preceding siblings ...)
2009-06-18 13:33 ` juergen dot reuter at desy dot de
@ 2009-06-18 14:45 ` burnus at gcc dot gnu dot org
2009-06-18 15:18 ` burnus at gcc dot gnu dot org
` (8 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: burnus at gcc dot gnu dot org @ 2009-06-18 14:45 UTC (permalink / raw)
To: gcc-bugs
------- Comment #8 from burnus at gcc dot gnu dot org 2009-06-18 14:45 -------
> I am not sure that your testcase should be allowed at all! I am not sure that
> I understand what it means.
I think it is valid and not different from:
integer, pointer :: ptr
allocate(ptr)
ptr = 5
call f(ptr)
where you don't pass the pointer "ptr" to "f" but the target of pointer "f".
My example is invalid, however, as I never set the return value. Add
allocate(func)
if you want. That should make it valid as one now has a pointer target. But it
shouldn't matter regarding the bug. (The not-needed "target" attribute can also
be removed.)
Regarding the big program:
function f(tgt)
integer,target :: tgt
f => tgt
end function f
I am not sure that using "tgt" as return value is valid; I think as soon as one
leaves "f", the "tgt" dummy ceases to exist, which would make it invalid. But I
might be wrong and it is valid. In practice, it should work if the actual
argument is either in static memory or one uses the pointer while the target is
still on the stack (or on the heap).
(If one wants to check the validity, one needs to read all about pointers,
targets and argument association - and maybe scope - in the standard.)
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (7 preceding siblings ...)
2009-06-18 14:45 ` burnus at gcc dot gnu dot org
@ 2009-06-18 15:18 ` burnus at gcc dot gnu dot org
2009-06-18 20:52 ` pault at gcc dot gnu dot org
` (7 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: burnus at gcc dot gnu dot org @ 2009-06-18 15:18 UTC (permalink / raw)
To: gcc-bugs
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 1809 bytes --]
------- Comment #9 from burnus at gcc dot gnu dot org 2009-06-18 15:17 -------
(In reply to comment #7)
> I'm still convinced that this is a problem of the compiler, since it works with the
> NAG and Intel compilers.
Well, compilers can have all bugs - and not all invalid programs can be
diagnosed as such by a compiler.
In any case, I believe gfortran has a bug (cf. comment 5 and comment 8).
(In reply to comment #8)
> Regarding the big program:
[...]
I think the big program is valid (at least with this regard) as the following
applies.
"If the dummy argument has the TARGET attribute, does not have the VALUE
attribute, and is
either a scalar or an assumed-shape array, and the corresponding actual
argument has the
TARGET attribute but is not an array section with a vector subscript then
(1) Any pointers associated with the actual argument become associated with
the
corresponding dummy argument on invocation of the procedure and
(2) When execution of the procedure completes, any pointers that do not become
undefined
(16.4.2.1.3) and are associated with the dummy argument remain associated
with the
actual argument." [F2003, 12.4.1.2 Actual arguments associated with dummy
data objects]
And in "16.4.2.1.3 Events that cause the association status of pointers to
become undefined". Relevant would be for instance:
"(4) Execution of a RETURN or END statement causes the pointers target to
become undefined
(item (3) of 16.5.6),"
which is never the case for the PROGRAM; additionally, the SAVE preserves it
even longer [(3) in 16.5.6]:
"Variables become undefined as follows: [...]
(3) When execution of an instance of a subprogram completes,
(a) its unsaved local variables become undefined,"
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (8 preceding siblings ...)
2009-06-18 15:18 ` burnus at gcc dot gnu dot org
@ 2009-06-18 20:52 ` pault at gcc dot gnu dot org
2009-06-18 21:15 ` burnus at gcc dot gnu dot org
` (6 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-06-18 20:52 UTC (permalink / raw)
To: gcc-bugs
------- Comment #10 from pault at gcc dot gnu dot org 2009-06-18 20:51 -------
(In reply to comment #8)
> > I am not sure that your testcase should be allowed at all! I am not sure that
> > I understand what it means.
>
> I think it is valid and not different from:
Yes, I understood after a bit of dyslexia about it :-(
Since the function result is a pointer, it is an ultimate component and, I
think, the deallocation of the allocatable components should not be attempted.
If you agree with me, I'll make it so. Otherwise, it'll need a temporary.
Cheers
Paul
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (9 preceding siblings ...)
2009-06-18 20:52 ` pault at gcc dot gnu dot org
@ 2009-06-18 21:15 ` burnus at gcc dot gnu dot org
2009-06-19 0:20 ` pault at gcc dot gnu dot org
` (5 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: burnus at gcc dot gnu dot org @ 2009-06-18 21:15 UTC (permalink / raw)
To: gcc-bugs
------- Comment #11 from burnus at gcc dot gnu dot org 2009-06-18 21:15 -------
(In reply to comment #10)
> Yes, I understood after a bit of dyslexia about it :-(
>
> Since the function result is a pointer, it is an ultimate component and, I
> think, the deallocation of the allocatable components should not be attempted.
I agree that no deallocation should happen. (Sorry for claiming so before.)
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (10 preceding siblings ...)
2009-06-18 21:15 ` burnus at gcc dot gnu dot org
@ 2009-06-19 0:20 ` pault at gcc dot gnu dot org
2009-06-19 21:58 ` pault at gcc dot gnu dot org
` (4 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-06-19 0:20 UTC (permalink / raw)
To: gcc-bugs
------- Comment #12 from pault at gcc dot gnu dot org 2009-06-19 00:20 -------
Adding at trans-expr.c:2740
&& !(e->symtree && e->symtree->n.sym->attr.pointer)
eliminates the problem in the reduced testcase and allows the original testcase
to run correctly. This has not been regtested yet - even if it introduces
regressions, it will be a question of getting the condition right. Notice that
pointer variables need to be excluded from deallocation of allocatable
components too.
My tree is sourced from a more recent version of svn than is available on the
system that I am using - hence the lack of a diff.
It's mine :-)
Cheers
Paul
--
pault at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
AssignedTo|unassigned at gcc dot gnu |pault at gcc dot gnu dot org
|dot org |
Status|NEW |ASSIGNED
Last reconfirmed|2009-06-15 13:09:45 |2009-06-19 00:20:01
date| |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (11 preceding siblings ...)
2009-06-19 0:20 ` pault at gcc dot gnu dot org
@ 2009-06-19 21:58 ` pault at gcc dot gnu dot org
2009-07-09 19:28 ` pault at gcc dot gnu dot org
` (3 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-06-19 21:58 UTC (permalink / raw)
To: gcc-bugs
------- Comment #13 from pault at gcc dot gnu dot org 2009-06-19 21:58 -------
Subject: Bug 40440
Author: pault
Date: Fri Jun 19 21:58:27 2009
New Revision: 148731
URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=148731
Log:
2009-06-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40440
* trans-expr.c (gfc_conv_procedure_call): Do not deallocate
allocatable components if the argument is a pointer.
2009-06-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40440
* gfortran.dg/alloc_comp_result_2.f90: New test.
Added:
trunk/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
Modified:
trunk/gcc/fortran/ChangeLog
trunk/gcc/fortran/trans-expr.c
trunk/gcc/testsuite/ChangeLog
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (12 preceding siblings ...)
2009-06-19 21:58 ` pault at gcc dot gnu dot org
@ 2009-07-09 19:28 ` pault at gcc dot gnu dot org
2009-07-09 19:29 ` pault at gcc dot gnu dot org
` (2 subsequent siblings)
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-07-09 19:28 UTC (permalink / raw)
To: gcc-bugs
------- Comment #14 from pault at gcc dot gnu dot org 2009-07-09 19:28 -------
Subject: Bug 40440
Author: pault
Date: Thu Jul 9 19:28:20 2009
New Revision: 149431
URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=149431
Log:
2009-07-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40440
* trans-expr.c (gfc_conv_procedure_call): Do not deallocate
allocatable components if the argument is a pointer.
2009-07-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40440
* gfortran.dg/alloc_comp_result_2.f90: New test.
Added:
branches/gcc-4_4-branch/gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
Modified:
branches/gcc-4_4-branch/gcc/fortran/ChangeLog
branches/gcc-4_4-branch/gcc/fortran/trans-expr.c
branches/gcc-4_4-branch/gcc/testsuite/ChangeLog
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (13 preceding siblings ...)
2009-07-09 19:28 ` pault at gcc dot gnu dot org
@ 2009-07-09 19:29 ` pault at gcc dot gnu dot org
2009-10-11 12:20 ` pault at gcc dot gnu dot org
2009-10-11 12:26 ` pault at gcc dot gnu dot org
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-07-09 19:29 UTC (permalink / raw)
To: gcc-bugs
------- Comment #15 from pault at gcc dot gnu dot org 2009-07-09 19:29 -------
Fixed on trunk and 4.4
Thanks for the patch
Paul
--
pault at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|ASSIGNED |RESOLVED
Resolution| |FIXED
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (14 preceding siblings ...)
2009-07-09 19:29 ` pault at gcc dot gnu dot org
@ 2009-10-11 12:20 ` pault at gcc dot gnu dot org
2009-10-11 12:26 ` pault at gcc dot gnu dot org
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-10-11 12:20 UTC (permalink / raw)
To: gcc-bugs
------- Comment #16 from pault at gcc dot gnu dot org 2009-10-11 12:20 -------
Subject: Bug 40440
Author: pault
Date: Sun Oct 11 12:20:09 2009
New Revision: 152640
URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=152640
Log:
2009-10-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40440
* decl.c (hash_value): New function.
(gfc_match_derived_decl): Call it.
2009-10-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40440
* gfortran.dg/class_4a.f03: New test with class_4b,c and d.f03.
* gfortran.dg/class_4b.f03: As above.
* gfortran.dg/class_4c.f03: As above.
* gfortran.dg/class_4d.f03: As above.
Added:
trunk/gcc/testsuite/gfortran.dg/class_4a.f03
trunk/gcc/testsuite/gfortran.dg/class_4b.f03
trunk/gcc/testsuite/gfortran.dg/class_4c.f03
trunk/gcc/testsuite/gfortran.dg/class_4d.f03
Modified:
trunk/gcc/fortran/ChangeLog
trunk/gcc/fortran/decl.c
trunk/gcc/testsuite/ChangeLog
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
* [Bug fortran/40440] Automatic deallocation component of DT function return value
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
` (15 preceding siblings ...)
2009-10-11 12:20 ` pault at gcc dot gnu dot org
@ 2009-10-11 12:26 ` pault at gcc dot gnu dot org
16 siblings, 0 replies; 18+ messages in thread
From: pault at gcc dot gnu dot org @ 2009-10-11 12:26 UTC (permalink / raw)
To: gcc-bugs
------- Comment #17 from pault at gcc dot gnu dot org 2009-10-11 12:26 -------
(In reply to comment #16)
Sorry - that was fingers trouble on my part - wrong PR.
Paul
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40440
^ permalink raw reply [flat|nested] 18+ messages in thread
end of thread, other threads:[~2009-10-11 12:26 UTC | newest]
Thread overview: 18+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2009-06-14 21:50 [Bug fortran/40440] New: [4.5.0 Regression] Garbage or segmentation fault in allocatable array derived type structures juergen dot reuter at desy dot de
2009-06-14 22:14 ` [Bug fortran/40440] " kargl at gcc dot gnu dot org
2009-06-14 22:19 ` juergen dot reuter at desy dot de
2009-06-15 8:52 ` [Bug fortran/40440] [4.4/4.5 " burnus at gcc dot gnu dot org
2009-06-15 12:17 ` burnus at gcc dot gnu dot org
2009-06-15 13:09 ` [Bug fortran/40440] Automatic deallocation component of DT function return value burnus at gcc dot gnu dot org
2009-06-18 9:44 ` pault at gcc dot gnu dot org
2009-06-18 13:33 ` juergen dot reuter at desy dot de
2009-06-18 14:45 ` burnus at gcc dot gnu dot org
2009-06-18 15:18 ` burnus at gcc dot gnu dot org
2009-06-18 20:52 ` pault at gcc dot gnu dot org
2009-06-18 21:15 ` burnus at gcc dot gnu dot org
2009-06-19 0:20 ` pault at gcc dot gnu dot org
2009-06-19 21:58 ` pault at gcc dot gnu dot org
2009-07-09 19:28 ` pault at gcc dot gnu dot org
2009-07-09 19:29 ` pault at gcc dot gnu dot org
2009-10-11 12:20 ` pault at gcc dot gnu dot org
2009-10-11 12:26 ` pault at gcc dot gnu dot org
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).