From 628c06d6bc47c3a1487ecd41eb12d13a968d4480 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Thu, 11 May 2017 20:40:49 +0000
Subject: re PR fortran/78659 ([F03] Spurious "requires DTIO" reported against
 namelist statement)

2017-05-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/78659
	* io.c (dtio_procs_present): Add new function to check for DTIO
	procedures relative to I/O statement READ or WRITE.
	(gfc_resolve_dt): Add namelist checks using the new function.
	* resolve.c (dtio_procs_present): Remove function and related
	namelist checks. (resolve_fl_namelist): Add check specific to
	Fortran 95 restriction on namelist objects.

	* gfortran.dg/namelist_91.f90: New test.
	* gfortran.dg/namelist_92.f90: New test.
	* gfortran.dg/namelist_93.f90: New test.
	* gfortran.dg/namelist_94.f90: New test.

From-SVN: r247930
---
 gcc/fortran/resolve.c | 56 ++++++++++-----------------------------------------
 1 file changed, 11 insertions(+), 45 deletions(-)

(limited to 'gcc/fortran/resolve.c')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index df32a8a..d50ffdb 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -13846,31 +13846,11 @@ resolve_fl_derived (gfc_symbol *sym)
 }
 
 
-/* Check for formatted read and write DTIO procedures.  */
-
-static bool
-dtio_procs_present (gfc_symbol *sym)
-{
-  gfc_symbol *derived;
-
-  if (sym->ts.type == BT_CLASS)
-    derived = CLASS_DATA (sym)->ts.u.derived;
-  else if (sym->ts.type == BT_DERIVED)
-    derived = sym->ts.u.derived;
-  else
-    return false;
-
-  return gfc_find_specific_dtio_proc (derived, true, true) != NULL
-	 && gfc_find_specific_dtio_proc (derived, false, true) != NULL;
-}
-
-
 static bool
 resolve_fl_namelist (gfc_symbol *sym)
 {
   gfc_namelist *nl;
   gfc_symbol *nlsym;
-  bool dtio;
 
   for (nl = sym->namelist; nl; nl = nl->next)
     {
@@ -13904,27 +13884,6 @@ resolve_fl_namelist (gfc_symbol *sym)
 			      sym->name, &sym->declared_at))
 	return false;
 
-      dtio = dtio_procs_present (nl->sym);
-
-      if (nl->sym->ts.type == BT_CLASS && !dtio)
-	{
-	  gfc_error ("NAMELIST object %qs in namelist %qs at %L is "
-		     "polymorphic and requires a defined input/output "
-		     "procedure", nl->sym->name, sym->name, &sym->declared_at);
-	  return false;
-	}
-
-      if (nl->sym->ts.type == BT_DERIVED
-	  && (nl->sym->ts.u.derived->attr.alloc_comp
-	      || nl->sym->ts.u.derived->attr.pointer_comp))
-	{
-	  if (!gfc_notify_std (GFC_STD_F2003, "NAMELIST object %qs in "
-			       "namelist %qs at %L with ALLOCATABLE "
-			       "or POINTER components", nl->sym->name,
-			       sym->name, &sym->declared_at))
-	    return false;
-	  return true;
-	}
     }
 
   /* Reject PRIVATE objects in a PUBLIC namelist.  */
@@ -13942,10 +13901,17 @@ resolve_fl_namelist (gfc_symbol *sym)
 	      return false;
 	    }
 
-	  /* If the derived type has specific DTIO procedures for both read and
-	     write then namelist objects with private components are OK.  */
-	  if (dtio_procs_present (nl->sym))
-	    continue;
+	  if (nl->sym->ts.type == BT_DERIVED
+	     && (nl->sym->ts.u.derived->attr.alloc_comp
+		 || nl->sym->ts.u.derived->attr.pointer_comp))
+	   {
+	     if (!gfc_notify_std (GFC_STD_F2003, "NAMELIST object %qs in "
+				  "namelist %qs at %L with ALLOCATABLE "
+				  "or POINTER components", nl->sym->name,
+				  sym->name, &sym->declared_at))
+	       return false;
+	     return true;
+	   }
 
 	  /* Types with private components that came here by USE-association.  */
 	  if (nl->sym->ts.type == BT_DERIVED
-- 
cgit v1.1