* 12 PR fixed @ 2021-03-13 21:33 Steve Kargl 2021-03-14 4:46 ` Jerry DeLisle 0 siblings, 1 reply; 9+ messages in thread From: Steve Kargl @ 2021-03-13 21:33 UTC (permalink / raw) To: fortran 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-13 21:33 12 PR fixed Steve Kargl @ 2021-03-14 4:46 ` Jerry DeLisle 2021-03-14 5:13 ` Jerry DeLisle 0 siblings, 1 reply; 9+ messages in thread From: Jerry DeLisle @ 2021-03-14 4:46 UTC (permalink / raw) To: Steve Kargl; +Cc: gfortran I have reviewed this and all looks good. I also regression tested on x86_64-pc-linux-gnu. I don't want to do a bunch of individual commits. Steve, if you can do a ChangeLog I can commit in one blast. Regards, Jerry On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote: > 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 ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-14 4:46 ` Jerry DeLisle @ 2021-03-14 5:13 ` Jerry DeLisle 2021-03-14 6:05 ` Steve Kargl 2021-03-14 11:38 ` Tobias Burnus 0 siblings, 2 replies; 9+ messages in thread From: Jerry DeLisle @ 2021-03-14 5:13 UTC (permalink / raw) To: Steve Kargl; +Cc: gfortran Well, I am seeing the falling upon a closer look. I do not know if related to the patch yet. Lets make sure this is fixed. FAIL: gfortran.dg/pr87907.f90 -O (internal compiler error) FAIL: gfortran.dg/pr87907.f90 -O (test for excess errors) FAIL: gfortran.dg/pr96013.f90 -O (test for excess errors) FAIL: gfortran.dg/pr96025.f90 -O (internal compiler error) FAIL: gfortran.dg/pr96025.f90 -O (test for errors, line 5) FAIL: gfortran.dg/pr96025.f90 -O (test for excess errors) On 3/13/21 8:46 PM, Jerry DeLisle wrote: > I have reviewed this and all looks good. > > I also regression tested on x86_64-pc-linux-gnu. > > I don't want to do a bunch of individual commits. > > Steve, if you can do a ChangeLog I can commit in one blast. > > Regards, > > Jerry > > On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote: >> 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 > ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-14 5:13 ` Jerry DeLisle @ 2021-03-14 6:05 ` Steve Kargl 2021-03-14 11:38 ` Tobias Burnus 1 sibling, 0 replies; 9+ messages in thread From: Steve Kargl @ 2021-03-14 6:05 UTC (permalink / raw) To: Jerry DeLisle; +Cc: gfortran On Sat, Mar 13, 2021 at 09:13:53PM -0800, Jerry DeLisle wrote: > Well, I am seeing the falling upon a closer look. I do not know if related > to the patch yet. Lets make sure this is fixed. > > FAIL: gfortran.dg/pr87907.f90 -O (internal compiler error) > FAIL: gfortran.dg/pr87907.f90 -O (test for excess errors) > FAIL: gfortran.dg/pr96013.f90 -O (test for excess errors) > FAIL: gfortran.dg/pr96025.f90 -O (internal compiler error) > FAIL: gfortran.dg/pr96025.f90 -O (test for errors, line 5) > FAIL: gfortran.dg/pr96025.f90 -O (test for excess errors) On my system, === gfortran Summary === # of expected passes 56305 # of expected failures 232 # of unsupported tests 109 /home/kargl/gcc/obj/gcc/gfortran version 11.0.1 20210313 (experimental) (GCC) AFAIK, my tree is up-to-date, but then again, git is a foreign beast to me. Too bad that the people responsible for the switch to git throw 15 years of corporate knowledge for little gain. I see what I can do for a ChangeLog. Some of my patches have lingered in bugzilla for too long. I don't remember all of the details. -- steve ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-14 5:13 ` Jerry DeLisle 2021-03-14 6:05 ` Steve Kargl @ 2021-03-14 11:38 ` Tobias Burnus 2021-03-14 12:01 ` Tobias Burnus 2021-03-14 16:46 ` Steve Kargl 1 sibling, 2 replies; 9+ messages in thread From: Tobias Burnus @ 2021-03-14 11:38 UTC (permalink / raw) To: Jerry DeLisle, Steve Kargl; +Cc: gfortran On 14.03.21 06:13, Jerry DeLisle wrote: > Well, I am seeing the falling upon a closer look. I do not know if > related to the patch yet. Lets make sure this is fixed. > > FAIL: gfortran.dg/pr87907.f90 -O (internal compiler error) > FAIL: gfortran.dg/pr87907.f90 -O (test for excess errors) > FAIL: gfortran.dg/pr96013.f90 -O (test for excess errors) > FAIL: gfortran.dg/pr96025.f90 -O (internal compiler error) > FAIL: gfortran.dg/pr96025.f90 -O (test for errors, line 5) > FAIL: gfortran.dg/pr96025.f90 -O (test for excess errors) I do see the failure with the new patch applied – and the testcase from the patchset for: @@ -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 The problem is that for: #6 0x00000000008c1195 in gfc_error (gmsgid=gmsgid@entry=0x1bfbdbe "Invalid symbol %qs at %L") at ../../repos/gcc/gcc/fortran/error.c:1381 #7 0x0000000000904204 in write_symbol (n=<optimized out>, sym=0x2905350) at ../../repos/gcc/gcc/fortran/module.c:5892 #8 0x0000000000904272 in write_symbol1_recursion (sp=<optimized out>) at ../../repos/gcc/gcc/fortran/module.c:6122 #9 0x0000000000907136 in write_symbol1 (p=<optimized out>) at ../../repos/gcc/gcc/fortran/module.c:6155 #10 write_module () at ../../repos/gcc/gcc/fortran/module.c:6302 #11 dump_module (name=<optimized out>, name@entry=0x7ffff7189120 "m", dump_flag=dump_flag@entry=1) at ../../repos/gcc/gcc/fortran/module.c:6431 namely: 5889 if ((sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL) 5890 && !(sym->ts.type != BT_UNKNOWN && sym->attr.result)) 5891 { 5892 gfc_error ("Invalid symbol %qs at %L", sym->name, 5893 &sym->declared_at); sym->name is invalid. valgrind shows: ==61032== Invalid read of size 1 ==61032== at 0x90411C: write_symbol(int, gfc_symbol*) (module.c:5889) ==61032== by 0x904271: write_symbol1_recursion(sorted_pointer_info*) (module.c:6122) ==61032== by 0x907135: write_symbol1 (module.c:6155) ==61032== by 0x907135: write_module (module.c:6302) ==61032== by 0x907135: dump_module(char const*, int) (module.c:6431) ==61032== by 0x907494: gfc_dump_module(char const*, int) (module.c:6488) ==61032== by 0x922643: gfc_parse_file() (parse.c:6509) ==61032== by 0x971063: gfc_be_parse_file() (f95-lang.c:212) ==61032== by 0xF23C3E: compile_file() (toplev.c:457) ==61032== by 0x88453E: do_compile (toplev.c:2201) ==61032== by 0x88453E: toplev::main(int, char**) (toplev.c:2340) ==61032== by 0x88703F: main (main.c:39) ==61032== Address 0x52207fa is 90 bytes inside a block of size 344 free'd ==61032== at 0x483CA3F: free (in /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so) ==61032== by 0x93C3BE: resolve_symbol(gfc_symbol*) (resolve.c:15340) ==61032== by 0x95B7F2: do_traverse_symtree(gfc_symtree*, void (*)(gfc_symtree*), void (*)(gfc_symbol*)) (symbol.c:4204) ==61032== by 0x93F2C3: resolve_types(gfc_namespace*) (resolve.c:17326) ==61032== by 0x93F363: resolve_types(gfc_namespace*) (resolve.c:17337) ==61032== by 0x93A80C: gfc_resolve(gfc_namespace*) [clone .part.0] (resolve.c:17441) ==61032== by 0x921F16: gfc_parse_file() (parse.c:6495) ==61032== by 0x971063: gfc_be_parse_file() (f95-lang.c:212) ==61032== by 0xF23C3E: compile_file() (toplev.c:457) ==61032== by 0x88453E: do_compile (toplev.c:2201) ==61032== by 0x88453E: toplev::main(int, char**) (toplev.c:2340) ==61032== by 0x88703F: main (main.c:39) ==61032== Block was alloc'd at ==61032== at 0x483DD99: calloc (in /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so) ==61032== by 0x1BBDD24: xcalloc (xmalloc.c:162) ==61032== by 0x960C4C: gfc_new_symbol(char const*, gfc_namespace*) (symbol.c:3172) ==61032== by 0x961007: gfc_get_sym_tree(char const*, gfc_namespace*, gfc_symtree**, bool) (symbol.c:3412) ==61032== by 0x961235: gfc_get_symbol(char const*, gfc_namespace*, gfc_symbol**) (symbol.c:3465) ==61032== by 0x8A79C3: match_result(gfc_symbol*, gfc_symbol**) [clone .isra.0] [clone .part.0] (decl.c:6679) ==61032== by 0x8AD29A: match_result (decl.c:6772) ==61032== by 0x8AD29A: gfc_match_suffix(gfc_symbol*, gfc_symbol**) (decl.c:6724) ==61032== by 0x8B194C: gfc_match_function_decl() (decl.c:7387) ==61032== by 0x9182AA: decode_statement() (parse.c:343) ==61032== by 0x91C53C: next_free (parse.c:1316) ==61032== by 0x91C53C: next_statement() (parse.c:1548) ==61032== by 0x920C0A: parse_contained(int) (parse.c:5746) ==61032== by 0x921A6E: parse_module() (parse.c:6173) Tobias > > > On 3/13/21 8:46 PM, Jerry DeLisle wrote: >> I have reviewed this and all looks good. >> >> I also regression tested on x86_64-pc-linux-gnu. >> >> I don't want to do a bunch of individual commits. >> >> Steve, if you can do a ChangeLog I can commit in one blast. >> >> Regards, >> >> Jerry >> >> On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote: >>> 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 >> > ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-14 11:38 ` Tobias Burnus @ 2021-03-14 12:01 ` Tobias Burnus 2021-03-14 15:22 ` Jerry DeLisle 2021-03-14 16:46 ` Steve Kargl 1 sibling, 1 reply; 9+ messages in thread From: Tobias Burnus @ 2021-03-14 12:01 UTC (permalink / raw) To: Jerry DeLisle, Steve Kargl; +Cc: gfortran Small additional remark: I see new lines which use 8 spaces instead of a tab – that should also be fixed. And: Please don't forget to CC gcc-patches@ as well. Thanks, Tobias On 14.03.21 12:38, Tobias Burnus wrote: > On 14.03.21 06:13, Jerry DeLisle wrote: > >> Well, I am seeing the falling upon a closer look. I do not know if >> related to the patch yet. Lets make sure this is fixed. >> >> FAIL: gfortran.dg/pr87907.f90 -O (internal compiler error) >> FAIL: gfortran.dg/pr87907.f90 -O (test for excess errors) >> FAIL: gfortran.dg/pr96013.f90 -O (test for excess errors) >> FAIL: gfortran.dg/pr96025.f90 -O (internal compiler error) >> FAIL: gfortran.dg/pr96025.f90 -O (test for errors, line 5) >> FAIL: gfortran.dg/pr96025.f90 -O (test for excess errors) > > I do see the failure with the new patch applied – > and the testcase from the patchset for: > > @@ -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 > > The problem is that for: > > #6 0x00000000008c1195 in gfc_error (gmsgid=gmsgid@entry=0x1bfbdbe > "Invalid symbol %qs at %L") at ../../repos/gcc/gcc/fortran/error.c:1381 > #7 0x0000000000904204 in write_symbol (n=<optimized out>, > sym=0x2905350) at ../../repos/gcc/gcc/fortran/module.c:5892 > #8 0x0000000000904272 in write_symbol1_recursion (sp=<optimized out>) > at ../../repos/gcc/gcc/fortran/module.c:6122 > #9 0x0000000000907136 in write_symbol1 (p=<optimized out>) at > ../../repos/gcc/gcc/fortran/module.c:6155 > #10 write_module () at ../../repos/gcc/gcc/fortran/module.c:6302 > #11 dump_module (name=<optimized out>, name@entry=0x7ffff7189120 "m", > dump_flag=dump_flag@entry=1) at ../../repos/gcc/gcc/fortran/module.c:6431 > > namely: > > 5889 if ((sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == > FL_LABEL) > 5890 && !(sym->ts.type != BT_UNKNOWN && sym->attr.result)) > 5891 { > 5892 gfc_error ("Invalid symbol %qs at %L", sym->name, > 5893 &sym->declared_at); > > sym->name is invalid. > > valgrind shows: > > ==61032== Invalid read of size 1 > ==61032== at 0x90411C: write_symbol(int, gfc_symbol*) (module.c:5889) > ==61032== by 0x904271: > write_symbol1_recursion(sorted_pointer_info*) (module.c:6122) > ==61032== by 0x907135: write_symbol1 (module.c:6155) > ==61032== by 0x907135: write_module (module.c:6302) > ==61032== by 0x907135: dump_module(char const*, int) (module.c:6431) > ==61032== by 0x907494: gfc_dump_module(char const*, int) > (module.c:6488) > ==61032== by 0x922643: gfc_parse_file() (parse.c:6509) > ==61032== by 0x971063: gfc_be_parse_file() (f95-lang.c:212) > ==61032== by 0xF23C3E: compile_file() (toplev.c:457) > ==61032== by 0x88453E: do_compile (toplev.c:2201) > ==61032== by 0x88453E: toplev::main(int, char**) (toplev.c:2340) > ==61032== by 0x88703F: main (main.c:39) > ==61032== Address 0x52207fa is 90 bytes inside a block of size 344 > free'd > ==61032== at 0x483CA3F: free (in > /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so) > ==61032== by 0x93C3BE: resolve_symbol(gfc_symbol*) (resolve.c:15340) > ==61032== by 0x95B7F2: do_traverse_symtree(gfc_symtree*, void > (*)(gfc_symtree*), void (*)(gfc_symbol*)) (symbol.c:4204) > ==61032== by 0x93F2C3: resolve_types(gfc_namespace*) (resolve.c:17326) > ==61032== by 0x93F363: resolve_types(gfc_namespace*) (resolve.c:17337) > ==61032== by 0x93A80C: gfc_resolve(gfc_namespace*) [clone .part.0] > (resolve.c:17441) > ==61032== by 0x921F16: gfc_parse_file() (parse.c:6495) > ==61032== by 0x971063: gfc_be_parse_file() (f95-lang.c:212) > ==61032== by 0xF23C3E: compile_file() (toplev.c:457) > ==61032== by 0x88453E: do_compile (toplev.c:2201) > ==61032== by 0x88453E: toplev::main(int, char**) (toplev.c:2340) > ==61032== by 0x88703F: main (main.c:39) > ==61032== Block was alloc'd at > ==61032== at 0x483DD99: calloc (in > /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so) > ==61032== by 0x1BBDD24: xcalloc (xmalloc.c:162) > ==61032== by 0x960C4C: gfc_new_symbol(char const*, gfc_namespace*) > (symbol.c:3172) > ==61032== by 0x961007: gfc_get_sym_tree(char const*, > gfc_namespace*, gfc_symtree**, bool) (symbol.c:3412) > ==61032== by 0x961235: gfc_get_symbol(char const*, gfc_namespace*, > gfc_symbol**) (symbol.c:3465) > ==61032== by 0x8A79C3: match_result(gfc_symbol*, gfc_symbol**) > [clone .isra.0] [clone .part.0] (decl.c:6679) > ==61032== by 0x8AD29A: match_result (decl.c:6772) > ==61032== by 0x8AD29A: gfc_match_suffix(gfc_symbol*, gfc_symbol**) > (decl.c:6724) > ==61032== by 0x8B194C: gfc_match_function_decl() (decl.c:7387) > ==61032== by 0x9182AA: decode_statement() (parse.c:343) > ==61032== by 0x91C53C: next_free (parse.c:1316) > ==61032== by 0x91C53C: next_statement() (parse.c:1548) > ==61032== by 0x920C0A: parse_contained(int) (parse.c:5746) > ==61032== by 0x921A6E: parse_module() (parse.c:6173) > > Tobias > > >> >> >> On 3/13/21 8:46 PM, Jerry DeLisle wrote: >>> I have reviewed this and all looks good. >>> >>> I also regression tested on x86_64-pc-linux-gnu. >>> >>> I don't want to do a bunch of individual commits. >>> >>> Steve, if you can do a ChangeLog I can commit in one blast. >>> >>> Regards, >>> >>> Jerry >>> >>> On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote: >>>> 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 >>> >> ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-14 12:01 ` Tobias Burnus @ 2021-03-14 15:22 ` Jerry DeLisle 2021-03-15 22:17 ` Steve Kargl 0 siblings, 1 reply; 9+ messages in thread From: Jerry DeLisle @ 2021-03-14 15:22 UTC (permalink / raw) To: Tobias Burnus, Steve Kargl; +Cc: gfortran I can convert the tabs/spaces no problem. On 3/14/21 5:01 AM, Tobias Burnus wrote: > Small additional remark: I see new lines which use 8 spaces instead of > a tab – that should also be fixed. > > And: Please don't forget to CC gcc-patches@ as well. > > Thanks, > > Tobias > > On 14.03.21 12:38, Tobias Burnus wrote: >> On 14.03.21 06:13, Jerry DeLisle wrote: >> >>> Well, I am seeing the falling upon a closer look. I do not know if >>> related to the patch yet. Lets make sure this is fixed. >>> >>> FAIL: gfortran.dg/pr87907.f90 -O (internal compiler error) >>> FAIL: gfortran.dg/pr87907.f90 -O (test for excess errors) >>> FAIL: gfortran.dg/pr96013.f90 -O (test for excess errors) >>> FAIL: gfortran.dg/pr96025.f90 -O (internal compiler error) >>> FAIL: gfortran.dg/pr96025.f90 -O (test for errors, line 5) >>> FAIL: gfortran.dg/pr96025.f90 -O (test for excess errors) >> >> I do see the failure with the new patch applied – >> and the testcase from the patchset for: >> >> @@ -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 >> >> The problem is that for: >> >> #6 0x00000000008c1195 in gfc_error (gmsgid=gmsgid@entry=0x1bfbdbe >> "Invalid symbol %qs at %L") at ../../repos/gcc/gcc/fortran/error.c:1381 >> #7 0x0000000000904204 in write_symbol (n=<optimized out>, >> sym=0x2905350) at ../../repos/gcc/gcc/fortran/module.c:5892 >> #8 0x0000000000904272 in write_symbol1_recursion (sp=<optimized >> out>) at ../../repos/gcc/gcc/fortran/module.c:6122 >> #9 0x0000000000907136 in write_symbol1 (p=<optimized out>) at >> ../../repos/gcc/gcc/fortran/module.c:6155 >> #10 write_module () at ../../repos/gcc/gcc/fortran/module.c:6302 >> #11 dump_module (name=<optimized out>, name@entry=0x7ffff7189120 "m", >> dump_flag=dump_flag@entry=1) at >> ../../repos/gcc/gcc/fortran/module.c:6431 >> >> namely: >> >> 5889 if ((sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == >> FL_LABEL) >> 5890 && !(sym->ts.type != BT_UNKNOWN && sym->attr.result)) >> 5891 { >> 5892 gfc_error ("Invalid symbol %qs at %L", sym->name, >> 5893 &sym->declared_at); >> >> sym->name is invalid. >> >> valgrind shows: >> >> ==61032== Invalid read of size 1 >> ==61032== at 0x90411C: write_symbol(int, gfc_symbol*) (module.c:5889) >> ==61032== by 0x904271: >> write_symbol1_recursion(sorted_pointer_info*) (module.c:6122) >> ==61032== by 0x907135: write_symbol1 (module.c:6155) >> ==61032== by 0x907135: write_module (module.c:6302) >> ==61032== by 0x907135: dump_module(char const*, int) (module.c:6431) >> ==61032== by 0x907494: gfc_dump_module(char const*, int) >> (module.c:6488) >> ==61032== by 0x922643: gfc_parse_file() (parse.c:6509) >> ==61032== by 0x971063: gfc_be_parse_file() (f95-lang.c:212) >> ==61032== by 0xF23C3E: compile_file() (toplev.c:457) >> ==61032== by 0x88453E: do_compile (toplev.c:2201) >> ==61032== by 0x88453E: toplev::main(int, char**) (toplev.c:2340) >> ==61032== by 0x88703F: main (main.c:39) >> ==61032== Address 0x52207fa is 90 bytes inside a block of size 344 >> free'd >> ==61032== at 0x483CA3F: free (in >> /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so) >> ==61032== by 0x93C3BE: resolve_symbol(gfc_symbol*) (resolve.c:15340) >> ==61032== by 0x95B7F2: do_traverse_symtree(gfc_symtree*, void >> (*)(gfc_symtree*), void (*)(gfc_symbol*)) (symbol.c:4204) >> ==61032== by 0x93F2C3: resolve_types(gfc_namespace*) >> (resolve.c:17326) >> ==61032== by 0x93F363: resolve_types(gfc_namespace*) >> (resolve.c:17337) >> ==61032== by 0x93A80C: gfc_resolve(gfc_namespace*) [clone .part.0] >> (resolve.c:17441) >> ==61032== by 0x921F16: gfc_parse_file() (parse.c:6495) >> ==61032== by 0x971063: gfc_be_parse_file() (f95-lang.c:212) >> ==61032== by 0xF23C3E: compile_file() (toplev.c:457) >> ==61032== by 0x88453E: do_compile (toplev.c:2201) >> ==61032== by 0x88453E: toplev::main(int, char**) (toplev.c:2340) >> ==61032== by 0x88703F: main (main.c:39) >> ==61032== Block was alloc'd at >> ==61032== at 0x483DD99: calloc (in >> /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so) >> ==61032== by 0x1BBDD24: xcalloc (xmalloc.c:162) >> ==61032== by 0x960C4C: gfc_new_symbol(char const*, gfc_namespace*) >> (symbol.c:3172) >> ==61032== by 0x961007: gfc_get_sym_tree(char const*, >> gfc_namespace*, gfc_symtree**, bool) (symbol.c:3412) >> ==61032== by 0x961235: gfc_get_symbol(char const*, gfc_namespace*, >> gfc_symbol**) (symbol.c:3465) >> ==61032== by 0x8A79C3: match_result(gfc_symbol*, gfc_symbol**) >> [clone .isra.0] [clone .part.0] (decl.c:6679) >> ==61032== by 0x8AD29A: match_result (decl.c:6772) >> ==61032== by 0x8AD29A: gfc_match_suffix(gfc_symbol*, gfc_symbol**) >> (decl.c:6724) >> ==61032== by 0x8B194C: gfc_match_function_decl() (decl.c:7387) >> ==61032== by 0x9182AA: decode_statement() (parse.c:343) >> ==61032== by 0x91C53C: next_free (parse.c:1316) >> ==61032== by 0x91C53C: next_statement() (parse.c:1548) >> ==61032== by 0x920C0A: parse_contained(int) (parse.c:5746) >> ==61032== by 0x921A6E: parse_module() (parse.c:6173) >> >> Tobias >> >> >>> >>> >>> On 3/13/21 8:46 PM, Jerry DeLisle wrote: >>>> I have reviewed this and all looks good. >>>> >>>> I also regression tested on x86_64-pc-linux-gnu. >>>> >>>> I don't want to do a bunch of individual commits. >>>> >>>> Steve, if you can do a ChangeLog I can commit in one blast. >>>> >>>> Regards, >>>> >>>> Jerry >>>> >>>> On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote: >>>>> 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 >>>> >>> ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-14 15:22 ` Jerry DeLisle @ 2021-03-15 22:17 ` Steve Kargl 0 siblings, 0 replies; 9+ messages in thread From: Steve Kargl @ 2021-03-15 22:17 UTC (permalink / raw) To: Jerry DeLisle; +Cc: Tobias Burnus, gfortran On Sun, Mar 14, 2021 at 08:22:58AM -0700, Jerry DeLisle wrote: > > > > > > > > FAIL: gfortran.dg/pr87907.f90 -O (internal compiler error) > > > > FAIL: gfortran.dg/pr87907.f90 -O (test for excess errors) > > > > FAIL: gfortran.dg/pr96013.f90 -O (test for excess errors) > > > > FAIL: gfortran.dg/pr96025.f90 -O (internal compiler error) > > > > FAIL: gfortran.dg/pr96025.f90 -O (test for errors, line 5) > > > > FAIL: gfortran.dg/pr96025.f90 -O (test for excess errors) > > > No idea why I don't see the above. This patch on top of the previous patch might fix the last 3 FAILs. (Watch for copy-n-paste whitespace corruption.) diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index e1acc2db000..081487a45e6 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3476,7 +3476,6 @@ 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; } @@ -5246,11 +5245,12 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym, if ((*func) (expr, sym, &f)) return true; - if (expr->ts.type == BT_CHARACTER - && expr->ts.u.cl - && expr->ts.u.cl->length - && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT - && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f)) + if (expr->expr_type != EXPR_CONSTANT + && expr->ts.type == BT_CHARACTER + && expr->ts.u.cl + && expr->ts.u.cl->length + && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT + && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f)) return true; switch (expr->expr_type) -- steve ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: 12 PR fixed 2021-03-14 11:38 ` Tobias Burnus 2021-03-14 12:01 ` Tobias Burnus @ 2021-03-14 16:46 ` Steve Kargl 1 sibling, 0 replies; 9+ messages in thread From: Steve Kargl @ 2021-03-14 16:46 UTC (permalink / raw) To: Tobias Burnus; +Cc: Jerry DeLisle, gfortran On Sun, Mar 14, 2021 at 12:38:59PM +0100, Tobias Burnus wrote: > On 14.03.21 06:13, Jerry DeLisle wrote: > > > Well, I am seeing the falling upon a closer look. I do not know if > > related to the patch yet. Lets make sure this is fixed. > > > > FAIL: gfortran.dg/pr87907.f90 -O (internal compiler error) > > FAIL: gfortran.dg/pr87907.f90 -O (test for excess errors) > > FAIL: gfortran.dg/pr96013.f90 -O (test for excess errors) > > FAIL: gfortran.dg/pr96025.f90 -O (internal compiler error) > > FAIL: gfortran.dg/pr96025.f90 -O (test for errors, line 5) > > FAIL: gfortran.dg/pr96025.f90 -O (test for excess errors) > > I do see the failure with the new patch applied – Interesting. I don't see issues, but then again I don't do git, so something may have gone south in trying to generate a patch. Probably to be expected when patches ferment in bugzilla. 91960 2021-03-10, patch not in BZ, tipping point, comment longer than code. 93635 2020-02-10, patch comment #2, does not apply cleanly due to changes 95501 2020-06-03, patch comment #1, 1 line, null ptr check 95502 2020-06-03, patch comment #1, 6 lines, 2 null ptr checks 95710 2020-06-17, patch comment #2, 2 null ptr checks, new error msg 96013 2020-06-30, patch comment #6, 10 lines changed 96025 2020-07-01, patch comment #3, 1 line changed, nullifies a typespec (ts). 97122 2020-09-20, patch comment #1, 2 line changed 99256 2021-02-25, patch comment #1, 8 lines, null ptr, new error msg 99349 2021-02-25, patch comment #1, 2 lines deleted 99351 2021-03-03, patch comemnt #1, adds checks on STAT and ERRMSG in SYNCxxx. 99506 (patch for 91960 fixes this one) None of the above individual patches should have been difficult to review. All patches, except 91960, developed against svn r280157, so svn vs git might be an issue. All testcases not under git control are hand merged into gcc/gfortran.dg, so again an opportunity for a screw-up. Took a few hours to figure out how to generate the posted diff, so again an opportunity to FU. 95038 Not in mega patch. Fixes ICE allowing code to compile. Code should issue an error due to missing IMPORT statement in interface. 95372 Not in mega patch. Change assert() to null ptr check and error msg. Harald has assigned this to himself. Stopped working on bug. 95613 Not in mega patch. Removes legacy extension of branching to to a label in a different block. Somehow breaks OpenMP. Don't know OpenMP, so cannot judge whether branching to a different block is allowed. 95543 Not in mega patch. Fixes a PDT issue, but PDT are so horribly broken the result produces wrong code. I also have very old patches for pr30371 and pr69101, which I have not tried to merge into my local git repository. I guess I can start over with % git clone git://gcc.gnu.org/git/gcc.git DIR1 % cp -R DIR1 DIR2 (merge changes into DIR1) % diff -NR DIR2 DIR1 -- steve ^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2021-03-15 22:17 UTC | newest] Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2021-03-13 21:33 12 PR fixed Steve Kargl 2021-03-14 4:46 ` Jerry DeLisle 2021-03-14 5:13 ` Jerry DeLisle 2021-03-14 6:05 ` Steve Kargl 2021-03-14 11:38 ` Tobias Burnus 2021-03-14 12:01 ` Tobias Burnus 2021-03-14 15:22 ` Jerry DeLisle 2021-03-15 22:17 ` Steve Kargl 2021-03-14 16:46 ` Steve Kargl
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).