From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from impout009.msg.chrl.nc.charter.net (impout009aa.msg.chrl.nc.charter.net [47.43.20.33]) by sourceware.org (Postfix) with ESMTPS id 72C333857C6B for ; Sun, 14 Mar 2021 05:13:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 72C333857C6B Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=charter.net Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=jvdelisle@charter.net Received: from [192.168.1.119] ([76.178.144.232]) by cmsmtp with ESMTPA id LJ4blMuJwe9aELJ4cllADb; Sun, 14 Mar 2021 05:13:55 +0000 Authentication-Results: charter.net; none X-Authority-Analysis: v=2.3 cv=NdJSKFL4 c=1 sm=1 tr=0 a=40r4m8ZdyXnswhLz6cknGw==:117 a=40r4m8ZdyXnswhLz6cknGw==:17 a=IkcTkHD0fZMA:10 a=dE8wyuWs14f3rGTZ2WgA:9 a=Z2gqv9ekZJNEq9fe:21 a=9-41JHcKepUNQjeF:21 a=QEXdDO2ut3YA:10 Subject: Re: 12 PR fixed From: Jerry DeLisle To: Steve Kargl Cc: gfortran References: <20210313213338.GA1350@troutmask.apl.washington.edu> <407787d3-e6af-ed45-d02d-708dff36a9bb@charter.net> Message-ID: Date: Sat, 13 Mar 2021 21:13:53 -0800 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.8.0 MIME-Version: 1.0 In-Reply-To: <407787d3-e6af-ed45-d02d-708dff36a9bb@charter.net> Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Content-Language: en-US X-CMAE-Envelope: MS4wfHr+dmXP4HvCETgAKt0XdFlFIVGJtphsn+sw2cj1u0Kcy70LeAIw1jyTDE2PNBY3oL3942+gQpvlfBBlxSHGlT9E5s9Y+xuFbJbtL8LjnGC1OXgGuHk+ /GMNF9OZzsv+C9VjrHFZ5aC0VHn6VHN71RlvjvfnAvSMJJabqJk98oas4tizgH8tpqkNdZeWAWFcyvX/IbJzCM+mUHrNN+UVGtPGR0HnE+L0TUdANIR8o6qm X-Spam-Status: No, score=-8.9 required=5.0 tests=BAYES_00, BODY_8BITS, FREEMAIL_FROM, GIT_PATCH_0, KAM_DMARC_STATUS, NICE_REPLY_A, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, 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 05:13:58 -0000 Well, I am seeing the falling upon a closer look.  I do not know if related to the patch yet.  Lets make sure this is fixed. FAIL: gfortran.dg/pr87907.f90   -O  (internal compiler error) FAIL: gfortran.dg/pr87907.f90   -O  (test for excess errors) FAIL: gfortran.dg/pr96013.f90   -O  (test for excess errors) FAIL: gfortran.dg/pr96025.f90   -O  (internal compiler error) FAIL: gfortran.dg/pr96025.f90   -O   (test for errors, line 5) FAIL: gfortran.dg/pr96025.f90   -O  (test for excess errors) On 3/13/21 8:46 PM, Jerry DeLisle wrote: > I have reviewed this and all looks good. > > I also regression tested on x86_64-pc-linux-gnu. > > I don't want to do a bunch of individual commits. > > Steve, if you can do a ChangeLog I can commit in one blast. > > Regards, > > Jerry > > On 3/13/21 1:33 PM, Steve Kargl via Fortran wrote: >> The following patch fixes 91960, 93635, 95501, 95502, 95710, 96013, >> 96025, 97122, 99256, 99349, 99351, and 99506.  Most of the individual >> patches are languishing in bugzilla.  One or two needed to reformatted >> due to divergences in main and my local repository.  Please commit. >> >> diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c >> index 82db8e4e1b2..63138cfa9bc 100644 >> --- a/gcc/fortran/check.c >> +++ b/gcc/fortran/check.c >> @@ -1009,6 +1009,14 @@ kind_value_check (gfc_expr *e, int n, int k) >>   static bool >>   variable_check (gfc_expr *e, int n, bool allow_proc) >>   { >> +  /* Expecting a variable, not an alternate return.  */ >> +  if (!e) >> +    { >> +      gfc_error ("%qs argument of %qs intrinsic must be a variable", >> +         gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic); >> +      return false; >> +    } >> + >>     if (e->expr_type == EXPR_VARIABLE >>         && e->symtree->n.sym->attr.intent == INTENT_IN >>         && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT >> diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c >> index 947e4f868a1..9039c9dca2a 100644 >> --- a/gcc/fortran/decl.c >> +++ b/gcc/fortran/decl.c >> @@ -410,9 +410,7 @@ match_data_constant (gfc_expr **result) >>         /* If a parameter inquiry ends up here, symtree is NULL but >> **result >>        contains the right constant expression.  Check here.  */ >>         if ((*result)->symtree == NULL >> -      && (*result)->expr_type == EXPR_CONSTANT >> -      && ((*result)->ts.type == BT_INTEGER >> -          || (*result)->ts.type == BT_REAL)) >> +      && (*result)->expr_type == EXPR_CONSTANT) >>       return m; >>           /* F2018:R845 data-stmt-constant is initial-data-target. >> @@ -1772,12 +1770,6 @@ gfc_set_constant_character_len (gfc_charlen_t >> len, gfc_expr *expr, >>     if (expr->ts.type != BT_CHARACTER) >>       return; >>   -  if (expr->expr_type != EXPR_CONSTANT) >> -    { >> -      gfc_error_now ("CHARACTER length must be a constant at %L", >> &expr->where); >> -      return; >> -    } >> - >>     slen = expr->value.character.length; >>     if (len != slen) >>       { >> @@ -11495,8 +11487,9 @@ gfc_match_final_decl (void) >>     block = gfc_state_stack->previous->sym; >>     gcc_assert (block); >>   -  if (!gfc_state_stack->previous || >> !gfc_state_stack->previous->previous >> -      || gfc_state_stack->previous->previous->state != COMP_MODULE) >> +  if (!gfc_state_stack->previous->previous >> +      && gfc_state_stack->previous->previous->state != COMP_MODULE >> +      && gfc_state_stack->previous->previous->state != COMP_SUBMODULE) >>       { >>         gfc_error ("Derived type declaration with FINAL at %C must be >> in the" >>            " specification part of a MODULE"); >> @@ -11505,7 +11498,6 @@ gfc_match_final_decl (void) >>       module_ns = gfc_current_ns; >>     gcc_assert (module_ns); >> -  gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE); >>       /* Match optional ::, don't care about MATCH_YES or MATCH_NO.  */ >>     if (gfc_match (" ::") == MATCH_ERROR) >> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c >> index 92a6700568d..e1acc2db000 100644 >> --- a/gcc/fortran/expr.c >> +++ b/gcc/fortran/expr.c >> @@ -3476,6 +3476,7 @@ gfc_specification_expr (gfc_expr *e) >>       { >>         gfc_error ("Expression at %L must be of INTEGER type, found %s", >>            &e->where, gfc_basic_typename (e->ts.type)); >> +      gfc_clear_ts (&e->ts); >>         return false; >>       } >>   @@ -3815,6 +3816,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, >> gfc_expr *rvalue, >>     int proc_pointer; >>     bool same_rank; >>   +  if (!lvalue->symtree) >> +    return false; >> + >>     lhs_attr = gfc_expr_attr (lvalue); >>     if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer) >>       { >> diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c >> index 4d5890fd523..86aabf4a840 100644 >> --- a/gcc/fortran/match.c >> +++ b/gcc/fortran/match.c >> @@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void) >>     gfc_matching_procptr_assignment = 0; >>       m = gfc_match (" %v =>", &lvalue); >> -  if (m != MATCH_YES) >> +  if (m != MATCH_YES || !lvalue->symtree) >>       { >>         m = MATCH_NO; >>         goto cleanup; >> @@ -3867,6 +3867,15 @@ sync_statement (gfc_statement st) >>         stat = tmp; >>         saw_stat = true; >>   +      if (tmp->symtree >> +          && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER >> +          || tmp->symtree->n.sym->ts.type != BT_INTEGER)) >> +        { >> +          gfc_error ("Expecting scalar-int-variable at %L", >> +             &tmp->where); >> +          goto cleanup; >> +        } >> + >>         if (gfc_match_char (',') == MATCH_YES) >>           continue; >>   @@ -3884,6 +3893,16 @@ sync_statement (gfc_statement st) >>             gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where); >>             goto cleanup; >>           } >> + >> +      if (tmp->symtree >> +          && (tmp->symtree->n.sym->attr.flavor == FL_PARAMETER >> +          || tmp->symtree->n.sym->ts.type != BT_CHARACTER)) >> +        { >> +          gfc_error ("Expecting scalar-default-char-variable at %L", >> +             &tmp->where); >> +          goto cleanup; >> +        } >> + >>         errmsg = tmp; >>         saw_errmsg = true; >>   diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c >> index 4db0a3ac76d..aa039a8d9a0 100644 >> --- a/gcc/fortran/module.c >> +++ b/gcc/fortran/module.c >> @@ -5886,8 +5886,13 @@ write_symbol (int n, gfc_symbol *sym) >>   { >>     const char *label; >>   -  if (sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL) >> -    gfc_internal_error ("write_symbol(): bad module symbol %qs", >> sym->name); >> +  if ((sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL) >> +      && !(sym->ts.type != BT_UNKNOWN && sym->attr.result)) >> +    { >> +      gfc_error ("Invalid symbol %qs at %L", sym->name, >> +         &sym->declared_at); >> +      return; >> +    } >>       mio_integer (&n); >>   diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c >> index 1549f8e1635..610e729c68a 100644 >> --- a/gcc/fortran/parse.c >> +++ b/gcc/fortran/parse.c >> @@ -4485,6 +4485,9 @@ gfc_check_do_variable (gfc_symtree *st) >>   { >>     gfc_state_data *s; >>   +  if (!st) >> +    return 0; >> + >>     for (s=gfc_state_stack; s; s = s->previous) >>       if (s->do_variable == st) >>         { >> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c >> index 32015c21efc..286e1372699 100644 >> --- a/gcc/fortran/resolve.c >> +++ b/gcc/fortran/resolve.c >> @@ -8902,6 +8902,9 @@ resolve_select (gfc_code *code, bool select_type) >>   bool >>   gfc_type_is_extensible (gfc_symbol *sym) >>   { >> +  if (!sym) >> +    return false; >> + >>     return !(sym->attr.is_bind_c || sym->attr.sequence >>          || (sym->attr.is_class >>              && >> sym->components->ts.u.derived->attr.unlimited_polymorphic)); >> @@ -12749,9 +12752,13 @@ resolve_fl_var_and_proc (gfc_symbol *sym, >> int mp_flag) >>         && !UNLIMITED_POLY (sym) >>         && !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived)) >>       { >> -      gfc_error ("Type %qs of CLASS variable %qs at %L is not >> extensible", >> -             CLASS_DATA (sym)->ts.u.derived->name, sym->name, >> -             &sym->declared_at); >> +      if (CLASS_DATA (sym)->ts.u.derived) >> +        gfc_error ("Type %qs of CLASS variable %qs at %L is not >> extensible", >> +             CLASS_DATA (sym)->ts.u.derived->name, >> +            sym->name, &sym->declared_at); >> +      else >> +        gfc_error ("CLASS variable %qs at %L is not extensible", >> +            sym->name, &sym->declared_at); >>         return false; >>       } >>   @@ -15179,6 +15186,20 @@ resolve_fl_parameter (gfc_symbol *sym) >>         return false; >>       } >>   +  /* Some programmers can have a typo when using an implied-do >> loop to >> +     initialize an array constant.  For example, >> +       INTEGER I,J >> +       INTEGER, PARAMETER :: A(3) = [(I, I = 1, 3)]    ! OK >> +       INTEGER, PARAMETER :: B(3) = [(A(J), I = 1, 3)]  ! Not OK >> +     This check catches the typo.  */ >> +  if (sym->attr.dimension >> +      && sym->value && sym->value->expr_type == EXPR_ARRAY >> +      && !gfc_is_constant_expr (sym->value)) >> +    { >> +      gfc_error ("Expecting constant expression near %L", >> &sym->value->where); >> +      return false; >> +    } >> + >>     return true; >>   } >>   diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c >> index e982374d9d1..d7d3900cd6e 100644 >> --- a/gcc/fortran/symbol.c >> +++ b/gcc/fortran/symbol.c >> @@ -309,6 +309,7 @@ gfc_set_default_type (gfc_symbol *sym, int >> error_flag, gfc_namespace *ns) >>         else >>           gfc_error ("Symbol %qs at %L has no IMPLICIT type", >>                  sym->name, &sym->declared_at); >> + >>         sym->attr.untyped = 1; /* Ensure we only give an error once.  */ >>       } >>   @@ -394,18 +395,34 @@ gfc_check_function_type (gfc_namespace *ns) >>     /******************** Symbol attribute stuff *********************/ >>   +/* Older standards produced conflicts for some attributes that are >> now >> +   allowed in newer standards.  Check for the conflict and issue an >> +   error depending on the standard in play.  */ >> + >> +static bool >> +conflict_std (int standard, const char *a1, const char *a2, const >> char *name, >> +          locus *where) >> +{ >> +  if (name == NULL) >> +    { >> +      return gfc_notify_std (standard, "%s attribute conflicts " >> +                             "with %s attribute at %L", a1, a2, >> +                             where); >> +    } >> +  else >> +    { >> +      return gfc_notify_std (standard, "%s attribute conflicts " >> +                 "with %s attribute in %qs at %L", >> +                             a1, a2, name, where); >> +    } >> +} >> + >> + >>   /* This is a generic conflict-checker.  We do this to avoid having a >>      single conflict in two places.  */ >>     #define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto >> conflict; } >>   #define conf2(a) if (attr->a) { a2 = a; goto conflict; } >> -#define conf_std(a, b, std) if (attr->a && attr->b)\ >> -                              {\ >> -                                a1 = a;\ >> -                                a2 = b;\ >> -                                standard = std;\ >> -                                goto conflict_std;\ >> -                              } >>     bool >>   gfc_check_conflict (symbol_attribute *attr, const char *name, locus >> *where) >> @@ -438,7 +455,7 @@ gfc_check_conflict (symbol_attribute *attr, const >> char *name, locus *where) >>                           "OACC DECLARE DEVICE_RESIDENT"; >>       const char *a1, *a2; >> -  int standard; >> +  bool standard; >>       if (attr->artificial) >>       return true; >> @@ -450,16 +467,18 @@ gfc_check_conflict (symbol_attribute *attr, >> const char *name, locus *where) >>       { >>         a1 = pointer; >>         a2 = intent; >> -      standard = GFC_STD_F2003; >> -      goto conflict_std; >> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where); >> +      if (!standard) >> +         return standard; >>       } >>       if (attr->in_namelist && (attr->allocatable || attr->pointer)) >>       { >>         a1 = in_namelist; >>         a2 = attr->allocatable ? allocatable : pointer; >> -      standard = GFC_STD_F2003; >> -      goto conflict_std; >> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where); >> +      if (!standard) >> +         return standard; >>       } >>       /* Check for attributes not allowed in a BLOCK DATA.  */ >> @@ -566,10 +585,42 @@ gfc_check_conflict (symbol_attribute *attr, >> const char *name, locus *where) >>       return false; >>       conf (allocatable, pointer); >> -  conf_std (allocatable, dummy, GFC_STD_F2003); >> -  conf_std (allocatable, function, GFC_STD_F2003); >> -  conf_std (allocatable, result, GFC_STD_F2003); >> -  conf_std (elemental, recursive, GFC_STD_F2018); >> + >> +  if (attr->allocatable && attr->dummy) >> +    { >> +      a1 = allocatable; >> +      a2 = dummy; >> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where); >> +      if (!standard) >> +         return standard; >> +    } >> + >> +  if (attr->allocatable && attr->function) >> +    { >> +      a1 = allocatable; >> +      a2 = function; >> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where); >> +      if (!standard) >> +         return standard; >> +    } >> + >> +  if (attr->allocatable && attr->result) >> +    { >> +      a1 = allocatable; >> +      a2 = result; >> +      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where); >> +      if (!standard) >> +         return standard; >> +    } >> + >> +  if (attr->elemental && attr->recursive) >> +    { >> +      a1 = elemental; >> +      a2 = recursive; >> +      standard = conflict_std (GFC_STD_F2018, a1, a2, name, where); >> +      if (!standard) >> +         return standard; >> +    } >>       conf (in_common, dummy); >>     conf (in_common, allocatable); >> @@ -908,25 +959,10 @@ conflict: >>              a1, a2, name, where); >>       return false; >> - >> -conflict_std: >> -  if (name == NULL) >> -    { >> -      return gfc_notify_std (standard, "%s attribute conflicts " >> -                             "with %s attribute at %L", a1, a2, >> -                             where); >> -    } >> -  else >> -    { >> -      return gfc_notify_std (standard, "%s attribute conflicts " >> -                 "with %s attribute in %qs at %L", >> -                             a1, a2, name, where); >> -    } >>   } >>     #undef conf >>   #undef conf2 >> -#undef conf_std >>       /* Mark a symbol as referenced.  */ >> @@ -4034,8 +4070,6 @@ gfc_free_namespace (gfc_namespace *ns) >>     if (ns->refs > 0) >>       return; >>   -  gcc_assert (ns->refs == 0); >> - >>     gfc_free_statements (ns->code); >>       free_sym_tree (ns->sym_root); >> diff --git a/gcc/testsuite/gfortran.dg/coarray_3.f90 >> b/gcc/testsuite/gfortran.dg/coarray_3.f90 >> index d152ce1b2bd..1049e426085 100644 >> --- a/gcc/testsuite/gfortran.dg/coarray_3.f90 >> +++ b/gcc/testsuite/gfortran.dg/coarray_3.f90 >> @@ -13,8 +13,8 @@ end critical fkl ! { dg-error "Expecting END >> PROGRAM" } >>     sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" } >>   sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" } >> -sync memory (errmsg=str) ! { dg-error "must be a scalar CHARACTER >> variable" } >> -sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER >> variable" } >> +sync memory (errmsg=str) ! { dg-error "must be a scalar CHARACTER" } >> +sync memory (errmsg=n) ! { dg-error "Expecting >> scalar-default-char-variable" } >>   sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" } >>   sync images (-1) ! { dg-error "must between 1 and num_images" } >>   sync images (1) >> diff --git a/gcc/testsuite/gfortran.dg/finalize_8.f03 >> b/gcc/testsuite/gfortran.dg/finalize_8.f03 >> index b2027a0ba6d..2c4f1d30108 100644 >> --- a/gcc/testsuite/gfortran.dg/finalize_8.f03 >> +++ b/gcc/testsuite/gfortran.dg/finalize_8.f03 >> @@ -16,12 +16,12 @@ CONTAINS >>         INTEGER, ALLOCATABLE :: fooarr(:) >>         REAL :: foobar >>       CONTAINS >> -      FINAL :: myfinal ! { dg-error "in the specification part of a >> MODULE" } >> +      FINAL :: myfinal >>       END TYPE mytype >>       CONTAINS >>   -    SUBROUTINE myfinal (el) >> +    SUBROUTINE myfinal (el) ! { dg-error "is already declared as >> MODULE-PROC" } >>         TYPE(mytype) :: el >>       END SUBROUTINE myfinal >>   diff --git a/gcc/testsuite/gfortran.dg/pr69962.f90 >> b/gcc/testsuite/gfortran.dg/pr69962.f90 >> index 2684398ee31..def7364de59 100644 >> --- a/gcc/testsuite/gfortran.dg/pr69962.f90 >> +++ b/gcc/testsuite/gfortran.dg/pr69962.f90 >> @@ -2,5 +2,5 @@ >>   program p >>      integer :: n = 1 >>      character(3), parameter :: x(2) = ['abc', 'xyz'] >> -   character(2), parameter :: y(2) = [x(2)(2:3), x(n)(1:2)] ! { >> dg-error "CHARACTER length must be a constant" } >> +   character(2), parameter :: y(2) = [x(2)(2:3), x(n)(1:2)] ! { >> dg-error "Expecting constant" } >>   end >> diff --git a/gcc/testsuite/gfortran.dg/pr87907.f90 >> b/gcc/testsuite/gfortran.dg/pr87907.f90 >> index 0fe4e5090d2..a4a5ecfac07 100644 >> --- a/gcc/testsuite/gfortran.dg/pr87907.f90 >> +++ b/gcc/testsuite/gfortran.dg/pr87907.f90 >> @@ -12,12 +12,6 @@ end >>     submodule(m) m2 >>      contains >> -      subroutine g(x)   ! { dg-error "mismatch in argument" } >> +      subroutine g(x)   ! { dg-error "attribute conflicts with" } >>         end >>   end >> - >> -program p >> -   use m                ! { dg-error "has a type" } >> -   integer :: x = 3 >> -   call g(x)            ! { dg-error "which is not consistent with" } >> -end >> diff --git a/gcc/testsuite/gfortran.dg/pr91960.f90 >> b/gcc/testsuite/gfortran.dg/pr91960.f90 >> new file mode 100644 >> index 00000000000..76663f00c01 >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr91960.f90 >> @@ -0,0 +1,6 @@ >> +! { dg-do compile } >> +module m >> +   integer :: i, j >> +   integer, parameter :: a(3) = [(i,i=1,3)] >> +   integer, parameter :: b(3) = [(a(j),i=1,3)]  ! { dg-error " >> Expecting constant" } >> +end >> diff --git a/gcc/testsuite/gfortran.dg/pr93635.f90 >> b/gcc/testsuite/gfortran.dg/pr93635.f90 >> new file mode 100644 >> index 00000000000..b9700f31713 >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr93635.f90 >> @@ -0,0 +1,8 @@ >> +! { dg-do compile } >> +program boom >> +   implicit none >> +   character(len=:),allocatable :: r,rel >> +   namelist /args/ r,rel >> +   equivalence(r,rel)      ! { dg-error "EQUIVALENCE attribute >> conflicts" } >> +   allocate(character(len=1024) :: r) >> +   end program boom >> diff --git a/gcc/testsuite/gfortran.dg/pr95501.f90 >> b/gcc/testsuite/gfortran.dg/pr95501.f90 >> new file mode 100644 >> index 00000000000..b83f6ab9f1f >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr95501.f90 >> @@ -0,0 +1,18 @@ >> +! { dg-do compile } >> +subroutine p >> +   integer, target :: a = 2 >> +   integer, pointer :: z >> +   z%kind => a%kind     ! { dg-error "a constant expression" } >> +   z%kind => a          ! { dg-error "a constant expression" } >> +end >> + >> +subroutine q >> +   character, target :: a = 'a' >> +   character, pointer :: z >> +   z%kind => a          ! { dg-error "a constant expression" } >> +   z%kind => a%kind     ! { dg-error "a constant expression" } >> +   z%len => a           ! { dg-error "a constant expression" } >> +   z%len => a%len       ! { dg-error "a constant expression" } >> +   a%kind => a%len      ! { dg-error "a constant expression" } >> +   a%len => a%kind      ! { dg-error "a constant expression" } >> +end >> diff --git a/gcc/testsuite/gfortran.dg/pr95502.f90 >> b/gcc/testsuite/gfortran.dg/pr95502.f90 >> new file mode 100644 >> index 00000000000..a5751bb8b76 >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr95502.f90 >> @@ -0,0 +1,9 @@ >> +! { dg-do compile } >> +subroutine p >> +   character, pointer :: z ! { dg-error "in variable definition >> context" } >> +   complex, pointer :: a >> +   nullify(z%len) >> +   nullify(z%kind)         ! { dg-error "in variable definition >> context" } >> +   nullify(a%re)           ! { dg-error "in pointer association >> context" } >> +   nullify(a%im)           ! { dg-error "in pointer association >> context" } >> +end >> diff --git a/gcc/testsuite/gfortran.dg/pr95710.f90 >> b/gcc/testsuite/gfortran.dg/pr95710.f90 >> new file mode 100644 >> index 00000000000..7eab368cb5d >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr95710.f90 >> @@ -0,0 +1,17 @@ >> +! { dg-do compile } >> +module m >> +   type t >> +      integer :: a = 1 >> +   end type >> +   interface >> +      module subroutine s >> +      end >> +   end interface >> +end >> +submodule(m) m2 >> +contains >> +   subroutine s   ! or module subroutine s >> +      class(t), allocatable :: x    ! { dg-error "is not extensible" } >> +      class(t), allocatable :: x >> +   end >> +end >> diff --git a/gcc/testsuite/gfortran.dg/pr96013.f90 >> b/gcc/testsuite/gfortran.dg/pr96013.f90 >> new file mode 100644 >> index 00000000000..a5c6a13547f >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr96013.f90 >> @@ -0,0 +1,10 @@ >> +! { dg-do compile } >> +module m >> +   type t >> +   end type >> +contains >> +   function f() result(t) >> +      character(3) :: c >> +      c = 'abc' >> +   end >> +end >> diff --git a/gcc/testsuite/gfortran.dg/pr96025.f90 >> b/gcc/testsuite/gfortran.dg/pr96025.f90 >> new file mode 100644 >> index 00000000000..5ff8f6452bb >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr96025.f90 >> @@ -0,0 +1,8 @@ >> +! { dg-do compile } >> +program p >> +   print *, f() >> +contains >> +   character(char(1)) function f()  ! { dg-error "must be of INTEGER >> type" }s >> +      f = 'f' >> +   end >> +end >> diff --git a/gcc/testsuite/gfortran.dg/pr97122.f90 >> b/gcc/testsuite/gfortran.dg/pr97122.f90 >> new file mode 100644 >> index 00000000000..a81edb68fd8 >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr97122.f90 >> @@ -0,0 +1,24 @@ >> +! { dg-do compile } >> +module m >> +  implicit none >> +  interface >> +    module subroutine other >> +      implicit none >> +    end subroutine other >> +  end interface >> +end module m >> + >> +submodule (m) s >> +  implicit none >> +  type :: t >> +  contains >> +    final :: p >> +  end type t >> +contains >> +  subroutine p(arg) >> +    type(t), intent(inout) :: arg >> +  end subroutine p >> + >> +  module subroutine other >> +  end subroutine other >> +end submodule s >> diff --git a/gcc/testsuite/gfortran.dg/pr99256.f90 >> b/gcc/testsuite/gfortran.dg/pr99256.f90 >> new file mode 100644 >> index 00000000000..b39e1453ce3 >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr99256.f90 >> @@ -0,0 +1,7 @@ >> +! { dg-do compile } >> +! { dg-options "-w" } >> +program p >> +   call move_alloc (*1, *1) >> + 1 stop >> +end >> +! { dg-prune-output "must be a variable" } >> diff --git a/gcc/testsuite/gfortran.dg/pr99349.f90 >> b/gcc/testsuite/gfortran.dg/pr99349.f90 >> new file mode 100644 >> index 00000000000..d5b34eeeebd >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr99349.f90 >> @@ -0,0 +1,7 @@ >> +! { dg-do compile } >> +function f() >> +   logical, parameter :: a((1.)/0) = .true.  ! { dg-error "Division >> by zero" } >> +   integer :: b >> +   data b /a%kind/      ! { dg-error "Incompatible ranks" } >> +end >> +! { dg-prune-output "Parameter array" } >> diff --git a/gcc/testsuite/gfortran.dg/pr99351.f90 >> b/gcc/testsuite/gfortran.dg/pr99351.f90 >> new file mode 100644 >> index 00000000000..a36fcf9cd5d >> --- /dev/null >> +++ b/gcc/testsuite/gfortran.dg/pr99351.f90 >> @@ -0,0 +1,17 @@ >> +! { dg-do compile } >> +! { dg-options "-fcoarray=single" } >> +module m >> +   character(3), parameter :: c = 'abc' >> +contains >> +   subroutine s >> +      sync all (errmsg=c)        ! { dg-error "Expecting >> scalar-default-char-variable" } >> +   end >> +end module m >> + >> +module n >> +   integer, parameter :: a = 0 >> +contains >> +   subroutine s >> +      sync images (*, stat=a)    ! { dg-error "Expecting >> scalar-int-variable" } >> +   end >> +end module n >