[Bug fortran/43256] New: [OOP] character-valued TBP with missing optional arg

[Bug fortran/43256] New: [OOP] character-valued TBP with missing optional arg

[janus at gcc dot gnu dot org]

Consider the following code:

module module_myobj

  implicit none

  type :: myobj
  contains
    procedure :: myfunc
  end type

contains

  function myfunc(this, status)
    class(myobj), intent(in) :: this
    integer, intent(out), optional  :: status
    character(len=80)               :: myfunc
    if (present(status)) then
      write (*,*) 'myfunc: status is present.'
    else
      write (*,*) 'myfunc: status is not present.'
    end if
    myfunc = ' '
  end function

end module


program test_optional

  use :: module_myobj
  implicit none

  character(len=80) :: res
  integer           :: status
  type(myobj)       :: myinstance

  res = myfunc(myinstance)         ! OK
  res = myfunc(myinstance, status) ! OK
  res = myinstance%myfunc()        ! FAILED
  res = myinstance%myfunc(status)  ! OK

end program


This currently produces the output:

 myfunc: status is not present.
 myfunc: status is present.
 myfunc: status is present.
 myfunc: status is present.

The correct output would be:

 myfunc: status is not present.
 myfunc: status is present.
 myfunc: status is not present.
 myfunc: status is present.

Apparently this only happens for type-bound character-valued functions (but not
for subroutines or e.g. integer-valued functions).

-fdump-tree-original shows the following for the four calls to 'myfunc':

    myfunc ((character(kind=1)[1:80] *) &str.3, 80, &class.2, 0B);
    myfunc ((character(kind=1)[1:80] *) &str.5, 80, &class.4, &status);
    myfunc ((character(kind=1)[1:80] *) &str.7, 80, &class.6);
    myfunc ((character(kind=1)[1:80] *) &str.9, 80, &class.8, &status);

In the third case we fail to pass a null pointer for the missing optional arg.


-- 
           Summary: [OOP] character-valued TBP with missing optional arg
           Product: gcc
           Version: 4.5.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=43256

[Bug fortran/43256] [OOP] character-valued TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #1 from janus at gcc dot gnu dot org  2010-03-04 16:04 -------
(In reply to comment #0)
> Apparently this only happens for type-bound character-valued functions (but not
> for subroutines or e.g. integer-valued functions).

Actually that is wrong. It does work with subroutines, but it fails with all
sorts of functions, also integer-valued ones, and with NOPASS:

module module_myobj

  implicit none

  type :: myobj
  contains
    procedure, nopass :: myfunc
  end type

contains

  integer function myfunc(status)
    integer, optional :: status
    if (present(status)) then
      write (*,*) 'myfunc: status is present.'
    else
      write (*,*) 'myfunc: status is not present.'
    end if
    myfunc = 1
  end function

end module


program test_optional

  use :: module_myobj
  implicit none

  integer     :: res,status
  type(myobj) :: myinstance

  res = myfunc()                   ! OK
  res = myfunc(status)             ! OK
  res = myinstance%myfunc()        ! FAILED
  res = myinstance%myfunc(status)  ! OK

end program


For checking if it works, one should not only look at the output of the
program, since this could be correct by chance. Instead, one should look at the
dump, to see if a zero is passed for the missing optional arg.


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #2 from janus at gcc dot gnu dot org  2010-03-04 16:11 -------
Btw, I just checked an analogous example with a procedure pointer component
instead of a type-bound procedure, and this works.


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #3 from janus at gcc dot gnu dot org  2010-03-04 21:14 -------
Ok, think I got it. It's a one-liner:

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 157225)
+++ gcc/fortran/resolve.c       (working copy)
@@ -5124,7 +5124,7 @@ resolve_compcall (gfc_expr* e, bool fcn)
     return FAILURE;

   e->value.function.actual = newactual;
-  e->value.function.name = e->value.compcall.name;
+  e->value.function.name = NULL;
   e->value.function.esym = target->n.sym;
   e->value.function.class_esym = NULL;
   e->value.function.isym = NULL;


Hope this produces no regressions.

[Explanation: The problem was that 'compare_actual_formal', which sets up the
null pointer for the missing actual arg, was never called for the TBP call. Due
to e->value.function.name being set already, 'resolve_function' always assumed
the function call had already been resolved, although it was never done.]


-- 

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-03-04 21:14:06
               date|                            |


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #4 from janus at gcc dot gnu dot org  2010-03-04 22:10 -------
(In reply to comment #3)
> Hope this produces no regressions.

Unfortunately it does :(

FAIL: gfortran.dg/dynamic_dispatch_1.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_3.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_4.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_6.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/class_12.f03  -O  (test for excess errors)
FAIL: gfortran.dg/interface_abstract_4.f90  -O  (test for excess errors)


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #5 from janus at gcc dot gnu dot org  2010-03-04 22:44 -------
(In reply to comment #4)
> FAIL: gfortran.dg/dynamic_dispatch_1.f03  -O0  (test for excess errors)
> FAIL: gfortran.dg/dynamic_dispatch_3.f03  -O0  (test for excess errors)
> FAIL: gfortran.dg/dynamic_dispatch_4.f03  -O0  (test for excess errors)
> FAIL: gfortran.dg/dynamic_dispatch_6.f03  -O0  (test for excess errors)
> FAIL: gfortran.dg/class_12.f03  -O  (test for excess errors)
> FAIL: gfortran.dg/interface_abstract_4.f90  -O  (test for excess errors)


All of these throw error messages like

ABSTRACT INTERFACE '...' must not be referenced at (1)

or

Type mismatch in argument '...' at (1); passed CLASS(...) to CLASS(...)


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #6 from janus at gcc dot gnu dot org  2010-03-05 09:36 -------
(In reply to comment #5)
> All of these throw error messages like
> 
> ABSTRACT INTERFACE '...' must not be referenced at (1)

This was PR41873 and was fixed by querying "expr->value.function.name", which
fails now. We should find a better way to silence this error message for
polymorphic calls.


> Type mismatch in argument '...' at (1); passed CLASS(...) to CLASS(...)

This one is a bit more tricky, but understandable. It is not a problem of the
one-line patch shown above, but of the implementation of polymorphic calls:
When doing a polymorphic call with 'dynamic type /= declared type' of the
passed object and an overridden TBP, we have to convert the passed object to a
CLASS of the dynamic type.


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #7 from janus at gcc dot gnu dot org  2010-03-05 09:56 -------
(In reply to comment #6)
> > ABSTRACT INTERFACE '...' must not be referenced at (1)
> 
> This was PR41873 and was fixed by querying "expr->value.function.name", which
> fails now. We should find a better way to silence this error message for
> polymorphic calls.

To solve this I propose the following:

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 157233)
+++ gcc/fortran/resolve.c       (working copy)
@@ -2556,8 +2556,8 @@ resolve_function (gfc_expr *expr)
     }

   /* If this ia a deferred TBP with an abstract interface (which may
-     of course be referenced), expr->value.function.name will be set.  */
-  if (sym && sym->attr.abstract && !expr->value.function.name)
+     of course be referenced), expr->value.function.esym will be set.  */
+  if (sym && sym->attr.abstract && !expr->value.function.esym)
     {
       gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
                 sym->name, &expr->where);


This leaves us with the following regressions:

FAIL: gfortran.dg/dynamic_dispatch_1.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_3.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_4.f03  -O0  (test for excess errors)
FAIL: gfortran.dg/dynamic_dispatch_6.f03  -O0  (test for excess errors)

due to the error

Error: Type mismatch in argument '...' at (1); passed CLASS(...) to CLASS(...)


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #8 from janus at gcc dot gnu dot org  2010-03-07 14:07 -------
(In reply to comment #7)
> This leaves us with the following regressions:
> 
> FAIL: gfortran.dg/dynamic_dispatch_1.f03  -O0  (test for excess errors)
> FAIL: gfortran.dg/dynamic_dispatch_3.f03  -O0  (test for excess errors)
> FAIL: gfortran.dg/dynamic_dispatch_4.f03  -O0  (test for excess errors)
> FAIL: gfortran.dg/dynamic_dispatch_6.f03  -O0  (test for excess errors)
> 
> due to the error
> 
> Error: Type mismatch in argument '...' at (1); passed CLASS(...) to CLASS(...)


These are resolved when adding to the patches in comment #3 and #7 the
following one:

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 157262)
+++ gcc/fortran/resolve.c       (working copy)
@@ -5178,18 +5178,17 @@ check_class_members (gfc_symbol *derived)
       return;
     }

-  if (tbp->n.tb->is_generic)
+  /* If we have to match a passed class member, force the actual
+      expression to have the correct type.  */
+  if (!tbp->n.tb->nopass)
     {
-      /* If we have to match a passed class member, force the actual
-        expression to have the correct type.  */
-      if (!tbp->n.tb->nopass)
-       {
-         if (e->value.compcall.base_object == NULL)
-           e->value.compcall.base_object =
-                       extract_compcall_passed_object (e);
+      if (e->value.compcall.base_object == NULL)
+       e->value.compcall.base_object = extract_compcall_passed_object (e);

-          e->value.compcall.base_object->ts.type = BT_DERIVED;
-          e->value.compcall.base_object->ts.u.derived = derived;
+      if (!derived->attr.abstract)
+       {
+         e->value.compcall.base_object->ts.type = BT_DERIVED;
+         e->value.compcall.base_object->ts.u.derived = derived;
        }
     }

I hope that's it now. I'll do another regtest to make sure ...


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[dominiq at lps dot ens dot fr]

------- Comment #9 from dominiq at lps dot ens dot fr  2010-03-07 15:59 -------
For the record, the patch in comment #8 does not apply on fortran-dev. AFAICT
the patches in comments #2 and 7 are enough for the branch.


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #10 from janus at gcc dot gnu dot org  2010-03-08 09:35 -------
Subject: Bug 43256

Author: janus
Date: Mon Mar  8 09:35:04 2010
New Revision: 157272

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

        PR fortran/43256
        * resolve.c (resolve_compcall): Don't set 'value.function.name' here
        for TBPs, otherwise they will not be resolved properly.
        (resolve_function): Use 'value.function.esym' instead of
        'value.function.name' to check if we're dealing with a TBP.
        (check_class_members): Set correct type of passed object for all TBPs,
        not only generic ones, except if the type is abstract.


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

        PR fortran/43256
        * gfortran.dg/typebound_call_13.f03: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/typebound_call_13.f03
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/resolve.c
    trunk/gcc/testsuite/ChangeLog


-- 


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

[Bug fortran/43256] [OOP] TBP with missing optional arg

[janus at gcc dot gnu dot org]

------- Comment #11 from janus at gcc dot gnu dot org  2010-03-08 09:37 -------
Fixed with r157272. Closing.


-- 

janus at gcc dot gnu dot org changed:

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


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