This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gomp] Fix privatized allocatable arrays (PR fortran/27916)


Hi!

OpenMP allows Fortran allocatable arrays in PRIVATE clauses (see 2.8.3.3,
unlike e.g. FIRSTPRIVATE/LASTPRIVATE/REDUCTION clauses), as long as
the variable is "not currently allocated" before entering the construct.
There is no explicit wording that the privatized variable is
"not currently allocated" at the beginning of the construct, but there
is no wording that the allocation status is undefined either and really
only "not currently allocated" allocation status makes sense.
The following patch uses the default ctor hook to initialize the privatized
allocatable arrays to "not currently allocated".

Ok for trunk?

2006-06-09  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/27916
	* trans-openmp.c (gfc_omp_clause_default_ctor): New function.
	* trans.h (gfc_omp_clause_default_ctor): New prototype.
	* f95-lang.c (LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR): Define.

	* testsuite/libgomp.fortran/pr27916-1.f90: New test.
	* testsuite/libgomp.fortran/pr27916-2.f90: New test.

--- gcc/gcc/fortran/trans-openmp.c.jj	2006-05-17 13:10:30.000000000 +0200
+++ gcc/gcc/fortran/trans-openmp.c	2006-06-09 00:13:58.000000000 +0200
@@ -94,6 +94,29 @@ gfc_omp_predetermined_sharing (tree decl
   return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
 }
 
+
+/* Return code to initialize DECL with its default constructor, or
+   NULL if there's nothing to do.  */
+
+tree
+gfc_omp_clause_default_ctor (tree clause, tree decl)
+{
+  tree type = TREE_TYPE (decl);
+  stmtblock_t block;
+
+  if (! GFC_DESCRIPTOR_TYPE_P (type))
+    return NULL;
+
+  /* Allocatable arrays in PRIVATE clauses need to be set to
+     "not currently allocated" allocation status.  */
+  gfc_init_block (&block);
+
+  gfc_conv_descriptor_data_set (&block, decl, null_pointer_node);
+
+  return gfc_finish_block (&block);
+}
+
+
 /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
    disregarded in OpenMP construct, because it is going to be
    remapped during OpenMP lowering.  SHARED is true if DECL
--- gcc/gcc/fortran/trans.h.jj	2006-06-07 13:28:47.000000000 +0200
+++ gcc/gcc/fortran/trans.h	2006-06-09 00:14:57.000000000 +0200
@@ -451,6 +451,7 @@ tree builtin_function (const char *, tre
 /* In trans-openmp.c */
 bool gfc_omp_privatize_by_reference (tree);
 enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
+tree gfc_omp_clause_default_ctor (tree, tree);
 bool gfc_omp_disregard_value_expr (tree, bool);
 bool gfc_omp_private_debug_clause (tree, bool);
 struct gimplify_omp_ctx;
--- gcc/gcc/fortran/f95-lang.c.jj	2006-03-27 14:26:17.000000000 +0200
+++ gcc/gcc/fortran/f95-lang.c	2006-06-09 00:15:52.000000000 +0200
@@ -120,6 +120,7 @@ static HOST_WIDE_INT gfc_get_alias_set (
 #undef LANG_HOOKS_GET_ALIAS_SET
 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
+#undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
 #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
@@ -144,6 +145,7 @@ static HOST_WIDE_INT gfc_get_alias_set (
 #define LANG_HOOKS_GET_ALIAS_SET	   gfc_get_alias_set
 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE	gfc_omp_privatize_by_reference
 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING	gfc_omp_predetermined_sharing
+#define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR	gfc_omp_clause_default_ctor
 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR	gfc_omp_disregard_value_expr
 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE	gfc_omp_private_debug_clause
 #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
--- gcc/libgomp/testsuite/libgomp.fortran/pr27916-1.f90.jj	2006-06-09 11:06:25.000000000 +0200
+++ gcc/libgomp/testsuite/libgomp.fortran/pr27916-1.f90	2006-06-09 11:06:58.000000000 +0200
@@ -0,0 +1,24 @@
+! PR fortran/27916
+! { dg-do run }
+
+program pr27916
+  integer :: n, i
+  logical :: r
+  integer, dimension(:), allocatable :: a
+
+  r = .false.
+!$omp parallel do num_threads (4) private (n, a, i) &
+!$omp & reduction (.or.: r) schedule (static)
+  do n = 1, 16
+    r = r .or. allocated (a)
+    allocate (a (16))
+    r = r .or. .not. allocated (a)
+    do i = 1, 16
+      a (i) = i
+    end do
+    deallocate (a)
+    r = r .or. allocated (a)
+  end do
+ !$omp end parallel do
+  if (r) call abort
+end program pr27916
--- gcc/libgomp/testsuite/libgomp.fortran/pr27916-2.f90.jj	2006-06-09 11:06:25.000000000 +0200
+++ gcc/libgomp/testsuite/libgomp.fortran/pr27916-2.f90	2006-06-09 11:06:58.000000000 +0200
@@ -0,0 +1,24 @@
+! PR fortran/27916
+! { dg-do run }
+
+program pr27916
+  integer :: n, i
+  logical :: r
+  integer, dimension(:), allocatable :: a
+
+  r = .false.
+!$omp parallel do num_threads (4) default (private) &
+!$omp & reduction (.or.: r) schedule (static)
+  do n = 1, 16
+    r = r .or. allocated (a)
+    allocate (a (16))
+    r = r .or. .not. allocated (a)
+    do i = 1, 16
+      a (i) = i
+    end do
+    deallocate (a)
+    r = r .or. allocated (a)
+  end do
+ !$omp end parallel do
+  if (r) call abort
+end program pr27916

	Jakub


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]