+2019-09-20 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/78260
+ * openmp.c (gfc_resolve_oacc_declare): Reject all
+ non variables but accept function result variables.
+ * trans-openmp.c (gfc_trans_omp_clauses): Handle
+ function-result variables for remaing cases.
+
2019-09-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/91588
for (n = oc->clauses->lists[list]; n; n = n->next)
{
n->sym->mark = 0;
- if (n->sym->attr.function || n->sym->attr.subroutine)
+ if (n->sym->attr.flavor != FL_VARIABLE
+ && (n->sym->attr.flavor != FL_PROCEDURE
+ || n->sym->result != n->sym))
{
gfc_error ("Object %qs is not a variable at %L",
n->sym->name, &oc->loc);
continue;
}
- if (n->sym->attr.flavor == FL_PARAMETER)
- {
- gfc_error ("PARAMETER object %qs is not allowed at %L",
- n->sym->name, &oc->loc);
- continue;
- }
if (n->expr && n->expr->ref->type == REF_ARRAY)
{
tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
- tree decl = gfc_get_symbol_decl (n->sym);
+ tree decl = gfc_trans_omp_variable (n->sym, false);
if (gfc_omp_privatize_by_reference (decl))
decl = build_fold_indirect_ref (decl);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
tree node2 = NULL_TREE;
tree node3 = NULL_TREE;
tree node4 = NULL_TREE;
- tree decl = gfc_get_symbol_decl (n->sym);
+ tree decl = gfc_trans_omp_variable (n->sym, false);
if (DECL_P (decl))
TREE_ADDRESSABLE (decl) = 1;
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
tree node = build_omp_clause (input_location, clause_code);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
- tree decl = gfc_get_symbol_decl (n->sym);
+ tree decl = gfc_trans_omp_variable (n->sym, false);
if (gfc_omp_privatize_by_reference (decl))
decl = build_fold_indirect_ref (decl);
else if (DECL_P (decl))
+2019-09-20 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/78260
+ * gfortran.dg/goacc/parameter.f95: Change
+ dg-error as it is now detected earlier.
+ * gfortran.dg/goacc/pr85701.f90: Modify to
+ use a separate result variable.
+ * gfortran.dg/goacc/pr78260.f90: New.
+ * gfortran.dg/goacc/pr78260-2.f90: New.
+ * gfortran.dg/gomp/pr78260.f90: New.
+ * gfortran.dg/gomp/pr78260-2.f90: New.
+ * gfortran.dg/gomp/pr78260-3.f90: New.
+
2019-09-20 Olivier Hainque <hainque@adacore.com>
* gnat.dg/system_info1.adb: Restrict to *-*-linux* and *-*-mingw*.
2019-09-20 Martin Jambor <mjambor@suse.cz>
- * g++.dg/ipa/pr81248.C: Adjust dg-options and dump-scan.
- * gcc.dg/ipa/ipa-sra-1.c: Likewise.
- * gcc.dg/ipa/ipa-sra-10.c: Likewise.
- * gcc.dg/ipa/ipa-sra-11.c: Likewise.
- * gcc.dg/ipa/ipa-sra-3.c: Likewise.
- * gcc.dg/ipa/ipa-sra-4.c: Likewise.
- * gcc.dg/ipa/ipa-sra-5.c: Likewise.
- * gcc.dg/ipa/ipacost-2.c: Disable ipa-sra.
- * gcc.dg/ipa/ipcp-agg-9.c: Likewise.
- * gcc.dg/ipa/pr78121.c: Adjust scan pattern.
- * gcc.dg/ipa/vrp1.c: Likewise.
- * gcc.dg/ipa/vrp2.c: Likewise.
- * gcc.dg/ipa/vrp3.c: Likewise.
- * gcc.dg/ipa/vrp7.c: Likewise.
- * gcc.dg/ipa/vrp8.c: Likewise.
- * gcc.dg/noreorder.c: use noipa attribute instead of noinline.
- * gcc.dg/ipa/20040703-wpa.c: New test.
+ * g++.dg/ipa/pr81248.C: Adjust dg-options and dump-scan.
+ * gcc.dg/ipa/ipa-sra-1.c: Likewise.
+ * gcc.dg/ipa/ipa-sra-10.c: Likewise.
+ * gcc.dg/ipa/ipa-sra-11.c: Likewise.
+ * gcc.dg/ipa/ipa-sra-3.c: Likewise.
+ * gcc.dg/ipa/ipa-sra-4.c: Likewise.
+ * gcc.dg/ipa/ipa-sra-5.c: Likewise.
+ * gcc.dg/ipa/ipacost-2.c: Disable ipa-sra.
+ * gcc.dg/ipa/ipcp-agg-9.c: Likewise.
+ * gcc.dg/ipa/pr78121.c: Adjust scan pattern.
+ * gcc.dg/ipa/vrp1.c: Likewise.
+ * gcc.dg/ipa/vrp2.c: Likewise.
+ * gcc.dg/ipa/vrp3.c: Likewise.
+ * gcc.dg/ipa/vrp7.c: Likewise.
+ * gcc.dg/ipa/vrp8.c: Likewise.
+ * gcc.dg/noreorder.c: use noipa attribute instead of noinline.
+ * gcc.dg/ipa/20040703-wpa.c: New test.
* gcc.dg/ipa/ipa-sra-12.c: New test.
* gcc.dg/ipa/ipa-sra-13.c: Likewise.
* gcc.dg/ipa/ipa-sra-14.c: Likewise.
implicit none
integer :: i
integer, parameter :: a = 1
- !$acc declare device_resident (a) ! { dg-error "PARAMETER" }
+ !$acc declare device_resident (a) ! { dg-error "is not a variable" }
!$acc data copy (a) ! { dg-error "not a variable" }
!$acc end data
!$acc data deviceptr (a) ! { dg-error "not a variable" }
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenacc -fdump-tree-original" }
+! { dg-require-effective-target fopenacc }
+
+! PR fortran/78260
+
+module m
+ implicit none
+ integer :: n = 0
+contains
+ integer function f1()
+ !$acc declare present(f1)
+ !$acc kernels copyin(f1)
+ f1 = 5
+ !$acc end kernels
+ end function f1
+end module m
+! { dg-final { scan-tree-dump-times "#pragma acc data map\\(force_present:__result_f1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma acc data map\\(force_present:__result_f1\\)" 1 "original" } }
+
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenacc" }
+! { dg-require-effective-target fopenacc }
+
+! PR fortran/78260
+! Contributed by Gerhard Steinmetz
+
+module m
+ implicit none
+ integer :: n = 0
+contains
+ subroutine s
+ !$acc declare present(m) ! { dg-error "Object .m. is not a variable" }
+ !$acc kernels copyin(m) ! { dg-error "Object .m. is not a variable" }
+ n = n + 1
+ !$acc end kernels
+ end subroutine s
+ subroutine s2
+ !$acc declare present(s2) ! { dg-error "Object .s2. is not a variable" }
+ !$acc kernels copyin(s2) ! { dg-error "Object .s2. is not a variable" }
+ n = n + 1
+ !$acc end kernels
+ end subroutine s2
+ integer function f1()
+ !$acc declare present(f1) ! OK, f1 is also the result variable
+ !$acc kernels copyin(f1) ! OK, f1 is also the result variable
+ f1 = 5
+ !$acc end kernels
+ end function f1
+ integer function f2() result(res)
+ !$acc declare present(f2) ! { dg-error "Object .f2. is not a variable" }
+ !$acc kernels copyin(f2) ! { dg-error "Object .f2. is not a variable" }
+ res = 5
+ !$acc end kernels
+ end function f2
+end module m
!$acc declare present(s2) ! { dg-error "is not a variable" }
end
-function f1 ()
+function f1 () result(res)
!$acc declare copy(f1) ! { dg-error "is not a variable" }
end
-function f2 ()
+function f2 () result(res)
!$acc declare present(f2) ! { dg-error "is not a variable" }
end
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-original" }
+
+! PR fortran/78260
+
+module m
+ implicit none
+ integer :: n = 0
+contains
+ integer function f1()
+ !$omp target data map(f1)
+ !$omp target update to(f1)
+ f1 = 5
+ !$omp end target data
+ end function f1
+
+ integer function f2()
+ dimension :: f2(1)
+ !$omp target data map(f2)
+ !$omp target update to(f2)
+ f2(1) = 5
+ !$omp end target data
+ end function f2
+
+ integer function f3() result(res)
+ dimension :: res(1)
+ !$omp target data map(res)
+ !$omp target update to(res)
+ res(1) = 5
+ !$omp end target data
+ end function f3
+
+ integer function f4() result(res)
+ allocatable :: res
+ dimension :: res(:)
+ !$omp target data map(res)
+ !$omp target update to(res)
+ res = [5]
+ !$omp end target data
+ end function f4
+
+ subroutine sub()
+ integer, allocatable :: arr(:)
+ !$omp target data map(arr)
+ !$omp target update to(arr)
+ arr = [5]
+ !$omp end target data
+ end subroutine sub
+end module m
+
+! { dg-final { scan-tree-dump-times "#pragma omp target data map\\(tofrom:\\*\\(c_char \\*\\) arr.data \\\[len: D.\[0-9\]+ \\* 4\\\]\\) map\\(to:arr \\\[pointer set, len: ..\\\]\\) map\\(alloc:\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) arr.data \\\[pointer assign, bias: 0\\\]\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target update to\\(\\*\\(c_char \\*\\) arr.data \\\[len: D.\[0-9\]+ \\* 4\\\]\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target data map\\(tofrom:\\*\\(c_char \\*\\) __result->data \\\[len: D.\[0-9\]+ \\* 4\\\]\\) map\\(to:\\*__result \\\[pointer set, len: ..\\\]\\) map\\(alloc:\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) __result->data \\\[pointer assign, bias: 0\\\]\\) map\\(alloc:__result \\\[pointer assign, bias: 0\\\]\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target update to\\(\\*\\(c_char \\*\\) __result->data \\\[len: D.\[0-9\]+ \\* 4\\\]\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target data map\\(tofrom:\\*__result.0\\) map\\(alloc:__result.0 \\\[pointer assign, bias: 0\\\]\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target update to\\(\\*__result.0\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target data map\\(tofrom:__result_f1\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target update to\\(__result_f1\\)" 1 "original" } }
+
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-original" }
+
+! PR fortran/78260
+
+integer function f1()
+ implicit none
+
+ f1 = 0
+
+ !$omp task depend(inout:f1)
+ !$omp end task
+
+ !$omp task depend(inout:f1)
+ !$omp end task
+end function f1
+
+integer function f2()
+ implicit none
+ dimension :: f2(1)
+
+ f2(1) = 0
+
+ !$omp task depend(inout:f2)
+ !$omp end task
+
+ !$omp task depend(inout:f2)
+ !$omp end task
+end function f2
+
+integer function f3() result(res)
+ implicit none
+ dimension :: res(1)
+
+ res(1) = 0
+
+ !$omp task depend(inout:res)
+ !$omp end task
+
+ !$omp task depend(inout:res)
+ !$omp end task
+end function f3
+
+integer function f4() result(res)
+ implicit none
+ allocatable :: res
+ dimension :: res(:)
+
+ res = [0]
+
+ !$omp task depend(inout:res)
+ !$omp end task
+
+ !$omp task depend(inout:res)
+ !$omp end task
+end function f4
+
+subroutine sub()
+ implicit none
+ integer, allocatable :: arr(:)
+
+ arr = [3]
+
+ !$omp task depend(inout:arr)
+ !$omp end task
+
+ !$omp task depend(inout:arr)
+ !$omp end task
+end subroutine sub
+
+! { dg-final { scan-tree-dump-times "#pragma omp task depend\\(inout:__result_f1\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp task depend\\(inout:\\*__result.0\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp task depend\\(inout:\\*\\(c_char \\*\\) __result->data\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp task depend\\(inout:\\*\\(c_char \\*\\) arr.data\\)" 2 "original" } }
--- /dev/null
+! { dg-do compile }
+
+! PR fortran/78260
+
+module m
+ implicit none
+ integer :: n = 0
+contains
+ subroutine s
+ !$omp target data map(m) ! { dg-error "Object .m. is not a variable" }
+ !$omp target update to(m) ! { dg-error "Object .m. is not a variable" }
+ n = n + 1
+ !$omp end target data
+ end subroutine s
+ subroutine s2
+ !$omp target data map(s2) ! { dg-error "Object .s2. is not a variable" }
+ !$omp target update to(s2) ! { dg-error "Object .s2. is not a variable" }
+ n = n + 1
+ !$omp end target data
+ end subroutine s2
+ integer function f1()
+ !$omp target data map(f1) ! OK, f1 is also the result variable
+ !$omp target update to(f1) ! OK, f1 is also the result variable
+ f1 = 5
+ !$omp end target data
+ end function f1
+ integer function f2() result(res)
+ !$omp target data map(f2) ! { dg-error "Object .f2. is not a variable" }
+ !$omp target update to(f2) ! { dg-error "Object .f2. is not a variable" }
+ res = 5
+ !$omp end target data
+ end function f2
+end module m