2007-02-02 Paul Thomas <pault@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / arrayio_11.f90

diff --git a/gcc/testsuite/gfortran.dg/arrayio_11.f90 b/gcc/testsuite/gfortran.dg/arrayio_11.f90
new file mode 100644 (file)
index 0000000..39255db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_11.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! Tests the fix for PR30284, in which the substring plus
+! component reference for an internal file would cause an ICE.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+program gfcbug51
+  implicit none
+
+  type :: date_t
+    character(len=12) :: date      ! yyyymmddhhmm
+  end type date_t
+
+  type year_t
+    integer :: year = 0
+  end type year_t
+
+  type(date_t) :: file(3)
+  type(year_t) :: time(3)
+
+  FILE%date = (/'200612231200', '200712231200', &
+                '200812231200'/)
+
+  time = date_to_year (FILE)
+  if (any (time%year .ne. (/2006, 2007, 2008/))) call abort ()
+
+  call month_to_date ((/8, 9, 10/), FILE)
+  if ( any (file%date .ne. (/'200608231200', '200709231200', &
+                             '200810231200'/))) call abort ()
+
+contains
+
+  function date_to_year (d) result (y)
+    type(date_t) :: d(3)
+    type(year_t) :: y(size (d, 1))
+    read (d%date(1:4),'(i4)')  time% year
+  end function date_to_year
+
+  subroutine month_to_date (m, d)
+    type(date_t) :: d(3)
+    integer :: m(:)
+    write (d%date(5:6),'(i2.2)')  m
+  end subroutine month_to_date
+
+end program gfcbug51