public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH, Fortran, OpenACC] Fix PR70598, Fortran host_data ICE
@ 2016-05-09 14:27 Chung-Lin Tang
  2016-05-10 18:58 ` Bernhard Reutner-Fischer
  2016-07-21 11:13 ` [PATCH, Fortran, OpenACC] Fix PR70598, Fortran host_data ICE Jakub Jelinek
  0 siblings, 2 replies; 10+ messages in thread
From: Chung-Lin Tang @ 2016-05-09 14:27 UTC (permalink / raw)
  To: fortran; +Cc: gcc-patches, Thomas Schwinge

[-- Attachment #1: Type: text/plain, Size: 1015 bytes --]

Hi, this patch resolves an ICE for Fortran when using the OpenACC
host_data directive.  Actually, rather than say resolve, it's more like
adjusting the front-end to same middle-end restrictions as C/C++,
namely that we only support pointers or arrays for host_data right now.

This patch contains a little bit of adjustments in fortran/openmp.c:resolve_omp_clauses(),
and some testcase adjustments. This has been tested without regressions for Fortran.

Is this okay for trunk?

Thanks,
Chung-Lin

2015-05-09  Chung-Lin Tang  <cltang@codesourcery.com>

	gcc/
	* fortran/openmp.c (resolve_omp_clauses): Adjust use_device clause
	handling to only allow pointers and arrays.

	gcc/testsuite/
	* gfortran.dg/goacc/host_data-tree.f95: Adjust to use accept pointers in use_device clause.
	* gfortran.dg/goacc/uninit-use-device-clause.f95: Likewise.
	* gfortran.dg/goacc/list.f95: Adjust to catch "neither a pointer nor an array" error messages.

	libgomp/testsuite/
	* libgomp.oacc-fortran/host_data-1.f90: New testcase.

[-- Attachment #2: pr70598.patch --]
[-- Type: text/x-patch, Size: 5694 bytes --]

Index: gcc/fortran/openmp.c
===================================================================
--- gcc/fortran/openmp.c	(revision 236020)
+++ gcc/fortran/openmp.c	(working copy)
@@ -3743,11 +3743,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_claus
 			      && CLASS_DATA (n->sym)->attr.allocatable))
 			gfc_error ("ALLOCATABLE object %qs in %s clause at %L",
 				   n->sym->name, name, &n->where);
-		      if (n->sym->attr.pointer
-			  || (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
-			      && CLASS_DATA (n->sym)->attr.class_pointer))
-			gfc_error ("POINTER object %qs in %s clause at %L",
-				   n->sym->name, name, &n->where);
+		      if (n->sym->attr.flavor == FL_VARIABLE
+			  && !n->sym->as && !n->sym->attr.pointer
+			  && !n->sym->attr.cray_pointer
+			  && !n->sym->attr.cray_pointee)
+			gfc_error ("%s clause variable %qs at %L is neither "
+				   "a pointer nor an array", name,
+				   n->sym->name, &n->where);
+		      if (n->sym->ts.type == BT_CLASS && CLASS_DATA (n->sym)
+			  && CLASS_DATA (n->sym)->attr.class_pointer)
+			gfc_error ("POINTER object %qs of polymorphic type in "
+				   "%s clause at %L", n->sym->name, name,
+				   &n->where);
 		      if (n->sym->attr.cray_pointer)
 			gfc_error ("Cray pointer object %qs in %s clause at %L",
 				   n->sym->name, name, &n->where);
Index: gcc/testsuite/gfortran.dg/goacc/uninit-use-device-clause.f95
===================================================================
--- gcc/testsuite/gfortran.dg/goacc/uninit-use-device-clause.f95	(revision 236020)
+++ gcc/testsuite/gfortran.dg/goacc/uninit-use-device-clause.f95	(working copy)
@@ -2,9 +2,9 @@
 ! { dg-additional-options "-Wuninitialized" }
 
 subroutine test
-  integer :: i
+  integer, pointer :: p
 
-  !$acc host_data use_device(i) ! { dg-warning "is used uninitialized in this function" }
+  !$acc host_data use_device(p) ! { dg-warning "is used uninitialized in this function" }
   !$acc end host_data
 end subroutine test
 
Index: gcc/testsuite/gfortran.dg/goacc/list.f95
===================================================================
--- gcc/testsuite/gfortran.dg/goacc/list.f95	(revision 236020)
+++ gcc/testsuite/gfortran.dg/goacc/list.f95	(working copy)
@@ -76,19 +76,19 @@ program test
   !$acc parallel private (i) firstprivate (i) ! { dg-error "present on multiple clauses" }
   !$acc end parallel
 
-  !$acc host_data use_device(i)
+  !$acc host_data use_device(i) ! { dg-error "neither a pointer nor an array" }
   !$acc end host_data
 
-  !$acc host_data use_device(c, d)
+  !$acc host_data use_device(c, d) ! { dg-error "neither a pointer nor an array" }
   !$acc end host_data
 
   !$acc host_data use_device(a)
   !$acc end host_data
 
-  !$acc host_data use_device(i, j, k, l, a)
+  !$acc host_data use_device(i, j, k, l, a) ! { dg-error "neither a pointer nor an array" }
   !$acc end host_data  
 
-  !$acc host_data use_device (i) use_device (j)
+  !$acc host_data use_device (i) use_device (j) ! { dg-error "neither a pointer nor an array" }
   !$acc end host_data
 
   !$acc host_data use_device ! { dg-error "Unclassifiable OpenACC directive" }
@@ -99,13 +99,17 @@ program test
 
   !$acc host_data use_device(10) ! { dg-error "Syntax error" }
 
-  !$acc host_data use_device(/b/, /b/) ! { dg-error "present on multiple clauses" }
+  !$acc host_data use_device(/b/, /b/)
   !$acc end host_data
+  ! { dg-error "neither a pointer nor an array" "" { target *-*-* } 102 }
+  ! { dg-error "present on multiple clauses" "" { target *-*-* } 102 }
 
-  !$acc host_data use_device(i, j, i) ! { dg-error "present on multiple clauses" }
+  !$acc host_data use_device(i, j, i)
   !$acc end host_data
+  ! { dg-error "neither a pointer nor an array" "" { target *-*-* } 107 }
+  ! { dg-error "present on multiple clauses" "" { target *-*-* } 107 }
 
-  !$acc host_data use_device(p1) ! { dg-error "POINTER" }
+  !$acc host_data use_device(p1)
   !$acc end host_data
 
 end program test
Index: gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95
===================================================================
--- gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95	(revision 236020)
+++ gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95	(working copy)
@@ -3,9 +3,9 @@
 
 program test
   implicit none
-  integer :: i = 1
+  integer, pointer :: p
 
-  !$acc host_data use_device(i)
+  !$acc host_data use_device(p)
   !$acc end host_data
 end program test
-! { dg-final { scan-tree-dump-times "pragma acc host_data use_device_ptr\\(i\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "pragma acc host_data use_device_ptr\\(p\\)" 1 "original" } }
Index: libgomp/testsuite/libgomp.oacc-fortran/host_data-1.f90
===================================================================
--- libgomp/testsuite/libgomp.oacc-fortran/host_data-1.f90	(revision 0)
+++ libgomp/testsuite/libgomp.oacc-fortran/host_data-1.f90	(revision 0)
@@ -0,0 +1,35 @@
+! { dg-do run }
+! { dg-additional-options "-cpp" }
+
+! { dg-xfail-if "TODO" { *-*-* } }
+! { dg-excess-errors "TODO" }
+
+program test
+  implicit none
+
+  integer, target :: i, arr(1000)
+  integer, pointer :: ip, iph
+  integer, contiguous, pointer :: parr(:), parrh(:)
+
+  ! Assign the same targets
+  ip => i
+  parr => arr
+  iph => i
+  parrh => arr
+
+  !$acc data copyin(i, arr)
+  !$acc host_data use_device(ip, parr)
+
+  ! Test how the pointers compare inside a host_data construct
+#if ACC_MEM_SHARED
+  if (.not. associated(ip, iph)) call abort
+  if (.not. associated(parr, parrh)) call abort
+#else
+  if (associated(ip, iph)) call abort
+  if (associated(parr, parrh)) call abort
+#endif
+
+  !$acc end host_data
+  !$acc end data
+
+end program test

^ permalink raw reply	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2016-08-09 15:30 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-05-09 14:27 [PATCH, Fortran, OpenACC] Fix PR70598, Fortran host_data ICE Chung-Lin Tang
2016-05-10 18:58 ` Bernhard Reutner-Fischer
2016-06-07 12:04   ` Chung-Lin Tang
2016-06-21  6:18     ` [PATCH, Fortran, OpenACC] Fix PR70598, Fortran host_data ICE (ping x2) Chung-Lin Tang
2016-07-13 11:53       ` [PATCH, Fortran, OpenACC] Fix PR70598, Fortran host_data ICE (ping x3) Chung-Lin Tang
2016-07-21  9:29         ` [PATCH, Fortran, OpenACC] Fix PR70598, Fortran host_data ICE (ping x4) Chung-Lin Tang
2016-07-21 10:54           ` Paul Richard Thomas
2016-07-21 11:13 ` [PATCH, Fortran, OpenACC] Fix PR70598, Fortran host_data ICE Jakub Jelinek
2016-07-29 15:47   ` Chung-Lin Tang
2016-08-09 15:30     ` Jakub Jelinek

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).