[PATCH, Fortran] PR78659 Spurious "requires DTIO" reported against namelist statement

[PATCH, Fortran] PR78659 Spurious "requires DTIO" reported against namelist statement

[Jerry DeLisle]

[-- Attachment #1: Type: text/plain, Size: 1193 bytes --]

Hi all,

The attached patch fixes this issue by moving the DTIO namelist checks from 
namelist resolution to READ/WRITE statement resolution.  This allows the checks 
to be specific to the io_kind. The dtio_procs_present function is moved and 
modified to accept the io_kind as an argument and check for the specific DTIO 
procedure.

The original dtio_procs_present function also had a segfault for one of the test 
cases because in the particular case the accessed structures do not exist. This 
is prevented by adding the appropriate guarding to avoid memory accesses to 
never never land.

Several new test cases added.  Regression tested on x86-64.

OK for trunk.  I would like to recommend back porting to 7 after allowing some 
time for testing.

Regards,

Jerry

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.

[-- Attachment #2: namelist_91.f90 --]
[-- Type: text/x-fortran, Size: 195 bytes --]

! { dg-do compile }
! PR78659 Spurious "requires DTIO" reported against namelist statement
program p
   type t
     integer :: k
   end type
   class(t), allocatable :: x
   namelist /nml/ x
end

[-- Attachment #3: namelist_92.f90 --]
[-- Type: text/x-fortran, Size: 488 bytes --]

! { dg-do compile }
! PR78659 Spurious "requires DTIO" reported against namelist statement
MODULE ma
  IMPLICIT NONE
  TYPE :: ta
    INTEGER, allocatable :: array(:)
  END TYPE ta
END MODULE ma

PROGRAM p
  USE ma
  type(ta):: x
  NAMELIST /nml/ x
  WRITE (*, nml) ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
  READ (*, nml) ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
END PROGRAM p

[-- Attachment #4: namelist_93.f90 --]
[-- Type: text/x-fortran, Size: 466 bytes --]

! { dg-do compile }
! PR78659 Spurious "requires DTIO" reported against namelist statement
MODULE ma
  IMPLICIT NONE
  TYPE :: ta
    INTEGER, allocatable :: array(:)
  END TYPE ta
END MODULE ma

PROGRAM p
  USE ma
  class(ta), allocatable :: x
  NAMELIST /nml/ x
  WRITE (*, nml)! { dg-error "is polymorphic and requires a defined input/output procedure" }
  READ (*, nml) ! { dg-error "is polymorphic and requires a defined input/output procedure" }
END PROGRAM p

[-- Attachment #5: namelist_94.f90 --]
[-- Type: text/x-fortran, Size: 866 bytes --]

! { dg-do compile }
! PR78659 Spurious "requires DTIO" reported against namelist statement
MODULE m
  IMPLICIT NONE
  TYPE :: t
    CHARACTER :: c
  CONTAINS
    PROCEDURE :: write_formatted
    GENERIC :: WRITE(FORMATTED) => write_formatted
  END TYPE
CONTAINS
  SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), INTENT(IN) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER(*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: v_list(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) :: iomsg
    WRITE (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) dtv%c
    print *, "what"
  END SUBROUTINE
END MODULE

PROGRAM p
  USE m
  IMPLICIT NONE
  class(t), allocatable :: x
  NAMELIST /nml/ x
  x = t('a')
  WRITE (*, nml)
  READ (*, nml) ! { dg-error "is polymorphic and requires a defined input/output procedure" }
END

PATCH ATTACHED Re: [PATCH, Fortran] PR78659 Spurious "requires DTIO" reported against namelist statement

[Jerry DeLisle]

[-- Attachment #1: Type: text/plain, Size: 1355 bytes --]

And the actual patch ...

On 05/11/2017 08:30 AM, Jerry DeLisle wrote:
> Hi all,
> 
> The attached patch fixes this issue by moving the DTIO namelist checks from 
> namelist resolution to READ/WRITE statement resolution.  This allows the checks 
> to be specific to the io_kind. The dtio_procs_present function is moved and 
> modified to accept the io_kind as an argument and check for the specific DTIO 
> procedure.
> 
> The original dtio_procs_present function also had a segfault for one of the test 
> cases because in the particular case the accessed structures do not exist. This 
> is prevented by adding the appropriate guarding to avoid memory accesses to 
> never never land.
> 
> Several new test cases added.  Regression tested on x86-64.
> 
> OK for trunk.  I would like to recommend back porting to 7 after allowing some 
> time for testing.
> 
> Regards,
> 
> Jerry
> 
> 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.


[-- Attachment #2: pr78659.diff --]
[-- Type: text/x-patch, Size: 5784 bytes --]

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 7ab897da..b2fa741d 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2966,6 +2966,30 @@ conflict:
   return MATCH_ERROR;
 }
 
+/* Check for formatted read and write DTIO procedures.  */
+
+static bool
+dtio_procs_present (gfc_symbol *sym, io_kind k)
+{
+  gfc_symbol *derived;
+
+  if (sym && sym->ts.u.derived)
+    {
+      if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
+	derived = CLASS_DATA (sym)->ts.u.derived;
+      else if (sym->ts.type == BT_DERIVED)
+	derived = sym->ts.u.derived;
+      else
+	return false;
+      if ((k == M_WRITE || k == M_PRINT) && 
+	  (gfc_find_specific_dtio_proc (derived, true, true) != NULL))
+	return true;
+      if ((k == M_READ) &&
+	  (gfc_find_specific_dtio_proc (derived, false, true) != NULL))
+	return true;
+    }
+  return false;
+}
 
 /* Traverse a namelist that is part of a READ statement to make sure
    that none of the variables in the namelist are INTENT(IN).  Returns
@@ -3244,7 +3268,7 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
 
   /* If we are reading and have a namelist, check that all namelist symbols
      can appear in a variable definition context.  */
-  if (k == M_READ && dt->namelist)
+  if (dt->namelist)
     {
       gfc_namelist* n;
       for (n = dt->namelist->namelist; n; n = n->next)
@@ -3252,17 +3276,50 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
 	  gfc_expr* e;
 	  bool t;
 
-	  e = gfc_get_variable_expr (gfc_find_sym_in_symtree (n->sym));
-	  t = gfc_check_vardef_context (e, false, false, false, NULL);
-	  gfc_free_expr (e);
+	  if (k == M_READ)
+	    {
+	      e = gfc_get_variable_expr (gfc_find_sym_in_symtree (n->sym));
+	      t = gfc_check_vardef_context (e, false, false, false, NULL);
+	      gfc_free_expr (e);
+    
+	      if (!t)
+		{
+		  gfc_error ("NAMELIST %qs in READ statement at %L contains"
+			     " the symbol %qs which may not appear in a"
+			     " variable definition context",
+			     dt->namelist->name, loc, n->sym->name);
+		  return false;
+		}
+	    }
+
+	  t = dtio_procs_present (n->sym, k);
 
-	  if (!t)
+	  if (n->sym->ts.type == BT_CLASS && !t)
 	    {
-	      gfc_error ("NAMELIST %qs in READ statement at %L contains"
-			 " the symbol %qs which may not appear in a"
-			 " variable definition context",
-			 dt->namelist->name, loc, n->sym->name);
-	      return false;
+	      gfc_error ("NAMELIST object %qs in namelist %qs at %L is "
+			 "polymorphic and requires a defined input/output "
+			 "procedure", n->sym->name, dt->namelist->name, loc);
+	      return 1;
+	    }
+    
+	  if ((n->sym->ts.type == BT_DERIVED)
+	      && (n->sym->ts.u.derived->attr.alloc_comp
+		  || n->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", n->sym->name,
+				   dt->namelist->name, loc))
+		return 1;
+    
+	      if (!t)
+		{
+		  gfc_error ("NAMELIST object %qs in namelist %qs at %L has "
+			     "ALLOCATABLE or POINTER components and thus requires "
+			     "a defined input/output procedure", n->sym->name,
+			     dt->namelist->name, loc);
+		  return 1;
+		}
 	    }
 	}
     }
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index df32a8a8..d50ffdb8 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

Re: PATCH ATTACHED Re: [PATCH, Fortran] PR78659 Spurious "requires DTIO" reported against namelist statement

[Paul Richard Thomas]

Hi Jerry,

This patch is good for both trunk and 7-branch.

Thanks!

Paul


On 11 May 2017 at 16:35, Jerry DeLisle <jvdelisle@charter.net> wrote:
> And the actual patch ...
>
> On 05/11/2017 08:30 AM, Jerry DeLisle wrote:
>>
>> Hi all,
>>
>> The attached patch fixes this issue by moving the DTIO namelist checks
>> from namelist resolution to READ/WRITE statement resolution.  This allows
>> the checks to be specific to the io_kind. The dtio_procs_present function is
>> moved and modified to accept the io_kind as an argument and check for the
>> specific DTIO procedure.
>>
>> The original dtio_procs_present function also had a segfault for one of
>> the test cases because in the particular case the accessed structures do not
>> exist. This is prevented by adding the appropriate guarding to avoid memory
>> accesses to never never land.
>>
>> Several new test cases added.  Regression tested on x86-64.
>>
>> OK for trunk.  I would like to recommend back porting to 7 after allowing
>> some time for testing.
>>
>> Regards,
>>
>> Jerry
>>
>> 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.
>
>



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: PATCH ATTACHED Re: [PATCH, Fortran] PR78659 Spurious "requires DTIO" reported against namelist statement

[Jerry DeLisle]

On 05/13/2017 04:06 AM, Dominique d'Humières wrote:
> Dear Jerry,
> 
>> And the actual patch ...
> 
> Are you sure this the right patch? It seems mostly applied on trunk. 
> 
> TIA
> 
> Dominique
> 
> PS I saw some ‘return 1;’ which should probably ‘return true;’
> 
> 

When I moved the checks over from the other function that used 1's and 0's, I
missed those. They should be false.  I regression tested with fix and committed:


	M	gcc/fortran/ChangeLog
	M	gcc/fortran/io.c
Committed r248008

Thanks for catch.

Jerry

Re: PATCH ATTACHED Re: [PATCH, Fortran] PR78659 Spurious "requires DTIO" reported against namelist statement

[Dominique d'Humières]

Dear Jerry,

> And the actual patch ...

Are you sure this the right patch? It seems mostly applied on trunk. 

TIA

Dominique

PS I saw some ‘return 1;’ which should probably ‘return true;’