From: Tobias Burnus <burnus@net-b.de>
To: Jerry DeLisle <jvdelisle@charter.net>,
Steve Kargl <sgk@troutmask.apl.washington.edu>
Cc: gfortran <fortran@gcc.gnu.org>
Subject: Re: 12 PR fixed
Date: Sun, 14 Mar 2021 12:38:59 +0100 [thread overview]
Message-ID: <41ccb8db-cf7c-a49c-c84b-dc475f561dfa@net-b.de> (raw)
In-Reply-To: <fe22ba09-9968-e1cd-2133-1358901ed216@charter.net>
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
>>
>
next prev parent reply other threads:[~2021-03-14 11:39 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-03-13 21:33 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 [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=41ccb8db-cf7c-a49c-c84b-dc475f561dfa@net-b.de \
--to=burnus@net-b.de \
--cc=fortran@gcc.gnu.org \
--cc=jvdelisle@charter.net \
--cc=sgk@troutmask.apl.washington.edu \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).