GCC Bugzilla will be upgraded from version 4.4.9 to 5.0rc3 on Saturday, April 25, starting around 17:00 UTC. The upgrade process should only last a few minutes. Check bug 64968 for details.
Bug 49638 - [OOP] length parameter is ignored when overriding type bound character functions with constant length.
[OOP] length parameter is ignored when overriding type bound character functi...
Status: RESOLVED FIXED
Product: gcc
Classification: Unclassified
Component: fortran
4.7.0
: P3 normal
: ---
Assigned To: janus
: accepts-invalid
Depends on:
Blocks:
  Show dependency treegraph
 
Reported: 2011-07-05 08:04 UTC by Hans-Werner Boschmann
Modified: 2011-08-21 21:15 UTC (History)
4 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2011-07-30 16:16:12


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Hans-Werner Boschmann 2011-07-05 08:04:16 UTC
module world
  implicit none
  type::world_1
   contains
     procedure,nopass::string=>w1_string
  end type world_1
  type,extends(world_1)::world_2
   contains
     procedure,nopass::string=>w2_string
  end type world_2
contains
  function w1_string()
    character(6)::w1_string
    w1_string=" world"
  end function w1_string
  function w2_string()
    character(7)::w2_string
    w2_string=" world2"
  end function w2_string
end module world
program hello
  use world
  implicit none
  type(world_1)::w1
  type(world_2)::w2
  print *,"hello world: hello",w1%string()
  print *,"hello world2: hello",w2%string()
end program hello

This program compiles and runs fine with gfortran 4.6.1 and gfortran 4.7. Nevertheless, the length of an array is a type parameter and all type parameters of an overriding function shall match the overridden type parameters.
Comment 1 janus 2011-07-30 16:16:12 UTC
Confirmed.

ifort says:

pr49638.f90(9): error #8280: An overriding binding and its corresponding overridden binding must both be either subroutines or functions with the same result type, kind, and shape.   [STRING]

pgf95 says:

PGF90-S-0155-Result is not compatible with parent's result for type bound procedure w2_string (pr49638.f90: 20)
Comment 2 janus 2011-07-30 16:23:25 UTC
Note: In resolve.c there is 'check_typebound_override' which should take care of these kind of things. It already rejects overriding procedures with different result types, and it has a FIXME note for more comprehensive checking.
Comment 3 janus 2011-07-31 11:05:24 UTC
A check for different ranks can be added like this:


Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 176967)
+++ gcc/fortran/interface.c	(working copy)
@@ -501,7 +501,7 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec
    and types.  Returns nonzero if they have the same rank and type,
    zero otherwise.  */
 
-static int
+int
 compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
 {
   int r1, r2;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 176967)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2810,6 +2810,7 @@ gfc_try gfc_ref_dimen_size (gfc_array_ref *, int d
 void gfc_free_interface (gfc_interface *);
 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
+int compare_type_rank (gfc_symbol *, gfc_symbol *);
 int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
 			    char *, int);
 void gfc_check_interfaces (gfc_namespace *);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 176971)
+++ gcc/fortran/resolve.c	(working copy)
@@ -10760,11 +10760,10 @@ check_typebound_override (gfc_symtree* proc, gfc_s
       /* FIXME:  Do more comprehensive checking (including, for instance, the
 	 rank and array-shape).  */
       gcc_assert (proc_target->result && old_target->result);
-      if (!gfc_compare_types (&proc_target->result->ts,
-			      &old_target->result->ts))
+      if (!compare_type_rank (proc_target->result, old_target->result))
 	{
 	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
-		     " matching result types", proc->name, &where);
+		     " matching result types and ranks", proc->name, &where);
Comment 4 janus 2011-08-03 18:36:55 UTC
(In reply to comment #3)
> A check for different ranks can be added like this:

This will reject the following variant of the original test case, which is accepted up to now:


module world
  implicit none
  type :: world_1
   contains
     procedure, nopass :: string => w1_string
  end type
  type, extends(world_1)::world_2
   contains
     procedure, nopass :: string => w2_string
  end type
contains
  function w1_string()
    integer :: w1_string
    w1_string = 1
  end function
  function w2_string()
    integer,dimension(2) ::w2_string
    w2_string = 2
  end function
end module

program hello
  use world
  implicit none
  type(world_1)::w1
  type(world_2)::w2
  print *,"hello world: hello",w1%string()
  print *,"hello world2: hello",w2%string()
end program
Comment 5 janus 2011-08-03 18:53:17 UTC
I think in general we may also have to reject differing non-constant string lengths (at least that's what ifort does), as in:


module world
  implicit none
  type :: world_1
   contains
     procedure, nopass :: string => w1_string
  end type
  type, extends(world_1) :: world_2
   contains
     procedure, nopass :: string => w2_string
  end type
contains
  function w1_string(x)
    integer, intent(in) :: x
    character(2*x) :: w1_string
    w1_string = "world"
  end function
  function w2_string(x)
    integer, intent(in) :: x
    character(3*x) :: w2_string
    w2_string = "world2"
  end function
end module

program hello
  use world
  implicit none
  type(world_1)::w1
  type(world_2)::w2
  print *,"hello world: hello ",w1%string(3),"!"
  print *,"hello world2: hello ",w2%string(3),"!"
end program
Comment 6 janus 2011-08-03 19:41:17 UTC
The simple constant-length example in comment #0 can be rejected by extending the resolve.c part of the patch in comment #3 into:


Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 177065)
+++ gcc/fortran/resolve.c	(working copy)
@@ -10760,13 +10760,28 @@ check_typebound_override (gfc_symtree* proc, gfc_s
       /* FIXME:  Do more comprehensive checking (including, for instance, the
 	 rank and array-shape).  */
       gcc_assert (proc_target->result && old_target->result);
-      if (!gfc_compare_types (&proc_target->result->ts,
-			      &old_target->result->ts))
+      if (!compare_type_rank (proc_target->result, old_target->result))
 	{
 	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
-		     " matching result types", proc->name, &where);
+		     " matching result types and ranks", proc->name, &where);
 	  return FAILURE;
 	}
+	
+      if (proc_target->result->ts.type == BT_CHARACTER
+	  && proc_target->result->ts.u.cl && proc_target->result->ts.u.cl->length
+	  && proc_target->result->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && old_target->result->ts.u.cl && old_target->result->ts.u.cl && old_target->result->ts.u.cl->length
+	  && old_target->result->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && (mpz_cmp (proc_target->result->ts.u.cl->length->value.integer,
+		      old_target->result->ts.u.cl->length->value.integer) != 0))
+	{
+	  gfc_error ("Character length mismatch (%ld/%ld) between '%s' at '%L' "
+		     "and overridden FUNCTION",
+		     mpz_get_si (proc_target->ts.u.cl->length->value.integer),
+		     mpz_get_si (old_target->ts.u.cl->length->value.integer),
+		     proc->name, &where);
+	  return FAILURE;
+	}
     }
 
   /* If the overridden binding is PUBLIC, the overriding one must not be
Comment 7 janus 2011-08-03 20:17:49 UTC
I wonder whether the right thing to do would be to add a general expression comparison routine like the one below (just a rough sketch so far).

a) Do we have something like this already? I found gfc_compare_expr in arith.c, but this does not seem to do quite what we need here (e.g. it only handles constant expressions, etc).

b) Is it overkill and things can be done in a simpler way?



===================================================================
--- gcc/fortran/expr.c	(revision 177065)
+++ gcc/fortran/expr.c	(working copy)
@@ -255,6 +255,80 @@ gfc_get_iokind_expr (locus *where, io_kind k)
 }
 
 
+/* Compare two expressions.  */
+
+gfc_try
+gfc_cmp_expr (gfc_expr *e1, gfc_expr *e2)
+{
+  if (e1 == NULL && e2 == NULL)
+    return SUCCESS;
+
+  if (e1->expr_type != e2->expr_type)
+    return FAILURE;
+  
+  switch (e1->expr_type)
+    {
+    case EXPR_CONSTANT:
+      switch (e1->ts.type)
+	{
+	case BT_INTEGER:
+	  if (mpz_cmp (e1->value.integer, e2->value.integer) != 0)
+	    return FAILURE;
+	  break;
+
+	case BT_REAL:
+	  if (mpfr_cmp (e1->value.real, e2->value.real) != 0)
+	    return FAILURE;
+	  break;
+
+	case BT_COMPLEX:
+	  if (mpc_cmp (e1->value.complex, e2->value.complex) != 0)
+	    return FAILURE;
+	  break;
+
+	case BT_CHARACTER:  /* TODO.  */
+	case BT_HOLLERITH:
+	case BT_LOGICAL:
+	case BT_DERIVED:
+	case BT_CLASS:
+	  break;
+
+	case BT_PROCEDURE:
+	case BT_VOID:
+	  /* Should never be reached.  */
+	case BT_UNKNOWN:
+	  gfc_internal_error ("gfc_copy_expr(): Bad expr node");
+	  /* Not reached.  */
+	}
+      break;
+
+    case EXPR_VARIABLE:
+      if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)
+	return FAILURE;
+
+    case EXPR_OP:
+      if (e1->value.op.op != e2->value.op.op)
+	return FAILURE;
+      if (gfc_cmp_expr (e1->value.op.op1, e2->value.op.op1) == FAILURE)
+	return FAILURE;
+      if (gfc_cmp_expr (e1->value.op.op2, e2->value.op.op2) == FAILURE)
+	return FAILURE;
+      break;
+
+    case EXPR_FUNCTION:  /* TODO.  */
+    case EXPR_ARRAY:
+    case EXPR_SUBSTRING:
+    case EXPR_COMPCALL:
+    case EXPR_PPC:
+    case EXPR_STRUCTURE:
+    case EXPR_NULL:
+      break;
+    }
+
+  return SUCCESS;
+}
+
+
Comment 8 Mikael Morin 2011-08-03 21:35:49 UTC
(In reply to comment #7)
> I wonder whether the right thing to do would be to add a general expression
> comparison routine like the one below (just a rough sketch so far).
> 
> a) Do we have something like this already? I found gfc_compare_expr in arith.c,
> but this does not seem to do quite what we need here (e.g. it only handles
> constant expressions, etc).
> 
> b) Is it overkill and things can be done in a simpler way?
> 

4.5.7.3 (type-bound procedure overriding) has:
• Either both shall be subroutines or both shall be functions having the same result characteristics (12.3.3).

12.3.3 (Characteristics of function results):
If a type parameter of a function result or a bound of a function result array is not a constant expression, the
exact dependence on the entities in the expression is a characteristic


So the standards asks for same-expression-ness.
Whether a compiler should diagnose it is another question.
I understand reversed operands (for commutative operators) as having an equal "exact dependence on the entities". And same for associative operators. 
Thus it is bound to be very complicated in the general case. 

However one could use an exact expression comparison (like what you proposed) and emit a warning only. 
This should take care of the most common cases without being too complicated.

About the functions to reuse there is also gfc_dep_compare_expr and its sub-functions (they should handle functions, variables and arithmetic operators). I don't know however how you will have two corresponding dummy arguments (from different procedures) compare equal. It's possibly not that simple after all, if you need to rewrite the functions. As far as I'm concerned, constants are enough then.
Comment 9 janus 2011-08-04 07:41:43 UTC
Hi Mikael,

> 4.5.7.3 (type-bound procedure overriding) has:
> • Either both shall be subroutines or both shall be functions having the same
> result characteristics (12.3.3).
> 
> 12.3.3 (Characteristics of function results):
> If a type parameter of a function result or a bound of a function result array
> is not a constant expression, the
> exact dependence on the entities in the expression is a characteristic
> 
> 
> So the standards asks for same-expression-ness.
> Whether a compiler should diagnose it is another question.

thanks for digging out these references. That makes it pretty clear.


> I understand reversed operands (for commutative operators) as having an equal
> "exact dependence on the entities". And same for associative operators. 
> Thus it is bound to be very complicated in the general case.

Yes, these are the kinds of things that I have also been worrying about. They will complicate matters a bit, but I think one can handle it.


> About the functions to reuse there is also gfc_dep_compare_expr and its
> sub-functions (they should handle functions, variables and arithmetic
> operators).

Yes, Tobias already suggested this to me, and indeed it looks very much like what we need here.


> I don't know however how you will have two corresponding dummy
> arguments (from different procedures) compare equal.

Well, the patch in comment #7 handles this by just comparing the names of the arguments (which have to be the same in overridden procedures, so I this this will be enough):

+    case EXPR_VARIABLE:
+      if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)
+    return FAILURE;


gfc_dep_compare_expr relies on a function called 'gfc_are_identical_variables'. This really checks for equal symbols, which is too strict for our case here (so we may add an extra argument to loosen this restriction?).

Thanks for the feedback ...
Comment 10 Tobias Burnus 2011-08-04 08:09:26 UTC
(In reply to comment #9)
> +      if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)

That can be done quicker as:
   if (e1->symtree->n.sym->name == e1->symtree->n.sym->name)

well, not in the general case - but as long as "gfc_get_string" was used to obtain the value.
Comment 11 janus 2011-08-04 10:59:18 UTC
(In reply to comment #10)
> (In reply to comment #9)
> > +      if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)
> 
> That can be done quicker as:
>    if (e1->symtree->n.sym->name == e1->symtree->n.sym->name)
> 
> well, not in the general case - but as long as "gfc_get_string" was used to
> obtain the value.

Can we be sure that this is the case? With the strcmp we should be on the safe side.

And of course there is a typo above: One of the 'e1's should be an 'e2'!
Comment 12 Mikael Morin 2011-08-04 11:14:36 UTC
If we are willing to do some simple expression comparisons, here is what I think should be supported (most common cases):

 - constants: this is the minimum
 - variables/dummies: for the case len=n
 - sub-components: for the case len=derived%char_length_comp
 - function calls: for the case len=len(some_char)
 - arithmetic operators: for the case len=n+1

So, only missing in your preliminary patch are sub-components and function.



(In reply to comment #9)
> > I don't know however how you will have two corresponding dummy
> > arguments (from different procedures) compare equal.
> 
> Well, the patch in comment #7 handles this by just comparing the names of the
> arguments (which have to be the same in overridden procedures, so I this this
> will be enough):
> 
> +    case EXPR_VARIABLE:
> +      if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)
> +    return FAILURE;
> 
Ah, yes. 

> 
> gfc_dep_compare_expr relies on a function called 'gfc_are_identical_variables'.
> This really checks for equal symbols, which is too strict for our case here (so
> we may add an extra argument to loosen this restriction?).
Yes, makes sense. Then you have components and functions almost for free.
Comment 13 Mikael Morin 2011-08-04 11:16:41 UTC
(In reply to comment #11)
> (In reply to comment #10)
> > (In reply to comment #9)
> > > +      if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)
> > 
> > That can be done quicker as:
> >    if (e1->symtree->n.sym->name == e1->symtree->n.sym->name)
> > 
> > well, not in the general case - but as long as "gfc_get_string" was used to
> > obtain the value.
> 
> Can we be sure that this is the case? With the strcmp we should be on the safe
> side.
> 
If it's not the case there is a bug. ;-)
Comment 14 kargl 2011-08-04 15:18:43 UTC
(In reply to comment #10)
> (In reply to comment #9)
> > +      if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)
> 
> That can be done quicker as:
>    if (e1->symtree->n.sym->name == e1->symtree->n.sym->name)
> 
> well, not in the general case - but as long as "gfc_get_string" was used to
> obtain the value.

Hopefully, the above is optimized away by the c compiler.
I suspect that one of the 'e1' should be an 'e2'.
Comment 15 janus 2011-08-04 21:16:48 UTC
(In reply to comment #14)
> > That can be done quicker as:
> >    if (e1->symtree->n.sym->name == e1->symtree->n.sym->name)
> > 
> 
> Hopefully, the above is optimized away by the c compiler.
> I suspect that one of the 'e1' should be an 'e2'.

Yes, of course (noted already in comment #11).

Also: Taking this one.
Comment 16 janus 2011-08-07 10:12:14 UTC
Author: janus
Date: Sun Aug  7 10:12:09 2011
New Revision: 177545

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

	PR fortran/49638
	* dependency.h (gfc_is_same_range,gfc_are_identical_variables): Remove
	two prototypes.
	* dependency.c (gfc_are_identical_variables,are_identical_variables):
	Renamed the former to the latter and made static.
	(gfc_dep_compare_expr): Renamed 'gfc_are_identical_variables', handle
	commutativity of multiplication.
	(gfc_is_same_range,is_same_range): Renamed the former to the latter,
	made static and removed argument 'def'.
	(check_section_vs_section): Renamed 'gfc_is_same_range'.
	* gfortran.h (gfc_check_typebound_override): New prototype.
	* interface.c (gfc_check_typebound_override): Moved here from ...
	* resolve.c (check_typebound_override): ... here (and renamed).
	(resolve_typebound_procedure): Renamed 'check_typebound_override'.

Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/dependency.c
    trunk/gcc/fortran/dependency.h
    trunk/gcc/fortran/gfortran.h
    trunk/gcc/fortran/interface.c
    trunk/gcc/fortran/resolve.c
Comment 17 janus 2011-08-07 10:16:44 UTC
Note: r177545 only does some preparational stuff. It does not add any actual checking yet.
Comment 18 janus 2011-08-07 20:59:20 UTC
Author: janus
Date: Sun Aug  7 20:59:16 2011
New Revision: 177550

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=177550
Log:
2011-08-07  Janus Weil  <janus@gcc.gnu.org>
	    Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/49638
	* dependency.c (are_identical_variables): For dummy arguments only
	check for equal names, not equal symbols.
	* interface.c (gfc_check_typebound_override): Add checking for rank
	and character length.

2011-08-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49638
	* gfortran.dg/typebound_override_1.f90: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/typebound_override_1.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/dependency.c
    trunk/gcc/fortran/interface.c
    trunk/gcc/testsuite/ChangeLog
Comment 19 janus 2011-08-07 21:13:12 UTC
r177550 correctly rejects the original test case.

ToDo: For many cases one only gets a warning instead of an error right now.
Comment 20 janus 2011-08-20 19:11:59 UTC
Author: janus
Date: Sat Aug 20 19:11:56 2011
New Revision: 177932

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

	PR fortran/49638
	* dependency.c (gfc_dep_compare_expr): Add new result value "-3".
	(gfc_check_element_vs_section,gfc_check_element_vs_element): Handle
	result value "-3".
        * frontend-passes.c (optimize_comparison): Ditto.
	* interface.c (gfc_check_typebound_override): Ditto.


2011-08-20  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49638
	* gfortran.dg/typebound_override_1.f90: Modified.

Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/dependency.c
    trunk/gcc/fortran/frontend-passes.c
    trunk/gcc/fortran/interface.c
    trunk/gcc/testsuite/ChangeLog
    trunk/gcc/testsuite/gfortran.dg/typebound_override_1.f90
Comment 21 janus 2011-08-20 19:30:44 UTC
(In reply to comment #19)
> ToDo: For many cases one only gets a warning instead of an error right now.

r177932 turns some warnings into errors.
Comment 22 janus 2011-08-21 21:15:09 UTC
I think we can close this one. Thanks for reporting, Hans-Werner.