aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/trans-decl.c10
-rw-r--r--gcc/fortran/trans-stmt.c67
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/sync_1.f9064
5 files changed, 137 insertions, 17 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dad51bf..dbfaa7c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2011-06-10 Daniel Carrera <dcarrera@gmail.com>
+
+ * trans-decl.c (gfc_build_builtin_function_decls):
+ Updated declaration of caf_sync_all and caf_sync_images.
+ * trans-stmt.c (gfc_trans_sync): Function
+ can now handle a "stat" variable that has an integer type
+ different from integer_type_node.
+
2011-06-09 Richard Guenther <rguenther@suse.de>
* trans.c (gfc_allocate_array_with_status): Mark error path
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index a225915..6c6de13 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3059,13 +3059,13 @@ gfc_build_builtin_function_decls (void)
get_identifier (PREFIX("caf_end_critical")), void_type_node, 0);
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_all")), ".W", integer_type_node,
- 2, build_pointer_type (pchar_type_node), integer_type_node);
+ get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
+ 3, pint_type, build_pointer_type (pchar_type_node), integer_type_node);
gfor_fndecl_caf_sync_images = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_sync_images")), ".RRW", integer_type_node,
- 4, integer_type_node, pint_type, build_pointer_type (pchar_type_node),
- integer_type_node);
+ get_identifier (PREFIX("caf_sync_images")), ".RRWW", void_type_node,
+ 5, integer_type_node, pint_type, pint_type,
+ build_pointer_type (pchar_type_node), integer_type_node);
gfor_fndecl_caf_error_stop = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_error_stop")),
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index d2a0a5f..183778f 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -683,6 +683,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
gfc_conv_expr_val (&argse, code->expr2);
stat = argse.expr;
}
+ else
+ stat = null_pointer_node;
if (code->expr3 && gfc_option.coarray == GFC_FCOARRAY_LIB
&& type != EXEC_SYNC_MEMORY)
@@ -691,7 +693,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
gfc_init_se (&argse, NULL);
gfc_conv_expr (&argse, code->expr3);
gfc_conv_string_parameter (&argse);
- errmsg = argse.expr;
+ errmsg = gfc_build_addr_expr (NULL, argse.expr);
errmsglen = argse.string_length;
}
else if (gfc_option.coarray == GFC_FCOARRAY_LIB && type != EXEC_SYNC_MEMORY)
@@ -743,12 +745,32 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
}
else if (type == EXEC_SYNC_ALL)
{
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
- 2, errmsg, errmsglen);
- if (code->expr2)
- gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp));
+ /* SYNC ALL => stat == null_pointer_node
+ SYNC ALL(stat=s) => stat has an integer type
+
+ If "stat" has the wrong integer type, use a temp variable of
+ the right type and later cast the result back into "stat". */
+ if (stat == null_pointer_node || TREE_TYPE (stat) == integer_type_node)
+ {
+ if (TREE_TYPE (stat) == integer_type_node)
+ stat = gfc_build_addr_expr (NULL, stat);
+
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
+ 3, stat, errmsg, errmsglen);
+ gfc_add_expr_to_block (&se.pre, tmp);
+ }
else
- gfc_add_expr_to_block (&se.pre, tmp);
+ {
+ tree tmp_stat = gfc_create_var (integer_type_node, "stat");
+
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
+ 3, gfc_build_addr_expr (NULL, tmp_stat),
+ errmsg, errmsglen);
+ gfc_add_expr_to_block (&se.pre, tmp);
+
+ gfc_add_modify (&se.pre, stat,
+ fold_convert (TREE_TYPE (stat), tmp_stat));
+ }
}
else
{
@@ -790,13 +812,34 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
len = fold_convert (integer_type_node, len);
}
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images, 4,
- fold_convert (integer_type_node, len), images,
- errmsg, errmsglen);
- if (code->expr2)
- gfc_add_modify (&se.pre, stat, fold_convert (TREE_TYPE (stat), tmp));
+ /* SYNC IMAGES(imgs) => stat == null_pointer_node
+ SYNC IMAGES(imgs,stat=s) => stat has an integer type
+
+ If "stat" has the wrong integer type, use a temp variable of
+ the right type and later cast the result back into "stat". */
+ if (stat == null_pointer_node || TREE_TYPE (stat) == integer_type_node)
+ {
+ if (TREE_TYPE (stat) == integer_type_node)
+ stat = gfc_build_addr_expr (NULL, stat);
+
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images,
+ 5, fold_convert (integer_type_node, len),
+ images, stat, errmsg, errmsglen);
+ gfc_add_expr_to_block (&se.pre, tmp);
+ }
else
- gfc_add_expr_to_block (&se.pre, tmp);
+ {
+ tree tmp_stat = gfc_create_var (integer_type_node, "stat");
+
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_images,
+ 5, fold_convert (integer_type_node, len),
+ images, gfc_build_addr_expr (NULL, tmp_stat),
+ errmsg, errmsglen);
+ gfc_add_expr_to_block (&se.pre, tmp);
+
+ gfc_add_modify (&se.pre, stat,
+ fold_convert (TREE_TYPE (stat), tmp_stat));
+ }
}
return gfc_finish_block (&se.pre);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3ad4c21..a80c3cd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-06-10 Daniel Carrera <dcarrera@gmail.com>
+
+ * gfortran.dg/coarray/sync_1.f90: New test for
+ "SYNC ALL", "SYNC MEMORY" and "SYNC IMAGES".
+
2011-06-10 Ira Rosen <ira.rosen@linaro.org>
PR tree-optimization/49318
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_1.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
new file mode 100644
index 0000000..7c084e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+!
+! Coarray support
+! PR fortran/18918
+
+implicit none
+integer :: n
+character(len=30) :: str
+critical
+end critical
+myCr: critical
+end critical myCr
+
+!
+! Test SYNC ALL
+!
+sync all
+sync all ( )
+sync all (errmsg=str)
+
+n = 5
+sync all (stat=n)
+if (n /= 0) call abort()
+
+n = 5
+sync all (stat=n,errmsg=str)
+if (n /= 0) call abort()
+
+
+!
+! Test SYNC MEMORY
+!
+sync memory
+sync memory ( )
+sync memory (errmsg=str)
+
+n = 5
+sync memory (stat=n)
+if (n /= 0) call abort()
+
+n = 5
+sync memory (errmsg=str,stat=n)
+if (n /= 0) call abort()
+
+
+!
+! Test SYNC IMAGES
+!
+sync images (*)
+if (this_image() == 1) then
+ sync images (1)
+ sync images (1, errmsg=str)
+ sync images ([1])
+end if
+
+n = 5
+sync images (*, stat=n)
+if (n /= 0) call abort()
+
+n = 5
+sync images (*,errmsg=str,stat=n)
+if (n /= 0) call abort()
+
+end
generated by cgit v1.1 at 2024-07-21 16:15:41 +0000