Patchwork [Fortran] PRs 43062/47339 NAMELIST fixes

login
register
mail settings
Submitter Tobias Burnus
Date Jan. 23, 2011, 12:52 p.m.
Message ID <4D3C2489.7040001@net-b.de>
Download mbox | patch
Permalink /patch/80057/
State New
Headers show

Comments

Tobias Burnus - Jan. 23, 2011, 12:52 p.m.
This patch fixes some diagnostic and F2003 rejects valid issues; on the 
way, I found a scalar allocatable character(len=n) dummy issue (PR 47421).

My main motivation for the patch was the lacking diagnosis that 
"character(len=n)" is invalid in NAMELISTS - if one follows -std=f95. On 
the way, I added some more diagnostic, downgraded some errors to 
-std=f95 errors and added some F2003 related errors (polymorphic 
objects, allocatable/pointer components; those require defined I/O, 
which is not implemented).

I added also a rather large test case, which should cover all valid 
cases and now also allocatable/pointer variables can be used in namelists.

For quotes from the standard and for a link to an interpretation 
request, see PRs.

Build and regtested on on x86-64-linux.
OK for the trunk?

Tobias
Paul Richard Thomas - Jan. 26, 2011, 9:53 a.m.
Dear Tobias,


> I added also a rather large test case, which should cover all valid cases
> and now also allocatable/pointer variables can be used in namelists.

I wonder how we have managed to get up to NAMELIST_70.f** ??? :-)

>
> For quotes from the standard and for a link to an interpretation request,
> see PRs.

Given that the correction to the standard still needs to get passed in
a WG5 ballot, should we not produce a warning with -pedantic??
>
> Build and regtested on on x86-64-linux.
> OK for the trunk?
>

OK for trunk.  Many thanks for wading through the interpretation
request process and getting a clear response.

Each time I look at the NAMELIST part of trans-io.c, I cringe with
embarrassment.  Whilst it works OK, it is almost completely
impenetrable!  Sometime, I will clean it up..... sometime.

Cheers

Paul
Tobias Burnus - Jan. 26, 2011, 10:30 a.m.
On 01/26/2011 10:53 AM, Paul Richard Thomas wrote:
> I wonder how we have managed to get up to NAMELIST_70.f** ??? :-)

I  think mostly due to libgfortran-related stuff. Especially with arrays 
and derived types you have a huge number of possibilities how a user can 
enter a namelist, which is not really helped by the fact that gfortran 
also has some vendor extensions. Namelists with defined I/O for 
polymorphic or derived-type entities will give the next opportunity to 
introduce bugs.

> Given that the correction to the standard still needs to get passed in
> a WG5 ballot, should we not produce a warning with -pedantic??

Well, the standard is ambiguous thus some edit is needed. However, 
looking at the standard, the intent is rather clear that 
allocatables/pointers should be allowed. And the current wording only 
prohibits at most local pointer/allocatables - not already 
allocated/associated host-/use-associated or dummy 
pointers/allocatables. Thus, I doubt that WG5 will change the 
interpretation.

> OK for trunk.  Many thanks for wading through the interpretation
> request process and getting a clear response.

One should also thank Steve for spotting the ambiguity in the standard.

Thanks for the review. Committed as Rev. 169282.

Tobias

Patch

2011-01-23  Tobias Burnus  <burnus@net-b.de>

	PR fortran/47339
	PR fortran/43062
	* match.c (gfc_match_namelist): Allow assumed-length characters.
	* resolve.c (resolve_fl_namelist): Adapt and add error messages.
	* symbol.c (check_conflict): Allow allocatables in NML for F2003.
	* trans-io.c (nml_get_addr_expr,transfer_namelist_element):
	Changes due to that change.

2011-01-23  Tobias Burnus  <burnus@net-b.de>

	PR fortran/47339
	PR fortran/43062
	* fortran.dg/namelist_69.f90: New test.
	* fortran.dg/namelist_70.f90: New test.
	* fortran.dg/namelist_assumed_char.f90: Modify dg-error, augment test.
	* fortran.dg/namelist_3.f90: Adapt test.
	* fortran.dg/namelist_34.f90: Ditto.
	* fortran.dg/namelist_35.f90: Ditto.
	* fortran.dg/namelist_5.f90: Ditto.
	* fortran.dg/namelist_63.f90: Ditto.
	* gfortran.dg/alloc_comp_constraint_1.f90: Ditto.

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 70f5862..0793b8c 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4030,13 +4030,6 @@  gfc_match_namelist (void)
 	      gfc_error_check ();
 	    }
 
-	  if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl->length == NULL)
-	    {
-	      gfc_error ("Assumed character length '%s' in namelist '%s' at "
-			 "%C is not allowed", sym->name, group_name->name);
-	      gfc_error_check ();
-	    }
-
 	  nl = gfc_get_namelist ();
 	  nl->sym = sym;
 	  sym->refs++;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9f0d675..a4a77ac 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11726,40 +11726,64 @@  resolve_fl_namelist (gfc_symbol *sym)
 
   for (nl = sym->namelist; nl; nl = nl->next)
     {
-      /* Reject namelist arrays of assumed shape.  */
+      /* Check again, the check in match only works if NAMELIST comes
+	 after the decl.  */
+      if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SIZE)
+     	{
+	  gfc_error ("Assumed size array '%s' in namelist '%s' at %L is not "
+		     "allowed", nl->sym->name, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
       if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
-	  && gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
-			     "must not have assumed shape in namelist "
+	  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST array "
+			     "object '%s' with assumed shape in namelist "
 			     "'%s' at %L", nl->sym->name, sym->name,
 			     &sym->declared_at) == FAILURE)
-	    return FAILURE;
+	return FAILURE;
 
-      /* Reject namelist arrays that are not constant shape.  */
-      if (is_non_constant_shape_array (nl->sym))
-	{
-	  gfc_error ("NAMELIST array object '%s' must have constant "
-		     "shape in namelist '%s' at %L", nl->sym->name,
-		     sym->name, &sym->declared_at);
-	  return FAILURE;
-	}
+      if (is_non_constant_shape_array (nl->sym)
+	  && gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST array "
+			     "object '%s' with nonconstant shape in namelist "
+			     "'%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	return FAILURE;
 
-      /* Namelist objects cannot have allocatable or pointer components.  */
-      if (nl->sym->ts.type != BT_DERIVED)
-	continue;
+      if (nl->sym->ts.type == BT_CHARACTER
+	  && (nl->sym->ts.u.cl->length == NULL
+	      || !gfc_is_constant_expr (nl->sym->ts.u.cl->length))
+	  && gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST object "
+			     "'%s' with nonconstant character length in "
+			     "namelist '%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	return FAILURE;
 
-      if (nl->sym->ts.u.derived->attr.alloc_comp)
+      /* FIXME: Once UDDTIO is implemented, the following can be
+	 removed.  */
+      if (nl->sym->ts.type == BT_CLASS)
 	{
-	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
-		     "have ALLOCATABLE components",
-		     nl->sym->name, sym->name, &sym->declared_at);
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L is "
+		     "polymorphic and requires a defined input/output "
+		     "procedure", nl->sym->name, sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
 
-      if (nl->sym->ts.u.derived->attr.pointer_comp)
+      if (nl->sym->ts.type == BT_DERIVED
+	  && (nl->sym->ts.u.derived->attr.alloc_comp
+	      || nl->sym->ts.u.derived->attr.pointer_comp))
 	{
-	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L cannot "
-		     "have POINTER components", 
-		     nl->sym->name, sym->name, &sym->declared_at);
+	  if (gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST object "
+			      "'%s' in namelist '%s' at %L with ALLOCATABLE "
+			      "or POINTER components", nl->sym->name,
+			      sym->name, &sym->declared_at) == FAILURE)
+	    return FAILURE;
+
+	 /* FIXME: Once UDDTIO is implemented, the following can be
+	    removed.  */
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L has "
+		     "ALLOCATABLE or POINTER components and thus requires "
+		     "a defined input/output procedure", nl->sym->name,
+		     sym->name, &sym->declared_at);
 	  return FAILURE;
 	}
     }
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index cb5a08f..71aa518 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -390,6 +390,14 @@  check_conflict (symbol_attribute *attr, const char *name, locus *where)
       goto conflict_std;
     }
 
+  if (attr->in_namelist && (attr->allocatable || attr->pointer))
+    {
+      a1 = in_namelist;
+      a2 = attr->allocatable ? allocatable : pointer;
+      standard = GFC_STD_F2003;
+      goto conflict_std;
+    }
+
   /* Check for attributes not allowed in a BLOCK DATA.  */
   if (gfc_current_state () == COMP_BLOCK_DATA)
     {
@@ -495,9 +503,6 @@  check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (in_equivalence, allocatable);
   conf (in_equivalence, threadprivate);
 
-  conf (in_namelist, pointer);
-  conf (in_namelist, allocatable);
-
   conf (entry, result);
 
   conf (function, subroutine);
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 04ad870..f6a783f 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1463,6 +1463,7 @@  nml_full_name (const char* var_name, const char* cmp_name)
   return full_name;
 }
 
+
 /* nml_get_addr_expr builds an address expression from the
    gfc_symbol or gfc_component backend_decl's. An offset is
    provided so that the address of an element of an array of
@@ -1475,9 +1476,6 @@  nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
 {
   tree decl = NULL_TREE;
   tree tmp;
-  tree itmp;
-  int array_flagged;
-  int dummy_arg_flagged;
 
   if (sym)
     {
@@ -1503,18 +1501,8 @@  nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
 
   /* Build indirect reference, if dummy argument.  */
 
-  dummy_arg_flagged = POINTER_TYPE_P (TREE_TYPE(tmp));
-
-  itmp = (dummy_arg_flagged) ? build_fold_indirect_ref_loc (input_location,
-							tmp) : tmp;
-
-  /* If an array, set flag and use indirect ref. if built.  */
-
-  array_flagged = (TREE_CODE (TREE_TYPE (itmp)) == ARRAY_TYPE
-		   && !TYPE_STRING_FLAG (TREE_TYPE (itmp)));
-
-  if (array_flagged)
-    tmp = itmp;
+  if (POINTER_TYPE_P (TREE_TYPE(tmp)))
+    tmp = build_fold_indirect_ref_loc (input_location, tmp);
 
   /* Treat the component of a derived type, using base_addr for
      the derived type.  */
@@ -1523,29 +1511,27 @@  nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
     tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
 			   base_addr, tmp, NULL_TREE);
 
-  /* If we have a derived type component, a reference to the first
-     element of the array is built.  This is done so that base_addr,
-     used in the build of the component reference, always points to
-     a RECORD_TYPE.  */
-
-  if (array_flagged)
-    tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, NULL);
-
-  /* Now build the address expression.  */
-
-  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+    tmp = gfc_conv_array_data (tmp);
+  else
+    {
+      if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+	tmp = gfc_build_addr_expr (NULL_TREE, tmp);
 
-  /* If scalar dummy, resolve indirect reference now.  */
+      if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
+         tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, NULL);
 
-  if (dummy_arg_flagged && !array_flagged)
-    tmp = build_fold_indirect_ref_loc (input_location,
+      if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+	tmp = build_fold_indirect_ref_loc (input_location,
 				   tmp);
+    }
 
   gcc_assert (tmp && POINTER_TYPE_P (TREE_TYPE (tmp)));
 
   return tmp;
 }
 
+
 /* For an object VAR_NAME whose base address is BASE_ADDR, generate a
    call to iocall[IOCALL_SET_NML_VAL].  For derived type variable, recursively
    generate calls to iocall[IOCALL_SET_NML_VAL] for each component.  */
@@ -1565,6 +1551,7 @@  transfer_namelist_element (stmtblock_t * block, const char * var_name,
   tree tmp;
   tree dtype;
   tree dt_parm_addr;
+  tree decl = NULL_TREE;
   int n_dim; 
   int itype;
   int rank = 0;
@@ -1588,7 +1575,10 @@  transfer_namelist_element (stmtblock_t * block, const char * var_name,
 
   if (rank)
     {
-      dt =  TREE_TYPE ((sym) ? sym->backend_decl : c->backend_decl);
+      decl = (sym) ? sym->backend_decl : c->backend_decl;
+      if (sym && sym->attr.dummy)
+        decl = build_fold_indirect_ref_loc (input_location, decl);
+      dt =  TREE_TYPE (decl);
       dtype = gfc_get_dtype (dt);
     }
   else
@@ -1622,9 +1612,9 @@  transfer_namelist_element (stmtblock_t * block, const char * var_name,
 			     iocall[IOCALL_SET_NML_VAL_DIM], 5,
 			     dt_parm_addr,
 			     IARG (n_dim),
-			     GFC_TYPE_ARRAY_STRIDE (dt, n_dim),
-			     GFC_TYPE_ARRAY_LBOUND (dt, n_dim),
-			     GFC_TYPE_ARRAY_UBOUND (dt, n_dim));
+			     gfc_conv_array_stride (decl, n_dim),
+			     gfc_conv_array_lbound (decl, n_dim),
+			     gfc_conv_array_ubound (decl, n_dim));
       gfc_add_expr_to_block (block, tmp);
     }
 
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_1.f90
index cb5ac06..eb1b105 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_constraint_1.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constraint_1.f90
@@ -13,7 +13,7 @@  program main
 
     type(foo) :: a
     type(bar) :: b
-    namelist /blah/ a ! { dg-error "cannot have ALLOCATABLE components" }
+    namelist /blah/ a ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
 
     write (*, *) a  ! { dg-error "cannot have ALLOCATABLE components" }
 
diff --git a/gcc/testsuite/gfortran.dg/namelist_3.f90 b/gcc/testsuite/gfortran.dg/namelist_3.f90
index 68cc7d5..722b940 100644
--- a/gcc/testsuite/gfortran.dg/namelist_3.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_3.f90
@@ -1,7 +1,8 @@ 
 ! { dg-do compile }
+! { dg-options "-std=f95" }
 ! Check that a pointer cannot be a member of a namelist
 program namelist_3
   integer,pointer :: x
   allocate (x)
-  namelist /n/ x ! { dg-error "NAMELIST attribute conflicts with POINTER attribute" "" }
+  namelist /n/ x ! { dg-error "NAMELIST attribute with POINTER attribute" "" }
 end program namelist_3
diff --git a/gcc/testsuite/gfortran.dg/namelist_34.f90 b/gcc/testsuite/gfortran.dg/namelist_34.f90
index be050d9..f7c5e1c 100644
--- a/gcc/testsuite/gfortran.dg/namelist_34.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_34.f90
@@ -23,8 +23,8 @@  USE types
    type(tp1) :: t1
    type(tp3) :: t3
 
-   namelist /a/ t1    ! { dg-error "cannot have POINTER components" }
-   namelist /b/ t3    ! { dg-error "cannot have POINTER components" }
+   namelist /a/ t1    ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
+   namelist /b/ t3    ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
 END MODULE
 
 ! { dg-final { cleanup-modules "types nml" } }
diff --git a/gcc/testsuite/gfortran.dg/namelist_35.f90 b/gcc/testsuite/gfortran.dg/namelist_35.f90
index 531f636..9a2972d 100644
--- a/gcc/testsuite/gfortran.dg/namelist_35.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_35.f90
@@ -7,5 +7,5 @@ 
 subroutine test(cha)
   implicit none
   character(len=10) :: cha(:)
-  namelist /z/  cha             ! { dg-error "must not have assumed shape" }
+  namelist /z/  cha             ! { dg-error "with assumed shape in namelist" }
 end subroutine test
diff --git a/gcc/testsuite/gfortran.dg/namelist_5.f90 b/gcc/testsuite/gfortran.dg/namelist_5.f90
index d7ccfd1..4fcf9ae 100644
--- a/gcc/testsuite/gfortran.dg/namelist_5.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_5.f90
@@ -1,4 +1,6 @@ 
 ! { dg-do compile }
+! { dg-options "-std=f95" }
+!
 ! Tests the fix for PR25054 in which namelist objects with non-constant
 ! shape were allowed.
 !
@@ -6,8 +8,8 @@ 
 !
 SUBROUTINE S1(I)
  integer :: a,b(I)
- NAMELIST /NLIST/ a,b ! { dg-error "must have constant shape" }
+ NAMELIST /NLIST/ a,b ! { dg-error "with nonconstant shape" }
  a=1 ; b=2
  write(6,NML=NLIST)
 END SUBROUTINE S1
-END
\ No newline at end of file
+END
diff --git a/gcc/testsuite/gfortran.dg/namelist_63.f90 b/gcc/testsuite/gfortran.dg/namelist_63.f90
index 1d02789..0210174 100644
--- a/gcc/testsuite/gfortran.dg/namelist_63.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_63.f90
@@ -24,5 +24,5 @@  type region_struct
 end type
 
 type (c_struct) curve(10)
-namelist / params / curve ! { dg-error "NAMELIST object .curve. in namelist .params. at .1. cannot have POINTER components" }
+namelist / params / curve ! { dg-error "ALLOCATABLE or POINTER components and thus requires a defined input/output" }
 end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_assumed_char.f90 b/gcc/testsuite/gfortran.dg/namelist_assumed_char.f90
index 82f423f..b7d063c 100644
--- a/gcc/testsuite/gfortran.dg/namelist_assumed_char.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_assumed_char.f90
@@ -1,7 +1,20 @@ 
 ! { dg-do compile }
+! { dg-options "-std=f95" }
+
 ! PR30481 Assumed size character is not allowed in namelist.
 ! Test case from PR, submitted by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+!
+! Modifications for PR fortran/47339 / PR fortran/43062:
+! Add -std=f95, add bar()
+!
 subroutine foo(c)
   character*(*) c
-  namelist /abc/ c  ! { dg-error "Assumed character length" }
+  namelist /abc/ c  ! { dg-error "nonconstant character length in namelist" }
 end subroutine
+
+subroutine bar(d,n)
+  integer :: n
+  character(len=n) d
+  namelist /abcd/ d  ! { dg-error "nonconstant character length in namelist" }
+end subroutine bar
+
--- /dev/null	2011-01-14 07:32:07.372000004 +0100
+++ b/gcc/testsuite/gfortran.dg/namelist_69.f90	2011-01-22 22:10:34.000000000 +0100
@@ -0,0 +1,233 @@ 
+! { dg-do run }
+!
+! PR fortran/47339
+! PR fortran/43062
+!
+! Run-time test for Fortran 2003 NAMELISTS
+! Version for non-strings
+!
+program nml_test
+  implicit none
+
+  character(len=1000) :: str
+
+  integer, allocatable :: a(:)
+  integer, allocatable :: b
+  integer, pointer :: ap(:)
+  integer, pointer :: bp
+  integer :: c
+  integer :: d(3)
+
+  type t
+    integer :: c1
+    integer :: c2(3)
+  end type t
+  type(t) :: e,f(2)
+  type(t),allocatable :: g,h(:)
+  type(t),pointer :: i,j(:)
+
+  namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j
+
+  a = [1,2]
+  allocate(b,ap(2),bp)
+  ap = [98, 99]
+  b = 7
+  bp = 101
+  c = 8
+  d = [-1, -2, -3]
+
+  e%c1 = -701
+  e%c2 = [-702,-703,-704]
+  f(1)%c1 = 33001
+  f(2)%c1 = 33002
+  f(1)%c2 = [44001,44002,44003]
+  f(2)%c2 = [44011,44012,44013]
+
+  allocate(g,h(2),i,j(2))
+
+  g%c1 = -601
+  g%c2 = [-602,6703,-604]
+  h(1)%c1 = 35001
+  h(2)%c1 = 35002
+  h(1)%c2 = [45001,45002,45003]
+  h(2)%c2 = [45011,45012,45013]
+
+  i%c1 = -501
+  i%c2 = [-502,-503,-504]
+  j(1)%c1 = 36001
+  j(2)%c1 = 36002
+  j(1)%c2 = [46001,46002,46003]
+  j(2)%c2 = [46011,46012,46013]
+
+  ! SAVE NAMELIST
+  str = repeat('X', len(str))
+  write(str,nml=nml)
+
+  ! RESET NAMELIST
+  a = [-1,-1]
+  ap = [-1, -1]
+  b = -1
+  bp = -1
+  c = -1
+  d = [-1, -1, -1]
+
+  e%c1 = -1
+  e%c2 = [-1,-1,-1]
+  f(1)%c1 = -1
+  f(2)%c1 = -1
+  f(1)%c2 = [-1,-1,-1]
+  f(2)%c2 = [-1,-1,-1]
+
+  g%c1 = -1
+  g%c2 = [-1,-1,-1]
+  h(1)%c1 = -1
+  h(2)%c1 = -1
+  h(1)%c2 = [-1,-1,-1]
+  h(2)%c2 = [-1,-1,-1]
+
+  i%c1 = -1
+  i%c2 = [-1,-1,-1]
+  j(1)%c1 = -1
+  j(2)%c1 = -1
+  j(1)%c2 = [-1,-1,-1]
+  j(2)%c2 = [-1,-1,-1]
+
+  ! Read back
+  read(str,nml=nml)
+
+  ! Check result
+  if (any (a /= [1,2])) call abort()
+  if (any (ap /= [98, 99])) call abort()
+  if (b /= 7) call abort()
+  if (bp /= 101) call abort()
+  if (c /= 8) call abort()
+  if (any (d /= [-1, -2, -3])) call abort()
+
+  if (e%c1 /= -701) call abort()
+  if (any (e%c2 /= [-702,-703,-704])) call abort()
+  if (f(1)%c1 /= 33001) call abort()
+  if (f(2)%c1 /= 33002) call abort()
+  if (any (f(1)%c2 /= [44001,44002,44003])) call abort()
+  if (any (f(2)%c2 /= [44011,44012,44013])) call abort()
+
+  if (g%c1 /= -601) call abort()
+  if (any(g%c2 /= [-602,6703,-604])) call abort()
+  if (h(1)%c1 /= 35001) call abort()
+  if (h(2)%c1 /= 35002) call abort()
+  if (any (h(1)%c2 /= [45001,45002,45003])) call abort()
+  if (any (h(2)%c2 /= [45011,45012,45013])) call abort()
+
+  if (i%c1 /= -501) call abort()
+  if (any (i%c2 /= [-502,-503,-504])) call abort()
+  if (j(1)%c1 /= 36001) call abort()
+  if (j(2)%c1 /= 36002) call abort()
+  if (any (j(1)%c2 /= [46001,46002,46003])) call abort()
+  if (any (j(2)%c2 /= [46011,46012,46013])) call abort()
+
+  ! Check argument passing (dummy processing)
+  call test2(a,b,c,d,ap,bp,e,f,g,h,i,j,2) 
+
+contains
+  subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
+    integer, allocatable :: x1(:)
+    integer, allocatable :: x2
+    integer, pointer :: x1p(:)
+    integer, pointer :: x2p
+    integer :: x3
+    integer :: x4(3)
+    integer :: n
+    integer :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 42, 53 ]
+
+    x12(1)%c1 = 37001
+    x12(2)%c1 = 37002
+    x12(1)%c2 = [47001,47002,47003]
+    x12(2)%c2 = [47011,47012,47013]
+
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = [-1,-1]
+    x1p = [-1, -1]
+    x2 = -1
+    x2p = -1
+    x3 = -1
+    x4 = [-1, -1, -1]
+
+    x6%c1 = -1
+    x6%c2 = [-1,-1,-1]
+    x7(1)%c1 = -1
+    x7(2)%c1 = -1
+    x7(1)%c2 = [-1,-1,-1]
+    x7(2)%c2 = [-1,-1,-1]
+
+    x8%c1 = -1
+    x8%c2 = [-1,-1,-1]
+    x9(1)%c1 = -1
+    x9(2)%c1 = -1
+    x9(1)%c2 = [-1,-1,-1]
+    x9(2)%c2 = [-1,-1,-1]
+
+    x10%c1 = -1
+    x10%c2 = [-1,-1,-1]
+    x11(1)%c1 = -1
+    x11(2)%c1 = -1
+    x11(1)%c2 = [-1,-1,-1]
+    x11(2)%c2 = [-1,-1,-1]
+
+    x5 = [ -1, -1 ]
+
+    x12(1)%c1 = -1
+    x12(2)%c1 = -1
+    x12(1)%c2 = [-1,-1,-1]
+    x12(2)%c2 = [-1,-1,-1]
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= [1,2])) call abort()
+    if (any (x1p /= [98, 99])) call abort()
+    if (x2 /= 7) call abort()
+    if (x2p /= 101) call abort()
+    if (x3 /= 8) call abort()
+    if (any (x4 /= [-1, -2, -3])) call abort()
+
+    if (x6%c1 /= -701) call abort()
+    if (any (x6%c2 /= [-702,-703,-704])) call abort()
+    if (x7(1)%c1 /= 33001) call abort()
+    if (x7(2)%c1 /= 33002) call abort()
+    if (any (x7(1)%c2 /= [44001,44002,44003])) call abort()
+    if (any (x7(2)%c2 /= [44011,44012,44013])) call abort()
+
+    if (x8%c1 /= -601) call abort()
+    if (any(x8%c2 /= [-602,6703,-604])) call abort()
+    if (x9(1)%c1 /= 35001) call abort()
+    if (x9(2)%c1 /= 35002) call abort()
+    if (any (x9(1)%c2 /= [45001,45002,45003])) call abort()
+    if (any (x9(2)%c2 /= [45011,45012,45013])) call abort()
+
+    if (x10%c1 /= -501) call abort()
+    if (any (x10%c2 /= [-502,-503,-504])) call abort()
+    if (x11(1)%c1 /= 36001) call abort()
+    if (x11(2)%c1 /= 36002) call abort()
+    if (any (x11(1)%c2 /= [46001,46002,46003])) call abort()
+    if (any (x11(2)%c2 /= [46011,46012,46013])) call abort()
+
+    if (any (x5 /= [ 42, 53 ])) call abort()
+
+    if (x12(1)%c1 /= 37001) call abort()
+    if (x12(2)%c1 /= 37002) call abort()
+    if (any (x12(1)%c2 /= [47001,47002,47003])) call abort()
+    if (any (x12(2)%c2 /= [47011,47012,47013])) call abort()
+  end subroutine test2
+end program nml_test
--- /dev/null	2011-01-14 07:32:07.372000004 +0100
+++ b/gcc/testsuite/gfortran.dg/namelist_70.f90	2011-01-23 11:51:28.000000000 +0100
@@ -0,0 +1,451 @@ 
+! { dg-do run }
+!
+! PR fortran/47339
+! PR fortran/43062
+!
+! Run-time test for Fortran 2003 NAMELISTS
+! Version for non-strings
+!
+program nml_test
+  implicit none
+
+  character(len=1000) :: str
+
+  character(len=5), allocatable :: a(:)
+  character(len=5), allocatable :: b
+  character(len=5), pointer :: ap(:)
+  character(len=5), pointer :: bp
+  character(len=5) :: c
+  character(len=5) :: d(3)
+
+  type t
+    character(len=5) :: c1
+    character(len=5) :: c2(3)
+  end type t
+  type(t) :: e,f(2)
+  type(t),allocatable :: g,h(:)
+  type(t),pointer :: i,j(:)
+
+  namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j
+
+  a = ["aa01", "aa02"]
+  allocate(b,ap(2),bp)
+  ap = ['98', '99']
+  b = '7'
+  bp = '101'
+  c = '8'
+  d = ['-1', '-2', '-3']
+
+  e%c1 = '-701'
+  e%c2 = ['-702','-703','-704']
+  f(1)%c1 = '33001'
+  f(2)%c1 = '33002'
+  f(1)%c2 = ['44001','44002','44003']
+  f(2)%c2 = ['44011','44012','44013']
+
+  allocate(g,h(2),i,j(2))
+
+  g%c1 = '-601'
+  g%c2 = ['-602','6703','-604']
+  h(1)%c1 = '35001'
+  h(2)%c1 = '35002'
+  h(1)%c2 = ['45001','45002','45003']
+  h(2)%c2 = ['45011','45012','45013']
+
+  i%c1 = '-501'
+  i%c2 = ['-502','-503','-504']
+  j(1)%c1 = '36001'
+  j(2)%c1 = '36002'
+  j(1)%c2 = ['46001','46002','46003']
+  j(2)%c2 = ['46011','46012','46013']
+
+  ! SAVE NAMELIST
+  str = repeat('X', len(str))
+  write(str,nml=nml)
+
+  ! RESET NAMELIST
+  a = repeat('X', len(a))
+  ap = repeat('X', len(ap))
+  b = repeat('X', len(b))
+  bp = repeat('X', len(bp))
+  c = repeat('X', len(c))
+  d = repeat('X', len(d))
+
+  e%c1 = repeat('X', len(e%c1))
+  e%c2 = repeat('X', len(e%c2))
+  f(1)%c1 = repeat('X', len(f(1)%c1))
+  f(2)%c1 = repeat('X', len(f(2)%c1))
+  f(1)%c2 = repeat('X', len(f(1)%c2))
+  f(2)%c2 = repeat('X', len(f(2)%c2))
+
+  g%c1 = repeat('X', len(g%c1))
+  g%c2 = repeat('X', len(g%c1))
+  h(1)%c1 = repeat('X', len(h(1)%c1))
+  h(2)%c1 = repeat('X', len(h(1)%c1))
+  h(1)%c2 = repeat('X', len(h(1)%c1))
+  h(2)%c2 = repeat('X', len(h(1)%c1))
+
+  i%c1 = repeat('X', len(i%c1))
+  i%c2 = repeat('X', len(i%c1))
+  j(1)%c1 = repeat('X', len(j(1)%c1))
+  j(2)%c1 = repeat('X', len(j(2)%c1))
+  j(1)%c2 = repeat('X', len(j(1)%c2))
+  j(2)%c2 = repeat('X', len(j(2)%c2))
+
+  ! Read back
+  read(str,nml=nml)
+
+  ! Check result
+  if (any (a /= ['aa01','aa02'])) call abort()
+  if (any (ap /= ['98', '99'])) call abort()
+  if (b /= '7') call abort()
+  if (bp /= '101') call abort()
+  if (c /= '8') call abort()
+  if (any (d /= ['-1', '-2', '-3'])) call abort()
+
+  if (e%c1 /= '-701') call abort()
+  if (any (e%c2 /= ['-702','-703','-704'])) call abort()
+  if (f(1)%c1 /= '33001') call abort()
+  if (f(2)%c1 /= '33002') call abort()
+  if (any (f(1)%c2 /= ['44001','44002','44003'])) call abort()
+  if (any (f(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+  if (g%c1 /= '-601') call abort()
+  if (any(g%c2 /= ['-602','6703','-604'])) call abort()
+  if (h(1)%c1 /= '35001') call abort()
+  if (h(2)%c1 /= '35002') call abort()
+  if (any (h(1)%c2 /= ['45001','45002','45003'])) call abort()
+  if (any (h(2)%c2 /= ['45011','45012','45013'])) call abort()
+
+  if (i%c1 /= '-501') call abort()
+  if (any (i%c2 /= ['-502','-503','-504'])) call abort()
+  if (j(1)%c1 /= '36001') call abort()
+  if (j(2)%c1 /= '36002') call abort()
+  if (any (j(1)%c2 /= ['46001','46002','46003'])) call abort()
+  if (any (j(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+  ! Check argument passing (dummy processing)
+  call test2(a,b,c,d,ap,bp,e,f,g,h,i,j,2) 
+! FIXME: b  excluded because of PR 47421.
+! call test3(a,b,c,d,ap,bp,e,f,g,h,i,j,2,len(a)) 
+  call test3(a,  c,d,ap,bp,e,f,g,h,i,j,2,len(a)) 
+  call test4(a,b,c,d,ap,bp,e,f,g,h,i,j,2)
+
+contains
+  subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
+    character(len=5), allocatable :: x1(:)
+    character(len=5), allocatable :: x2
+    character(len=5), pointer :: x1p(:)
+    character(len=5), pointer :: x2p
+    character(len=5) :: x3
+    character(len=5) :: x4(3)
+    integer :: n
+    character(len=5) :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 'x5-42', 'x5-53' ]
+
+    x12(1)%c1 = '37001'
+    x12(2)%c1 = '37002'
+    x12(1)%c2 = ['47001','47002','47003']
+    x12(2)%c2 = ['47011','47012','47013']
+ 
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = repeat('X', len(x1))
+    x1p = repeat('X', len(x1p))
+    x2 = repeat('X', len(x2))
+    x2p = repeat('X', len(x2p))
+    x3 = repeat('X', len(x3))
+    x4 = repeat('X', len(x4))
+
+    x6%c1 = repeat('X', len(x6%c1))
+    x6%c2 = repeat('X', len(x6%c2))
+    x7(1)%c1 = repeat('X', len(x7(1)%c1))
+    x7(2)%c1 = repeat('X', len(x7(2)%c1))
+    x7(1)%c2 = repeat('X', len(x7(1)%c2))
+    x7(2)%c2 = repeat('X', len(x7(2)%c2))
+
+    x8%c1 = repeat('X', len(x8%c1))
+    x8%c2 = repeat('X', len(x8%c1))
+    x9(1)%c1 = repeat('X', len(x9(1)%c1))
+    x9(2)%c1 = repeat('X', len(x9(1)%c1))
+    x9(1)%c2 = repeat('X', len(x9(1)%c1))
+    x9(2)%c2 = repeat('X', len(x9(1)%c1))
+
+    x10%c1 = repeat('X', len(x10%c1))
+    x10%c2 = repeat('X', len(x10%c1))
+    x11(1)%c1 = repeat('X', len(x11(1)%c1))
+    x11(2)%c1 = repeat('X', len(x11(2)%c1))
+    x11(1)%c2 = repeat('X', len(x11(1)%c2))
+    x11(2)%c2 = repeat('X', len(x11(2)%c2))
+
+    x5 = repeat('X', len(x5))
+
+    x12(1)%c1 = repeat('X', len(x12(2)%c2))
+    x12(2)%c1 = repeat('X', len(x12(2)%c2))
+    x12(1)%c2 = repeat('X', len(x12(2)%c2))
+    x12(2)%c2 = repeat('X', len(x12(2)%c2))
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= ['aa01','aa02'])) call abort()
+    if (any (x1p /= ['98', '99'])) call abort()
+    if (x2 /= '7') call abort()
+    if (x2p /= '101') call abort()
+    if (x3 /= '8') call abort()
+    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
+
+    if (x6%c1 /= '-701') call abort()
+    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
+    if (x7(1)%c1 /= '33001') call abort()
+    if (x7(2)%c1 /= '33002') call abort()
+    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
+    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+    if (x8%c1 /= '-601') call abort()
+    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
+    if (x9(1)%c1 /= '35001') call abort()
+    if (x9(2)%c1 /= '35002') call abort()
+    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
+    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
+ 
+    if (x10%c1 /= '-501') call abort()
+    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
+    if (x11(1)%c1 /= '36001') call abort()
+    if (x11(2)%c1 /= '36002') call abort()
+    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
+    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
+
+    if (x12(1)%c1 /= '37001') call abort()
+    if (x12(2)%c1 /= '37002') call abort()
+    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
+    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
+  end subroutine test2
+
+! FIXME: x2  excluded because of PR 47421.
+!  subroutine test3(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n,ll)
+  subroutine test3(x1,   x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n,ll)
+    integer :: n, ll
+    character(len=ll), allocatable :: x1(:)
+! FIXME: x2  excluded because of PR 47421.
+!    character(len=ll), allocatable :: x2
+    character(len=ll), pointer :: x1p(:)
+    character(len=ll), pointer :: x2p
+    character(len=ll) :: x3
+    character(len=ll) :: x4(3)
+    character(len=ll) :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+! FIXME: x2  excluded because of PR 47421.
+!   namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+    namelist /nml2/ x1,     x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 'x5-42', 'x5-53' ]
+
+    x12(1)%c1 = '37001'
+    x12(2)%c1 = '37002'
+    x12(1)%c2 = ['47001','47002','47003']
+    x12(2)%c2 = ['47011','47012','47013']
+ 
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = repeat('X', len(x1))
+    x1p = repeat('X', len(x1p))
+
+! FIXME: x2  excluded because of PR 47421.
+!    x2 = repeat('X', len(x2))
+    x2p = repeat('X', len(x2p))
+    x3 = repeat('X', len(x3))
+    x4 = repeat('X', len(x4))
+
+    x6%c1 = repeat('X', len(x6%c1))
+    x6%c2 = repeat('X', len(x6%c2))
+    x7(1)%c1 = repeat('X', len(x7(1)%c1))
+    x7(2)%c1 = repeat('X', len(x7(2)%c1))
+    x7(1)%c2 = repeat('X', len(x7(1)%c2))
+    x7(2)%c2 = repeat('X', len(x7(2)%c2))
+
+    x8%c1 = repeat('X', len(x8%c1))
+    x8%c2 = repeat('X', len(x8%c1))
+    x9(1)%c1 = repeat('X', len(x9(1)%c1))
+    x9(2)%c1 = repeat('X', len(x9(1)%c1))
+    x9(1)%c2 = repeat('X', len(x9(1)%c1))
+    x9(2)%c2 = repeat('X', len(x9(1)%c1))
+
+    x10%c1 = repeat('X', len(x10%c1))
+    x10%c2 = repeat('X', len(x10%c1))
+    x11(1)%c1 = repeat('X', len(x11(1)%c1))
+    x11(2)%c1 = repeat('X', len(x11(2)%c1))
+    x11(1)%c2 = repeat('X', len(x11(1)%c2))
+    x11(2)%c2 = repeat('X', len(x11(2)%c2))
+
+    x5 = repeat('X', len(x5))
+
+    x12(1)%c1 = repeat('X', len(x12(2)%c2))
+    x12(2)%c1 = repeat('X', len(x12(2)%c2))
+    x12(1)%c2 = repeat('X', len(x12(2)%c2))
+    x12(2)%c2 = repeat('X', len(x12(2)%c2))
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= ['aa01','aa02'])) call abort()
+    if (any (x1p /= ['98', '99'])) call abort()
+! FIXME: x2  excluded because of PR 47421.
+!    if (x2 /= '7') call abort()
+    if (x2p /= '101') call abort()
+    if (x3 /= '8') call abort()
+    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
+
+    if (x6%c1 /= '-701') call abort()
+    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
+    if (x7(1)%c1 /= '33001') call abort()
+    if (x7(2)%c1 /= '33002') call abort()
+    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
+    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+    if (x8%c1 /= '-601') call abort()
+    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
+    if (x9(1)%c1 /= '35001') call abort()
+    if (x9(2)%c1 /= '35002') call abort()
+    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
+    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
+ 
+    if (x10%c1 /= '-501') call abort()
+    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
+    if (x11(1)%c1 /= '36001') call abort()
+    if (x11(2)%c1 /= '36002') call abort()
+    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
+    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
+
+    if (x12(1)%c1 /= '37001') call abort()
+    if (x12(2)%c1 /= '37002') call abort()
+    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
+    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
+  end subroutine test3
+
+  subroutine test4(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
+    character(len=*), allocatable :: x1(:)
+    character(len=*), allocatable :: x2
+    character(len=*), pointer :: x1p(:)
+    character(len=*), pointer :: x2p
+    character(len=*) :: x3
+    character(len=*) :: x4(3)
+    integer :: n
+    character(len=5) :: x5(n)
+    type(t) :: x6,x7(2)
+    type(t),allocatable :: x8,x9(:)
+    type(t),pointer :: x10,x11(:)
+    type(t) :: x12(n)
+
+    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
+
+    x5 = [ 'x5-42', 'x5-53' ]
+
+    x12(1)%c1 = '37001'
+    x12(2)%c1 = '37002'
+    x12(1)%c2 = ['47001','47002','47003']
+    x12(2)%c2 = ['47011','47012','47013']
+ 
+    ! SAVE NAMELIST
+    str = repeat('X', len(str))
+    write(str,nml=nml2)
+
+    ! RESET NAMELIST
+    x1 = repeat('X', len(x1))
+    x1p = repeat('X', len(x1p))
+    x2 = repeat('X', len(x2))
+    x2p = repeat('X', len(x2p))
+    x3 = repeat('X', len(x3))
+    x4 = repeat('X', len(x4))
+
+    x6%c1 = repeat('X', len(x6%c1))
+    x6%c2 = repeat('X', len(x6%c2))
+    x7(1)%c1 = repeat('X', len(x7(1)%c1))
+    x7(2)%c1 = repeat('X', len(x7(2)%c1))
+    x7(1)%c2 = repeat('X', len(x7(1)%c2))
+    x7(2)%c2 = repeat('X', len(x7(2)%c2))
+
+    x8%c1 = repeat('X', len(x8%c1))
+    x8%c2 = repeat('X', len(x8%c1))
+    x9(1)%c1 = repeat('X', len(x9(1)%c1))
+    x9(2)%c1 = repeat('X', len(x9(1)%c1))
+    x9(1)%c2 = repeat('X', len(x9(1)%c1))
+    x9(2)%c2 = repeat('X', len(x9(1)%c1))
+
+    x10%c1 = repeat('X', len(x10%c1))
+    x10%c2 = repeat('X', len(x10%c1))
+    x11(1)%c1 = repeat('X', len(x11(1)%c1))
+    x11(2)%c1 = repeat('X', len(x11(2)%c1))
+    x11(1)%c2 = repeat('X', len(x11(1)%c2))
+    x11(2)%c2 = repeat('X', len(x11(2)%c2))
+
+    x5 = repeat('X', len(x5))
+
+    x12(1)%c1 = repeat('X', len(x12(2)%c2))
+    x12(2)%c1 = repeat('X', len(x12(2)%c2))
+    x12(1)%c2 = repeat('X', len(x12(2)%c2))
+    x12(2)%c2 = repeat('X', len(x12(2)%c2))
+
+    ! Read back
+    read(str,nml=nml2)
+
+    ! Check result
+    if (any (x1 /= ['aa01','aa02'])) call abort()
+    if (any (x1p /= ['98', '99'])) call abort()
+    if (x2 /= '7') call abort()
+    if (x2p /= '101') call abort()
+    if (x3 /= '8') call abort()
+    if (any (x4 /= ['-1', '-2', '-3'])) call abort()
+
+    if (x6%c1 /= '-701') call abort()
+    if (any (x6%c2 /= ['-702','-703','-704'])) call abort()
+    if (x7(1)%c1 /= '33001') call abort()
+    if (x7(2)%c1 /= '33002') call abort()
+    if (any (x7(1)%c2 /= ['44001','44002','44003'])) call abort()
+    if (any (x7(2)%c2 /= ['44011','44012','44013'])) call abort()
+
+    if (x8%c1 /= '-601') call abort()
+    if (any(x8%c2 /= ['-602','6703','-604'])) call abort()
+    if (x9(1)%c1 /= '35001') call abort()
+    if (x9(2)%c1 /= '35002') call abort()
+    if (any (x9(1)%c2 /= ['45001','45002','45003'])) call abort()
+    if (any (x9(2)%c2 /= ['45011','45012','45013'])) call abort()
+ 
+    if (x10%c1 /= '-501') call abort()
+    if (any (x10%c2 /= ['-502','-503','-504'])) call abort()
+    if (x11(1)%c1 /= '36001') call abort()
+    if (x11(2)%c1 /= '36002') call abort()
+    if (any (x11(1)%c2 /= ['46001','46002','46003'])) call abort()
+    if (any (x11(2)%c2 /= ['46011','46012','46013'])) call abort()
+
+    if (any (x5 /= [ 'x5-42', 'x5-53' ])) call abort()
+
+    if (x12(1)%c1 /= '37001') call abort()
+    if (x12(2)%c1 /= '37002') call abort()
+    if (any (x12(1)%c2 /= ['47001','47002','47003'])) call abort()
+    if (any (x12(2)%c2 /= ['47011','47012','47013'])) call abort()
+  end subroutine test4
+end program nml_test