The following patch fixes 91960, 93635, 95501, 95502, 95710, 96013,
96025, 97122, 99256, 99349, 99351, and 99506. Most of the individual
patches are languishing in bugzilla. One or two needed to reformatted
due to divergences in main and my local repository. Please commit.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4e1b2..63138cfa9bc 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1009,6 +1009,14 @@ kind_value_check (gfc_expr *e, int n, int k)
static bool
variable_check (gfc_expr *e, int n, bool allow_proc)
{
+ /* Expecting a variable, not an alternate return. */
+ if (!e)
+ {
+ gfc_error ("%qs argument of %qs intrinsic must be a variable",
+ gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic);
+ return false;
+ }
+
if (e->expr_type == EXPR_VARIABLE
&& e->symtree->n.sym->attr.intent == INTENT_IN
&& (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 947e4f868a1..9039c9dca2a 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -410,9 +410,7 @@ match_data_constant (gfc_expr **result)
/* If a parameter inquiry ends up here, symtree is NULL but **result
contains the right constant expression. Check here. */
if ((*result)->symtree == NULL
- && (*result)->expr_type == EXPR_CONSTANT
- && ((*result)->ts.type == BT_INTEGER
- || (*result)->ts.type == BT_REAL))
+ && (*result)->expr_type == EXPR_CONSTANT)
return m;
/* F2018:R845 data-stmt-constant is initial-data-target.
@@ -1772,12 +1770,6 @@ gfc_set_constant_character_len (gfc_charlen_t len,
gfc_expr *expr,
if (expr->ts.type != BT_CHARACTER)
return;
- if (expr->expr_type != EXPR_CONSTANT)
- {
- gfc_error_now ("CHARACTER length must be a constant at %L",
&expr->where);
- return;
- }
-
slen = expr->value.character.length;
if (len != slen)
{
@@ -11495,8 +11487,9 @@ gfc_match_final_decl (void)
block = gfc_state_stack->previous->sym;
gcc_assert (block);
- if (!gfc_state_stack->previous || !gfc_state_stack->previous->previous
- || gfc_state_stack->previous->previous->state != COMP_MODULE)
+ if (!gfc_state_stack->previous->previous
+ && gfc_state_stack->previous->previous->state != COMP_MODULE
+ && gfc_state_stack->previous->previous->state != COMP_SUBMODULE)
{
gfc_error ("Derived type declaration with FINAL at %C must be in the"
" specification part of a MODULE");
@@ -11505,7 +11498,6 @@ gfc_match_final_decl (void)
module_ns = gfc_current_ns;
gcc_assert (module_ns);
- gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE);
/* Match optional ::, don't care about MATCH_YES or MATCH_NO. */
if (gfc_match (" ::") == MATCH_ERROR)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 92a6700568d..e1acc2db000 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3476,6 +3476,7 @@ gfc_specification_expr (gfc_expr *e)
{
gfc_error ("Expression at %L must be of INTEGER type, found %s",
&e->where, gfc_basic_typename (e->ts.type));
+ gfc_clear_ts (&e->ts);
return false;
}
@@ -3815,6 +3816,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
int proc_pointer;
bool same_rank;
+ if (!lvalue->symtree)
+ return false;
+
lhs_attr = gfc_expr_attr (lvalue);
if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
{
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 4d5890fd523..86aabf4a840 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
gfc_matching_procptr_assignment = 0;
m = gfc_match (" %v =>", &lvalue);
- if (m != MATCH_YES)
+ if (m != MATCH_YES || !lvalue->symtree)
{
m = MATCH_NO;
goto cleanup;
@@ -3867,6 +3867,15 @@ sync_statement (gfc_statement st)
stat = tmp;
saw_stat = true;
+ if (tmp->symtree
+ && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
+ || tmp->symtree->n.sym->ts.type != BT_INTEGER))
+ {
+ gfc_error ("Expecting scalar-int-variable at %L",
+ &tmp->where);
+ goto cleanup;
+ }
+
if (gfc_match_char (',') == MATCH_YES)
continue;
@@ -3884,6 +3893,16 @@ sync_statement (gfc_statement st)
gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
goto cleanup;
}
+
+ if (tmp->symtree
+ && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
+ || tmp->symtree->n.sym->ts.type != BT_CHARACTER))
+ {
+ gfc_error ("Expecting scalar-default-char-variable at %L",
+ &tmp->where);
+ goto cleanup;
+ }
+
errmsg = tmp;
saw_errmsg = true;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4db0a3ac76d..aa039a8d9a0 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5886,8 +5886,13 @@ write_symbol (int n, gfc_symbol *sym)
{
const char *label;
- if (sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL)
- gfc_internal_error ("write_symbol(): bad module symbol %qs", sym->name);
+ if ((sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL)
+ && !(sym->ts.type != BT_UNKNOWN && sym->attr.result))
+ {
+ gfc_error ("Invalid symbol %qs at %L", sym->name,
+ &sym->declared_at);
+ return;
+ }
mio_integer (&n);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1549f8e1635..610e729c68a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4485,6 +4485,9 @@ gfc_check_do_variable (gfc_symtree *st)
{
gfc_state_data *s;
+ if (!st)
+ return 0;
+
for (s=gfc_state_stack; s; s = s->previous)
if (s->do_variable == st)
{
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 32015c21efc..286e1372699 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8902,6 +8902,9 @@ resolve_select (gfc_code *code, bool select_type)
bool
gfc_type_is_extensible (gfc_symbol *sym)
{
+ if (!sym)
+ return false;
+
return !(sym->attr.is_bind_c || sym->attr.sequence
|| (sym->attr.is_class
&& sym->components->ts.u.derived->attr.unlimited_polymorphic));
@@ -12749,9 +12752,13 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
&& !UNLIMITED_POLY (sym)
&& !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
{
- gfc_error ("Type %qs of CLASS variable %qs at %L is not extensible",
- CLASS_DATA (sym)->ts.u.derived->name, sym->name,
- &sym->declared_at);
+ if (CLASS_DATA (sym)->ts.u.derived)
+ gfc_error ("Type %qs of CLASS variable %qs at %L is not extensible",
+ CLASS_DATA (sym)->ts.u.derived->name,
+ sym->name, &sym->declared_at);
+ else
+ gfc_error ("CLASS variable %qs at %L is not extensible",
+ sym->name, &sym->declared_at);
return false;
}
@@ -15179,6 +15186,20 @@ resolve_fl_parameter (gfc_symbol *sym)
return false;
}
+ /* Some programmers can have a typo when using an implied-do loop to
+ initialize an array constant. For example,
+ INTEGER I,J
+ INTEGER, PARAMETER :: A(3) = [(I, I = 1, 3)] ! OK
+ INTEGER, PARAMETER :: B(3) = [(A(J), I = 1, 3)] ! Not OK
+ This check catches the typo. */
+ if (sym->attr.dimension
+ && sym->value && sym->value->expr_type == EXPR_ARRAY
+ && !gfc_is_constant_expr (sym->value))
+ {
+ gfc_error ("Expecting constant expression near %L", &sym->value->where);
+ return false;
+ }
+
return true;
}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index e982374d9d1..d7d3900cd6e 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -309,6 +309,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag,
gfc_namespace *ns)
else
gfc_error ("Symbol %qs at %L has no IMPLICIT type",
sym->name, &sym->declared_at);
+
sym->attr.untyped = 1; /* Ensure we only give an error once. */
}
@@ -394,18 +395,34 @@ gfc_check_function_type (gfc_namespace *ns)
/******************** Symbol attribute stuff *********************/
+/* Older standards produced conflicts for some attributes that are now
+ allowed in newer standards. Check for the conflict and issue an
+ error depending on the standard in play. */
+
+static bool
+conflict_std (int standard, const char *a1, const char *a2, const char *name,
+ locus *where)
+{
+ if (name == NULL)
+ {
+ return gfc_notify_std (standard, "%s attribute conflicts "
+ "with %s attribute at %L", a1, a2,
+ where);
+ }
+ else
+ {
+ return gfc_notify_std (standard, "%s attribute conflicts "
+ "with %s attribute in %qs at %L",
+ a1, a2, name, where);
+ }
+}
+
+
/* This is a generic conflict-checker. We do this to avoid having a
single conflict in two places. */
#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
-#define conf_std(a, b, std) if (attr->a && attr->b)\
- {\
- a1 = a;\
- a2 = b;\
- standard = std;\
- goto conflict_std;\
- }
bool
gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
@@ -438,7 +455,7 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
"OACC DECLARE DEVICE_RESIDENT";
const char *a1, *a2;
- int standard;
+ bool standard;
if (attr->artificial)
return true;
@@ -450,16 +467,18 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
{
a1 = pointer;
a2 = intent;
- standard = GFC_STD_F2003;
- goto conflict_std;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
}
if (attr->in_namelist && (attr->allocatable || attr->pointer))
{
a1 = in_namelist;
a2 = attr->allocatable ? allocatable : pointer;
- standard = GFC_STD_F2003;
- goto conflict_std;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
}
/* Check for attributes not allowed in a BLOCK DATA. */
@@ -566,10 +585,42 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
return false;
conf (allocatable, pointer);
- conf_std (allocatable, dummy, GFC_STD_F2003);
- conf_std (allocatable, function, GFC_STD_F2003);
- conf_std (allocatable, result, GFC_STD_F2003);
- conf_std (elemental, recursive, GFC_STD_F2018);
+
+ if (attr->allocatable && attr->dummy)
+ {
+ a1 = allocatable;
+ a2 = dummy;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
+ }
+
+ if (attr->allocatable && attr->function)
+ {
+ a1 = allocatable;
+ a2 = function;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
+ }
+
+ if (attr->allocatable && attr->result)
+ {
+ a1 = allocatable;
+ a2 = result;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
+ }
+
+ if (attr->elemental && attr->recursive)
+ {
+ a1 = elemental;
+ a2 = recursive;
+ standard = conflict_std (GFC_STD_F2018, a1, a2, name, where);
+ if (!standard)
+ return standard;
+ }
conf (in_common, dummy);
conf (in_common, allocatable);
@@ -908,25 +959,10 @@ conflict:
a1, a2, name, where);
return false;
-
-conflict_std:
- if (name == NULL)
- {
- return gfc_notify_std (standard, "%s attribute conflicts "
- "with %s attribute at %L", a1, a2,
- where);
- }
- else
- {
- return gfc_notify_std (standard, "%s attribute conflicts "
- "with %s attribute in %qs at %L",
- a1, a2, name, where);
- }
}
#undef conf
#undef conf2
-#undef conf_std
/* Mark a symbol as referenced. */
@@ -4034,8 +4070,6 @@ gfc_free_namespace (gfc_namespace *ns)
if (ns->refs > 0)
return;
- gcc_assert (ns->refs == 0);
-
gfc_free_statements (ns->code);
free_sym_tree (ns->sym_root);
diff --git a/gcc/testsuite/gfortran.dg/coarray_3.f90
b/gcc/testsuite/gfortran.dg/coarray_3.f90
index d152ce1b2bd..1049e426085 100644
--- a/gcc/testsuite/gfortran.dg/coarray_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_3.f90
@@ -13,8 +13,8 @@ end critical fkl ! { dg-error "Expecting END PROGRAM" }
sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
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 memory (errmsg=str) ! { dg-error "must be a scalar CHARACTER" }
+sync memory (errmsg=n) ! { dg-error "Expecting scalar-default-char-variable" }
sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
sync images (-1) ! { dg-error "must between 1 and num_images" }
sync images (1)
diff --git a/gcc/testsuite/gfortran.dg/finalize_8.f03
b/gcc/testsuite/gfortran.dg/finalize_8.f03
index b2027a0ba6d..2c4f1d30108 100644
--- a/gcc/testsuite/gfortran.dg/finalize_8.f03
+++ b/gcc/testsuite/gfortran.dg/finalize_8.f03
@@ -16,12 +16,12 @@ CONTAINS
INTEGER, ALLOCATABLE :: fooarr(:)
REAL :: foobar
CONTAINS
- FINAL :: myfinal ! { dg-error "in the specification part of a MODULE" }
+ FINAL :: myfinal
END TYPE mytype
CONTAINS
- SUBROUTINE myfinal (el)
+ SUBROUTINE myfinal (el) ! { dg-error "is already declared as MODULE-PROC" }
TYPE(mytype) :: el
END SUBROUTINE myfinal
diff --git a/gcc/testsuite/gfortran.dg/pr69962.f90 b/gcc/testsuite/gfortran.dg/pr69962.f90
index 2684398ee31..def7364de59 100644
--- a/gcc/testsuite/gfortran.dg/pr69962.f90
+++ b/gcc/testsuite/gfortran.dg/pr69962.f90
@@ -2,5 +2,5 @@
program p
integer :: n = 1
character(3), parameter :: x(2) = ['abc', 'xyz']
- character(2), parameter :: y(2) = [x(2)(2:3), x(n)(1:2)] ! { dg-error "CHARACTER
length must be a constant" }
+ character(2), parameter :: y(2) = [x(2)(2:3), x(n)(1:2)] ! { dg-error "Expecting
constant" }
end
diff --git a/gcc/testsuite/gfortran.dg/pr87907.f90
b/gcc/testsuite/gfortran.dg/pr87907.f90
index 0fe4e5090d2..a4a5ecfac07 100644
--- a/gcc/testsuite/gfortran.dg/pr87907.f90
+++ b/gcc/testsuite/gfortran.dg/pr87907.f90
@@ -12,12 +12,6 @@ end
submodule(m) m2
contains
- subroutine g(x) ! { dg-error "mismatch in argument" }
+ subroutine g(x) ! { dg-error "attribute conflicts with" }
end
end
-
-program p
- use m ! { dg-error "has a type" }
- integer :: x = 3
- call g(x) ! { dg-error "which is not consistent with" }
-end
diff --git a/gcc/testsuite/gfortran.dg/pr91960.f90
b/gcc/testsuite/gfortran.dg/pr91960.f90
new file mode 100644
index 00000000000..76663f00c01
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr91960.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+module m
+ integer :: i, j
+ integer, parameter :: a(3) = [(i,i=1,3)]
+ integer, parameter :: b(3) = [(a(j),i=1,3)] ! { dg-error " Expecting
constant" }
+end
diff --git a/gcc/testsuite/gfortran.dg/pr93635.f90
b/gcc/testsuite/gfortran.dg/pr93635.f90
new file mode 100644
index 00000000000..b9700f31713
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93635.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+program boom
+ implicit none
+ character(len=:),allocatable :: r,rel
+ namelist /args/ r,rel
+ equivalence(r,rel) ! { dg-error "EQUIVALENCE attribute conflicts" }
+ allocate(character(len=1024) :: r)
+ end program boom
diff --git a/gcc/testsuite/gfortran.dg/pr95501.f90
b/gcc/testsuite/gfortran.dg/pr95501.f90
new file mode 100644
index 00000000000..b83f6ab9f1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr95501.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+subroutine p
+ integer, target :: a = 2
+ integer, pointer :: z
+ z%kind => a%kind ! { dg-error "a constant expression" }
+ z%kind => a ! { dg-error "a constant expression" }
+end
+
+subroutine q
+ character, target :: a = 'a'
+ character, pointer :: z
+ z%kind => a ! { dg-error "a constant expression" }
+ z%kind => a%kind ! { dg-error "a constant expression" }
+ z%len => a ! { dg-error "a constant expression" }
+ z%len => a%len ! { dg-error "a constant expression" }
+ a%kind => a%len ! { dg-error "a constant expression" }
+ a%len => a%kind ! { dg-error "a constant expression" }
+end
diff --git a/gcc/testsuite/gfortran.dg/pr95502.f90
b/gcc/testsuite/gfortran.dg/pr95502.f90
new file mode 100644
index 00000000000..a5751bb8b76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr95502.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+subroutine p
+ character, pointer :: z ! { dg-error "in variable definition context" }
+ complex, pointer :: a
+ nullify(z%len)
+ nullify(z%kind) ! { dg-error "in variable definition context" }
+ nullify(a%re) ! { dg-error "in pointer association context" }
+ nullify(a%im) ! { dg-error "in pointer association context" }
+end
diff --git a/gcc/testsuite/gfortran.dg/pr95710.f90
b/gcc/testsuite/gfortran.dg/pr95710.f90
new file mode 100644
index 00000000000..7eab368cb5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr95710.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+module m
+ type t
+ integer :: a = 1
+ end type
+ interface
+ module subroutine s
+ end
+ end interface
+end
+submodule(m) m2
+contains
+ subroutine s ! or module subroutine s
+ class(t), allocatable :: x ! { dg-error "is not extensible" }
+ class(t), allocatable :: x
+ end
+end
diff --git a/gcc/testsuite/gfortran.dg/pr96013.f90
b/gcc/testsuite/gfortran.dg/pr96013.f90
new file mode 100644
index 00000000000..a5c6a13547f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96013.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+module m
+ type t
+ end type
+contains
+ function f() result(t)
+ character(3) :: c
+ c = 'abc'
+ end
+end
diff --git a/gcc/testsuite/gfortran.dg/pr96025.f90
b/gcc/testsuite/gfortran.dg/pr96025.f90
new file mode 100644
index 00000000000..5ff8f6452bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96025.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+program p
+ print *, f()
+contains
+ character(char(1)) function f() ! { dg-error "must be of INTEGER type" }s
+ f = 'f'
+ end
+end
diff --git a/gcc/testsuite/gfortran.dg/pr97122.f90
b/gcc/testsuite/gfortran.dg/pr97122.f90
new file mode 100644
index 00000000000..a81edb68fd8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr97122.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+module m
+ implicit none
+ interface
+ module subroutine other
+ implicit none
+ end subroutine other
+ end interface
+end module m
+
+submodule (m) s
+ implicit none
+ type :: t
+ contains
+ final :: p
+ end type t
+contains
+ subroutine p(arg)
+ type(t), intent(inout) :: arg
+ end subroutine p
+
+ module subroutine other
+ end subroutine other
+end submodule s
diff --git a/gcc/testsuite/gfortran.dg/pr99256.f90
b/gcc/testsuite/gfortran.dg/pr99256.f90
new file mode 100644
index 00000000000..b39e1453ce3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99256.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+! { dg-options "-w" }
+program p
+ call move_alloc (*1, *1)
+ 1 stop
+end
+! { dg-prune-output "must be a variable" }
diff --git a/gcc/testsuite/gfortran.dg/pr99349.f90
b/gcc/testsuite/gfortran.dg/pr99349.f90
new file mode 100644
index 00000000000..d5b34eeeebd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99349.f90
@@ -0,0 +1,7 @@
+! { dg-do compile }
+function f()
+ logical, parameter :: a((1.)/0) = .true. ! { dg-error "Division by zero" }
+ integer :: b
+ data b /a%kind/ ! { dg-error "Incompatible ranks" }
+end
+! { dg-prune-output "Parameter array" }
diff --git a/gcc/testsuite/gfortran.dg/pr99351.f90
b/gcc/testsuite/gfortran.dg/pr99351.f90
new file mode 100644
index 00000000000..a36fcf9cd5d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99351.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+module m
+ character(3), parameter :: c = 'abc'
+contains
+ subroutine s
+ sync all (errmsg=c) ! { dg-error "Expecting
scalar-default-char-variable" }
+ end
+end module m
+
+module n
+ integer, parameter :: a = 0
+contains
+ subroutine s
+ sync images (*, stat=a) ! { dg-error "Expecting scalar-int-variable" }
+ end
+end module n
