re PR fortran/83012 (Simply contiguous pointer function not recognized as contiguous)

2017-11-18  Thomas Koenig  <tkoenig@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-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/83012
	* gfortran.dg/contiguous_5.f90: New test.

From-SVN: r254914

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cd72b1cf0c3fb2ed060d4de40636d51727d436f1..8be551822b1252c9e74afa92edeb4c5519b83368 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2017-11-18  Thomas Koenig  <tkoenig@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  Richard Biener  <rguenther@suse.de>
 
        PR fortran/83017

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 09abacf83ecb7e66fea8900fa0dfec107545f09e..e1c0caccdc1056c12dfc87687395de4c158e3a48 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -5207,8 +5207,31 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
   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;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 52ae4a1025fb47afe264ccceb536e41621ddb0fe..dabd308f88ae0fa0887698def104ed3e48bdff5f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-11-18  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/83012
+       * gfortran.dg/contiguous_5.f90: New test.
+
 2017-11-17  Steve Ellcey  <sellcey@cavium.com>
 
        * gcc.target/aarch64/fmls.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/contiguous_5.f90 b/gcc/testsuite/gfortran.dg/contiguous_5.f90
new file mode 100644 (file)
index 0000000..71d6d03
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_5.f90
@@ -0,0 +1,23 @@
+! { 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