From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mx-relay82-hz1.antispameurope.com (mx-relay82-hz1.antispameurope.com [94.100.133.251]) by sourceware.org (Postfix) with ESMTPS id C25033860C34 for ; Sun, 14 Mar 2021 11:39:05 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org C25033860C34 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=net-b.de Authentication-Results: sourceware.org; spf=none smtp.mailfrom=prvs=0700b8c1b2=burnus@net-b.de Received: from s041.wsp.plusnet.de ([195.90.7.81]) by mx-relay82-hz1.antispameurope.com; Sun, 14 Mar 2021 12:39:03 +0100 Received: from [192.168.8.102] (tmo-117-141.customers.d1-online.com [80.187.117.141]) by s041.wsp.plusnet.de (Postfix) with ESMTPSA id D88612C0112; Sun, 14 Mar 2021 12:38:59 +0100 (CET) Subject: Re: 12 PR fixed To: Jerry DeLisle , Steve Kargl Cc: gfortran References: <20210313213338.GA1350@troutmask.apl.washington.edu> <407787d3-e6af-ed45-d02d-708dff36a9bb@charter.net> From: Tobias Burnus Message-ID: <41ccb8db-cf7c-a49c-c84b-dc475f561dfa@net-b.de> Date: Sun, 14 Mar 2021 12:38:59 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.8.1 MIME-Version: 1.0 In-Reply-To: Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Content-Language: en-US X-cloud-security-sender: burnus@net-b.de X-cloud-security-recipient: fortran@gcc.gnu.org X-cloud-security-Virusscan: CLEAN X-cloud-security-disclaimer: This E-Mail was scanned by E-Mailservice on mx-relay82-hz1.antispameurope.com with 8799838E0008 X-cloud-security-connect: s041.wsp.plusnet.de[195.90.7.81], TLS=1, IP=195.90.7.81 X-cloud-security-Digest: 76f2bb511d548883113ae27d4739e58b X-cloud-security: scantime:1.579 X-Spam-Status: No, score=-8.4 required=5.0 tests=BAYES_00, BODY_8BITS, GIT_PATCH_0, KAM_DMARC_STATUS, KAM_LAZY_DOMAIN_SECURITY, NICE_REPLY_A, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sun, 14 Mar 2021 11:39:10 -0000 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=, sym=0x2905350) at ../../repos/gcc/gcc/fortran/module.c:5892 #8 0x0000000000904272 in write_symbol1_recursion (sp=) at ../../repos/gcc/gcc/fortran/module.c:6122 #9 0x0000000000907136 in write_symbol1 (p=) at ../../repos/gcc/gcc/fortran/module.c:6155 #10 write_module () at ../../repos/gcc/gcc/fortran/module.c:6302 #11 dump_module (name=, 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 >> >