Re: 12 PR fixed

[Jerry DeLisle <jvdelisle@charter.net>]

I can convert the tabs/spaces no problem.

On 3/14/21 5:01 AM, Tobias Burnus wrote:
> Small additional remark: I see new lines which use 8 spaces instead of 
> a tab – that should also be fixed.
>
> And: Please don't forget to CC gcc-patches@ as well.
>
> Thanks,
>
> Tobias
>
> On 14.03.21 12:38, Tobias Burnus wrote:
>> On 14.03.21 06:13, Jerry DeLisle wrote:
>>
>>> Well, I am seeing the falling upon a closer look.  I do not know if 
>>> related to the patch yet.  Lets make sure this is fixed.
>>>
>>> FAIL: gfortran.dg/pr87907.f90   -O  (internal compiler error)
>>> FAIL: gfortran.dg/pr87907.f90   -O  (test for excess errors)
>>> FAIL: gfortran.dg/pr96013.f90   -O  (test for excess errors)
>>> FAIL: gfortran.dg/pr96025.f90   -O  (internal compiler error)
>>> FAIL: gfortran.dg/pr96025.f90   -O   (test for errors, line 5)
>>> FAIL: gfortran.dg/pr96025.f90   -O  (test for excess errors)
>>
>> I do see the failure with the new patch applied –
>> and the testcase from the patchset for:
>>
>> @@ -0,0 +1,10 @@
>> +! { dg-do compile }
>> +module m
>> +   type t
>> +   end type
>> +contains
>> +   function f() result(t)
>> +      character(3) :: c
>> +      c = 'abc'
>> +   end
>> +end
>>
>> The problem is that for:
>>
>> #6  0x00000000008c1195 in gfc_error (gmsgid=gmsgid@entry=0x1bfbdbe 
>> "Invalid symbol %qs at %L") at ../../repos/gcc/gcc/fortran/error.c:1381
>> #7  0x0000000000904204 in write_symbol (n=<optimized out>, 
>> sym=0x2905350) at ../../repos/gcc/gcc/fortran/module.c:5892
>> #8  0x0000000000904272 in write_symbol1_recursion (sp=<optimized 
>> out>) at ../../repos/gcc/gcc/fortran/module.c:6122
>> #9  0x0000000000907136 in write_symbol1 (p=<optimized out>) at 
>> ../../repos/gcc/gcc/fortran/module.c:6155
>> #10 write_module () at ../../repos/gcc/gcc/fortran/module.c:6302
>> #11 dump_module (name=<optimized out>, name@entry=0x7ffff7189120 "m", 
>> dump_flag=dump_flag@entry=1) at 
>> ../../repos/gcc/gcc/fortran/module.c:6431
>>
>> namely:
>>
>> 5889      if ((sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == 
>> FL_LABEL)
>> 5890          && !(sym->ts.type != BT_UNKNOWN && sym->attr.result))
>> 5891        {
>> 5892          gfc_error ("Invalid symbol %qs at %L", sym->name,
>> 5893                     &sym->declared_at);
>>
>> sym->name is invalid.
>>
>> valgrind shows:
>>
>> ==61032== Invalid read of size 1
>> ==61032==    at 0x90411C: write_symbol(int, gfc_symbol*) (module.c:5889)
>> ==61032==    by 0x904271: 
>> write_symbol1_recursion(sorted_pointer_info*) (module.c:6122)
>> ==61032==    by 0x907135: write_symbol1 (module.c:6155)
>> ==61032==    by 0x907135: write_module (module.c:6302)
>> ==61032==    by 0x907135: dump_module(char const*, int) (module.c:6431)
>> ==61032==    by 0x907494: gfc_dump_module(char const*, int) 
>> (module.c:6488)
>> ==61032==    by 0x922643: gfc_parse_file() (parse.c:6509)
>> ==61032==    by 0x971063: gfc_be_parse_file() (f95-lang.c:212)
>> ==61032==    by 0xF23C3E: compile_file() (toplev.c:457)
>> ==61032==    by 0x88453E: do_compile (toplev.c:2201)
>> ==61032==    by 0x88453E: toplev::main(int, char**) (toplev.c:2340)
>> ==61032==    by 0x88703F: main (main.c:39)
>> ==61032==  Address 0x52207fa is 90 bytes inside a block of size 344 
>> free'd
>> ==61032==    at 0x483CA3F: free (in 
>> /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so)
>> ==61032==    by 0x93C3BE: resolve_symbol(gfc_symbol*) (resolve.c:15340)
>> ==61032==    by 0x95B7F2: do_traverse_symtree(gfc_symtree*, void 
>> (*)(gfc_symtree*), void (*)(gfc_symbol*)) (symbol.c:4204)
>> ==61032==    by 0x93F2C3: resolve_types(gfc_namespace*) 
>> (resolve.c:17326)
>> ==61032==    by 0x93F363: resolve_types(gfc_namespace*) 
>> (resolve.c:17337)
>> ==61032==    by 0x93A80C: gfc_resolve(gfc_namespace*) [clone .part.0] 
>> (resolve.c:17441)
>> ==61032==    by 0x921F16: gfc_parse_file() (parse.c:6495)
>> ==61032==    by 0x971063: gfc_be_parse_file() (f95-lang.c:212)
>> ==61032==    by 0xF23C3E: compile_file() (toplev.c:457)
>> ==61032==    by 0x88453E: do_compile (toplev.c:2201)
>> ==61032==    by 0x88453E: toplev::main(int, char**) (toplev.c:2340)
>> ==61032==    by 0x88703F: main (main.c:39)
>> ==61032==  Block was alloc'd at
>> ==61032==    at 0x483DD99: calloc (in 
>> /usr/lib/x86_64-linux-gnu/valgrind/vgpreload_memcheck-amd64-linux.so)
>> ==61032==    by 0x1BBDD24: xcalloc (xmalloc.c:162)
>> ==61032==    by 0x960C4C: gfc_new_symbol(char const*, gfc_namespace*) 
>> (symbol.c:3172)
>> ==61032==    by 0x961007: gfc_get_sym_tree(char const*, 
>> gfc_namespace*, gfc_symtree**, bool) (symbol.c:3412)
>> ==61032==    by 0x961235: gfc_get_symbol(char const*, gfc_namespace*, 
>> gfc_symbol**) (symbol.c:3465)
>> ==61032==    by 0x8A79C3: match_result(gfc_symbol*, gfc_symbol**) 
>> [clone .isra.0] [clone .part.0] (decl.c:6679)
>> ==61032==    by 0x8AD29A: match_result (decl.c:6772)
>> ==61032==    by 0x8AD29A: gfc_match_suffix(gfc_symbol*, gfc_symbol**) 
>> (decl.c:6724)
>> ==61032==    by 0x8B194C: gfc_match_function_decl() (decl.c:7387)
>> ==61032==    by 0x9182AA: decode_statement() (parse.c:343)
>> ==61032==    by 0x91C53C: next_free (parse.c:1316)
>> ==61032==    by 0x91C53C: next_statement() (parse.c:1548)
>> ==61032==    by 0x920C0A: parse_contained(int) (parse.c:5746)
>> ==61032==    by 0x921A6E: parse_module() (parse.c:6173)
>>
>> Tobias
>>
>>
>>>
>>>
>>> On 3/13/21 8:46 PM, Jerry DeLisle wrote:
>>>> I have reviewed this and all looks good.
>>>>
>>>> I also regression tested on x86_64-pc-linux-gnu.
>>>>
>>>> I don't want to do a bunch of individual commits.
>>>>
>>>> Steve, if you can do a ChangeLog I can commit in one blast.
>>>>
>>>> Regards,
>>>>
>>>> Jerry
>>>>
>>>> On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote:
>>>>> The following patch fixes 91960, 93635, 95501, 95502, 95710, 96013,
>>>>> 96025, 97122, 99256, 99349, 99351, and 99506.  Most of the individual
>>>>> patches are languishing in bugzilla.  One or two needed to 
>>>>> reformatted
>>>>> due to divergences in main and my local repository. Please commit.
>>>>>
>>>>> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
>>>>> index 82db8e4e1b2..63138cfa9bc 100644
>>>>> --- a/gcc/fortran/check.c
>>>>> +++ b/gcc/fortran/check.c
>>>>> @@ -1009,6 +1009,14 @@ kind_value_check (gfc_expr *e, int n, int k)
>>>>>   static bool
>>>>>   variable_check (gfc_expr *e, int n, bool allow_proc)
>>>>>   {
>>>>> +  /* Expecting a variable, not an alternate return.  */
>>>>> +  if (!e)
>>>>> +    {
>>>>> +      gfc_error ("%qs argument of %qs intrinsic must be a variable",
>>>>> +         gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic);
>>>>> +      return false;
>>>>> +    }
>>>>> +
>>>>>     if (e->expr_type == EXPR_VARIABLE
>>>>>         && e->symtree->n.sym->attr.intent == INTENT_IN
>>>>>         && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
>>>>> diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
>>>>> index 947e4f868a1..9039c9dca2a 100644
>>>>> --- a/gcc/fortran/decl.c
>>>>> +++ b/gcc/fortran/decl.c
>>>>> @@ -410,9 +410,7 @@ match_data_constant (gfc_expr **result)
>>>>>         /* If a parameter inquiry ends up here, symtree is NULL 
>>>>> but **result
>>>>>        contains the right constant expression.  Check here. */
>>>>>         if ((*result)->symtree == NULL
>>>>> -      && (*result)->expr_type == EXPR_CONSTANT
>>>>> -      && ((*result)->ts.type == BT_INTEGER
>>>>> -          || (*result)->ts.type == BT_REAL))
>>>>> +      && (*result)->expr_type == EXPR_CONSTANT)
>>>>>       return m;
>>>>>           /* F2018:R845 data-stmt-constant is initial-data-target.
>>>>> @@ -1772,12 +1770,6 @@ gfc_set_constant_character_len 
>>>>> (gfc_charlen_t len, gfc_expr *expr,
>>>>>     if (expr->ts.type != BT_CHARACTER)
>>>>>       return;
>>>>>   -  if (expr->expr_type != EXPR_CONSTANT)
>>>>> -    {
>>>>> -      gfc_error_now ("CHARACTER length must be a constant at %L", 
>>>>> &expr->where);
>>>>> -      return;
>>>>> -    }
>>>>> -
>>>>>     slen = expr->value.character.length;
>>>>>     if (len != slen)
>>>>>       {
>>>>> @@ -11495,8 +11487,9 @@ gfc_match_final_decl (void)
>>>>>     block = gfc_state_stack->previous->sym;
>>>>>     gcc_assert (block);
>>>>>   -  if (!gfc_state_stack->previous || 
>>>>> !gfc_state_stack->previous->previous
>>>>> -      || gfc_state_stack->previous->previous->state != COMP_MODULE)
>>>>> +  if (!gfc_state_stack->previous->previous
>>>>> +      && gfc_state_stack->previous->previous->state != COMP_MODULE
>>>>> +      && gfc_state_stack->previous->previous->state != 
>>>>> COMP_SUBMODULE)
>>>>>       {
>>>>>         gfc_error ("Derived type declaration with FINAL at %C must 
>>>>> be in the"
>>>>>            " specification part of a MODULE");
>>>>> @@ -11505,7 +11498,6 @@ gfc_match_final_decl (void)
>>>>>       module_ns = gfc_current_ns;
>>>>>     gcc_assert (module_ns);
>>>>> -  gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE);
>>>>>       /* Match optional ::, don't care about MATCH_YES or 
>>>>> MATCH_NO.  */
>>>>>     if (gfc_match (" ::") == MATCH_ERROR)
>>>>> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
>>>>> index 92a6700568d..e1acc2db000 100644
>>>>> --- a/gcc/fortran/expr.c
>>>>> +++ b/gcc/fortran/expr.c
>>>>> @@ -3476,6 +3476,7 @@ gfc_specification_expr (gfc_expr *e)
>>>>>       {
>>>>>         gfc_error ("Expression at %L must be of INTEGER type, 
>>>>> found %s",
>>>>>            &e->where, gfc_basic_typename (e->ts.type));
>>>>> +      gfc_clear_ts (&e->ts);
>>>>>         return false;
>>>>>       }
>>>>>   @@ -3815,6 +3816,9 @@ gfc_check_pointer_assign (gfc_expr 
>>>>> *lvalue, gfc_expr *rvalue,
>>>>>     int proc_pointer;
>>>>>     bool same_rank;
>>>>>   +  if (!lvalue->symtree)
>>>>> +    return false;
>>>>> +
>>>>>     lhs_attr = gfc_expr_attr (lvalue);
>>>>>     if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
>>>>>       {
>>>>> diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
>>>>> index 4d5890fd523..86aabf4a840 100644
>>>>> --- a/gcc/fortran/match.c
>>>>> +++ b/gcc/fortran/match.c
>>>>> @@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
>>>>>     gfc_matching_procptr_assignment = 0;
>>>>>       m = gfc_match (" %v =>", &lvalue);
>>>>> -  if (m != MATCH_YES)
>>>>> +  if (m != MATCH_YES || !lvalue->symtree)
>>>>>       {
>>>>>         m = MATCH_NO;
>>>>>         goto cleanup;
>>>>> @@ -3867,6 +3867,15 @@ sync_statement (gfc_statement st)
>>>>>         stat = tmp;
>>>>>         saw_stat = true;
>>>>>   +      if (tmp->symtree
>>>>> +          && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
>>>>> +          || tmp->symtree->n.sym->ts.type != BT_INTEGER))
>>>>> +        {
>>>>> +          gfc_error ("Expecting scalar-int-variable at %L",
>>>>> +             &tmp->where);
>>>>> +          goto cleanup;
>>>>> +        }
>>>>> +
>>>>>         if (gfc_match_char (',') == MATCH_YES)
>>>>>           continue;
>>>>>   @@ -3884,6 +3893,16 @@ sync_statement (gfc_statement st)
>>>>>             gfc_error ("Redundant ERRMSG tag found at %L", 
>>>>> &tmp->where);
>>>>>             goto cleanup;
>>>>>           }
>>>>> +
>>>>> +      if (tmp->symtree
>>>>> +          && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER
>>>>> +          || tmp->symtree->n.sym->ts.type != BT_CHARACTER))
>>>>> +        {
>>>>> +          gfc_error ("Expecting scalar-default-char-variable at %L",
>>>>> +             &tmp->where);
>>>>> +          goto cleanup;
>>>>> +        }
>>>>> +
>>>>>         errmsg = tmp;
>>>>>         saw_errmsg = true;
>>>>>   diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
>>>>> index 4db0a3ac76d..aa039a8d9a0 100644
>>>>> --- a/gcc/fortran/module.c
>>>>> +++ b/gcc/fortran/module.c
>>>>> @@ -5886,8 +5886,13 @@ write_symbol (int n, gfc_symbol *sym)
>>>>>   {
>>>>>     const char *label;
>>>>>   -  if (sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == 
>>>>> FL_LABEL)
>>>>> -    gfc_internal_error ("write_symbol(): bad module symbol %qs", 
>>>>> sym->name);
>>>>> +  if ((sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == 
>>>>> FL_LABEL)
>>>>> +      && !(sym->ts.type != BT_UNKNOWN && sym->attr.result))
>>>>> +    {
>>>>> +      gfc_error ("Invalid symbol %qs at %L", sym->name,
>>>>> +         &sym->declared_at);
>>>>> +      return;
>>>>> +    }
>>>>>       mio_integer (&n);
>>>>>   diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
>>>>> index 1549f8e1635..610e729c68a 100644
>>>>> --- a/gcc/fortran/parse.c
>>>>> +++ b/gcc/fortran/parse.c
>>>>> @@ -4485,6 +4485,9 @@ gfc_check_do_variable (gfc_symtree *st)
>>>>>   {
>>>>>     gfc_state_data *s;
>>>>>   +  if (!st)
>>>>> +    return 0;
>>>>> +
>>>>>     for (s=gfc_state_stack; s; s = s->previous)
>>>>>       if (s->do_variable == st)
>>>>>         {
>>>>> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
>>>>> index 32015c21efc..286e1372699 100644
>>>>> --- a/gcc/fortran/resolve.c
>>>>> +++ b/gcc/fortran/resolve.c
>>>>> @@ -8902,6 +8902,9 @@ resolve_select (gfc_code *code, bool 
>>>>> select_type)
>>>>>   bool
>>>>>   gfc_type_is_extensible (gfc_symbol *sym)
>>>>>   {
>>>>> +  if (!sym)
>>>>> +    return false;
>>>>> +
>>>>>     return !(sym->attr.is_bind_c || sym->attr.sequence
>>>>>          || (sym->attr.is_class
>>>>>              && 
>>>>> sym->components->ts.u.derived->attr.unlimited_polymorphic));
>>>>> @@ -12749,9 +12752,13 @@ resolve_fl_var_and_proc (gfc_symbol *sym, 
>>>>> int mp_flag)
>>>>>         && !UNLIMITED_POLY (sym)
>>>>>         && !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
>>>>>       {
>>>>> -      gfc_error ("Type %qs of CLASS variable %qs at %L is not 
>>>>> extensible",
>>>>> -             CLASS_DATA (sym)->ts.u.derived->name, sym->name,
>>>>> -             &sym->declared_at);
>>>>> +      if (CLASS_DATA (sym)->ts.u.derived)
>>>>> +        gfc_error ("Type %qs of CLASS variable %qs at %L is not 
>>>>> extensible",
>>>>> +             CLASS_DATA (sym)->ts.u.derived->name,
>>>>> +            sym->name, &sym->declared_at);
>>>>> +      else
>>>>> +        gfc_error ("CLASS variable %qs at %L is not extensible",
>>>>> +            sym->name, &sym->declared_at);
>>>>>         return false;
>>>>>       }
>>>>>   @@ -15179,6 +15186,20 @@ resolve_fl_parameter (gfc_symbol *sym)
>>>>>         return false;
>>>>>       }
>>>>>   +  /* Some programmers can have a typo when using an implied-do 
>>>>> loop to
>>>>> +     initialize an array constant.  For example,
>>>>> +       INTEGER I,J
>>>>> +       INTEGER, PARAMETER :: A(3) = [(I, I = 1, 3)]    ! OK
>>>>> +       INTEGER, PARAMETER :: B(3) = [(A(J), I = 1, 3)]  ! Not OK
>>>>> +     This check catches the typo.  */
>>>>> +  if (sym->attr.dimension
>>>>> +      && sym->value && sym->value->expr_type == EXPR_ARRAY
>>>>> +      && !gfc_is_constant_expr (sym->value))
>>>>> +    {
>>>>> +      gfc_error ("Expecting constant expression near %L", 
>>>>> &sym->value->where);
>>>>> +      return false;
>>>>> +    }
>>>>> +
>>>>>     return true;
>>>>>   }
>>>>>   diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
>>>>> index e982374d9d1..d7d3900cd6e 100644
>>>>> --- a/gcc/fortran/symbol.c
>>>>> +++ b/gcc/fortran/symbol.c
>>>>> @@ -309,6 +309,7 @@ gfc_set_default_type (gfc_symbol *sym, int 
>>>>> error_flag, gfc_namespace *ns)
>>>>>         else
>>>>>           gfc_error ("Symbol %qs at %L has no IMPLICIT type",
>>>>>                  sym->name, &sym->declared_at);
>>>>> +
>>>>>         sym->attr.untyped = 1; /* Ensure we only give an error 
>>>>> once.  */
>>>>>       }
>>>>>   @@ -394,18 +395,34 @@ gfc_check_function_type (gfc_namespace *ns)
>>>>>     /******************** Symbol attribute stuff 
>>>>> *********************/
>>>>>   +/* Older standards produced conflicts for some attributes that 
>>>>> are now
>>>>> +   allowed in newer standards.  Check for the conflict and issue an
>>>>> +   error depending on the standard in play.  */
>>>>> +
>>>>> +static bool
>>>>> +conflict_std (int standard, const char *a1, const char *a2, const 
>>>>> char *name,
>>>>> +          locus *where)
>>>>> +{
>>>>> +  if (name == NULL)
>>>>> +    {
>>>>> +      return gfc_notify_std (standard, "%s attribute conflicts "
>>>>> +                             "with %s attribute at %L", a1, a2,
>>>>> +                             where);
>>>>> +    }
>>>>> +  else
>>>>> +    {
>>>>> +      return gfc_notify_std (standard, "%s attribute conflicts "
>>>>> +                 "with %s attribute in %qs at %L",
>>>>> +                             a1, a2, name, where);
>>>>> +    }
>>>>> +}
>>>>> +
>>>>> +
>>>>>   /* This is a generic conflict-checker.  We do this to avoid 
>>>>> having a
>>>>>      single conflict in two places.  */
>>>>>     #define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; 
>>>>> goto conflict; }
>>>>>   #define conf2(a) if (attr->a) { a2 = a; goto conflict; }
>>>>> -#define conf_std(a, b, std) if (attr->a && attr->b)\
>>>>> -                              {\
>>>>> -                                a1 = a;\
>>>>> -                                a2 = b;\
>>>>> -                                standard = std;\
>>>>> -                                goto conflict_std;\
>>>>> -                              }
>>>>>     bool
>>>>>   gfc_check_conflict (symbol_attribute *attr, const char *name, 
>>>>> locus *where)
>>>>> @@ -438,7 +455,7 @@ gfc_check_conflict (symbol_attribute *attr, 
>>>>> const char *name, locus *where)
>>>>>                           "OACC DECLARE DEVICE_RESIDENT";
>>>>>       const char *a1, *a2;
>>>>> -  int standard;
>>>>> +  bool standard;
>>>>>       if (attr->artificial)
>>>>>       return true;
>>>>> @@ -450,16 +467,18 @@ gfc_check_conflict (symbol_attribute *attr, 
>>>>> const char *name, locus *where)
>>>>>       {
>>>>>         a1 = pointer;
>>>>>         a2 = intent;
>>>>> -      standard = GFC_STD_F2003;
>>>>> -      goto conflict_std;
>>>>> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
>>>>> +      if (!standard)
>>>>> +         return standard;
>>>>>       }
>>>>>       if (attr->in_namelist && (attr->allocatable || attr->pointer))
>>>>>       {
>>>>>         a1 = in_namelist;
>>>>>         a2 = attr->allocatable ? allocatable : pointer;
>>>>> -      standard = GFC_STD_F2003;
>>>>> -      goto conflict_std;
>>>>> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
>>>>> +      if (!standard)
>>>>> +         return standard;
>>>>>       }
>>>>>       /* Check for attributes not allowed in a BLOCK DATA. */
>>>>> @@ -566,10 +585,42 @@ gfc_check_conflict (symbol_attribute *attr, 
>>>>> const char *name, locus *where)
>>>>>       return false;
>>>>>       conf (allocatable, pointer);
>>>>> -  conf_std (allocatable, dummy, GFC_STD_F2003);
>>>>> -  conf_std (allocatable, function, GFC_STD_F2003);
>>>>> -  conf_std (allocatable, result, GFC_STD_F2003);
>>>>> -  conf_std (elemental, recursive, GFC_STD_F2018);
>>>>> +
>>>>> +  if (attr->allocatable && attr->dummy)
>>>>> +    {
>>>>> +      a1 = allocatable;
>>>>> +      a2 = dummy;
>>>>> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
>>>>> +      if (!standard)
>>>>> +         return standard;
>>>>> +    }
>>>>> +
>>>>> +  if (attr->allocatable && attr->function)
>>>>> +    {
>>>>> +      a1 = allocatable;
>>>>> +      a2 = function;
>>>>> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
>>>>> +      if (!standard)
>>>>> +         return standard;
>>>>> +    }
>>>>> +
>>>>> +  if (attr->allocatable && attr->result)
>>>>> +    {
>>>>> +      a1 = allocatable;
>>>>> +      a2 = result;
>>>>> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
>>>>> +      if (!standard)
>>>>> +         return standard;
>>>>> +    }
>>>>> +
>>>>> +  if (attr->elemental && attr->recursive)
>>>>> +    {
>>>>> +      a1 = elemental;
>>>>> +      a2 = recursive;
>>>>> +      standard = conflict_std (GFC_STD_F2018, a1, a2, name, where);
>>>>> +      if (!standard)
>>>>> +         return standard;
>>>>> +    }
>>>>>       conf (in_common, dummy);
>>>>>     conf (in_common, allocatable);
>>>>> @@ -908,25 +959,10 @@ conflict:
>>>>>              a1, a2, name, where);
>>>>>       return false;
>>>>> -
>>>>> -conflict_std:
>>>>> -  if (name == NULL)
>>>>> -    {
>>>>> -      return gfc_notify_std (standard, "%s attribute conflicts "
>>>>> -                             "with %s attribute at %L", a1, a2,
>>>>> -                             where);
>>>>> -    }
>>>>> -  else
>>>>> -    {
>>>>> -      return gfc_notify_std (standard, "%s attribute conflicts "
>>>>> -                 "with %s attribute in %qs at %L",
>>>>> -                             a1, a2, name, where);
>>>>> -    }
>>>>>   }
>>>>>     #undef conf
>>>>>   #undef conf2
>>>>> -#undef conf_std
>>>>>       /* Mark a symbol as referenced.  */
>>>>> @@ -4034,8 +4070,6 @@ gfc_free_namespace (gfc_namespace *ns)
>>>>>     if (ns->refs > 0)
>>>>>       return;
>>>>>   -  gcc_assert (ns->refs == 0);
>>>>> -
>>>>>     gfc_free_statements (ns->code);
>>>>>       free_sym_tree (ns->sym_root);
>>>>> diff --git a/gcc/testsuite/gfortran.dg/coarray_3.f90 
>>>>> b/gcc/testsuite/gfortran.dg/coarray_3.f90
>>>>> index d152ce1b2bd..1049e426085 100644
>>>>> --- a/gcc/testsuite/gfortran.dg/coarray_3.f90
>>>>> +++ b/gcc/testsuite/gfortran.dg/coarray_3.f90
>>>>> @@ -13,8 +13,8 @@ end critical fkl ! { dg-error "Expecting END 
>>>>> PROGRAM" }
>>>>>     sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
>>>>>   sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
>>>>> -sync memory (errmsg=str) ! { dg-error "must be a scalar CHARACTER 
>>>>> variable" }
>>>>> -sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER 
>>>>> variable" }
>>>>> +sync memory (errmsg=str) ! { dg-error "must be a scalar CHARACTER" }
>>>>> +sync memory (errmsg=n) ! { dg-error "Expecting 
>>>>> scalar-default-char-variable" }
>>>>>   sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC 
>>>>> IMAGES" }
>>>>>   sync images (-1) ! { dg-error "must between 1 and num_images" }
>>>>>   sync images (1)
>>>>> diff --git a/gcc/testsuite/gfortran.dg/finalize_8.f03 
>>>>> b/gcc/testsuite/gfortran.dg/finalize_8.f03
>>>>> index b2027a0ba6d..2c4f1d30108 100644
>>>>> --- a/gcc/testsuite/gfortran.dg/finalize_8.f03
>>>>> +++ b/gcc/testsuite/gfortran.dg/finalize_8.f03
>>>>> @@ -16,12 +16,12 @@ CONTAINS
>>>>>         INTEGER, ALLOCATABLE :: fooarr(:)
>>>>>         REAL :: foobar
>>>>>       CONTAINS
>>>>> -      FINAL :: myfinal ! { dg-error "in the specification part of 
>>>>> a MODULE" }
>>>>> +      FINAL :: myfinal
>>>>>       END TYPE mytype
>>>>>       CONTAINS
>>>>>   -    SUBROUTINE myfinal (el)
>>>>> +    SUBROUTINE myfinal (el) ! { dg-error "is already declared as 
>>>>> MODULE-PROC" }
>>>>>         TYPE(mytype) :: el
>>>>>       END SUBROUTINE myfinal
>>>>>   diff --git a/gcc/testsuite/gfortran.dg/pr69962.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr69962.f90
>>>>> index 2684398ee31..def7364de59 100644
>>>>> --- a/gcc/testsuite/gfortran.dg/pr69962.f90
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr69962.f90
>>>>> @@ -2,5 +2,5 @@
>>>>>   program p
>>>>>      integer :: n = 1
>>>>>      character(3), parameter :: x(2) = ['abc', 'xyz']
>>>>> -   character(2), parameter :: y(2) = [x(2)(2:3), x(n)(1:2)] ! { 
>>>>> dg-error "CHARACTER length must be a constant" }
>>>>> +   character(2), parameter :: y(2) = [x(2)(2:3), x(n)(1:2)] ! { 
>>>>> dg-error "Expecting constant" }
>>>>>   end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr87907.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr87907.f90
>>>>> index 0fe4e5090d2..a4a5ecfac07 100644
>>>>> --- a/gcc/testsuite/gfortran.dg/pr87907.f90
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr87907.f90
>>>>> @@ -12,12 +12,6 @@ end
>>>>>     submodule(m) m2
>>>>>      contains
>>>>> -      subroutine g(x)   ! { dg-error "mismatch in argument" }
>>>>> +      subroutine g(x)   ! { dg-error "attribute conflicts with" }
>>>>>         end
>>>>>   end
>>>>> -
>>>>> -program p
>>>>> -   use m                ! { dg-error "has a type" }
>>>>> -   integer :: x = 3
>>>>> -   call g(x)            ! { dg-error "which is not consistent 
>>>>> with" }
>>>>> -end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr91960.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr91960.f90
>>>>> new file mode 100644
>>>>> index 00000000000..76663f00c01
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr91960.f90
>>>>> @@ -0,0 +1,6 @@
>>>>> +! { dg-do compile }
>>>>> +module m
>>>>> +   integer :: i, j
>>>>> +   integer, parameter :: a(3) = [(i,i=1,3)]
>>>>> +   integer, parameter :: b(3) = [(a(j),i=1,3)]  ! { dg-error " 
>>>>> Expecting constant" }
>>>>> +end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr93635.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr93635.f90
>>>>> new file mode 100644
>>>>> index 00000000000..b9700f31713
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr93635.f90
>>>>> @@ -0,0 +1,8 @@
>>>>> +! { dg-do compile }
>>>>> +program boom
>>>>> +   implicit none
>>>>> +   character(len=:),allocatable :: r,rel
>>>>> +   namelist /args/ r,rel
>>>>> +   equivalence(r,rel)      ! { dg-error "EQUIVALENCE attribute 
>>>>> conflicts" }
>>>>> +   allocate(character(len=1024) :: r)
>>>>> +   end program boom
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr95501.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr95501.f90
>>>>> new file mode 100644
>>>>> index 00000000000..b83f6ab9f1f
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr95501.f90
>>>>> @@ -0,0 +1,18 @@
>>>>> +! { dg-do compile }
>>>>> +subroutine p
>>>>> +   integer, target :: a = 2
>>>>> +   integer, pointer :: z
>>>>> +   z%kind => a%kind     ! { dg-error "a constant expression" }
>>>>> +   z%kind => a          ! { dg-error "a constant expression" }
>>>>> +end
>>>>> +
>>>>> +subroutine q
>>>>> +   character, target :: a = 'a'
>>>>> +   character, pointer :: z
>>>>> +   z%kind => a          ! { dg-error "a constant expression" }
>>>>> +   z%kind => a%kind     ! { dg-error "a constant expression" }
>>>>> +   z%len => a           ! { dg-error "a constant expression" }
>>>>> +   z%len => a%len       ! { dg-error "a constant expression" }
>>>>> +   a%kind => a%len      ! { dg-error "a constant expression" }
>>>>> +   a%len => a%kind      ! { dg-error "a constant expression" }
>>>>> +end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr95502.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr95502.f90
>>>>> new file mode 100644
>>>>> index 00000000000..a5751bb8b76
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr95502.f90
>>>>> @@ -0,0 +1,9 @@
>>>>> +! { dg-do compile }
>>>>> +subroutine p
>>>>> +   character, pointer :: z ! { dg-error "in variable definition 
>>>>> context" }
>>>>> +   complex, pointer :: a
>>>>> +   nullify(z%len)
>>>>> +   nullify(z%kind)         ! { dg-error "in variable definition 
>>>>> context" }
>>>>> +   nullify(a%re)           ! { dg-error "in pointer association 
>>>>> context" }
>>>>> +   nullify(a%im)           ! { dg-error "in pointer association 
>>>>> context" }
>>>>> +end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr95710.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr95710.f90
>>>>> new file mode 100644
>>>>> index 00000000000..7eab368cb5d
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr95710.f90
>>>>> @@ -0,0 +1,17 @@
>>>>> +! { dg-do compile }
>>>>> +module m
>>>>> +   type t
>>>>> +      integer :: a = 1
>>>>> +   end type
>>>>> +   interface
>>>>> +      module subroutine s
>>>>> +      end
>>>>> +   end interface
>>>>> +end
>>>>> +submodule(m) m2
>>>>> +contains
>>>>> +   subroutine s   ! or module subroutine s
>>>>> +      class(t), allocatable :: x    ! { dg-error "is not 
>>>>> extensible" }
>>>>> +      class(t), allocatable :: x
>>>>> +   end
>>>>> +end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr96013.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr96013.f90
>>>>> new file mode 100644
>>>>> index 00000000000..a5c6a13547f
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr96013.f90
>>>>> @@ -0,0 +1,10 @@
>>>>> +! { dg-do compile }
>>>>> +module m
>>>>> +   type t
>>>>> +   end type
>>>>> +contains
>>>>> +   function f() result(t)
>>>>> +      character(3) :: c
>>>>> +      c = 'abc'
>>>>> +   end
>>>>> +end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr96025.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr96025.f90
>>>>> new file mode 100644
>>>>> index 00000000000..5ff8f6452bb
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr96025.f90
>>>>> @@ -0,0 +1,8 @@
>>>>> +! { dg-do compile }
>>>>> +program p
>>>>> +   print *, f()
>>>>> +contains
>>>>> +   character(char(1)) function f()  ! { dg-error "must be of 
>>>>> INTEGER type" }s
>>>>> +      f = 'f'
>>>>> +   end
>>>>> +end
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr97122.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr97122.f90
>>>>> new file mode 100644
>>>>> index 00000000000..a81edb68fd8
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr97122.f90
>>>>> @@ -0,0 +1,24 @@
>>>>> +! { dg-do compile }
>>>>> +module m
>>>>> +  implicit none
>>>>> +  interface
>>>>> +    module subroutine other
>>>>> +      implicit none
>>>>> +    end subroutine other
>>>>> +  end interface
>>>>> +end module m
>>>>> +
>>>>> +submodule (m) s
>>>>> +  implicit none
>>>>> +  type :: t
>>>>> +  contains
>>>>> +    final :: p
>>>>> +  end type t
>>>>> +contains
>>>>> +  subroutine p(arg)
>>>>> +    type(t), intent(inout) :: arg
>>>>> +  end subroutine p
>>>>> +
>>>>> +  module subroutine other
>>>>> +  end subroutine other
>>>>> +end submodule s
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr99256.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr99256.f90
>>>>> new file mode 100644
>>>>> index 00000000000..b39e1453ce3
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr99256.f90
>>>>> @@ -0,0 +1,7 @@
>>>>> +! { dg-do compile }
>>>>> +! { dg-options "-w" }
>>>>> +program p
>>>>> +   call move_alloc (*1, *1)
>>>>> + 1 stop
>>>>> +end
>>>>> +! { dg-prune-output "must be a variable" }
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr99349.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr99349.f90
>>>>> new file mode 100644
>>>>> index 00000000000..d5b34eeeebd
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr99349.f90
>>>>> @@ -0,0 +1,7 @@
>>>>> +! { dg-do compile }
>>>>> +function f()
>>>>> +   logical, parameter :: a((1.)/0) = .true.  ! { dg-error 
>>>>> "Division by zero" }
>>>>> +   integer :: b
>>>>> +   data b /a%kind/      ! { dg-error "Incompatible ranks" }
>>>>> +end
>>>>> +! { dg-prune-output "Parameter array" }
>>>>> diff --git a/gcc/testsuite/gfortran.dg/pr99351.f90 
>>>>> b/gcc/testsuite/gfortran.dg/pr99351.f90
>>>>> new file mode 100644
>>>>> index 00000000000..a36fcf9cd5d
>>>>> --- /dev/null
>>>>> +++ b/gcc/testsuite/gfortran.dg/pr99351.f90
>>>>> @@ -0,0 +1,17 @@
>>>>> +! { dg-do compile }
>>>>> +! { dg-options "-fcoarray=single" }
>>>>> +module m
>>>>> +   character(3), parameter :: c = 'abc'
>>>>> +contains
>>>>> +   subroutine s
>>>>> +      sync all (errmsg=c)        ! { dg-error "Expecting 
>>>>> scalar-default-char-variable" }
>>>>> +   end
>>>>> +end module m
>>>>> +
>>>>> +module n
>>>>> +   integer, parameter :: a = 0
>>>>> +contains
>>>>> +   subroutine s
>>>>> +      sync images (*, stat=a)    ! { dg-error "Expecting 
>>>>> scalar-int-variable" }
>>>>> +   end
>>>>> +end module n
>>>>
>>>