User account creation filtered due to spam.

Bug 43256 - [OOP] TBP with missing optional arg
Summary: [OOP] TBP with missing optional arg
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.5.0
: P3 normal
Target Milestone: ---
Assignee: janus
URL:
Keywords: wrong-code
Depends on:
Blocks:
 
Reported: 2010-03-04 15:44 UTC by janus
Modified: 2010-03-08 09:37 UTC (History)
1 user (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2010-03-04 21:14:06


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description janus 2010-03-04 15:44:21 UTC
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.
Comment 1 janus 2010-03-04 16:04:06 UTC
(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.
Comment 2 janus 2010-03-04 16:11:42 UTC
Btw, I just checked an analogous example with a procedure pointer component instead of a type-bound procedure, and this works.
Comment 3 janus 2010-03-04 21:14:05 UTC
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.]
Comment 4 janus 2010-03-04 22:10:44 UTC
(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)
Comment 5 janus 2010-03-04 22:44:04 UTC
(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(...)
Comment 6 janus 2010-03-05 09:36:03 UTC
(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.
Comment 7 janus 2010-03-05 09:56:08 UTC
(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(...)
Comment 8 janus 2010-03-07 14:07:15 UTC
(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 ...
Comment 9 Dominique d'Humieres 2010-03-07 15:59:30 UTC
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.
Comment 10 janus 2010-03-08 09:35:19 UTC
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

Comment 11 janus 2010-03-08 09:37:18 UTC
Fixed with r157272. Closing.