From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from troutmask.apl.washington.edu (troutmask.apl.washington.edu [128.95.76.21]) by sourceware.org (Postfix) with ESMTPS id E5C52384403E for ; Sat, 13 Mar 2021 21:33:39 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org E5C52384403E Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.16.1/8.16.1) with ESMTPS id 12DLXcG8001367 (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384 bits=256 verify=NO) for ; Sat, 13 Mar 2021 13:33:38 -0800 (PST) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.16.1/8.16.1/Submit) id 12DLXckg001366 for fortran@gcc.gnu.org; Sat, 13 Mar 2021 13:33:38 -0800 (PST) (envelope-from sgk) Date: Sat, 13 Mar 2021 13:33:38 -0800 From: Steve Kargl To: fortran@gcc.gnu.org Subject: 12 PR fixed Message-ID: <20210313213338.GA1350@troutmask.apl.washington.edu> MIME-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline X-Spam-Status: No, score=-7.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, KAM_LAZY_DOMAIN_SECURITY, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sat, 13 Mar 2021 21:33:42 -0000 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 -- Steve