[Bug fortran/45420] New: [OOP] poylmorphic TBP calls in a CLASS DEFAULT clause

[Bug fortran/45420] New: [OOP] poylmorphic TBP calls in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

Reported by Salvatore at http://gcc.gnu.org/ml/fortran/2010-08/msg00351.html.

Here is a slightly simplified version of the test case:


module base_mat_mod

 type  :: base_sparse_mat
 contains
   procedure, pass(a) :: get_fmt => base_get_fmt
 end type base_sparse_mat

contains

 function base_get_fmt(a) result(res)
   implicit none
   class(base_sparse_mat), intent(in) :: a
   character(len=5) :: res
   res = 'NULL'
 end function base_get_fmt

end module base_mat_mod


module d_base_mat_mod

 use base_mat_mod

 type, extends(base_sparse_mat) :: d_base_sparse_mat
 contains
   procedure, pass(a) :: get_fmt => d_base_get_fmt
 end type d_base_sparse_mat

 type, extends(d_base_sparse_mat) :: x_base_sparse_mat
 contains
   procedure, pass(a) :: get_fmt => x_base_get_fmt
 end type x_base_sparse_mat

contains

 function d_base_get_fmt(a) result(res)
   implicit none
   class(d_base_sparse_mat), intent(in) :: a
   character(len=5) :: res
   res = 'DBASE'
 end function d_base_get_fmt

 function x_base_get_fmt(a) result(res)
   implicit none
   class(x_base_sparse_mat), intent(in) :: a
   character(len=5) :: res
   res = 'XBASE'
 end function x_base_get_fmt

end module d_base_mat_mod


program bug20
  use d_base_mat_mod
  class(d_base_sparse_mat), allocatable  :: a

  allocate(x_base_sparse_mat :: a)
  write(0,*) 'Dynamic type on entry: ',a%get_fmt()

  select type(a)
  type is (d_base_sparse_mat)
    write(0,*) 'Dynamic type TYPE IS clause: ',a%get_fmt()
  class default
    write(0,*) 'Dynamic type CLASS DEFAULT clause: ',a%get_fmt()
  end select

end program bug20


Current output:

 Dynamic type on entry: XBASE
 Dynamic type CLASS DEFAULT clause: DBASE

Expected output:

 Dynamic type on entry: XBASE
 Dynamic type CLASS DEFAULT clause: XBASE


-- 
           Summary: [OOP] poylmorphic TBP calls in a CLASS DEFAULT clause
           Product: gcc
           Version: 4.6.0
            Status: UNCONFIRMED
          Keywords: wrong-code
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: janus at gcc dot gnu dot org


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] poylmorphic TBP calls in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

------- Comment #1 from janus at gcc dot gnu dot org  2010-08-26 17:54 -------
The dump shows that the first call to 'get_fmt' is executed dynamically as
'a.$vptr->get_fmt(...)', while the ones inside the SELECT TYPE block are
resolved statically to 'd_base_get_fmt'. For the TYPE IS clause this is fine,
but not so for CLASS DEFAULT, where a polymorphic call should be generated.

F08 quotes (chapter 8.1.9.2):

Within the block following a TYPE IS type guard statement, the associating
entity (16.5.5) is not polymorphic (4.3.1.3), has the type named in the type
guard statement, and has the type parameter values of the selector.

Within the block following a CLASS IS type guard statement, the associating
entity is polymorphic and has the declared type named in the type guard
statement. The type parameter values of the associating entity are the
corresponding type parameter values of the selector.

Within the block following a CLASS DEFAULT type guard statement, the
associating entity is polymorphic and has the same declared type as the
selector. The type parameter values of the associating entity are those of the
declared type of the selector.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] poylmorphic TBP calls in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

------- Comment #2 from janus at gcc dot gnu dot org  2010-08-26 19:55 -------
It turns out this bug is rather easy to fix. The problem was the we used the
temporary needed for the TYPE IS clause also in the CLASS DEFAULT clause (where
we need none). The following patch fixes it (haven't checked for regressions
yet):

Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 163470)
+++ gcc/fortran/match.c (working copy)
@@ -4460,6 +4460,12 @@ select_type_set_tmp (gfc_typespec *ts)
   char name[GFC_MAX_SYMBOL_LEN];
   gfc_symtree *tmp;

+  if (!ts)
+    {
+      select_type_stack->tmp = NULL;
+      return;
+    }
+  
   if (!gfc_type_is_extensible (ts->u.derived))
     return;

@@ -4702,6 +4708,7 @@ gfc_match_class_is (void)
       c->where = gfc_current_locus;
       c->ts.type = BT_UNKNOWN;
       new_st.ext.case_list = c;
+      select_type_set_tmp (NULL);
       return MATCH_YES;
     }


-- 

janus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |janus at gcc dot gnu dot org
                   |dot org                     |
             Status|UNCONFIRMED                 |ASSIGNED
     Ever Confirmed|0                           |1
   Last reconfirmed|0000-00-00 00:00:00         |2010-08-26 19:55:39
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

-- 

janus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
            Summary|[OOP] poylmorphic TBP calls |[OOP] polymorphic TBP call
                   |in a CLASS DEFAULT clause   |in a CLASS DEFAULT clause
   Target Milestone|---                         |4.6.0


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[sfilippone at uniroma2 dot it]

------- Comment #3 from sfilippone at uniroma2 dot it  2010-08-27 07:37 -------
(In reply to comment #2)
> It turns out this bug is rather easy to fix. The problem was the we used the
> temporary needed for the TYPE IS clause also in the CLASS DEFAULT clause (where
> we need none). The following patch fixes it (haven't checked for regressions
> yet):
> 
Hi, 
First, the patch did not apply cleanly, the first hunk was rejected. I applied
it by hand, and I got a problem down the road in my library: 
===============================================================
gfortran -ggdb -I.. -I../modules -I. -c psb_srwextd.f90
psb_srwextd.f90:76.13:

      call aa%mv_to_coo(actmp,info)
             1
Error: Actual argument at (1) must be definable as the dummy argument 'a' is
INTENT = OUT/INOUT
psb_srwextd.f90:84.39:

      if (info == psb_success_) call aa%mv_from_coo(actmp,info)
                                       1
Error: Actual argument at (1) must be definable as the dummy argument 'a' is
INTENT = OUT/INOUT
============================================================================
The relevant piece of code is as follows:
============================================================================
subroutine psb_srwextd(nr,a,info,b,rowscale)
  use psb_sparse_mod, psb_protect_name => psb_srwextd
  implicit none

  ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes)
  integer, intent(in)                          :: nr
  type(psb_s_sparse_mat), intent(inout)        :: a
  integer,intent(out)                          :: info
  type(psb_s_sparse_mat), intent(in), optional :: b
  logical,intent(in), optional                 :: rowscale

  integer :: i,j,ja,jb,err_act,nza,nzb
  character(len=20)                 :: name, ch_err
  type(psb_s_coo_sparse_mat)        :: actmp
  logical  rowscale_ 

  name='psb_srwextd'
  info  = psb_success_
  call psb_erractionsave(err_act)

  if (nr > a%get_nrows()) then 
    select type(aa=> a%a) 
    type is (psb_s_csr_sparse_mat)
      if (present(b)) then 
        call psb_rwextd(nr,aa,info,b%a,rowscale)
      else
        call psb_rwextd(nr,aa,info,rowscale=rowscale)
      end if
    type is (psb_s_coo_sparse_mat) 
      if (present(b)) then 
        call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale)
      else
        call psb_rwextd(nr,aa,info,rowscale=rowscale)
      end if
    class default
      call aa%mv_to_coo(actmp,info)
      if (info == psb_success_) then 
        if (present(b)) then 
          call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale)
        else
          call psb_rwextd(nr,actmp,info,rowscale=rowscale)
        end if
      end if
      if (info == psb_success_) call aa%mv_from_coo(actmp,info)
    end select
  end if
  if (info /= psb_success_) goto 9999

  call psb_erractionrestore(err_act)
  return

9999 continue
  call psb_erractionrestore(err_act)
  if (err_act == psb_act_abort_) then
     call psb_error()
     return
  end if
  return

end subroutine psb_srwextd
==================================================================
The calls to AA%MV_TO ad AA%MV_FROM should be able to modify AA, since 
1. AA => A%A
2. A is an INOUT dummy argument. 


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

------- Comment #4 from janus at gcc dot gnu dot org  2010-08-27 09:06 -------
(In reply to comment #3)
> First, the patch did not apply cleanly, the first hunk was rejected. I applied
> it by hand, and I got a problem down the road in my library: 
> ===============================================================
> gfortran -ggdb -I.. -I../modules -I. -c psb_srwextd.f90
> psb_srwextd.f90:76.13:
> 
>       call aa%mv_to_coo(actmp,info)
>              1
> Error: Actual argument at (1) must be definable as the dummy argument 'a' is
> INTENT = OUT/INOUT
> psb_srwextd.f90:84.39:
> 
>       if (info == psb_success_) call aa%mv_from_coo(actmp,info)
>                                        1
> Error: Actual argument at (1) must be definable as the dummy argument 'a' is
> INTENT = OUT/INOUT

I tried to reproduce this by modifying your original test case, but did not
succeed so far. Can you provide a standalone test case for this problem? My
feeling is that this is another bug uncovered by the fix for the previous one.

The patch in comment #2 is free of testsuite regressions and certainly does the
right thing.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[sfilippone at uniroma2 dot it]

------- Comment #5 from sfilippone at uniroma2 dot it  2010-08-27 11:38 -------
(In reply to comment #4)
> (In reply to comment #3)
> I tried to reproduce this by modifying your original test case, but did not
> succeed so far. Can you provide a standalone test case for this problem? My
> feeling is that this is another bug uncovered by the fix for the previous one.
> 
> The patch in comment #2 is free of testsuite regressions and certainly does the
> right thing.
> 

Ok, go ahead with this fix, and I will open a new PR as appropriate. 


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[sfilippone at uniroma2 dot it]

------- Comment #6 from sfilippone at uniroma2 dot it  2010-08-27 14:40 -------
(In reply to comment #3)
       end if
>     class default
>       call aa%mv_to_coo(actmp,info)
>       if (info == psb_success_) then 
>         if (present(b)) then 
>           call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale)
>         else
>           call psb_rwextd(nr,actmp,info,rowscale=rowscale)
>         end if
>       end if
>       if (info == psb_success_) call aa%mv_from_coo(actmp,info)
>     end select
>
If however  I change the code as follows:
     select type(aa => a%a)
            ........
     class default
       call a%a%mv_to_coo(actmp,info)
  .......

it compiles. 


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

------- Comment #7 from janus at gcc dot gnu dot org  2010-08-27 19:02 -------
Subject: Bug 45420

Author: janus
Date: Fri Aug 27 19:02:15 2010
New Revision: 163594

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=163594
Log:
2010-08-27  Janus Weil  <janus@gcc.gnu.org>

        PR fortran/45420
        * match.c (select_type_set_tmp): Add the possibility to reset the
        temporary to NULL.
        (gfc_match_class_is): Reset the temporary in CLASS DEFAULT clauses.


2010-08-27  Janus Weil  <janus@gcc.gnu.org>

        PR fortran/45420
        * gfortran.dg/select_type_15.f03: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/select_type_15.f03
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/match.c
    trunk/gcc/testsuite/ChangeLog


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

------- Comment #8 from janus at gcc dot gnu dot org  2010-08-27 19:14 -------
Fixed with r163594. Closing.

(Salvatore, please open a new PR for your problem in comment #3 if you have
reduced it.)


-- 

janus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|janus at gcc dot gnu dot org|unassigned at gcc dot gnu
                   |                            |dot org
             Status|ASSIGNED                    |NEW


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420

[Bug fortran/45420] [OOP] polymorphic TBP call in a CLASS DEFAULT clause

[janus at gcc dot gnu dot org]

------- Comment #9 from janus at gcc dot gnu dot org  2010-08-27 19:15 -------
Closing.


-- 

janus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|NEW                         |RESOLVED
         Resolution|                            |FIXED


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45420