[Patch, fortran] Clean up of error recovery in DTIO procedures

[Patch, fortran] Clean up of error recovery in DTIO procedures

[Paul Richard Thomas]

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

Dear All,

Please find attached a patch to clean up the various issues with
errors in DTIO procedures. The tests were all provided by Gerhard
Steinmetz for which thanks are due.

I intend to commit this patch as 'obvious' tomorrow morning unless
there are any objections in the meantime.

Bootstrapped and regtested on x86_64/FC21 - OK for trunk?

Paul

2016-09-21  Paul Thomas  <pault@gcc.gnu.org>

    * interface.c (check_dtio_interface1): Introduce errors for
    alternate returns and incorrect numbers of arguments.
    (gfc_find_specific_dtio_proc): Return cleanly if the derived
    type either doesn't exist or has no namespace.

2016-09-21  Paul Thomas  <pault@gcc.gnu.org>

    * gfortran.dg/dtio_13.f90: New test.

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

Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c	(revision 240301)
--- gcc/fortran/interface.c	(working copy)
*************** check_dtio_interface1 (gfc_symbol *deriv
*** 4629,4635 ****
  
        for (intr = tb_io_st->n.sym->generic; intr; intr = intr->next)
  	{
! 	  if (intr->sym && intr->sym->formal
  	      && ((intr->sym->formal->sym->ts.type == BT_CLASS
  	           && CLASS_DATA (intr->sym->formal->sym)->ts.u.derived
  							     == derived)
--- 4629,4635 ----
  
        for (intr = tb_io_st->n.sym->generic; intr; intr = intr->next)
  	{
! 	  if (intr->sym && intr->sym->formal && intr->sym->formal->sym
  	      && ((intr->sym->formal->sym->ts.type == BT_CLASS
  	           && CLASS_DATA (intr->sym->formal->sym)->ts.u.derived
  							     == derived)
*************** check_dtio_interface1 (gfc_symbol *deriv
*** 4639,4644 ****
--- 4639,4650 ----
  	      dtio_sub = intr->sym;
  	      break;
  	    }
+ 	  else if (intr->sym && intr->sym->formal && !intr->sym->formal->sym)
+ 	    {
+ 	      gfc_error ("Alternate return at %L is not permitted in a DTIO "
+ 			 "procedure", &intr->sym->declared_at);
+ 	      return;
+ 	    }
  	}
  
        if (dtio_sub == NULL)
*************** check_dtio_interface1 (gfc_symbol *deriv
*** 4647,4655 ****
  
    gcc_assert (dtio_sub);
    if (!dtio_sub->attr.subroutine)
!     gfc_error ("DTIO procedure %s at %L must be a subroutine",
  	       dtio_sub->name, &dtio_sub->declared_at);
  
    /* Now go through the formal arglist.  */
    arg_num = 1;
    for (formal = dtio_sub->formal; formal; formal = formal->next, arg_num++)
--- 4653,4680 ----
  
    gcc_assert (dtio_sub);
    if (!dtio_sub->attr.subroutine)
!     gfc_error ("DTIO procedure '%s' at %L must be a subroutine",
  	       dtio_sub->name, &dtio_sub->declared_at);
  
+   arg_num = 0;
+   for (formal = dtio_sub->formal; formal; formal = formal->next)
+     arg_num++;
+ 
+   if (arg_num < (formatted ? 6 : 4))
+     {
+       gfc_error ("Too few dummy arguments in DTIO procedure '%s' at %L",
+ 		 dtio_sub->name, &dtio_sub->declared_at);
+       return;
+     }
+ 
+   if (arg_num > (formatted ? 6 : 4))
+     {
+       gfc_error ("Too many dummy arguments in DTIO procedure '%s' at %L",
+ 		 dtio_sub->name, &dtio_sub->declared_at);
+       return;
+     }
+ 
+ 
    /* Now go through the formal arglist.  */
    arg_num = 1;
    for (formal = dtio_sub->formal; formal; formal = formal->next, arg_num++)
*************** check_dtio_interface1 (gfc_symbol *deriv
*** 4657,4662 ****
--- 4682,4695 ----
        if (!formatted && arg_num == 3)
  	arg_num = 5;
        fsym = formal->sym;
+ 
+       if (fsym == NULL)
+ 	{
+ 	  gfc_error ("Alternate return at %L is not permitted in a DTIO "
+ 		     "procedure", &dtio_sub->declared_at);
+ 	  return;
+ 	}
+ 
        switch (arg_num)
  	{
  	case(1):			/* DTV  */
*************** gfc_find_specific_dtio_proc (gfc_symbol
*** 4823,4828 ****
--- 4856,4864 ----
    for (extended = derived; extended;
         extended = gfc_get_derived_super_type (extended))
      {
+       if (extended == NULL || extended->ns == NULL)
+ 	return NULL;
+ 
        if (formatted == true)
  	{
  	  if (write == true)
Index: gcc/testsuite/gfortran.dg/dtio_13.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dtio_13.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/dtio_13.f90	(working copy)
***************
*** 0 ****
--- 1,144 ----
+ ! { dg-do compile }
+ ! { dg-options -std=legacy }
+ !
+ ! Test elimination of various segfaults and ICEs on error recovery.
+ !
+ ! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
+ !
+ module m1
+    type t
+    end type
+    interface write(formatted)
+       module procedure s
+    end interface
+ contains
+    subroutine s(dtv,unit,iotype,vlist,extra,iostat,iomsg) ! { dg-error "Too many dummy arguments" }
+       class(t), intent(in) :: dtv
+       integer, intent(in) :: unit
+       character(len=*), intent(in) :: iotype
+       integer, intent(in) :: vlist(:)
+       integer, intent(out) :: iostat
+       character(len=*), intent(inout) :: iomsg
+    end
+ end
+ 
+ module m2
+    type t
+    end type
+    interface read(formatted)
+       module procedure s
+    end interface
+ contains
+    subroutine s(dtv,unit,iotype,vlist,iostat,iomsg,extra) ! { dg-error "Too many dummy arguments" }
+       class(t), intent(inout) :: dtv
+       integer, intent(in) :: unit
+       character(len=*), intent(in) :: iotype
+       integer, intent(in) :: vlist(:)
+       integer, intent(out) :: iostat
+       character(len=*), intent(inout) :: iomsg
+    end
+ end
+ 
+ module m3
+    type t
+    end type
+    interface read(formatted)
+       module procedure s
+    end interface
+ contains
+    subroutine s(dtv,extra,unit,iotype,vlist,iostat,iomsg) ! { dg-error "Too many dummy arguments" }
+       class(t), intent(inout) :: dtv
+       integer, intent(in) :: unit
+       character(len=*), intent(in) :: iotype
+       integer, intent(in) :: vlist(:)
+       integer, intent(out) :: iostat
+       character(len=*), intent(inout) :: iomsg
+    end
+ end
+ 
+ module m4
+    type t
+    end type
+    interface write(unformatted)
+       module procedure s
+    end interface
+ contains
+    subroutine s(*) ! { dg-error "Alternate return" }
+    end
+ end
+ 
+ module m5
+    type t
+    contains
+       procedure :: s
+       generic :: write(unformatted) => s
+    end type
+ contains
+    subroutine s(dtv, *) ! { dg-error "Too few dummy arguments" }
+       class(t), intent(out) :: dtv
+    end
+ end
+ 
+ module m6
+    type t
+       character(len=20) :: name
+       integer(4) :: age
+    contains
+       procedure :: pruf
+       generic :: read(unformatted) => pruf
+    end type
+ contains
+    subroutine pruf (dtv,unit,*,iomsg) ! { dg-error "Alternate return" }
+       class(t), intent(inout) :: dtv
+       integer, intent(in) :: unit
+       character(len=*), intent(inout) :: iomsg
+       write (unit=unit, iostat=iostat, iomsg=iomsg) dtv%name, dtv%age
+    end
+ end
+ 
+ module m7
+    type t
+       character(len=20) :: name
+       integer(4) :: age
+    contains
+       procedure :: pruf
+       generic :: read(unformatted) => pruf
+    end type
+ contains
+    subroutine pruf (dtv,unit,iostat) ! { dg-error "Too few dummy arguments" }
+       class(t), intent(inout) :: dtv
+       integer, intent(in) :: unit
+       integer, intent(out) :: iostat
+       character(len=1) :: iomsg
+       write (unit=unit, iostat=iostat, iomsg=iomsg) dtv%name, dtv%age
+    end
+ end
+ 
+ module m
+    type t
+       character(len=20) :: name
+       integer(4) :: age
+    contains
+       procedure :: pruf
+       generic :: read(unformatted) => pruf
+    end type
+ contains
+    subroutine pruf (dtv,unit,iostat,iomsg)
+       class(t), intent(inout) :: dtv
+       integer, intent(in) :: unit
+       integer, intent(out) :: iostat
+       character(len=*), intent(inout) :: iomsg
+       write (unit=unit, iostat=iostat, iomsg=iomsg) dtv%name, dtv%age
+    end
+ end
+ program test
+    use m
+    character(3) :: a, b
+    class(t) :: chairman ! { dg-error "must be dummy, allocatable or pointer" }
+    open (unit=71, file='myunformatted_data.dat', form='unformatted')
+ ! The following error is spurious and is eliminated if previous error is corrected.
+ ! TODO Although better than an ICE, fix me.
+    read (71) a, chairman, b ! { dg-error "cannot be polymorphic" }
+    close (unit=71)
+ end
+ 

Re: [Patch, fortran] Clean up of error recovery in DTIO procedures

[Paul Richard Thomas]

Committed as revision 240342.

Paul

On 21 September 2016 at 12:18, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear All,
>
> Please find attached a patch to clean up the various issues with
> errors in DTIO procedures. The tests were all provided by Gerhard
> Steinmetz for which thanks are due.
>
> I intend to commit this patch as 'obvious' tomorrow morning unless
> there are any objections in the meantime.
>
> Bootstrapped and regtested on x86_64/FC21 - OK for trunk?
>
> Paul
>
> 2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
>
>     * interface.c (check_dtio_interface1): Introduce errors for
>     alternate returns and incorrect numbers of arguments.
>     (gfc_find_specific_dtio_proc): Return cleanly if the derived
>     type either doesn't exist or has no namespace.
>
> 2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
>
>     * gfortran.dg/dtio_13.f90: New test.



-- 
The difference between genius and stupidity is; genius has its limits.

Albert Einstein

Re: [Patch, fortran] Clean up of error recovery in DTIO procedures

[Rainer Orth]

Hi Paul,

> Dear All,
>
> Please find attached a patch to clean up the various issues with
> errors in DTIO procedures. The tests were all provided by Gerhard
> Steinmetz for which thanks are due.
>
> I intend to commit this patch as 'obvious' tomorrow morning unless
> there are any objections in the meantime.
>
> Bootstrapped and regtested on x86_64/FC21 - OK for trunk?
>
> Paul
>
> 2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
>
>     * interface.c (check_dtio_interface1): Introduce errors for
>     alternate returns and incorrect numbers of arguments.
>     (gfc_find_specific_dtio_proc): Return cleanly if the derived
>     type either doesn't exist or has no namespace.
>
> 2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
>
>     * gfortran.dg/dtio_13.f90: New test.

This test ICEs on Solaris (both sparc and x86, 32 and 64-bit):

FAIL: gfortran.dg/dtio_13.f90   -O   (test for errors, line 141)
FAIL: gfortran.dg/dtio_13.f90   -O  (internal compiler error)
FAIL: gfortran.dg/dtio_13.f90   -O  (test for excess errors)

Excess errors:
f951: internal compiler error: Segmentation Fault
0x8e165ec crash_signal
        /vol/gcc/src/hg/trunk/local/gcc/toplev.c:337
0x89357b8 gfc_find_symtree(gfc_symtree*, char const*)
        /vol/gcc/src/hg/trunk/local/gcc/fortran/symbol.c:2737
0x8895b77 find_typebound_proc_uop
        /vol/gcc/src/hg/trunk/local/gcc/fortran/class.c:2753
0x88c2a60 gfc_find_specific_dtio_proc(gfc_symbol*, bool, bool)
        /vol/gcc/src/hg/trunk/local/gcc/fortran/interface.c:4825
0x89166cb resolve_transfer
        /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:8738
0x89166cb gfc_resolve_code(gfc_code*, gfc_namespace*)
        /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:10874
0x8914e9c gfc_resolve_blocks(gfc_code*, gfc_namespace*)
        /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:9616
0x89152e8 gfc_resolve_code(gfc_code*, gfc_namespace*)
        /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:10557
0x89178d1 resolve_codes
        /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:15721
0x89179b1 gfc_resolve(gfc_namespace*)
0x89179b1 gfc_resolve(gfc_namespace*)
        /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:15756
0x8902909 resolve_all_program_units
        /vol/gcc/src/hg/trunk/local/gcc/fortran/parse.c:5875
0x8902909 gfc_parse_file()
        /vol/gcc/src/hg/trunk/local/gcc/fortran/parse.c:6127
0x8944d30 gfc_be_parse_file
        /vol/gcc/src/hg/trunk/local/gcc/fortran/f95-lang.c:198

The failure can be reproduced with

$ f951 gfortran.dg/dtio_13.f90 -quiet -o dtio_13.s

In gdb, I find

Thread 2 received signal SIGSEGV, Segmentation fault.
[Switching to Thread 1 (LWP 1)]
0x089357b8 in gfc_find_symtree (st=0x1, 
    name=0x83726a6 "_dtio_unformatted_read")
    at /vol/gcc/src/hg/trunk/local/gcc/fortran/symbol.c:2737
2737          c = strcmp (name, st->name);
(gdb) p name
$1 = 0x83726a6 "_dtio_unformatted_read"
(gdb) p st->name
Cannot access memory at address 0xd

	Rainer

-- 
-----------------------------------------------------------------------------
Rainer Orth, Center for Biotechnology, Bielefeld University

Re: [Patch, fortran] Clean up of error recovery in DTIO procedures

[Paul Richard Thomas]

Dear Rainer,

Thanks for the report. I'll have a stab at finding the problem
tomorrow. In the interim, could you try applying:

Index: /svn/trunk/gcc/fortran/interface.c
===================================================================
*** /svn/trunk/gcc/fortran/interface.c    (revision 240349)
--- /svn/trunk/gcc/fortran/interface.c    (working copy)
*************** gfc_find_specific_dtio_proc (gfc_symbol
*** 4793,4798 ****
--- 4793,4801 ----
    gfc_typebound_proc *tb_io_proc, *specific_proc;
    bool t = false;

+   if (derived == NULL)
+     return NULL;
+
    /* Try to find a typebound DTIO binding.  */
    if (formatted == true)
      {

Cheers

Paul

On 23 September 2016 at 14:08, Rainer Orth <ro@cebitec.uni-bielefeld.de> wrote:
> Hi Paul,
>
>> Dear All,
>>
>> Please find attached a patch to clean up the various issues with
>> errors in DTIO procedures. The tests were all provided by Gerhard
>> Steinmetz for which thanks are due.
>>
>> I intend to commit this patch as 'obvious' tomorrow morning unless
>> there are any objections in the meantime.
>>
>> Bootstrapped and regtested on x86_64/FC21 - OK for trunk?
>>
>> Paul
>>
>> 2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     * interface.c (check_dtio_interface1): Introduce errors for
>>     alternate returns and incorrect numbers of arguments.
>>     (gfc_find_specific_dtio_proc): Return cleanly if the derived
>>     type either doesn't exist or has no namespace.
>>
>> 2016-09-21  Paul Thomas  <pault@gcc.gnu.org>
>>
>>     * gfortran.dg/dtio_13.f90: New test.
>
> This test ICEs on Solaris (both sparc and x86, 32 and 64-bit):
>
> FAIL: gfortran.dg/dtio_13.f90   -O   (test for errors, line 141)
> FAIL: gfortran.dg/dtio_13.f90   -O  (internal compiler error)
> FAIL: gfortran.dg/dtio_13.f90   -O  (test for excess errors)
>
> Excess errors:
> f951: internal compiler error: Segmentation Fault
> 0x8e165ec crash_signal
>         /vol/gcc/src/hg/trunk/local/gcc/toplev.c:337
> 0x89357b8 gfc_find_symtree(gfc_symtree*, char const*)
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/symbol.c:2737
> 0x8895b77 find_typebound_proc_uop
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/class.c:2753
> 0x88c2a60 gfc_find_specific_dtio_proc(gfc_symbol*, bool, bool)
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/interface.c:4825
> 0x89166cb resolve_transfer
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:8738
> 0x89166cb gfc_resolve_code(gfc_code*, gfc_namespace*)
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:10874
> 0x8914e9c gfc_resolve_blocks(gfc_code*, gfc_namespace*)
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:9616
> 0x89152e8 gfc_resolve_code(gfc_code*, gfc_namespace*)
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:10557
> 0x89178d1 resolve_codes
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:15721
> 0x89179b1 gfc_resolve(gfc_namespace*)
> 0x89179b1 gfc_resolve(gfc_namespace*)
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/resolve.c:15756
> 0x8902909 resolve_all_program_units
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/parse.c:5875
> 0x8902909 gfc_parse_file()
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/parse.c:6127
> 0x8944d30 gfc_be_parse_file
>         /vol/gcc/src/hg/trunk/local/gcc/fortran/f95-lang.c:198
>
> The failure can be reproduced with
>
> $ f951 gfortran.dg/dtio_13.f90 -quiet -o dtio_13.s
>
> In gdb, I find
>
> Thread 2 received signal SIGSEGV, Segmentation fault.
> [Switching to Thread 1 (LWP 1)]
> 0x089357b8 in gfc_find_symtree (st=0x1,
>     name=0x83726a6 "_dtio_unformatted_read")
>     at /vol/gcc/src/hg/trunk/local/gcc/fortran/symbol.c:2737
> 2737          c = strcmp (name, st->name);
> (gdb) p name
> $1 = 0x83726a6 "_dtio_unformatted_read"
> (gdb) p st->name
> Cannot access memory at address 0xd
>
>         Rainer
>
> --
> -----------------------------------------------------------------------------
> Rainer Orth, Center for Biotechnology, Bielefeld University



-- 
The difference between genius and stupidity is; genius has its limits.

Albert Einstein

Re: [Patch, fortran] Clean up of error recovery in DTIO procedures

[Paul Richard Thomas]

Dear Rainer and Dominique,

Committed as obvious in revision 240493.

Thanks for doing the testing.

Cheers

Paul

2016-09-26  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/48298
    * interface.c (gfc_find_specific_dtio_proc) : Return NULL if
    the derived type is broken, as indicated by a flavor other than
    FL_DERIVED.

On 26 September 2016 at 10:26, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear Rainer,
>
> Thanks to you and Dominique for the confirmation that the patch works. I
> will commit it sometime today.
>
> Regards
>
> Paul
>
>
> On 26 Sep 2016 10:23 a.m., "Rainer Orth" <ro@cebitec.uni-bielefeld.de>
> wrote:
>
> Hi Paul,
>
>> Dominique has informed me that the earlier patch did not fix this problem.
>
> indeed, it just shifted the SEGV to a different place.
>
>> Although I still cannot reproduce the problem on FC21, I think that I
>> can see what the problem is. The declared type of 'chairman' is
>> thoroughly broken when it arrives at
>> interface.c(gfc_find_specific_dtio_proc). It doesn't even have the
>> right name! The key signature is that its flavor is FL_UNKNOWN. The
>> attached prevents the code coming anywhere near the call that causes
>> the segfault and regtests OK.
>
> I've now managed to run a sparc-sun-solaris2.10 bootstrap with the patch
> included and the failures are gone indeed.
>
> Thanks.
>         Rainer
>
> --
> -----------------------------------------------------------------------------
> Rainer Orth, Center for Biotechnology, Bielefeld University
>
>



-- 
The difference between genius and stupidity is; genius has its limits.

Albert Einstein