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