re PR fortran/27916 (Problem with allocatable arrays inside OpenMP do loop)

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.

From-SVN: r114520
This commit is contained in:
Jakub Jelinek 2006-06-09 23:18:42 +02:00 committed by Jakub Jelinek
parent 1c90c6f9c0
commit cd75853e1d
7 changed files with 91 additions and 0 deletions

View File

@ -1,3 +1,10 @@
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.
2006-06-08 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/27958

View File

@ -120,6 +120,7 @@ static HOST_WIDE_INT gfc_get_alias_set (tree);
#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 (tree);
#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 \

View File

@ -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 ATTRIBUTE_UNUSED, 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

View File

@ -451,6 +451,7 @@ tree builtin_function (const char *, tree, int, enum built_in_class,
/* 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;

View File

@ -1,3 +1,9 @@
2006-06-09 Jakub Jelinek <jakub@redhat.com>
PR fortran/27916
* testsuite/libgomp.fortran/pr27916-1.f90: New test.
* testsuite/libgomp.fortran/pr27916-2.f90: New test.
2006-06-06 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* config/mingw32/time.c: New file.

View File

@ -0,0 +1,26 @@
! PR fortran/27916
! Test whether allocatable privatized arrays has "not currently allocated"
! status at the start of OpenMP constructs.
! { 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

View File

@ -0,0 +1,26 @@
! PR fortran/27916
! Test whether allocatable privatized arrays has "not currently allocated"
! status at the start of OpenMP constructs.
! { 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