From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <prvs=0700b8c1b2=burnus@net-b.de>
Received: from mx-relay81-hz2.antispameurope.com
 (mx-relay81-hz2.antispameurope.com [94.100.136.181])
 by sourceware.org (Postfix) with ESMTPS id DF6E73860C34
 for <fortran@gcc.gnu.org>; Sun, 14 Mar 2021 12:01:40 +0000 (GMT)
DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org DF6E73860C34
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-relay81-hz2.antispameurope.com; Sun, 14 Mar 2021 13:01:38 +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 4F6E12C0112;
 Sun, 14 Mar 2021 13:01:35 +0100 (CET)
Subject: Re: 12 PR fixed
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>
References: <20210313213338.GA1350@troutmask.apl.washington.edu>
 <407787d3-e6af-ed45-d02d-708dff36a9bb@charter.net>
 <fe22ba09-9968-e1cd-2133-1358901ed216@charter.net>
 <41ccb8db-cf7c-a49c-c84b-dc475f561dfa@net-b.de>
Message-ID: <147cab49-a0d2-ae80-1576-d47ccd3efe64@net-b.de>
Date: Sun, 14 Mar 2021 13:01:34 +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: <41ccb8db-cf7c-a49c-c84b-dc475f561dfa@net-b.de>
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-relay81-hz2.antispameurope.com with 08CFD2E1ED4
X-cloud-security-connect: s041.wsp.plusnet.de[195.90.7.81], TLS=1,
 IP=195.90.7.81
X-cloud-security-Digest: 6242c2730e5b9219dd63983b1117723c
X-cloud-security: scantime:1.409
X-Spam-Status: No, score=-9.1 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, 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 <fortran.gcc.gnu.org>
List-Unsubscribe: <https://gcc.gnu.org/mailman/options/fortran>,
 <mailto:fortran-request@gcc.gnu.org?subject=unsubscribe>
List-Archive: <https://gcc.gnu.org/pipermail/fortran/>
List-Help: <mailto:fortran-request@gcc.gnu.org?subject=help>
List-Subscribe: <https://gcc.gnu.org/mailman/listinfo/fortran>,
 <mailto:fortran-request@gcc.gnu.org?subject=subscribe>
X-List-Received-Date: Sun, 14 Mar 2021 12:01:45 -0000

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
>>>
>>