[patch, fortran] Fix PR 83012, rejects-valid regression with contiguous pointer

[Thomas Koenig]

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  <tkoe...@gcc.gnu.org>

        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  <tkoe...@gcc.gnu.org>

        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