Fortran: fix checks for STAT= and ERRMSG= arguments of SYNC ALL/SYNC IMAGES

gcc/fortran/ChangeLog:

	PR fortran/99351
	* match.c (sync_statement): Replace %v code by %e in gfc_match to
	allow for function references as STAT and ERRMSG arguments.
	* resolve.c (resolve_sync): Adjust checks of STAT= and ERRMSG= to
	being definable arguments.  Function references with a data
	pointer result are accepted.
	* trans-stmt.c (gfc_trans_sync): Adjust assertion.

gcc/testsuite/ChangeLog:

	PR fortran/99351
	* gfortran.dg/coarray_sync.f90: New test.
	* gfortran.dg/coarray_3.f90: Adjust error messages.

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index b11054810991c7b72de65cf48157d35c43f89823..16502da001d318804bff00fea5237c5d2719f118 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3855,7 +3855,7 @@ sync_statement (gfc_statement st)
 
   for (;;)
     {
-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
        goto syntax;
       if (m == MATCH_YES)
@@ -3875,7 +3875,7 @@ sync_statement (gfc_statement st)
          break;
        }
 
-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
        goto syntax;
       if (m == MATCH_YES)

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 592364689f9771efb42cb429f99530752f649643..959f0bed4fbe4ac9b34b6cc006e4b8e0ed858dff 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10236,19 +10236,27 @@ resolve_sync (gfc_code *code)
 
   /* Check STAT.  */
   gfc_resolve_expr (code->expr2);
-  if (code->expr2
-      && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0
-         || code->expr2->expr_type != EXPR_VARIABLE))
-    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
-              &code->expr2->where);
+  if (code->expr2)
+    {
+      if (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0)
+       gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+                  &code->expr2->where);
+      else
+       gfc_check_vardef_context (code->expr2, false, false, false,
+                                 _("STAT variable"));
+    }
 
   /* Check ERRMSG.  */
   gfc_resolve_expr (code->expr3);
-  if (code->expr3
-      && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0
-         || code->expr3->expr_type != EXPR_VARIABLE))
-    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
-              &code->expr3->where);
+  if (code->expr3)
+    {
+      if (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0)
+       gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+                  &code->expr3->where);
+      else
+       gfc_check_vardef_context (code->expr3, false, false, false,
+                                 _("ERRMSG variable"));
+    }
 }
 
 

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 7cbdef7a30453ce8f1d81ea9267ae99d74677a78..11df1863badfa7a22846b5992426aa583bdb1a98 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1226,7 +1226,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
 
   if (code->expr2)
     {
-      gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
+      gcc_assert (code->expr2->expr_type == EXPR_VARIABLE
+                 || code->expr2->expr_type == EXPR_FUNCTION);
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_val (&argse, code->expr2);
       stat = argse.expr;
@@ -1236,7 +1237,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
 
   if (code->expr3 && flag_coarray == GFC_FCOARRAY_LIB)
     {
-      gcc_assert (code->expr3->expr_type == EXPR_VARIABLE);
+      gcc_assert (code->expr3->expr_type == EXPR_VARIABLE
+                 || code->expr3->expr_type == EXPR_FUNCTION);
       gfc_init_se (&argse, NULL);
       argse.want_pointer = 1;
       gfc_conv_expr (&argse, code->expr3);

diff --git a/gcc/testsuite/gfortran.dg/coarray_3.f90 b/gcc/testsuite/gfortran.dg/coarray_3.f90
index d152ce1b2bdcb023aa28e8b94eb78e831fc0f402..1c294cd01891663e9fea9bed1234cbfc506cea95 100644 (file)
--- a/gcc/testsuite/gfortran.dg/coarray_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_3.f90
@@ -11,11 +11,11 @@ character(len=30) :: str(2)
 critical fkl ! { dg-error "Syntax error in CRITICAL" }
 end critical fkl ! { dg-error "Expecting END PROGRAM" }
 
-sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
+sync all (stat=1) ! { dg-error "Non-variable expression" }
 sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
 sync memory (errmsg=str) ! { dg-error "must be a scalar CHARACTER variable" }
 sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" }
-sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
+sync images (*, stat=1.0) ! { dg-error "must be a scalar INTEGER variable" }
 sync images (-1) ! { dg-error "must between 1 and num_images" }
 sync images (1)
 sync images ( [ 1 ])

diff --git a/gcc/testsuite/gfortran.dg/coarray_sync.f90 b/gcc/testsuite/gfortran.dg/coarray_sync.f90
new file mode 100644 (file)
index 0000000..f3d6be1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_sync.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+! PR fortran/99351 - ICE in gfc_finish_var_decl, at fortran/trans-decl.c:695
+
+module m
+  character(3), parameter   :: c = 'abc'
+  integer,      parameter   :: s = 42
+  integer,      target      :: i
+  character(:), allocatable :: a
+  target :: a
+contains
+  subroutine s1
+    allocate (character(42) :: a)
+    sync all (stat=i)
+    sync all (stat=f())
+    sync all (errmsg=a)
+    sync all (errmsg=p())
+    sync all (stat=a%len) ! { dg-error "variable definition context" }
+    sync all (stat=s)     ! { dg-error "variable definition context" }
+    sync all (errmsg=c)   ! { dg-error "variable definition context" }
+  end
+  subroutine s2
+    sync images (*, stat=i)
+    sync images (*, errmsg=a)
+    sync images (*, stat=a%len) ! { dg-error "variable definition context" }
+    sync images (*, stat=s)     ! { dg-error "variable definition context" }
+    sync images (*, errmsg=c)   ! { dg-error "variable definition context" }
+  end
+  subroutine s3
+    sync memory (stat=i,errmsg=p())
+    sync memory (stat=f(),errmsg=a)
+    sync memory (stat=a%len) ! { dg-error "variable definition context" }
+    sync memory (stat=s)     ! { dg-error "variable definition context" }
+    sync memory (errmsg=c)   ! { dg-error "variable definition context" }
+  end
+  integer function f()
+    pointer :: f
+    f => i
+  end function f
+  function p()
+    character(:), pointer :: p
+    p => a
+  end function p
+end