OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Harald Anlauf 2021-08-15 20:13:11 +02:00
parent 34ce7f7a9a
commit bbf19f9c20
5 changed files with 70 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
gcc/fortran/match.c
View File

@ -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)

28
gcc/fortran/resolve.c
View File

@ -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"));
}
}

6
gcc/fortran/trans-stmt.c
View File

@ -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);

4
gcc/testsuite/gfortran.dg/coarray_3.f90
View File

@ -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 ])

44
gcc/testsuite/gfortran.dg/coarray_sync.f90 Normal file
View File

@ -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