[Patch, fortran] PR79382 - DTIO ICE

[Patch, fortran] PR79382 - DTIO ICE

[Paul Richard Thomas]

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

Dear All,

The fix for the original bug is tested in dtio_24.f90. It is triggered
by the PRIVATE statement in the module and occurs because there is no
such generic interface in the module. Note, however, that there is a
typebound generic interface, which should not be affected by the
PRIVATE statement. The fix looks for the interface and issues an error
if it is not present.

It was found that the absence of a DTIO procedure in a formatted
transfer, where a DT descriptor is present, caused a segfault. The fix
in transfer.c was to check if a reference to the DTIO procedure is
present and to issue an error if it is not. Unfortunately, since
trans-io.c transfers the components of derived types, in the absence
of a DTIO procedure, this negates the type check and requires that the
test in dtio_10.f90 be changed. I think that it would be a good idea
in the future to flag passing of components so that the type test can
be recovered. For this reason, I have left the calls in place.

Bootstrapped and regtested on FC23/x86_64 - OK for trunk and 6-branch?

I am building up a backlog of approved patches: Including this one (if
approved :-) ), PRs79402, 79434 & 79447. Would it be OK to commit
these to trunk, even though it is in stage 4?

Paul

2017-02-16  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/79382
    * decl.c (access_attr_decl): Test for presence of generic DTIO
    interface and emit error if not present.
    (gfc_match_end): Catch case where a procedure is contained in
    a module procedure and ensure that 'end procedure' is the
    correct termination.

2017-02-16  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/79382
    * io/transfer.c (check_dtio_proc): New function.
    (formatted_transfer_scalar_read): Use it.
    (formatted_transfer_scalar_write): ditto.

2017-02-16  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/79382
    * gfortran.dg/dtio_10.f90 : Change test of error message.
    * gfortran.dg/dtio_23.f90 : New test.
    * gfortran.dg/dtio_24.f90 : New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 6481 bytes --]

Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(revision 245196)
--- gcc/fortran/decl.c	(working copy)
*************** gfc_set_constant_character_len (int len,
*** 1499,1505 ****
  
    if (expr->ts.type != BT_CHARACTER)
      return;
!  
    if (expr->expr_type != EXPR_CONSTANT)
      {
        gfc_error_now ("CHARACTER length must be a constant at %L", &expr->where);
--- 1499,1505 ----
  
    if (expr->ts.type != BT_CHARACTER)
      return;
! 
    if (expr->expr_type != EXPR_CONSTANT)
      {
        gfc_error_now ("CHARACTER length must be a constant at %L", &expr->where);
*************** access_attr_decl (gfc_statement st)
*** 7566,7571 ****
--- 7566,7586 ----
  
  	case INTERFACE_GENERIC:
  	case INTERFACE_DTIO:
+ 
+ 	  if (type == INTERFACE_DTIO
+ 	      && gfc_current_ns->proc_name
+ 	      && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+ 	    {
+ 	      gfc_find_symbol (name, gfc_current_ns, 0, &sym);
+ 	      if (sym == NULL)
+ 		{
+ 		  gfc_error ("The GENERIC DTIO INTERFACE at %C is not "
+ 			     "present in the MODULE '%s'",
+ 			     gfc_current_ns->proc_name->name);
+ 		  return MATCH_ERROR;
+ 		}
+ 	    }
+ 
  	  if (gfc_get_symbol (name, NULL, &sym))
  	    goto done;
  
Index: libgfortran/io/transfer.c
===================================================================
*** libgfortran/io/transfer.c	(revision 245196)
--- libgfortran/io/transfer.c	(working copy)
*************** require_type (st_parameter_dt *dtp, bt e
*** 1244,1249 ****
--- 1244,1269 ----
  }
  
  
+ /* Check that the dtio procedure required for formatted IO is present.  */
+ 
+ static int
+ check_dtio_proc (st_parameter_dt *dtp, const fnode *f)
+ {
+   char buffer[BUFLEN];
+ 
+   if (dtp->u.p.fdtio_ptr != NULL)
+     return 0;
+ 
+   snprintf (buffer, BUFLEN,
+ 	    "Missing DTIO procedure or intrinsic type passed for item %d "
+ 	    "in formatted transfer",
+ 	    dtp->u.p.item_count - 1);
+ 
+   format_error (dtp, f, buffer);
+   return 1;
+ }
+ 
+ 
  static int
  require_numeric_type (st_parameter_dt *dtp, bt actual, const fnode *f)
  {
*************** formatted_transfer_scalar_read (st_param
*** 1436,1441 ****
--- 1456,1464 ----
  	case FMT_DT:
  	  if (n == 0)
  	    goto need_read_data;
+ 
+ 	  if (check_dtio_proc (dtp, f))
+ 	    return;
  	  if (require_type (dtp, BT_CLASS, type, f))
  	    return;
  	  int unit = dtp->u.p.current_unit->unit_number;
*************** formatted_transfer_scalar_write (st_para
*** 1938,1945 ****
--- 1961,1972 ----
  	      child_iomsg_len = IOMSG_LEN;
  	    }
  
+ 	  if (check_dtio_proc (dtp, f))
+ 	    return;
+ 
  	  /* Call the user defined formatted WRITE procedure.  */
  	  dtp->u.p.current_unit->child_dtio++;
+ 
  	  dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
  			      child_iostat, child_iomsg,
  			      iotype_len, child_iomsg_len);
Index: gcc/testsuite/gfortran.dg/dtio_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dtio_10.f90	(revision 245196)
--- gcc/testsuite/gfortran.dg/dtio_10.f90	(working copy)
*************** program test1
*** 23,27 ****
    read (10, fmt='(dt)', advance='no', size=thesize, iostat=ios, &
              & iomsg=errormsg) i, udt1
    if (ios.ne.5006) call abort
!   if (errormsg(1:25).ne."Expected CLASS or DERIVED") call abort
  end program test1
--- 23,27 ----
    read (10, fmt='(dt)', advance='no', size=thesize, iostat=ios, &
              & iomsg=errormsg) i, udt1
    if (ios.ne.5006) call abort
!   if (errormsg(27:47).ne."intrinsic type passed") call abort
  end program test1
Index: gcc/testsuite/gfortran.dg/dtio_23.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dtio_23.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/dtio_23.f90	(working copy)
***************
*** 0 ****
--- 1,37 ----
+ ! { dg-do compile }
+ !
+ ! Test fix for the original in PR79832.
+ !
+ ! Contributed by Walt Brainerd  <walt.brainerd@gmail.com>
+ !
+ module dollar_mod
+ 
+    implicit none
+    private
+ 
+    type, public :: dollar_type
+       real :: amount
+    contains
+       procedure :: Write_dollar
+       generic :: write(formatted) => Write_dollar
+    end type dollar_type
+ 
+    PRIVATE :: write (formatted) ! { dg-error "is not present" }
+ 
+ contains
+ 
+ subroutine Write_dollar &
+ 
+    (dollar_value, unit, b_edit_descriptor, v_list, iostat, iomsg)
+ 
+    class (dollar_type), intent(in) :: dollar_value
+    integer, intent(in) :: unit
+    character (len=*), intent(in) :: b_edit_descriptor
+    integer, dimension(:), intent(in) :: v_list
+    integer, intent(out) :: iostat
+    character (len=*), intent(inout) :: iomsg
+    write (unit=unit, fmt="(f9.2)", iostat=iostat) dollar_value%amount
+ 
+ end subroutine Write_dollar
+ 
+ end module dollar_mod
Index: gcc/testsuite/gfortran.dg/dtio_24.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dtio_24.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/dtio_24.f90	(working copy)
***************
*** 0 ****
--- 1,51 ----
+ ! { dg-do run }
+ !
+ ! Test fix for the additional bug that was found in fixing PR79832.
+ !
+ ! Contributed by Walt Brainerd  <walt.brainerd@gmail.com>
+ !
+ module dollar_mod
+ 
+    implicit none
+    private
+ 
+    type, public :: dollar_type
+       real :: amount
+    end type dollar_type
+ 
+    interface write(formatted)
+       module procedure Write_dollar
+    end interface
+ 
+    private :: write (formatted)
+ 
+ contains
+ 
+ subroutine Write_dollar &
+ 
+    (dollar_value, unit, b_edit_descriptor, v_list, iostat, iomsg)
+ 
+    class (dollar_type), intent(in) :: dollar_value
+    integer, intent(in) :: unit
+    character (len=*), intent(in) :: b_edit_descriptor
+    integer, dimension(:), intent(in) :: v_list
+    integer, intent(out) :: iostat
+    character (len=*), intent(inout) :: iomsg
+    write (unit=unit, fmt="(f9.2)", iostat=iostat) dollar_value%amount
+ 
+ end subroutine Write_dollar
+ 
+ end module dollar_mod
+ 
+ program test_dollar
+ 
+    use :: dollar_mod
+    implicit none
+    integer  :: ios
+    character(100) :: errormsg
+ 
+    type (dollar_type), parameter :: wage = dollar_type(15.10)
+    write (unit=*, fmt="(DT)", iostat=ios, iomsg=errormsg) wage
+    if (ios.ne.5006) call abort
+    if (errormsg(1:22).ne."Missing DTIO procedure") call abort
+ end program test_dollar

Re: [Patch, fortran] PR79382 - DTIO ICE

[Jerry DeLisle]

On 02/16/2017 03:31 AM, Paul Richard Thomas wrote:
> Dear All,
>
> The fix for the original bug is tested in dtio_24.f90. It is triggered
> by the PRIVATE statement in the module and occurs because there is no
> such generic interface in the module. Note, however, that there is a
> typebound generic interface, which should not be affected by the
> PRIVATE statement. The fix looks for the interface and issues an error
> if it is not present.
>
> It was found that the absence of a DTIO procedure in a formatted
> transfer, where a DT descriptor is present, caused a segfault. The fix
> in transfer.c was to check if a reference to the DTIO procedure is
> present and to issue an error if it is not. Unfortunately, since
> trans-io.c transfers the components of derived types, in the absence
> of a DTIO procedure, this negates the type check and requires that the
> test in dtio_10.f90 be changed. I think that it would be a good idea
> in the future to flag passing of components so that the type test can
> be recovered. For this reason, I have left the calls in place.
>
> Bootstrapped and regtested on FC23/x86_64 - OK for trunk and 6-branch?

OK for trunk. Not applicable for 6-branch
>
> I am building up a backlog of approved patches: Including this one (if
> approved :-) ), PRs79402, 79434 & 79447. Would it be OK to commit
> these to trunk, even though it is in stage 4?

Yes OK as long as we are not in freeze.

>
> Paul
>
> 2017-02-16  Paul Thomas  <pault@gcc.gnu.org>
>
>     PR fortran/79382
>     * decl.c (access_attr_decl): Test for presence of generic DTIO
>     interface and emit error if not present.
>     (gfc_match_end): Catch case where a procedure is contained in
>     a module procedure and ensure that 'end procedure' is the
>     correct termination.
>
> 2017-02-16  Paul Thomas  <pault@gcc.gnu.org>
>
>     PR fortran/79382
>     * io/transfer.c (check_dtio_proc): New function.
>     (formatted_transfer_scalar_read): Use it.
>     (formatted_transfer_scalar_write): ditto.
>
> 2017-02-16  Paul Thomas  <pault@gcc.gnu.org>
>
>     PR fortran/79382
>     * gfortran.dg/dtio_10.f90 : Change test of error message.
>     * gfortran.dg/dtio_23.f90 : New test.
>     * gfortran.dg/dtio_24.f90 : New test.
>

Re: [Patch, fortran] PR79382 - DTIO ICE

[Paul Richard Thomas]

Dear Jerry,

> OK for trunk. Not applicable for 6-branch

duuuuh! Thanks


> Yes OK as long as we are not in freeze.

This is not, strictly speaking what we all agreed about a year ago; ie
that we would try to abide by gcc conditions. However, I see that
everybody else is committing to their heart's content so I might as
well do so too. Fortunately, all four of my patches are for either
DTIO or submodules and are therefore sufficiently enclosed that they
will not break F95 and the rest of F2003 support.

Best regards

Paul

Re: [Patch, fortran] PR79382 - DTIO ICE

[Paul Richard Thomas]

Dear All,

Committed as revision 245596.

Thanks for the review.

Paul

On 16 February 2017 at 18:38, Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 02/16/2017 03:31 AM, Paul Richard Thomas wrote:
>>
>> Dear All,
>>
>> The fix for the original bug is tested in dtio_24.f90. It is triggered
>> by the PRIVATE statement in the module and occurs because there is no
>> such generic interface in the module. Note, however, that there is a
>> typebound generic interface, which should not be affected by the
>> PRIVATE statement. The fix looks for the interface and issues an error
>> if it is not present.
>>
>> It was found that the absence of a DTIO procedure in a formatted
>> transfer, where a DT descriptor is present, caused a segfault. The fix
>> in transfer.c was to check if a reference to the DTIO procedure is
>> present and to issue an error if it is not. Unfortunately, since
>> trans-io.c transfers the components of derived types, in the absence
>> of a DTIO procedure, this negates the type check and requires that the
>> test in dtio_10.f90 be changed. I think that it would be a good idea
>> in the future to flag passing of components so that the type test can
>> be recovered. For this reason, I have left the calls in place.
>>
>> Bootstrapped and regtested on FC23/x86_64 - OK for trunk and 6-branch?
>
>
> OK for trunk. Not applicable for 6-branch
>>
>>
>> I am building up a backlog of approved patches: Including this one (if
>> approved :-) ), PRs79402, 79434 & 79447. Would it be OK to commit
>> these to trunk, even though it is in stage 4?
>
>
> Yes OK as long as we are not in freeze.
>
>
>>
>> Paul
>>
>> 2017-02-16  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     PR fortran/79382
>>     * decl.c (access_attr_decl): Test for presence of generic DTIO
>>     interface and emit error if not present.
>>     (gfc_match_end): Catch case where a procedure is contained in
>>     a module procedure and ensure that 'end procedure' is the
>>     correct termination.
>>
>> 2017-02-16  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     PR fortran/79382
>>     * io/transfer.c (check_dtio_proc): New function.
>>     (formatted_transfer_scalar_read): Use it.
>>     (formatted_transfer_scalar_write): ditto.
>>
>> 2017-02-16  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     PR fortran/79382
>>     * gfortran.dg/dtio_10.f90 : Change test of error message.
>>     * gfortran.dg/dtio_23.f90 : New test.
>>     * gfortran.dg/dtio_24.f90 : New test.
>>
>



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