Hello world,
the attached patch fixes the PR by looking at the function interface if
one exists.
Regression-tested. OK for trunk?
Regards
Thomas
2017-11-17 Thomas Koenig <[email protected]>
PR fortran/83012
* expr.c (gfc_is_simply_contiguous): If a function call through a
class variable is done through a reference, check the function's
interface.
2017-11-17 Thomas Koenig <[email protected]>
PR fortran/83012
* gfortran.dg/contiguous_5.f90: New test.
Index: expr.c
===================================================================
--- expr.c (Revision 254408)
+++ expr.c (Arbeitskopie)
@@ -5185,8 +5185,31 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool str
gfc_symbol *sym;
if (expr->expr_type == EXPR_FUNCTION)
- return expr->value.function.esym
- ? expr->value.function.esym->result->attr.contiguous : false;
+ {
+ if (expr->value.function.esym)
+ return expr->value.function.esym->result->attr.contiguous;
+ else
+ {
+ /* We have to jump through some hoops if this is a vtab entry. */
+ gfc_symbol *s;
+ gfc_ref *r, *rc;
+
+ s = expr->symtree->n.sym;
+ if (s->ts.type != BT_CLASS)
+ return false;
+
+ rc = NULL;
+ for (r = expr->ref; r; r = r->next)
+ if (r->type == REF_COMPONENT)
+ rc = r;
+
+ if (rc == NULL || rc->u.c.component == NULL
+ || rc->u.c.component->ts.interface == NULL)
+ return false;
+
+ return rc->u.c.component->ts.interface->attr.contiguous;
+ }
+ }
else if (expr->expr_type != EXPR_VARIABLE)
return false;
! { dg-do compile }
! PR 83012 - this was incorrectly rejected.
! Original test case by Neil Carlson.
module mod
type :: foo
integer, pointer, contiguous :: p(:)
contains
procedure :: dataptr
end type
contains
function dataptr(this) result(dp)
class(foo), intent(in) :: this
integer, pointer, contiguous :: dp(:)
dp => this%p
end function
end module
subroutine bar(x)
use mod
class(foo) :: x
integer, pointer, contiguous :: p(:)
p => x%dataptr()
end subroutine
