* 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 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
* 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
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).