re PR fortran/17472 ([4.0 only] namelist does not handle arrays)

-------------------------------------------------------------------

From-SVN: r98287

24 files changed, 1036 insertions, 141 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5864697..3fb03c3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2005-04-17 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/17472
+	PR fortran/18209
+	PR fortran/18396
+	PR fortran/19467
+	PR fortran/19657
+	* fortran/trans-io.c (gfc_build_io_library_fndecls): Create declaration for
+	st_set_nml_var and st_set_nml_var_dim. Remove declarations of old
+	namelist functions.
+	(build_dt): Simplified call to transfer_namelist_element.
+	(nml_get_addr_expr): Generates address expression for start of object data. New function.
+	(nml_full_name): Qualified name for derived type components. New function.
+	(transfer_namelist_element): Modified for calls to new functions and improved derived
+	type handling.
+
 2005-04-17  Richard Guenther  <rguenth@gcc.gnu.org>
 
 	* scanner.c (gfc_next_char_literal): Reset truncation flag
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 4169321..8701d5e 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -125,11 +125,8 @@ static GTY(()) tree iocall_iolength_done;
 static GTY(()) tree iocall_rewind;
 static GTY(()) tree iocall_backspace;
 static GTY(()) tree iocall_endfile;
-static GTY(()) tree iocall_set_nml_val_int;
-static GTY(()) tree iocall_set_nml_val_float;
-static GTY(()) tree iocall_set_nml_val_char;
-static GTY(()) tree iocall_set_nml_val_complex;
-static GTY(()) tree iocall_set_nml_val_log;
+static GTY(()) tree iocall_set_nml_val;
+static GTY(()) tree iocall_set_nml_val_dim;
 
 /* Variable for keeping track of what the last data transfer statement
    was.  Used for deciding which subroutine to call when the data
@@ -314,34 +311,19 @@ gfc_build_io_library_fndecls (void)
     gfc_build_library_function_decl (get_identifier (PREFIX("st_iolength_done")),
 				     gfc_int4_type_node, 0);
 
-  iocall_set_nml_val_int =
-    gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_int")),
-                                     void_type_node, 4,
-                                     pvoid_type_node, pvoid_type_node,
-                                     gfc_int4_type_node,gfc_int4_type_node);
 
-  iocall_set_nml_val_float =
-    gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_float")),
-                                     void_type_node, 4,
-                                     pvoid_type_node, pvoid_type_node,
-                                     gfc_int4_type_node,gfc_int4_type_node);
-  iocall_set_nml_val_char =
-    gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_char")),
+  iocall_set_nml_val =
+    gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var")),
                                      void_type_node, 5,
                                      pvoid_type_node, pvoid_type_node,
-                                     gfc_int4_type_node, gfc_int4_type_node, 
-                                     gfc_charlen_type_node);
-  iocall_set_nml_val_complex =
-    gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_complex")),
-                                     void_type_node, 4,
-                                     pvoid_type_node, pvoid_type_node,
-                                     gfc_int4_type_node,gfc_int4_type_node);
-  iocall_set_nml_val_log =
-    gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_log")),
-                                     void_type_node, 4,
-                                     pvoid_type_node, pvoid_type_node,
-                                     gfc_int4_type_node,gfc_int4_type_node);
+                                     gfc_int4_type_node, gfc_charlen_type_node, 
+				     gfc_int4_type_node);
 
+  iocall_set_nml_val_dim =
+    gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_dim")),
+				     void_type_node, 4,
+				     gfc_int4_type_node, gfc_int4_type_node,
+				     gfc_int4_type_node, gfc_int4_type_node);
 }
 
 
@@ -815,11 +797,11 @@ gfc_trans_inquire (gfc_code * code)
   return gfc_finish_block (&block);
 }
 
-
 static gfc_expr *
 gfc_new_nml_name_expr (const char * name)
 {
    gfc_expr * nml_name;
+
    nml_name = gfc_get_expr();
    nml_name->ref = NULL;
    nml_name->expr_type = EXPR_CONSTANT;
@@ -832,114 +814,229 @@ gfc_new_nml_name_expr (const char * name)
    return nml_name;
 }
 
-static gfc_expr *
-get_new_var_expr(gfc_symbol * sym)
+/* nml_full_name builds up the fully qualified name of a
+   derived type component. */
+
+static char*
+nml_full_name (const char* var_name, const char* cmp_name)
 {
-  gfc_expr * nml_var;
-
-  nml_var = gfc_get_expr();
-  nml_var->expr_type = EXPR_VARIABLE;
-  nml_var->ts = sym->ts;
-  if (sym->as)
-    nml_var->rank = sym->as->rank;
-  nml_var->symtree = (gfc_symtree *)gfc_getmem (sizeof (gfc_symtree));
-  nml_var->symtree->n.sym = sym;
-  nml_var->where = sym->declared_at;
-  sym->attr.referenced = 1;
-
-  return nml_var;
+  int full_name_length;
+  char * full_name;
+
+  full_name_length = strlen (var_name) + strlen (cmp_name) + 1;
+  full_name = (char*)gfc_getmem (full_name_length + 1);
+  strcpy (full_name, var_name);
+  full_name = strcat (full_name, "%");
+  full_name = strcat (full_name, cmp_name);
+  return full_name;
 }
 
-/* For a scalar variable STRING whose address is ADDR_EXPR, generate a
-   call to iocall_set_nml_val.  For derived type variable, recursively
-   generate calls to iocall_set_nml_val for each leaf field. The leafs
-   have no names -- their STRING field is null, and are interpreted by
-   the run-time library as having only the value, as in the example:
+/* 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
+   derived types is returned. This is used in the runtime to
+   determine that span of the derived type. */
+
+static tree
+nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
+		   tree base_addr)
+{
+  tree decl = NULL_TREE;
+  tree tmp;
+  tree itmp;
+  int array_flagged;
+  int dummy_arg_flagged;
+
+  if (sym)
+    {
+      sym->attr.referenced = 1;
+      decl = gfc_get_symbol_decl (sym);
+    }
+  else
+    decl = c->backend_decl;
+
+  gcc_assert (decl && ((TREE_CODE (decl) == FIELD_DECL
+		     || TREE_CODE (decl) == VAR_DECL
+		     || TREE_CODE (decl) == PARM_DECL)
+		     || TREE_CODE (decl) == COMPONENT_REF));
+
+  tmp = decl;
+
+  /* Build indirect reference, if dummy argument.  */
+
+  dummy_arg_flagged = POINTER_TYPE_P (TREE_TYPE(tmp));
 
-   &foo bzz=1,2,3,4,5/
+  itmp = (dummy_arg_flagged) ? gfc_build_indirect_ref (tmp) : tmp;
 
-   Note that the first output field appears after the name of the
-   variable, not of the field name.  This causes a little complication
-   documented below.  */
+  /* 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;
+
+  /* Treat the component of a derived type, using base_addr for
+     the derived type.  */
+
+  if (TREE_CODE (decl) == FIELD_DECL)
+    tmp = build3 (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);
+
+  /* Now build the address expression.  */
+
+  tmp = gfc_build_addr_expr (NULL, tmp);
+
+  /* If scalar dummy, resolve indirect reference now.  */
+
+  if (dummy_arg_flagged && !array_flagged)
+    tmp = gfc_build_indirect_ref (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_set_nml_val.  For derived type variable, recursively
+   generate calls to iocall_set_nml_val for each component.  */
+
+#define NML_FIRST_ARG(a) args = gfc_chainon_list (NULL_TREE, a)
+#define NML_ADD_ARG(a) args = gfc_chainon_list (args, a)
+#define IARG(i) build_int_cst (gfc_array_index_type, i)
 
 static void
-transfer_namelist_element (stmtblock_t * block, gfc_typespec * ts, tree addr_expr, 
-                           tree string, tree string_length)
+transfer_namelist_element (stmtblock_t * block, const char * var_name,
+			   gfc_symbol * sym, gfc_component * c,
+			   tree base_addr)
 {
-  tree tmp, args, arg2;
-  tree expr;
+  gfc_typespec * ts = NULL;
+  gfc_array_spec * as = NULL;
+  tree addr_expr = NULL;
+  tree dt = NULL;
+  tree string;
+  tree tmp;
+  tree args;
+  tree dtype;
+  int n_dim; 
+  int itype;
+  int rank = 0;
 
-  gcc_assert (POINTER_TYPE_P (TREE_TYPE (addr_expr)));
+  gcc_assert (sym || c);
 
-  if (ts->type == BT_DERIVED)
-    {
-      gfc_component *c;
-      expr = gfc_build_indirect_ref (addr_expr);
+  /* Build the namelist object name.  */
 
-      for (c = ts->derived->components; c; c = c->next)
-        {
-          tree field = c->backend_decl;
-          gcc_assert (field && TREE_CODE (field) == FIELD_DECL);
-          tmp = build3 (COMPONENT_REF, TREE_TYPE (field), 
-			expr, field, NULL_TREE);
+  string = gfc_build_cstring_const (var_name);
+  string = gfc_build_addr_expr (pchar_type_node, string);
 
-          if (c->dimension)
-            gfc_todo_error ("NAMELIST IO of array in derived type");
-          if (!c->pointer)
-            tmp = gfc_build_addr_expr (NULL, tmp);
-          transfer_namelist_element (block, &c->ts, tmp, string, string_length);
-
-          /* The first output field bears the name of the topmost
-             derived type variable.  All other fields are anonymous
-             and appear with nulls in their string and string_length
-             fields.  After the first use, we set string and
-             string_length to null.  */
-          string = null_pointer_node;
-          string_length = integer_zero_node;
-        }
+  /* Build ts, as and data address using symbol or component.  */
 
-      return;
-    }
+  ts = (sym) ? &sym->ts : &c->ts;
+  as = (sym) ? sym->as : c->as;
 
-  args = gfc_chainon_list (NULL_TREE, addr_expr);
-  args = gfc_chainon_list (args, string);
-  args = gfc_chainon_list (args, string_length);
-  arg2 = build_int_cst (gfc_array_index_type, ts->kind);
-  args = gfc_chainon_list (args,arg2);
+  addr_expr = nml_get_addr_expr (sym, c, base_addr);
 
-  switch (ts->type)
+  if (as)
+    rank = as->rank;
+
+  if (rank)
     {
-    case BT_INTEGER:
-      tmp = gfc_build_function_call (iocall_set_nml_val_int, args);
-      break;
+      dt =  TREE_TYPE ((sym) ? sym->backend_decl : c->backend_decl);
+      dtype = gfc_get_dtype (dt);
+    }
+  else
+    {
+      itype = GFC_DTYPE_UNKNOWN;
 
-    case BT_CHARACTER:
-      expr = gfc_build_indirect_ref (addr_expr);
-      gcc_assert (TREE_CODE (TREE_TYPE (expr)) == ARRAY_TYPE);
-      args = gfc_chainon_list (args,
-                               TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (expr))));
-      tmp = gfc_build_function_call (iocall_set_nml_val_char, args);
-      break;
+      switch (ts->type)
 
-    case BT_REAL:
-      tmp = gfc_build_function_call (iocall_set_nml_val_float, args);
-      break;
+	{
+	case BT_INTEGER:
+	  itype = GFC_DTYPE_INTEGER;
+	  break;
+	case BT_LOGICAL:
+	  itype = GFC_DTYPE_LOGICAL;
+	  break;
+	case BT_REAL:
+	  itype = GFC_DTYPE_REAL;
+	  break;
+	case BT_COMPLEX:
+	  itype = GFC_DTYPE_COMPLEX;
+	break;
+	case BT_DERIVED:
+	  itype = GFC_DTYPE_DERIVED;
+	  break;
+	case BT_CHARACTER:
+	  itype = GFC_DTYPE_CHARACTER;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
 
-    case BT_LOGICAL:
-      tmp = gfc_build_function_call (iocall_set_nml_val_log, args);
-      break;
+      dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
+    }
 
-    case BT_COMPLEX:
-      tmp = gfc_build_function_call (iocall_set_nml_val_complex, args);
-      break;
+  /* Build up the arguments for the transfer call.
+     The call for the scalar part transfers:
+     (address, name, type, kind or string_length, dtype)  */
 
-    default :
-      internal_error ("Bad namelist IO basetype (%d)", ts->type);
-    }
+  NML_FIRST_ARG (addr_expr);
+  NML_ADD_ARG (string);
+  NML_ADD_ARG (IARG (ts->kind));
+
+  if (ts->type == BT_CHARACTER)
+    NML_ADD_ARG (ts->cl->backend_decl);
+  else
+    NML_ADD_ARG (convert (gfc_charlen_type_node, integer_zero_node));
 
+  NML_ADD_ARG (dtype);
+  tmp = gfc_build_function_call (iocall_set_nml_val, args);
   gfc_add_expr_to_block (block, tmp);
+
+  /* If the object is an array, transfer rank times:
+     (null pointer, name, stride, lbound, ubound)  */
+
+  for ( n_dim = 0 ; n_dim < rank ; n_dim++ )
+    {
+      NML_FIRST_ARG (IARG (n_dim));
+      NML_ADD_ARG (GFC_TYPE_ARRAY_STRIDE (dt, n_dim));
+      NML_ADD_ARG (GFC_TYPE_ARRAY_LBOUND (dt, n_dim));
+      NML_ADD_ARG (GFC_TYPE_ARRAY_UBOUND (dt, n_dim));
+      tmp = gfc_build_function_call (iocall_set_nml_val_dim, args);
+      gfc_add_expr_to_block (block, tmp);
+    }
+
+  if (ts->type == BT_DERIVED)
+    {
+      gfc_component *cmp;
+
+      /* Provide the RECORD_TYPE to build component references.  */
+
+      tree expr = gfc_build_indirect_ref (addr_expr);
+
+      for (cmp = ts->derived->components; cmp; cmp = cmp->next)
+	{
+	  char *full_name = nml_full_name (var_name, cmp->name);
+	  transfer_namelist_element (block,
+				     full_name,
+				     NULL, cmp, expr);
+	  gfc_free (full_name);
+	}
+    }
 }
 
+#undef IARG
+#undef NML_ADD_ARG
+#undef NML_FIRST_ARG
+
 /* Create a data transfer statement.  Not all of the fields are valid
    for both reading and writing, but improper use has been filtered
    out by now.  */
@@ -950,9 +1047,8 @@ build_dt (tree * function, gfc_code * code)
   stmtblock_t block, post_block;
   gfc_dt *dt;
   tree tmp;
-  gfc_expr *nmlname, *nmlvar;
+  gfc_expr *nmlname;
   gfc_namelist *nml;
-  gfc_se se,se2;
 
   gfc_init_block (&block);
   gfc_init_block (&post_block);
@@ -1010,30 +1106,20 @@ build_dt (tree * function, gfc_code * code)
 
   if (dt->namelist)
     {
-       if (dt->format_expr || dt->format_label)
-          fatal_error("A format cannot be specified with a namelist");
-
-       nmlname = gfc_new_nml_name_expr(dt->namelist->name);
-
-       set_string (&block, &post_block, ioparm_namelist_name,
-                ioparm_namelist_name_len, nmlname);
-
-       if (last_dt == READ)
-          set_flag (&block, ioparm_namelist_read_mode);
-
-	for (nml = dt->namelist->namelist; nml; nml = nml->next)
-	  {
-	    gfc_init_se (&se, NULL);
-	    gfc_init_se (&se2, NULL);
-	    nmlvar = get_new_var_expr (nml->sym);
-	    nmlname = gfc_new_nml_name_expr (nml->sym->name);
-	    gfc_conv_expr_reference (&se2, nmlname);
-	    gfc_conv_expr_reference (&se, nmlvar);
-	    gfc_evaluate_now (se.expr, &se.pre); 
-
-	    transfer_namelist_element (&block, &nml->sym->ts, se.expr,
-				       se2.expr, se2.string_length);
-	  }
+      if (dt->format_expr || dt->format_label)
+        gfc_internal_error ("build_dt: format with namelist");
+
+      nmlname = gfc_new_nml_name_expr(dt->namelist->name);
+
+      set_string (&block, &post_block, ioparm_namelist_name,
+		  ioparm_namelist_name_len, nmlname);
+
+      if (last_dt == READ)
+	set_flag (&block, ioparm_namelist_read_mode);
+
+      for (nml = dt->namelist->namelist; nml; nml = nml->next)
+	transfer_namelist_element (&block, nml->sym->name, nml->sym,
+				   NULL, NULL);
     }
 
   tmp = gfc_build_function_call (*function, NULL_TREE);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 023ccdd..73501f2 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,27 @@
+2005-04-17 Paul Thomas <pault@gcc.gnu.org>
+
+	PR libfortran/12884 gfortran.dg/pr12884.f: New test
+	PR libfortran/17285 gfortran.dg/pr17285.f90: New test
+	PR libfortran/17472, 18396, 18209 gfortran.dg/pr17472.f: New test
+	PR libfortran/18122, 18591 gfortran.dg/pr18122.f90: New test
+	PR libfortran/18210 gfortran.dg/pr18210.f90: New test
+	PR libfortran/18392 gfortran.dg/pr18392.f90: New test
+	PR libfortran/19467 gfortran.dg/pr19467.f90: New test
+	PR libfortran/19657 gfortran.dg/pr19657.f90: New test
+	* gfortran.dg/namelist_1.f90: Correct comment (PUBLIC and PRIVATE wrong way round).
+	* gfortran.dg/namelist_2.f90: Variables with INTENT(IN) cannot be in namelists. New test
+	* gfortran.dg/namelist_3.f90: Pointers cannot be in namelists. New test
+	* gfortran.dg/namelist_11.f: Tests reals and qualifiers in namelist. New test
+	* gfortran.dg/namelist_12.f: Tests integers and qualifiers in namelist. New test
+	* gfortran.dg/namelist_13.f90: Tests derived types in namelist. New test
+	* gfortran.dg/namelist_14.f90: Tests trans-io.c namelist support. New test
+	* gfortran.dg/namelist_15.f90: Tests arrays of derived types in namelist. New test
+	* gfortran.dg/namelist_16.f90: Tests complex in namelist. New test
+	* gfortran.dg/namelist_17.f90: Tests logical in namelist. New test
+	* gfortran.dg/namelist_18.f90: Tests charcter delimiters in namelist. New test
+	* gfortran.dg/namelist_19.f90: Tests namelist errors. New test
+	* gfortran.dg/namelist_20.f90: Tests negative bounds for explicit arrays. New test
+
 2005-04-17  Richard Guenther  <rguenth@gcc.gnu.org>
 
 	* gfortran.dg/wtruncate.f: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/namelist_1.f90 b/gcc/testsuite/gfortran.dg/namelist_1.f90
index 9bebe77..ee028dd 100644
--- a/gcc/testsuite/gfortran.dg/namelist_1.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_1.f90
@@ -1,8 +1,7 @@
 ! { dg-do compile }
-! Check that public entities in private namelists are rejected
+! Check that private entities in public namelists are rejected
 module namelist_1
   public
   integer,private :: x
   namelist /n/ x ! { dg-error "cannot be member of PUBLIC namelist" "" }
 end module
-
diff --git a/gcc/testsuite/gfortran.dg/namelist_11.f b/gcc/testsuite/gfortran.dg/namelist_11.f
new file mode 100644
index 0000000..4145a90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_11.f
@@ -0,0 +1,55 @@
+c { dg-do run }
+c This program tests: namelist comment, a blank line before the nameilist name, the namelist name,
+c a scalar qualifier, various combinations of space, comma and lf delimiters, f-formats, e-formats
+c a blank line within the data read, nulls, a range qualifier, a new object name before end of data
+c and an integer read.  It also tests that namelist output can be re-read by namelist input.
+c provided by Paul Thomas - pault@gcc.gnu.org
+
+      program namelist_1
+
+      REAL*4 x(10)
+      REAL*8 xx
+      integer ier
+      namelist /mynml/ x, xx
+
+      do i = 1 , 10
+        x(i) = -1
+      end do
+      x(6) = 6.0
+      x(10) = 10.0
+      xx = 0d0
+
+      open (10,status="scratch")
+      write (10, *) "!mynml"
+      write (10, *) ""
+      write (10, *) "&gf /"
+      write (10, *) "&mynml  x(7) =+99.0e0 x=1.0, 2.0 ,"
+      write (10, *) " 2*3.0, ,, 7.0e0,+0.08e+02 !comment"
+      write (10, *) ""
+      write (10, *) " 9000e-3 x(4:5)=4 ,5 "
+      write (10, *) " x=,,3.0, xx=10d0 /"
+      rewind (10)
+
+      read (10, nml=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      do i = 1 , 10
+        if ( abs( x(i) - real(i) ) .gt. 1e-8 ) call abort
+      end do
+      if ( abs( xx - 10d0 ) .gt. 1e-8 ) call abort
+
+      write (10, nml=mynml, iostat=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      read (10, NML=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      close (10)
+
+      do i = 1 , 10
+        if ( abs( x(i) - real(i) ) .gt. 1e-8 ) call abort
+      end do
+      if ( abs( xx - 10d0 ) .gt. 1e-8 ) call abort
+
+      end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_12.f b/gcc/testsuite/gfortran.dg/namelist_12.f
new file mode 100644
index 0000000..e6d1224
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_12.f
@@ -0,0 +1,56 @@
+c{ dg-do run }
+c This program repeats many of the same tests as test_nml_1 but for integer instead of real.
+c  It also tests repeat nulls, comma delimited character read, a triplet qualifier, a range with
+c and assumed start, a quote delimited string, a qualifier with an assumed end and a fully
+c explicit range.  It also tests that integers and characters are successfully read back by
+c namelist.
+c Provided by Paul Thomas - pault@gcc.gnu.org
+
+      program namelist_12
+
+      integer*4 x(10)
+      integer*8 xx
+      integer ier
+      character*10 ch , check
+      namelist /mynml/ x, xx, ch
+ 
+c set debug = 0 or 1 in the namelist! (line 33)
+
+      do i = 1 , 10
+        x(i) = -1
+      end do
+      x(6) = 6
+      x(10) = 10
+      xx = 0
+      ch ="zzzzzzzzzz"
+      check="abcdefghij"
+
+      open (10,status="scratch")
+      write (10, *) "!mynml"
+      write (10, *) " "
+      write (10, *) "&mynml  x(7) =+99 x=1, 2 ,"
+      write (10, *) " 2*3, ,, 2* !comment"
+      write (10, *) " 9 ch=qqqdefghqq , x(8:7:-1) = 8 , 7"
+      write (10, *) " ch(:3) =""abc"","
+      write (10, *) " ch(9:)='ij' x(4:5)=4 ,5 xx = 42/"
+      rewind (10)
+
+      read (10, nml=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      write (10, nml=mynml, iostat=ier)
+      if (ier.ne.0) call abort
+      rewind (10)
+
+      read (10, NML=mynml, IOSTAT=ier)
+      if (ier.ne.0) call abort
+      close (10)
+
+      do i = 1 , 10
+        if ( abs( x(i) - i ) .ne. 0 ) call abort ()
+        if ( ch(i:i).ne.check(I:I) ) call abort
+      end do
+      if (xx.ne.42) call abort ()
+
+      end program
diff --git a/gcc/testsuite/gfortran.dg/namelist_13.f90 b/gcc/testsuite/gfortran.dg/namelist_13.f90
new file mode 100644
index 0000000..5b7122c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_13.f90
@@ -0,0 +1,38 @@
+!{ dg-do run }
+! Tests simple derived types.
+! Provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_13
+
+  type                        ::      yourtype
+    integer, dimension(2)     ::      yi = (/8,9/)
+    real, dimension(2)        ::      yx = (/80.,90./)
+    character(len=2)          ::      ych = "xx"
+  end type yourtype
+
+  type                        ::      mytype
+    integer, dimension(2)     ::      myi = (/800,900/)
+    real, dimension(2)        ::      myx = (/8000.,9000./)
+    character(len=2)          ::      mych = "zz"
+    type(yourtype)            ::      my_yourtype
+  end type mytype
+
+  type(mytype)                ::      z
+  integer                     ::      ier
+  integer                     ::      zeros(10)
+  namelist /mynml/ zeros, z
+
+  zeros = 0
+  zeros(5) = 1
+
+  open(10,status="scratch")
+  write (10, nml=mynml, iostat=ier)
+  if (ier.ne.0) call abort
+
+  rewind (10)
+  read (10, NML=mynml, IOSTAT=ier)
+  if (ier.ne.0) call abort
+  close (10)
+
+end program namelist_13
+
diff --git a/gcc/testsuite/gfortran.dg/namelist_14.f90 b/gcc/testsuite/gfortran.dg/namelist_14.f90
new file mode 100644
index 0000000..d22040f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_14.f90
@@ -0,0 +1,94 @@
+!{ dg-do run }
+! Tests various combinations of intrinsic types, derived types, arrays,
+! dummy arguments and common to check nml_get_addr_expr in trans-io.c.
+! See comments below for selection.
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+module global
+  type             ::  mt
+    integer        ::  ii(4)
+  end type mt
+end module global
+
+program namelist_14
+  use global
+  common /myc/ cdt
+  integer          ::  i(2) = (/101,201/)
+  type(mt)         ::  dt(2)
+  type(mt)         ::  cdt
+  real*8           ::  pi = 3.14159_8
+  character*10     ::  chs="singleton"
+  character*10     ::  cha(2)=(/"first     ","second    "/)
+
+  dt = mt ((/99,999,9999,99999/))
+  cdt = mt ((/-99,-999,-9999,-99999/))
+  call foo (i,dt,pi,chs,cha)
+
+contains
+
+  logical function dttest (dt1, dt2)
+    use global
+    type(mt)       :: dt1
+    type(mt)       :: dt2
+    dttest = any(dt1%ii == dt2%ii)
+  end function dttest
+
+
+  subroutine foo (i, dt, pi, chs, cha)
+    use global
+    common /myc/ cdt
+    real *8        :: pi                   !local real scalar
+    integer        :: i(2)                 !dummy arg. array
+    integer        :: j(2) = (/21, 21/)    !equivalenced array
+    integer        :: jj                   !    -||-     scalar
+    integer        :: ier
+    type(mt)       :: dt(2)                !dummy arg., derived array
+    type(mt)       :: dtl(2)               !in-scope derived type array
+    type(mt)       :: dts                  !in-scope derived type
+    type(mt)       :: cdt                  !derived type in common block
+    character*10   :: chs                  !dummy arg. character var.
+    character*10   :: cha(:)               !dummy arg. character array
+    character*10   :: chl="abcdefg"        !in-scope character var.
+    equivalence (j,jj)
+    namelist /z/     dt, dtl, dts, cdt, j, jj, i, pi, chs, chl, cha
+
+    dts = mt ((/1, 2, 3, 4/))
+    dtl = mt ((/41, 42, 43, 44/))
+
+    open (10, status = "scratch")
+    write (10, nml = z, iostat = ier)
+    if (ier /= 0 ) call abort()
+    rewind (10)
+
+    i = 0
+    j = 0
+    jj = 0
+    pi = 0
+    dt  = mt ((/0, 0, 0, 0/))
+    dtl = mt ((/0, 0, 0, 0/))
+    dts = mt ((/0, 0, 0, 0/))
+    cdt = mt ((/0, 0, 0, 0/))
+    chs = ""
+    cha = ""
+    chl = ""
+
+    read (10, nml = z, iostat = ier)
+    if (ier /= 0 ) call abort()
+    close (10)
+
+    if (.not.(dttest (dt(1),  mt ((/99,999,9999,99999/))) .and.  &
+	      dttest (dt(2),  mt ((/99,999,9999,99999/))) .and.  &
+	      dttest (dtl(1), mt ((/41, 42, 43, 44/))) .and.     &
+	      dttest (dtl(2), mt ((/41, 42, 43, 44/))) .and.     &
+	      dttest (dts, mt ((/1, 2, 3, 4/))) .and.            &
+	      dttest (cdt, mt ((/-99,-999,-9999,-99999/))) .and. &
+	      all (j ==(/21, 21/)) .and.                         &
+	      all (i ==(/101, 201/)) .and.                       &
+	      (pi == 3.14159_8) .and.                            &
+	      (chs == "singleton") .and.                         &
+	      (chl == "abcdefg") .and.                           &
+	      (cha(1)(1:10) == "first    ") .and.                &
+	      (cha(2)(1:10) == "second    "))) call abort ()
+
+    end subroutine foo
+end program namelist_14 
diff --git a/gcc/testsuite/gfortran.dg/namelist_15.f90 b/gcc/testsuite/gfortran.dg/namelist_15.f90
new file mode 100644
index 0000000..8c64ab0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_15.f90
@@ -0,0 +1,58 @@
+!{ dg-do run }
+! Tests arrays of derived types containing derived type arrays whose
+! components are character arrays - exercises object name parser in
+! list_read.c. Checks that namelist output can be reread. 
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+module global
+  type             ::  mt
+    character(len=2) ::  ch(2) = (/"aa","bb"/)
+  end type mt
+  type             ::  bt
+    integer        ::  i(2) = (/1,2/)
+    type(mt)       ::  m(2)
+  end type bt
+end module global
+
+program namelist_15
+  use global
+  type(bt)         ::  x(2)
+
+  namelist /mynml/ x
+
+  open (10, status = "scratch")
+  write (10, '(A)') "&MYNML"
+  write (10, '(A)') " x = 3, 4, 'dd', 'ee', 'ff', 'gg',"
+  write (10, '(A)') "     4, 5, 'hh', 'ii', 'jj', 'kk',"
+  write (10, '(A)') " x%i = , ,-3, -4"
+  write (10, '(A)') " x(2)%m(1)%ch(2) =q,"
+  write (10, '(A)') " x(2)%m(2)%ch(1)(1) =w,"
+  write (10, '(A)') " x%m%ch(:)(2) =z z z z z z z z,"
+  write (10, '(A)') "&end"
+   
+  rewind (10)
+  read (10, nml = mynml, iostat = ier)
+  if (ier .ne. 0) call abort () 
+  close (10)
+
+  open (10, status = "scratch")
+  write (10, nml = mynml)
+  rewind (10)
+  read (10, nml = mynml, iostat = ier)
+  if (ier .ne. 0) call abort () 
+  close(10)
+
+  if (.not. ((x(1)%i(1) == 3)          .and. &
+             (x(1)%i(2) == 4)          .and. &
+             (x(1)%m(1)%ch(1) == "dz") .and. &
+	     (x(1)%m(1)%ch(2) == "ez") .and. &
+             (x(1)%m(2)%ch(1) == "fz") .and. &
+	     (x(1)%m(2)%ch(2) == "gz") .and. &
+             (x(2)%i(1) == -3)         .and. &
+             (x(2)%i(2) == -4)         .and. &
+             (x(2)%m(1)%ch(1) == "hz") .and. &
+	     (x(2)%m(1)%ch(2) == "qz") .and. &
+             (x(2)%m(2)%ch(1) == "wz") .and. &
+	     (x(2)%m(2)%ch(2) == "kz"))) call abort ()
+
+end program namelist_15 
diff --git a/gcc/testsuite/gfortran.dg/namelist_16.f90 b/gcc/testsuite/gfortran.dg/namelist_16.f90
new file mode 100644
index 0000000..c6eb8f7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_16.f90
@@ -0,0 +1,29 @@
+!{ dg-do run }
+! Tests namelist on complex variables
+! provided by Paul Thomas - pault@gcc.gnu.org
+program namelist_16
+  complex(kind=8), dimension(2)  ::   z
+  namelist /mynml/ z
+  z = (/(1.0,2.0), (3.0,4.0)/)
+
+  open (10, status = "scratch")
+  write (10, '(A)') "&mynml z(1)=(5.,6.) z(2)=(7.,8.) /"
+  rewind (10)
+
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  open (10, status = "scratch")
+  write (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  rewind (10)
+
+  z = (/(1.0,2.0), (3.0,4.0)/)
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  if ((z(1) .ne. (5.0,6.0)) .or. (z(2) .ne. (7.0,8.0))) call abort ()
+
+end program namelist_16 
diff --git a/gcc/testsuite/gfortran.dg/namelist_17.f90 b/gcc/testsuite/gfortran.dg/namelist_17.f90
new file mode 100644
index 0000000..e3eac52
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_17.f90
@@ -0,0 +1,30 @@
+!{ dg-do run }
+! Tests namelist on logical variables
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_17
+  logical, dimension(2)        ::   l
+  namelist /mynml/ l
+  l = (/.true., .false./)
+
+  open (10, status = "scratch")
+  write (10, '(A)') "&mynml l = F T /"
+  rewind (10)
+  
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  open (10, status = "scratch")
+  write (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  rewind (10)
+
+  l = (/.true., .false./)
+  read (10, mynml, iostat = ier)
+  if (ier .ne. 0) call abort ()
+  close (10)
+
+  if (l(1) .or. (.not.l(2))) call abort ()
+
+end program namelist_17 
diff --git a/gcc/testsuite/gfortran.dg/namelist_18.f90 b/gcc/testsuite/gfortran.dg/namelist_18.f90
new file mode 100644
index 0000000..eba8b6b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_18.f90
@@ -0,0 +1,37 @@
+!{ dg-do run }
+! Tests character delimiters for namelist write 
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_18
+  character*3        ::   ch = "foo"
+  character*80       ::   buffer
+  namelist /mynml/ ch
+
+  open (10, status = "scratch")
+  write (10, mynml)
+  rewind (10)
+  read (10, '(a)', iostat = ier) buffer
+  read (10, '(a)', iostat = ier) buffer
+  if (ier .ne. 0) call abort ()
+  close (10)
+  If ((buffer(5:5) /= "f") .or. (buffer(9:9) /= " ")) call abort () 
+
+  open (10, status = "scratch", delim ="quote")
+  write (10, mynml)
+  rewind (10)
+  read (10, '(a)', iostat = ier) buffer
+  read (10, '(a)', iostat = ier) buffer
+  if (ier .ne. 0) call abort ()
+  close (10)
+  If ((buffer(5:5) /= """") .or. (buffer(9:9) /= """")) call abort ()
+
+  open (10, status = "scratch", delim ="apostrophe")
+  write (10, mynml)
+  rewind (10)
+  read (10, '(a)', iostat = ier) buffer
+  read (10, '(a)', iostat = ier) buffer
+  if (ier .ne. 0) call abort ()
+  close (10)
+  If ((buffer(5:5) /= "'") .or. (buffer(9:9) /= "'")) call abort ()
+
+end program namelist_18
diff --git a/gcc/testsuite/gfortran.dg/namelist_19.f90 b/gcc/testsuite/gfortran.dg/namelist_19.f90
new file mode 100644
index 0000000..c06abf5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_19.f90
@@ -0,0 +1,135 @@
+!{ dg-do run }
+! Test namelist error trapping.
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_19
+  character*80 wrong, right
+  
+! "=" before any object name
+  wrong = "&z = i = 1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+  
+! &* instead of &end for termination 
+  wrong = "&z i = 1,2 &xxx"
+  right = "&z i = 1,2 &end"
+  call test_err(wrong, right)
+  
+! bad data 
+  wrong = "&z i = 1,q /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+  
+! object name not matched 
+  wrong = "&z j = 1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! derived type component for intrinsic type
+  wrong = "&z i%j = 1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! step other than 1 for substring qualifier
+  wrong = "&z ch(1:2:2) = 'a'/"
+  right = "&z ch(1:2) = 'ab' /"
+  call test_err(wrong, right)
+
+! qualifier for scalar 
+  wrong = "&z k(2) = 1 /"
+  right = "&z k    = 1 /"
+  call test_err(wrong, right)
+
+! no '=' after object name 
+  wrong = "&z i   1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! repeat count too large 
+  wrong = "&z i = 3*2 /"
+  right = "&z i = 2*2 /"
+  call test_err(wrong, right)
+
+! too much data 
+  wrong = "&z i = 1 2 3 /"
+  right = "&z i = 1 2 /"
+  call test_err(wrong, right)
+
+! no '=' after object name 
+  wrong = "&z i   1,2 /"
+  right = "&z i = 1,2 /"
+  call test_err(wrong, right)
+
+! bad number of index fields
+  wrong = "&z i(1,2) = 1 /"
+  right = "&z i(1)   = 1 /"
+  call test_err(wrong, right)
+
+! bad character in index field 
+  wrong = "&z i(x) = 1 /"
+  right = "&z i(1) = 1 /"
+  call test_err(wrong, right)
+
+! null index field 
+  wrong = "&z i( ) = 1 /"
+  right = "&z i(1) = 1 /"
+  call test_err(wrong, right)
+
+! null index field 
+  wrong = "&z i(1::)   = 1 2/"
+  right = "&z i(1:2:1) = 1 2 /"
+  call test_err(wrong, right)
+
+! null index field 
+  wrong = "&z i(1:2:)  = 1 2/"
+  right = "&z i(1:2:1) = 1 2 /"
+  call test_err(wrong, right)
+
+! index out of range 
+  wrong = "&z i(10) = 1 /"
+  right = "&z i(1)  = 1 /"
+  call test_err(wrong, right)
+
+! index out of range 
+  wrong = "&z i(0:1) = 1 /"
+  right = "&z i(1:1) = 1 /"
+  call test_err(wrong, right)
+
+! bad range
+  wrong = "&z i(1:2:-1) = 1 2 /"
+  right = "&z i(1:2: 1) = 1 2 /"
+  call test_err(wrong, right)
+
+! bad range
+  wrong = "&z i(2:1: 1) = 1 2 /"
+  right = "&z i(2:1:-1) = 1 2 /"
+  call test_err(wrong, right)
+
+contains
+  subroutine test_err(wrong, right)
+    character*80 wrong, right
+    integer            :: i(2) = (/0, 0/)
+    integer            :: k =0
+    character*2        :: ch = "  "
+    namelist /z/ i, k, ch
+
+! Check that wrong namelist input gives an error
+
+    open (10, status = "scratch")
+    write (10, '(A)') wrong
+    rewind (10)
+    read (10, z, iostat = ier)
+    close(10)
+    if (ier == 0) call abort ()
+
+! Check that right namelist input gives no error
+
+    open (10, status = "scratch")
+    write (10, '(A)') right
+    rewind (10)
+    read (10, z, iostat = ier)
+    close(10)
+    if (ier /= 0) call abort ()
+  end subroutine test_err
+  
+end program namelist_19
diff --git a/gcc/testsuite/gfortran.dg/namelist_2.f90 b/gcc/testsuite/gfortran.dg/namelist_2.f90
new file mode 100644
index 0000000..b92e459
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_2.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! Check that variable with intent(in) cannot be a member of a namelist
+subroutine namelist_2(x)
+  integer,intent(in) :: x
+  namelist /n/ x
+  read(*,n) ! { dg-error "is INTENT" "" }
+end subroutine namelist_2
diff --git a/gcc/testsuite/gfortran.dg/namelist_20.f90 b/gcc/testsuite/gfortran.dg/namelist_20.f90
new file mode 100644
index 0000000..155cf6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_20.f90
@@ -0,0 +1,35 @@
+!{ dg-do run }
+! Tests namelist io for an explicit shape array with negative bounds
+! provided by Paul Thomas - pault@gcc.gnu.org
+
+program namelist_20
+  integer, dimension (-4:-2) :: x
+  integer                    :: i, ier
+  namelist /a/ x
+
+  open (10, status = "scratch")
+  write (10, '(A)') "&a x(-5)=0 /"            !-ve index below lbound
+  write (10, '(A)') "&a x(-1)=0 /"            !-ve index above ubound
+  write (10, '(A)') "&a x(1:2)=0 /"           !+ve indices
+  write (10, '(A)') "&a x(-4:-2)= -4,-3,-2 /" !correct
+  write (10, '(A)') " "
+  rewind (10)
+
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier == 0) call abort ()
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier == 0) call abort ()
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier == 0) call abort ()
+
+  ier=0
+  read(10, a, iostat=ier)
+  if (ier /= 0) call abort ()
+  do i = -4,-2
+    if (x(i) /= i) call abort ()
+  end do
+
+end program namelist_20 
diff --git a/gcc/testsuite/gfortran.dg/namelist_3.f90 b/gcc/testsuite/gfortran.dg/namelist_3.f90
new file mode 100644
index 0000000..68cc7d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_3.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! 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" "" }
+end program namelist_3
diff --git a/gcc/testsuite/gfortran.dg/pr12884.f b/gcc/testsuite/gfortran.dg/pr12884.f
new file mode 100644
index 0000000..425604c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr12884.f
@@ -0,0 +1,25 @@
+c { dg-do run }
+c pr 12884
+c test namelist with input file containg / before namelist. Also checks
+c non-standard use of $ instead of &
+c Based on example provided by jean-pierre.flament@univ-lille1.fr
+
+      program pr12884
+      integer ispher,nosym,runflg,noprop
+      namelist /cntrl/ ispher,nosym,runflg,noprop
+      ispher = 0
+      nosym = 0
+      runflg = 0
+      noprop = 0 
+      open (10, status = "scratch")
+      write (10, '(A)') " $FILE"
+      write (10, '(A)') "   pseu  dir/file"
+      write (10, '(A)') " $END"
+      write (10, '(A)') " $cntrl ispher=1,nosym=2,"
+      write (10, '(A)') " runflg=3,noprop=4,$END"
+      write (10, '(A)')"/"
+      rewind (10)
+      read (10, cntrl)
+      if ((ispher.ne.1).or.(nosym.ne.2).or.(runflg.ne.3).or.
+     &  (noprop.ne.4)) call abort ()
+      end
diff --git a/gcc/testsuite/gfortran.dg/pr17285.f90 b/gcc/testsuite/gfortran.dg/pr17285.f90
new file mode 100644
index 0000000..58aee32
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17285.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! pr 17285
+! Test that namelist can read its own output.
+! At the same time, check arrays and different terminations
+! Based on example provided by paulthomas2@wanadoo.fr
+
+program pr17285
+  implicit none
+  integer, dimension(10) :: number = 42
+  integer                :: ctr, ierr
+  namelist /mynml/ number
+  open (10, status = "scratch")
+  write (10,'(A)') &
+    "&mynml number(:)=42,42,42,42,42,42,42,42,42,42,/ "
+  write (10,mynml)
+  write (10,'(A)') "&mynml number(1:10)=10*42 &end"
+  rewind (10)
+  do ctr = 1,3
+    number = 0
+    read (10, nml = mynml, iostat = ierr)
+    if ((ierr /= 0) .or. (any (number /= 42))) &
+      call abort ()
+  end do
+  close(10)
+end program pr17285
diff --git a/gcc/testsuite/gfortran.dg/pr17472.f b/gcc/testsuite/gfortran.dg/pr17472.f
new file mode 100644
index 0000000..4a1ecd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr17472.f
@@ -0,0 +1,12 @@
+c { dg-do run }
+c pr 17472
+c test namelist handles arrays
+c Based on example provided by thomas.koenig@online.de
+
+       integer a(10), ctr
+       data a / 1,2,3,4,5,6,7,8,9,10 /
+       namelist /ints/ a
+       do ctr = 1,10
+         if (a(ctr).ne.ctr) call abort ()
+       end do
+       end
diff --git a/gcc/testsuite/gfortran.dg/pr18122.f90 b/gcc/testsuite/gfortran.dg/pr18122.f90
new file mode 100644
index 0000000..3907f0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr18122.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+! test namelist with scalars and arrays.
+! Based on example provided by thomas.koenig@online.de
+
+program sechs_w
+  implicit none
+
+  integer, parameter :: dr=selected_real_kind(15)
+
+  integer, parameter :: nkmax=6
+  real (kind=dr) :: rb(nkmax)
+  integer :: z
+
+  real (kind=dr) :: dg
+  real (kind=dr) :: a
+  real (kind=dr) :: da
+  real (kind=dr) :: delta
+  real (kind=dr) :: s,t
+  integer :: nk
+  real (kind=dr) alpha0
+
+  real (kind=dr) :: phi, phi0, rad, rex, zk, z0, drdphi, dzdphi
+
+  namelist /schnecke/ z, dg, a, t, delta, s, nk, rb, alpha0
+
+  open (10,status="scratch")
+  write (10, *)  "&SCHNECKE"
+  write (10, *)    " z=1,"
+  write (10, *)    " dg=58.4,"
+  write (10, *)    " a=48.,"
+  write (10, *)    " delta=0.4,"
+  write (10, *)    " s=0.4,"
+  write (10, *)    " nk=6,"
+  write (10, *)    " rb=60, 0, 40,"
+  write (10, *)    " alpha0=20.,"
+  write (10, *)    "/"
+
+  rewind (10)
+  read (10,schnecke)
+  close (10)
+  if ((z /= 1)       .or. (dg /= 58.4_dr)  .or. (a /= 48.0_dr)   .or. &
+    (delta /= 0.4_dr).or. (s /= 0.4_dr)    .or. (nk /= 6)        .or. &
+    (rb(1) /= 60._dr).or. (rb(2) /= 0.0_dr).or. (rb(3) /=40.0_dr).or. &
+    (alpha0 /= 20.0_dr)) call abort ()
+end program sechs_w
diff --git a/gcc/testsuite/gfortran.dg/pr18210.f90 b/gcc/testsuite/gfortran.dg/pr18210.f90
new file mode 100644
index 0000000..6095984
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr18210.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Names in upper case and object names starting column 2
+! Based on example provided by thomas.koenig@online.de
+
+program pr18210
+
+  real :: a
+  character*80 :: buffer
+  namelist /foo/ a
+
+  a = 1.4
+  open (10, status = "scratch")
+  write (10,foo)
+  rewind (10)
+  read (10, '(a)') buffer
+  if (buffer(2:4) /= "FOO") call abort ()
+  read (10, '(a)') buffer
+  if (buffer(1:2) /= " A") call abort ()
+  close (10)
+
+end program pr18210
diff --git a/gcc/testsuite/gfortran.dg/pr18392.f90 b/gcc/testsuite/gfortran.dg/pr18392.f90
new file mode 100644
index 0000000..de156f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr18392.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! pr 18392
+! test namelist with derived types
+! Based on example provided by thomas.koenig@online.de
+
+program pr18392
+  implicit none
+  type foo
+     integer a
+     real b
+  end type foo
+  type(foo) :: a
+  namelist /nl/ a
+  open (10, status="scratch")
+  write (10,*) " &NL"
+  write (10,*) " A%A = 10,"
+  write (10,*) "/"
+  rewind (10)
+  read (10,nl)
+  close (10)
+  IF (a%a /= 10.0) call abort ()
+end program pr18392
diff --git a/gcc/testsuite/gfortran.dg/pr19467.f90 b/gcc/testsuite/gfortran.dg/pr19467.f90
new file mode 100644
index 0000000..ab4fa99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19467.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! pr 19467
+! test namelist with character arrays
+! Based on example provided by paulthomas2@wanadoo.fr
+
+program pr19467
+  implicit none
+  integer             :: ier
+  character(len=2)    :: ch(2)
+  character(len=2)    :: dh(2)=(/"aa","bb"/)
+  namelist /a/ ch
+  open (10, status = "scratch")
+  write (10, *) "&A ch = 'aa' , 'bb' /"
+  rewind (10)
+  READ (10,nml=a, iostat = ier)
+  close (10)
+  if ((ier /= 0) .or. (any (ch /= dh))) call abort ()
+end program pr19467
diff --git a/gcc/testsuite/gfortran.dg/pr19657.f b/gcc/testsuite/gfortran.dg/pr19657.f
new file mode 100644
index 0000000..1fe32ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19657.f
@@ -0,0 +1,21 @@
+c { dg-do run }
+c pr 19657
+c test namelist not skipped if ending with logical.
+c Based on example provided by fuyuki@ccsr.u-tokyo.ac.jp
+
+      program pr19657
+      implicit none
+      logical   l
+      integer   i, ctr
+      namelist /nm/ i, l
+      open (10, status = "scratch")
+      write (10,*) "&nm i=1,l=t &end"
+      write (10,*) "&nm i=2 &end"
+      write (10,*) "&nm i=3 &end"
+      rewind (10)
+      do ctr = 1,3
+        read (10,nm,end=190)
+        if (i.ne.ctr) call abort ()
+      enddo
+ 190  continue 
+      end