OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

trans-array.c (gfc_array_allocate): Pass token to gfc_allocate_allocatable for -fcoarray=lib. 

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  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray_lib_token_3.f90: New.

From-SVN: r177198
This commit is contained in:
Tobias Burnus 2011-08-02 20:07:52 +02:00 committed by Tobias Burnus
parent b7cef5958d
commit 979d459888
7 changed files with 47 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
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> 2011-08-02 Jakub Jelinek <jakub@redhat.com>
PR fortran/46752 PR fortran/46752

7
gcc/fortran/trans-array.c
View File

@ -4409,6 +4409,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
tree tmp; tree tmp;
tree pointer; tree pointer;
tree offset = NULL_TREE; tree offset = NULL_TREE;
tree token = NULL_TREE;
tree size; tree size;
tree msg; tree msg;
tree error = NULL_TREE; 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); pointer = gfc_conv_descriptor_data_get (se->expr);
STRIP_NOPS (pointer); 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. */ /* The allocatable variant takes the old pointer as first argument. */
if (allocatable) if (allocatable)
gfc_allocate_allocatable (&elseblock, pointer, size, gfc_allocate_allocatable (&elseblock, pointer, size, token,
status, errmsg, errlen, expr); status, errmsg, errlen, expr);
else else
gfc_allocate_using_malloc (&elseblock, pointer, size, status); gfc_allocate_using_malloc (&elseblock, pointer, size, status);

2
gcc/fortran/trans-stmt.c
View File

@ -4867,7 +4867,7 @@ gfc_trans_allocate (gfc_code * code)
/* Allocate - for non-pointers with re-alloc checking. */ /* Allocate - for non-pointers with re-alloc checking. */
if (gfc_expr_attr (expr).allocatable) 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); stat, errmsg, errlen, expr);
else else
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat); gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);

21
gcc/fortran/trans.c
View File

@ -635,19 +635,21 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
This function follows the following pseudo-code: This function follows the following pseudo-code:
void * void *
allocate (size_t size, integer_type stat) allocate (size_t size, void** token, int *stat, char* errmsg, int errlen)
{ {
void *newmem; void *newmem;
newmem = _caf_register ( size, regtype, NULL, &stat, NULL, NULL); newmem = _caf_register (size, regtype, token, &stat, errmsg, errlen);
return newmem; return newmem;
} */ } */
void static void
gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, 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; tree tmp, pstat;
gcc_assert (token != NULL_TREE);
/* Evaluate size only once, and make sure it has the right type. */ /* Evaluate size only once, and make sure it has the right type. */
size = gfc_evaluate_now (size, block); size = gfc_evaluate_now (size, block);
if (TREE_TYPE (size) != TREE_TYPE (size_type_node)) 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 (size_type_node, 1)),
build_int_cst (integer_type_node, build_int_cst (integer_type_node,
GFC_CAF_COARRAY_ALLOC), GFC_CAF_COARRAY_ALLOC),
null_pointer_node, /* token */ token, pstat, errmsg, errlen);
pstat, errmsg, errlen);
tmp = fold_build2_loc (input_location, MODIFY_EXPR, tmp = fold_build2_loc (input_location, MODIFY_EXPR,
TREE_TYPE (pointer), pointer, 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 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. */ and variable name in case a runtime error has to be printed. */
void void
gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree status, gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token,
tree errmsg, tree errlen, gfc_expr* expr) tree status, tree errmsg, tree errlen, gfc_expr* expr)
{ {
stmtblock_t alloc_block; stmtblock_t alloc_block;
tree tmp, null_mem, alloc, error; 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 if (gfc_option.coarray == GFC_FCOARRAY_LIB
&& gfc_expr_attr (expr).codimension) && 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); errmsg, errlen);
else else
gfc_allocate_using_malloc (&alloc_block, mem, size, status); gfc_allocate_using_malloc (&alloc_block, mem, size, status);

3
gcc/fortran/trans.h
View File

@ -542,12 +542,11 @@ tree gfc_call_malloc (stmtblock_t *, tree, tree);
tree gfc_build_memcpy_call (tree, tree, tree); tree gfc_build_memcpy_call (tree, tree, tree);
/* Allocate memory for allocatable variables, with optional status variable. */ /* 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*); tree, tree, tree, gfc_expr*);
/* Allocate memory, with optional status variable. */ /* Allocate memory, with optional status variable. */
void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree); 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. */ /* Generate code to deallocate an array. */
tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*); tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*);

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
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> 2011-08-02 Jakub Jelinek <jakub@redhat.com>
PR fortran/46752 PR fortran/46752

13
gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 Normal file
View File

@ -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" } }