diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index dad51bf1a22..dbfaa7cd5dd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-06-10 Daniel Carrera + + * 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 * 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 a2259153563..6c6de133886 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 d2a0a5fc90d..183778f2d68 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 3ad4c213841..a80c3cd4afd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-06-10 Daniel Carrera + + * gfortran.dg/coarray/sync_1.f90: New test for + "SYNC ALL", "SYNC MEMORY" and "SYNC IMAGES". + 2011-06-10 Ira Rosen 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 00000000000..7c084e0bf46 --- /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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 5a22cd32bc7..bcd62f52c32 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,15 @@ +2011-06-10 Daniel Carrera + + * caf/mpi.c (_gfortran_caf_sync_all, + _gfortran_caf_sync_images): Functions have void return type + and move status into parameter list. + * caf/single.c (_gfortran_caf_sync_all, + _gfortran_caf_sync_images): Functions have void return type + and move status into parameter list. + * caf/libcaf.h (_gfortran_caf_sync_all, + _gfortran_caf_sync_images): Functions have void return type + and move status into parameter list. + 2011-06-03 Richard Henderson Rainer Orth @@ -7,15 +19,15 @@ 2011-05-29 Janne Blomqvist - PR libfortran/48931 - * libgfortran.h (find_addr2line): New prototype. - * runtime/backtrace.c (show_backtrace): Use async-signal-safe - execve and stored path of addr2line. - * runtime/compile_options.c (maybe_find_addr2line): New function. - (set_options): Call maybe_find_addr2line if backtracing is enabled. - * runtime/main.c (find_addr2line): New function. - (init): Call find_addr2line if backtracing is enabled. - (cleanup): Free addr2line_path. + PR libfortran/48931 + * libgfortran.h (find_addr2line): New prototype. + * runtime/backtrace.c (show_backtrace): Use async-signal-safe + execve and stored path of addr2line. + * runtime/compile_options.c (maybe_find_addr2line): New function. + (set_options): Call maybe_find_addr2line if backtracing is enabled. + * runtime/main.c (find_addr2line): New function. + (init): Call find_addr2line if backtracing is enabled. + (cleanup): Free addr2line_path. 2011-05-29 Janne Blomqvist diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h index 7b19f0d2dd0..9c20c4e9d78 100644 --- a/libgfortran/caf/libcaf.h +++ b/libgfortran/caf/libcaf.h @@ -54,8 +54,8 @@ void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void **); int _gfortran_caf_deregister (void **); -int _gfortran_caf_sync_all (char *, int); -int _gfortran_caf_sync_images (int, int[], char *, int); +void _gfortran_caf_sync_all (int *, char *, int); +void _gfortran_caf_sync_images (int, int[], int *, char *, int); /* FIXME: The CRITICAL functions should be removed; the functionality is better represented using Coarray's lock feature. */ diff --git a/libgfortran/caf/mpi.c b/libgfortran/caf/mpi.c index 9b7bb333c22..e64670ea8cb 100644 --- a/libgfortran/caf/mpi.c +++ b/libgfortran/caf/mpi.c @@ -92,41 +92,49 @@ _gfortran_caf_deregister (void **token __attribute__ ((unused))) } -/* SYNC ALL - the return value matches Fortran's STAT argument. */ - -int -_gfortran_caf_sync_all (char *errmsg, int errmsg_len) +void +_gfortran_caf_sync_all (int *stat, char *errmsg, int errmsg_len) { - int ierr; - ierr = MPI_Barrier (MPI_COMM_WORLD); + /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ + int ierr = MPI_Barrier (MPI_COMM_WORLD); - if (ierr && errmsg_len > 0) + if (stat) + *stat = ierr; + + if (ierr) { const char msg[] = "SYNC ALL failed"; - int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len - : (int) sizeof (msg); - memcpy (errmsg, msg, len); - if (errmsg_len > len) - memset (&errmsg[len], ' ', errmsg_len-len); + if (errmsg_len > 0) + { + int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len + : (int) sizeof (msg); + memcpy (errmsg, msg, len); + if (errmsg_len > len) + memset (&errmsg[len], ' ', errmsg_len-len); + } + else + { + fprintf (stderr, "SYNC ALL failed\n"); + error_stop (ierr); + } } - - /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ - return ierr; } /* SYNC IMAGES. Note: SYNC IMAGES(*) is passed as count == -1 while SYNC IMAGES([]) has count == 0. Note further that SYNC IMAGES(*) - is not equivalent to SYNC ALL. The return value matches Fortran's - STAT argument. */ -int -_gfortran_caf_sync_images (int count, int images[], char *errmsg, + is not equivalent to SYNC ALL. */ +void +_gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg, int errmsg_len) { int ierr; - if (count == 0 || (count == 1 && images[0] == caf_this_image)) - return 0; + { + if (stat) + *stat = 0; + return; + } #ifdef GFC_CAF_CHECK { @@ -151,20 +159,28 @@ _gfortran_caf_sync_images (int count, int images[], char *errmsg, } /* Handle SYNC IMAGES(*). */ + /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ ierr = MPI_Barrier (MPI_COMM_WORLD); + if (stat) + *stat = ierr; - if (ierr && errmsg_len > 0) + if (ierr) { const char msg[] = "SYNC IMAGES failed"; - int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len - : (int) sizeof (msg); - memcpy (errmsg, msg, len); - if (errmsg_len > len) - memset (&errmsg[len], ' ', errmsg_len-len); + if (errmsg_len > 0) + { + int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len + : (int) sizeof (msg); + memcpy (errmsg, msg, len); + if (errmsg_len > len) + memset (&errmsg[len], ' ', errmsg_len-len); + } + else + { + fprintf (stderr, "SYNC IMAGES failed\n"); + error_stop (ierr); + } } - - /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ - return ierr; } diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index c5c66b4b955..4c46e47d35c 100644 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -69,16 +69,19 @@ _gfortran_caf_deregister (void **token __attribute__ ((unused))) } -int -_gfortran_caf_sync_all (char *errmsg __attribute__ ((unused)), +void +_gfortran_caf_sync_all (int *stat, + char *errmsg __attribute__ ((unused)), int errmsg_len __attribute__ ((unused))) { - return 0; + if (stat) + *stat = 0; } -int +void _gfortran_caf_sync_images (int count __attribute__ ((unused)), int images[] __attribute__ ((unused)), + int *stat, char *errmsg __attribute__ ((unused)), int errmsg_len __attribute__ ((unused))) { @@ -94,7 +97,8 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)), } #endif - return 0; + if (stat) + *stat = 0; }