re PR fortran/55117 (Programs fails to read namelist (contains derived types objects))

2014-05-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/55117
	* gfortran.dg/namelist_85.f90: New test.

From-SVN: r210935

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c2c2f6a363f7d48f9cd0ac781d8195c3341c8aa9..63b44daaf0b20a24125b5d03433bf6b1e589266c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-05-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/55117
+       * gfortran.dg/namelist_85.f90: New test.
+
 2014-05-26  Igor Zamyatin  <igor.zamyatin@intel.com>
 
        PR c/61191

diff --git a/gcc/testsuite/gfortran.dg/namelist_85.f90 b/gcc/testsuite/gfortran.dg/namelist_85.f90
new file mode 100644 (file)
index 0000000..1775285
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_85.f90
@@ -0,0 +1,66 @@
+! { dg-do run  }
+! { dg-options -std=gnu }
+! PR55117  Programs fails namelist read (contains derived types objects)
+program test_type_extension
+
+  type tk_t
+     real :: x
+  end type tk_t
+
+  type, extends(tk_t) :: tke_t
+     character(8) :: string
+  end type tke_t
+
+  type, extends(tke_t) :: deep
+    integer :: int1
+    real :: y
+    character(10) :: the_name
+  end type deep
+
+  type other
+    integer :: one_oh
+    integer :: two_oh
+  end type other
+
+  type plain_type
+    integer :: var1
+    type(other) :: var2
+    real :: var3
+  end type plain_type
+
+  type some_other
+    complex :: varx
+    type(tke_t) :: tke
+    type (plain_type) :: varpy
+    real  :: vary
+  end type some_other
+
+  type(deep) :: trouble
+  type(some_other) :: somethinelse
+  type(tke_t) :: tke
+  integer :: answer
+  
+  namelist /test_NML/ trouble, somethinelse, tke, answer
+
+  tke%x = 0.0
+  tke%string = "xxxxxxxx"
+  answer = 5
+  trouble%x = 5.34
+  trouble%y = 4.25
+  trouble%string = "yyyy"
+  trouble%the_name = "mischief"
+
+  open(10, status="scratch")
+  
+  write(10,*) "&TEST_NML"
+  write(10,*) "TKE%X=  3.14    ,"
+  write(10,*) "TKE%STRING='kf7rcc',"
+  write(10,*) "ANSWER=          42,"
+  write(10,*) "/"
+  rewind(10)
+  
+  read(10,NML=test_NML)
+  if (tke%x - 3.14000010 > .00001) call abort
+  if (tke%string /= "kf7rcc") call abort
+  if (answer /= 42) call abort ! hitchkikers guide to the galaxy
+end program test_type_extension