Bug 46328

Summary: [OOP] type-bound operator call with non-trivial polymorphic operand
Product: gcc Reporter: Thomas Koenig <tkoenig>
Component: fortranAssignee: Not yet assigned to anyone <unassigned>
Status: RESOLVED FIXED    
Severity: normal CC: burnus, damian, janus, pault
Priority: P3 Keywords: rejects-valid
Version: 4.6.0   
Target Milestone: 4.7.0   
Host: Target:
Build: Known to work:
Known to fail: Last reconfirmed: 2011-10-30 00:00:00
Bug Depends on:    
Bug Blocks: 51334, 51634    

Description Thomas Koenig 2010-11-06 09:30:47 UTC
Reported by Damian Rouson in

http://gcc.gnu.org/ml/fortran/2010-11/msg00100.html

module field_module
  implicit none
  type ,abstract :: field
  contains
    procedure(field_op_real) ,deferred :: multiply_real
    generic :: operator(*) => multiply_real
  end type
  abstract interface
    function field_op_real(lhs,rhs)
      import :: field
      class(field) ,intent(in)  :: lhs
      real ,intent(in) :: rhs
      class(field) ,allocatable :: field_op_real
    end function
  end interface
end module

program main
  use field_module
  implicit none
  class(field) ,pointer :: u
  u = (u)*2.
end program

gets a segementation fault:

program received signal SIGSEGV, Segmentation fault.
0x00000000004b1b5c in gfc_add_component_ref (e=0x14589a0, name=0xd4bf9d "$vptr")
    at ../../trunk/gcc/fortran/class.c:61
61        gfc_symbol *derived = e->symtree->n.sym->ts.u.derived;

because the symtree is not set:

(gdb) p e->symtree
$3 = (gfc_symtree *) 0x0
(gdb) p *e
$2 = {expr_type = EXPR_FUNCTION, ts = {type = BT_CLASS, kind = 0, u = {derived = 0x1454c50,
      cl = 0x1454c50, pad = 21318736}, interface = 0x0, is_c_interop = 0, is_iso_c = 0,
    f90_type = BT_CLASS}, rank = 0, shape = 0x0, symtree = 0x0, ref = 0x0, where = {
    nextc = 0x14449a8, lb = 0x1444970}, is_boz = 0, is_snan = 0, error = 0, user_operator = 0,
  mold = 0, representation = {length = 0, string = 0x0}, value = {logical = 21310080,
    iokind = 21310080, integer = {{_mp_alloc = 21310080, _mp_size = 0, _mp_d = 0x7ffff7fc40b0}},
    real = {{_mpfr_prec = 21310080, _mpfr_sign = -134463312, _mpfr_exp = 0, _mpfr_d = 0x1455160}},
    complex = {{re = {{_mpfr_prec = 21310080, _mpfr_sign = -134463312, _mpfr_exp = 0,
            _mpfr_d = 0x1455160}}, im = {{_mpfr_prec = 1, _mpfr_sign = 0, _mpfr_exp = 0,
            _mpfr_d = 0x0}}}}, op = {op = 21310080, uop = 0x7ffff7fc40b0, op1 = 0x0,
      op2 = 0x1455160}, function = {actual = 0x1452a80, name = 0x7ffff7fc40b0 "field_op_real",
      isym = 0x0, esym = 0x1455160}, compcall = {actual = 0x1452a80,
      name = 0x7ffff7fc40b0 "field_op_real", base_object = 0x0, tbp = 0x1455160, ignore_pass = 1,
      assign = 0}, character = {length = 21310080, string = 0x7ffff7fc40b0},
Comment 1 janus 2010-11-06 12:01:51 UTC
This one is related to PR 46262: Both contain polymorphic type-bound operator calls with "non-trivial" operands. In the example here one might still just "optimize away" the parenthesis, but in more general cases like

u = (u*2.)*3.

one needs to insert a temporary (ditto for PR42626), so that this line is translated into something like:

{
  class$field tmp;

  tmp = u.$vptr->multiply_real (u,2.);

  u = tmp.$vptr->multiply_real (tmp,3.);
}

This does not work yet.
Comment 2 Damian Rouson 2011-08-10 04:46:08 UTC
i think the code below is another example of this bug.  Any chance this will be resolved in 4.7?  (The NAG Fortran and IBM XL Fortran compilers compile the code without error):

$ cat integrand.F90
module foo_module
  type ,abstract :: foo
  contains
    procedure(t_interface) ,deferred :: t
    procedure(assign_interface) ,deferred :: assign
    procedure(multiply_interface) ,deferred :: multiply
    generic :: operator(*) => multiply
    generic :: assignment(=) => assign
  end type
  abstract interface
    function t_interface(this)
      import :: foo 
      class(foo) :: this
      class(foo), allocatable ::t_interface
    end function 
    function multiply_interface(lhs,rhs) 
      import :: foo 
      class(foo), allocatable :: multiply_interface
      class(foo), intent(in) :: lhs
      real, intent(in) :: rhs
    end function 
    subroutine assign_interface(lhs,rhs) 
      import :: foo 
      class(foo), intent(in) :: rhs
      class(foo), intent(inout) :: lhs
    end subroutine 
  end interface
contains
  subroutine bar(x,dt)    
    class(foo) :: x
    real, intent(in) :: dt     
    x = x%t()*dt
  end subroutine 
end module

$ gfortran -c integrand.F90
integrand.F90:32.8:

    x = x%t()*dt
        1
Error: Operands of binary numeric operator '*' at (1) are CLASS(foo)/REAL(4)

$ gfortran --version
GNU Fortran (GCC) 4.6.1 20110325 (prerelease)
Copyright (C) 2011 Free Software Foundation, Inc.

GNU Fortran comes with NO WARRANTY, to the extent permitted by law.
You may redistribute copies of GNU Fortran
under the terms of the GNU General Public License.
For more information about these matters, see the file named COPYING
Comment 3 janus 2011-10-30 11:38:28 UTC
Note that the segfault on the code in comment #0 is gone by now. With 4.6 and trunk one currently gets:

  u = (u)*2.
      1
Error: Operands of binary numeric operator '*' at (1) are CLASS(field)/REAL(4)

(which is the same error as on comment #2.)

This error is due to the fact that the operator is not replaced by a TBP call (which in turn is due to the parenthesis, which is not optimized away).


Also note that comment #0 is invalid (since it is missing a defined assignment for type 'field'), as 4.5 reports:

  u = (u)*2.
  1
Error: Variable must not be polymorphic in assignment at (1)
Comment 4 Damian Rouson 2011-10-31 02:06:36 UTC
Thanks for the update.  The same error occurs when a defined assignment is added:


$ cat abstract_field_expression.F90 
module field_module
  implicit none
  type ,abstract :: field
  contains
    procedure(field_op_real) ,deferred :: multiply_real
    procedure(field_eq_field) ,deferred :: assign
    generic :: operator(*) => multiply_real
    generic :: assignment(=) => assign
  end type
  abstract interface
    function field_op_real(lhs,rhs)
      import :: field
      class(field) ,intent(in)  :: lhs
      real ,intent(in) :: rhs
      class(field) ,allocatable :: field_op_real
    end function
    subroutine field_eq_field(lhs,rhs)
      import :: field
      class(field) ,intent(inout)  :: lhs
      class(field) ,intent(in)  :: rhs
    end subroutine
  end interface
end module

program main
  use field_module
  implicit none
  class(field) ,pointer :: u
  u = (u)*2.
end program

$ gfortran abstract_field_expression.F90 
abstract_field_expression.F90:29.6:

  u = (u)*2.
      1
Error: Operands of binary numeric operator '*' at (1) are CLASS(field)/REAL(4)

$ gfortran --version
GNU Fortran (GCC) 4.6.2 20111019 (prerelease)
Comment 5 janus 2011-10-31 21:03:49 UTC
For the code in comment #2, there is actually a problem with the 'class_ok' attribute, which can be fixed with the following patchlet:

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 180696)
+++ gcc/fortran/resolve.c       (working copy)
@@ -11497,6 +11497,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
              c->attr.recursive = ifc->attr.recursive;
              c->attr.always_explicit = ifc->attr.always_explicit;
              c->attr.ext_attr |= ifc->attr.ext_attr;
+             if (c->ts.type == BT_CLASS)
+               c->attr.class_ok = ifc->attr.class_ok;
              /* Replace symbols in array spec.  */
              if (c->as)
                {

This gets us a bit further in 'matching_typebound_op' and changes the error on comment #2 into an ICE.

What is further needed for comment #2, is to insert a temporary to evaluate the call to x%t(), so that we can use the result as pass object and vptr base for the 'multiply' generic. The following patchlet sketches where this could happen (only flagging an ICE for the problematic case):

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c     (revision 180696)
+++ gcc/fortran/interface.c     (working copy)
@@ -3204,13 +3204,22 @@ build_compcall_for_operator (gfc_expr* e, gfc_actu
                             gfc_expr* base, gfc_typebound_proc* target,
                             const char *gname)
 {
-  e->expr_type = EXPR_COMPCALL;
-  e->value.compcall.tbp = target;
-  e->value.compcall.name = gname ? gname : "$op";
-  e->value.compcall.actual = actual;
-  e->value.compcall.base_object = base;
-  e->value.compcall.ignore_pass = 1;
-  e->value.compcall.assign = 0;
+  if (base->expr_type == EXPR_VARIABLE)
+    {
+      /* Generate a simple type-bound procedure call.  */
+      e->expr_type = EXPR_COMPCALL;
+      e->value.compcall.tbp = target;
+      e->value.compcall.name = gname ? gname : "$op";
+      e->value.compcall.actual = actual;
+      e->value.compcall.base_object = base;
+      e->value.compcall.ignore_pass = 1;
+      e->value.compcall.assign = 0;
+    }
+  else if (base->expr_type == EXPR_FUNCTION)
+    {
+      /* We need a temporary in order to evaluate the expression in two steps.  */
+      gfc_error ("build_compcall_for_operator: We need a temporary at %L", &e->where);
+    }
 }


The problem is that in 'build_compcall_for_operator', we only have access to the operator expression. However, we need to replace the whole gfc_code (in this case: the assignment "x=..."), preferentially by a BLOCK construct with a local temporary.

In the case at hand, things are further complicated by the fact that we need to replace the assignment itself by a type-bound call, too. Fortunately, this replacement requires no additional temporary, since the passed object is simple ("x").
Comment 6 janus 2011-10-31 21:51:22 UTC
One other thing that just occurred to me is that one might consider cleaning up 'gfc_extend_expr' by removing the 'real_error' argument and returning {MATCH_YES, MATCH_NO, MATCH_ERROR} instead of {SUCCESS, FAILURE}.



Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 180696)
+++ gcc/fortran/interface.c	(working copy)
@@ -3220,12 +3220,10 @@ build_compcall_for_operator (gfc_expr* e, gfc_actu
    with the operator.  This subroutine builds an actual argument list
    corresponding to the operands, then searches for a compatible
    interface.  If one is found, the expression node is replaced with
-   the appropriate function call.
-   real_error is an additional output argument that specifies if FAILURE
-   is because of some real error and not because no match was found.  */
+   the appropriate function call.  */
 
-gfc_try
-gfc_extend_expr (gfc_expr *e, bool *real_error)
+match
+gfc_extend_expr (gfc_expr *e)
 {
   gfc_actual_arglist *actual;
   gfc_symbol *sym;
Comment 7 Paul Thomas 2012-01-02 12:46:15 UTC
Author: pault
Date: Mon Jan  2 12:46:08 2012
New Revision: 182796

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=182796
Log:
2012-01-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/51529
	* trans-array.c (gfc_array_allocate): Null allocated memory of
	newly allocted class arrays.

	PR fortran/46262
	PR fortran/46328
	PR fortran/51052
	* interface.c(build_compcall_for_operator): Add a type to the
	expression.
	* trans-expr.c (conv_base_obj_fcn_val): New function.
	(gfc_conv_procedure_call): Use base_expr to detect non-variable
	base objects and, ensuring that there is a temporary variable,
	build up the typebound call using conv_base_obj_fcn_val.
	(gfc_trans_class_assign): Pick out class procedure pointer
	assignments and do the assignment with no further prcessing.
	(gfc_trans_class_array_init_assign, gfc_trans_class_init_assign
	gfc_trans_class_assign): Move to top of file.
	* gfortran.h : Add 'base_expr' field to gfc_expr.
	* resolve.c (get_declared_from_expr): Add 'types' argument to
	switch checking of derived types on or off.
	(resolve_typebound_generic_call): Set the new argument.
	(resolve_typebound_function, resolve_typebound_subroutine):
	Set 'types' argument for get_declared_from_expr appropriately.
	Identify base expression, if not a variable, in the argument
	list of class valued calls. Assign it to the 'base_expr' field
	of the final expression. Strip away all references after the
	last class reference.


2012-01-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46262
	PR fortran/46328
	PR fortran/51052
	* gfortran.dg/typebound_operator_7.f03: New.
	* gfortran.dg/typebound_operator_8.f03: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/typebound_operator_7.f03
    trunk/gcc/testsuite/gfortran.dg/typebound_operator_8.f03
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/dump-parse-tree.c
    trunk/gcc/fortran/gfortran.h
    trunk/gcc/fortran/interface.c
    trunk/gcc/fortran/resolve.c
    trunk/gcc/fortran/trans-array.c
    trunk/gcc/fortran/trans-expr.c
    trunk/gcc/testsuite/ChangeLog
Comment 8 Paul Thomas 2012-01-02 13:01:21 UTC
Fixed on trunk.

Thanks for the report

Paul
Comment 9 Damian Rouson 2012-01-02 17:01:47 UTC
Thanks for the fix!  I'm very excited about the way 4.7 is shaping up.  It appears this will be a very significant release for those interested in the more advanced capabilities of OOP.

Damian
Comment 10 Tobias Burnus 2012-01-06 16:29:03 UTC
REOPEN.

The issue is mostly fixed (i.e. polymorphic operators work), but not completely. As Dominique pointed out [1], the parentheses in
   u = (u)*2.
still confuse gfortran (it works without).


Some preliminary analysis what goes wrong is available at [2, 3]:

a) In gfc_build_class_symbol, the attr->class_ok does not propagate to
   fclass->attr.class_ok  (should it?)

b) In matching_typebound_op, checking an EXPR_OP with
   gfc_expr_attr (base->expr).class_ok fails - should on use
   base->expr->ts->u.derived->attr.class_ok ?

c) In get_declared_from_expr (called by resolve_typebound_function):
   The following is wrong (ice - segfault) for an EXPR_OP:
     if (declared == NULL)
       declared = e->symtree->n.sym->ts.u.derived;
   should one use e->ts.u.derived?

(Regarding (base->expr,e)->ts.u.derived: I vaguely recall that sometimes e->ts did not have the proper data and only e->symtree->n.sym->ts had. I don't recall the details and it might have been only needed with some draft patch. It might be that e->ts.u.derived was NULL, but it could have been also something different.)

[1] http://gcc.gnu.org/ml/fortran/2012-01/msg00045.html
[2] http://gcc.gnu.org/ml/fortran/2012-01/msg00049.html
[3] http://gcc.gnu.org/ml/fortran/2012-01/msg00050.html
Comment 11 Tobias Burnus 2012-01-06 18:06:37 UTC
The following patchlet fixes the issue of comment 2 [or at least, the program now compiles]; it does not fix the issue of comment 0 / comment 4.

Regarding the latter:

One gets now a segfault for:
  at 0x50C5A0: gfc_add_component_ref(gfc_expr*, char const*) (class.c:63)
  by 0x57BDFC: resolve_typebound_function(gfc_expr*) (resolve.c:5958)
  by 0x573D74: gfc_resolve_expr(gfc_expr*) (resolve.c:6280)

which is because of:
63        gfc_symbol *derived = e->symtree->n.sym->ts.u.derived;
which fails as we have: e->expr_type == EXPR_FUNCTION


If one adds to the example in comment 2:
  use foo_module
  class(foo), pointer :: xx
  xx = xx * 4
  end
one gets:
  Error: Operands of binary numeric operator '*' at (1)
         are CLASS(foo)/INTEGER(4)
I have not checked whether that's correct or whether it should have worked.


--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3172,3 +3172,6 @@ matching_typebound_op (gfc_expr** tb_base,
          {
-           if (!gfc_expr_attr (base->expr).class_ok)
+           if ((base->expr->expr_type == EXPR_VARIABLE
+                && !gfc_expr_attr (base->expr).class_ok)
+               || (base->expr->expr_type != EXPR_VARIABLE
+                   && !base->expr->ts.u.derived->components))
              continue;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 79245ce..8d02d6e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5685,4 +5685,6 @@ get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,

-  if (declared == NULL)
+  if (declared == NULL && e->expr_type == EXPR_VARIABLE)
     declared = e->symtree->n.sym->ts.u.derived;
+  else
+    declared = e->ts.u.derived;
Comment 12 Tobias Burnus 2012-01-09 23:23:29 UTC
Author: burnus
Date: Mon Jan  9 23:23:26 2012
New Revision: 183039

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=183039
Log:
2012-01-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/46328
        * gfortran.dg/typebound_operator_11.f90: New.


Added:
    trunk/gcc/testsuite/gfortran.dg/typebound_operator_11.f90
Modified:
    trunk/gcc/testsuite/ChangeLog
Comment 13 Tobias Burnus 2012-01-09 23:27:23 UTC
Remaining issues were FIXED by the commit for PR 51791.

The (u)*2 issue of comment 0 / comment 4 had already a test case; comment 12 added the test case of comment 2 to the test suite.