OSDN Git Service

gcc/fortran/
authorburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 10 Jun 2011 10:22:24 +0000 (10:22 +0000)
committerburnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 10 Jun 2011 10:22:24 +0000 (10:22 +0000)
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.

libgfortran/
2011-06-10  Daniel Carrera  <dcarrera@gmail.com>

        * 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.

gcc/testsuite/
2011-06-10  Daniel Carrera  <dcarrera@gmail.com>

        * gfortran.dg/coarray/sync_1.f90: New test for
        "SYNC ALL", "SYNC MEMORY" and "SYNC IMAGES".

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@174896 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-decl.c
gcc/fortran/trans-stmt.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/coarray/sync_1.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/caf/libcaf.h
libgfortran/caf/mpi.c
libgfortran/caf/single.c

index dad51bf..dbfaa7c 100644 (file)
@@ -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
index a225915..6c6de13 100644 (file)
@@ -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")),
index d2a0a5f..183778f 100644 (file)
@@ -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);
index 3ad4c21..a80c3cd 100644 (file)
@@ -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 (file)
index 0000000..7c084e0
--- /dev/null
@@ -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
index 5a22cd3..bcd62f5 100644 (file)
@@ -1,3 +1,15 @@
+2011-06-10  Daniel Carrera  <dcarrera@gmail.com>
+
+       * 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  <rth@redhat.com>
            Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 
 2011-05-29  Janne Blomqvist  <jb@gcc.gnu.org>
 
-        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  <jb@gcc.gnu.org>
 
index 7b19f0d..9c20c4e 100644 (file)
@@ -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.  */
index 9b7bb33..e64670e 100644 (file)
@@ -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 (stat)
+    *stat = ierr;
 
-  if (ierr && errmsg_len > 0)
+  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;
 }
 
 
index c5c66b4..4c46e47 100644 (file)
@@ -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;
 }