* 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 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_lib_token_3.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177198
138bc75d-0d04-0410-961f-
82ee72b054a4
+2011-08-02 Tobias Burnus <burnus@net-b.de>
+
+ * 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 <jakub@redhat.com>
PR fortran/46752
tree tmp;
tree pointer;
tree offset = NULL_TREE;
+ tree token = NULL_TREE;
tree size;
tree msg;
tree error = NULL_TREE;
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);
/* 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);
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))
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,
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;
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);
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*);
+2011-08-02 Tobias Burnus <burnus@net-b.de>
+
+ * gfortran.dg/coarray_lib_token_3.f90: New.
+
2011-08-02 Jakub Jelinek <jakub@redhat.com>
PR fortran/46752
--- /dev/null
+! { 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" } }