Is this valid code or bug in gfortran?

[Kamaraju Kusumanchi <kamaraju at bluebottle dot com>]

Consider the code (testfile.f90) pasted in the end. (Sorry! the gmane interface
does not allow attachements, so I have to paste the code and it is a bit long).

$make
gfortran -g -Wall -ffpe-trap=invalid,zero,overflow,underflow -fbounds-check  -I
/home/raju/software/compiledLibs/fftw_3.0.1_gcc_4.2.0_gfortran_4.2.0/include -c
testfile.f90 -o testfile.o

gfortran -g -Wall -ffpe-trap=invalid,zero,overflow,underflow -fbounds-check 
testfile.o -L
/home/raju/software/compiledLibs/fftw_3.0.1_gcc_4.2.0_gfortran_4.2.0/lib  -I
/home/raju/software/compiledLibs/fftw_3.0.1_gcc_4.2.0_gfortran_4.2.0/include -o
testfile


$./testfile
Floating point exception


Is this code valid or am I hitting a bug in gfortran? If it is a bug, I would
appreciate it someone can reduce the testcase further and report it. I am not
able to reduce the testcase any further. My system information, backtrace from
gdb are given below.

$gfortran -v
Using built-in specs.
Target: i686-pc-linux-gnu
Configured with: /home/raju/software/unZipped/gcc-4.2.0/configure
--prefix=/home/raju/software/compiledSoftware/gcc_4.2.0_20070514
Thread model: posix
gcc version 4.2.0

$uname -a
Linux node0 2.6.9-42.0.10.ELsmp #1 SMP Tue Feb 27 10:11:19 EST 2007 i686 i686
i386 GNU/Linux

machine is running CentOS 4.4. Backtrace from gdb is as follows.

$gdb ./testfile
GNU gdb Red Hat Linux (6.3.0.0-1.132.EL4rh)
Copyright 2004 Free Software Foundation, Inc.
GDB is free software, covered by the GNU General Public License, and you are
welcome to change it and/or distribute copies of it under certain conditions.
Type "show copying" to see the conditions.
There is absolutely no warranty for GDB.  Type "show warranty" for details.
This GDB was configured as "i386-redhat-linux-gnu"...Using host libthread_db
library "/lib/tls/libthread_db.so.1".

(gdb) r
Starting program: /home/raju/temp/testfile

Program received signal SIGFPE, Arithmetic exception.
0x4009437e in write_float (dtp=0xbffff05c, f=0x8102558,
    source=0x8048c50
"\215L$\004\203ÃÃÃqÃU\211ÃQ\203Ã\024\213A\004\213\021\211D$\004\211\024$Ã\
022ÃÃÃÃ\233ÃÃÃ\203Ã\0241ÃY]\215aÃÃ\220\220U\211ÃWVS\203Ã\fÃ",
len=8)
    at /home/raju/software/unZipped/gcc-4.2.0/libgfortran/io/write.c:256
256             i = tmp;
(gdb) bt
#0  0x4009437e in write_float (dtp=0xbffff05c, f=0x8102558,
    source=0x8048c50
"\215L$\004\203ÃÃÃqÃU\211ÃQ\203Ã\024\213A\004\213\021\211D$\004\211\024$Ã\
022ÃÃÃÃ\233ÃÃÃ\203Ã\0241ÃY]\215aÃÃ\220\220U\211ÃWVS\203Ã\fÃ",
len=8)
    at /home/raju/software/unZipped/gcc-4.2.0/libgfortran/io/write.c:256
#1  0x4008e5bf in formatted_transfer (dtp=0xbffff05c, type=BT_REAL, p=0x8048c50,
kind=8, size=8, nelems=1)
    at /home/raju/software/unZipped/gcc-4.2.0/libgfortran/io/transfer.c:1086
#2  0x4008cf72 in *_gfortran_transfer_real (dtp=0xbffff05c, p=0x8048c50, kind=8)
at /home/raju/software/unZipped/gcc-4.2.0/libgfortran/io/transfer.c:1369
#3  0x08048b89 in __dummy__print_array (unit_no=@0x8048e64, matrix=0x8048950,
style=@0x8048e5b, _style=7) at testfile.f90:22
#4  0x08048a67 in __dummy__func1 (__result=@0xbffff1f4) at testfile.f90:34
#5  0x08048918 in __dummy__trial1 () at testfile.f90:48
#6  0x08048c45 in MAIN__ () at testfile.f90:60
#7  0x08048c77 in main (argc=69487757, argv=0xfff0e483) at
/home/raju/software/unZipped/gcc-4.2.0/libgfortran/fmain.c:18



$cat testfile.f90
module dummy
  implicit none
  integer, parameter :: WP = kind(1.0d0)
  integer, parameter :: WPC = kind((1.0d0,1.0d0))
  integer, parameter :: elem_xr = 300

  integer :: unit_no
  character(len=40) :: file_name
  character(len=*), parameter :: rform1='(F13.5)'
contains
!------------------------------------------------------------------------------
subroutine print_array(unit_no, matrix, style)
  implicit none
  integer, intent(in) :: unit_no
  real(WP) :: matrix(0:elem_xr-1, 0:elem_xr-1)
  character(len=*) :: style

  integer :: i,j

  do i=0,elem_xr-1
    do j=0,elem_xr-1
      write(unit_no, style, advance='no') matrix(i,j)
    end do
    write(unit_no,*)
  end do
end subroutine print_array
!------------------------------------------------------------------------------
function func1()
  implicit none

  real(WP), dimension(0:elem_xr-1, 0:elem_xr-1) :: func1

  func1(0:elem_xr-1, 0:elem_xr-1) = 0.0_wp
  call print_array(10, func1, rform1)
  ! code works if the above statement is changed to
  ! call print_array(10, func1(:,:), rform1)
end function func1
!------------------------------------------------------------------------------
subroutine trial1()
  implicit none

  real(WP), dimension(0:elem_xr-1, 0:elem_xr-1) :: lhs


  write(file_name, '(A, I0, A)') "output_p", 0, ".txt"
  open(unit=unit_no, file=file_name, status='replace', action='write')

  lhs(0:elem_xr-1, 0:elem_xr-1) = func1()

  close(10)
end subroutine trial1
!------------------------------------------------------------------------------
end module dummy

!------------------------------------------------------------------------------

program testfile
  use dummy
  implicit none
  call trial1()

end program testfile