trans-array.c (gfc_array_allocate): Pass token to gfc_allocate_allocatable for -fcoar...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 123990f66b00893e6cfb13c514032b0601b6618b..bba8d0fb7705d35acbe65b94d5b4ec32d38876c0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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>
 
        PR fortran/46752

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index dc8fdb8dff196c5c79f31fcfbae1c43ede22fd4e..a151c560bc1c78493fba587f7fd1c0723b53c056 100644 (file)
--- 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 defa44565389984ef16905139c9f7909643c3bd0..a911a5b070e07f02c3d10988ac93096903e03012 100644 (file)
--- 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 19f215cd54db8e9c923b84f25ad5fc25cda2e33c..4c97cfdc6223b2076b8b7c247e68106e782bb318 100644 (file)
--- 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 a53360feb7d4e1c21de9d576734057d266d3d41c..bb94780ab646fc201a30389ffc071e194e3a44c1 100644 (file)
--- 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 fc949f94257436ed7dd831a4635eb30f321ebda6..f1c96a0e5f89abfb0d7ace24eca70dc6e9fd9ec4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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>
 
        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 (file)
index 0000000..2725549
--- /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" } }