diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 123990f66b0..bba8d0fb770 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2011-08-02 Tobias Burnus + + * trans-array.c (gfc_array_allocate): Pass token to + gfc_allocate_allocatable for -fcoarray=lib. + * trans-stmt.c (gfc_trans_allocate): Update + gfc_allocate_allocatable call. + * trans.h (gfc_allocate_allocatable): Update prototype. + (gfc_allocate_using_lib): Remove. + * trans.c (gfc_allocate_using_lib): Make static, handle token. + (gfc_allocate_allocatable): Ditto. + 2011-08-02 Jakub Jelinek PR fortran/46752 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index dc8fdb8dff1..a151c560bc1 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -4409,6 +4409,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, tree tmp; tree pointer; tree offset = NULL_TREE; + tree token = NULL_TREE; tree size; tree msg; tree error = NULL_TREE; @@ -4521,9 +4522,13 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, pointer = gfc_conv_descriptor_data_get (se->expr); STRIP_NOPS (pointer); + if (coarray && gfc_option.coarray == GFC_FCOARRAY_LIB) + token = gfc_build_addr_expr (NULL_TREE, + gfc_conv_descriptor_token (se->expr)); + /* The allocatable variant takes the old pointer as first argument. */ if (allocatable) - gfc_allocate_allocatable (&elseblock, pointer, size, + gfc_allocate_allocatable (&elseblock, pointer, size, token, status, errmsg, errlen, expr); else gfc_allocate_using_malloc (&elseblock, pointer, size, status); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index defa4456538..a911a5b070e 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4867,7 +4867,7 @@ gfc_trans_allocate (gfc_code * code) /* Allocate - for non-pointers with re-alloc checking. */ if (gfc_expr_attr (expr).allocatable) - gfc_allocate_allocatable (&se.pre, se.expr, memsz, + gfc_allocate_allocatable (&se.pre, se.expr, memsz, NULL_TREE, stat, errmsg, errlen, expr); else gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 19f215cd54d..4c97cfdc622 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -635,19 +635,21 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, This function follows the following pseudo-code: void * - allocate (size_t size, integer_type stat) + allocate (size_t size, void** token, int *stat, char* errmsg, int errlen) { void *newmem; - - newmem = _caf_register ( size, regtype, NULL, &stat, NULL, NULL); + + newmem = _caf_register (size, regtype, token, &stat, errmsg, errlen); return newmem; } */ -void +static void gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, - tree status, tree errmsg, tree errlen) + tree token, tree status, tree errmsg, tree errlen) { tree tmp, pstat; + gcc_assert (token != NULL_TREE); + /* Evaluate size only once, and make sure it has the right type. */ size = gfc_evaluate_now (size, block); if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) @@ -673,8 +675,7 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, build_int_cst (size_type_node, 1)), build_int_cst (integer_type_node, GFC_CAF_COARRAY_ALLOC), - null_pointer_node, /* token */ - pstat, errmsg, errlen); + token, pstat, errmsg, errlen); tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (pointer), pointer, @@ -706,8 +707,8 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, expr must be set to the original expression being allocated for its locus and variable name in case a runtime error has to be printed. */ void -gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status, - tree errmsg, tree errlen, gfc_expr* expr) +gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, + tree status, tree errmsg, tree errlen, gfc_expr* expr) { stmtblock_t alloc_block; tree tmp, null_mem, alloc, error; @@ -726,7 +727,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status, if (gfc_option.coarray == GFC_FCOARRAY_LIB && gfc_expr_attr (expr).codimension) - gfc_allocate_using_lib (&alloc_block, mem, size, status, + gfc_allocate_using_lib (&alloc_block, mem, size, token, status, errmsg, errlen); else gfc_allocate_using_malloc (&alloc_block, mem, size, status); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index a53360feb7d..bb94780ab64 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -542,12 +542,11 @@ tree gfc_call_malloc (stmtblock_t *, tree, tree); tree gfc_build_memcpy_call (tree, tree, tree); /* Allocate memory for allocatable variables, with optional status variable. */ -void gfc_allocate_allocatable (stmtblock_t*, tree, tree, +void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree, tree, tree, gfc_expr*); /* Allocate memory, with optional status variable. */ void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree); -void gfc_allocate_using_lib (stmtblock_t *, tree, tree, tree, tree, tree); /* Generate code to deallocate an array. */ tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fc949f94257..f1c96a0e5f8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2011-08-02 Tobias Burnus + + * gfortran.dg/coarray_lib_token_3.f90: New. + 2011-08-02 Jakub Jelinek PR fortran/46752 diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 new file mode 100644 index 00000000000..2725549a3ed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Test coarray registering +! +integer, allocatable :: CAF(:)[:], caf_scalar[:] +allocate(CAF(1)[*]) +allocate(CAF_SCALAR[*]) +end + +! { dg-final { scan-tree-dump-times "caf.data = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf.token, 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "caf_scalar.data = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf_scalar.token, 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } }