From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from impout003.msg.chrl.nc.charter.net (impout003aa.msg.chrl.nc.charter.net [47.43.20.27]) by sourceware.org (Postfix) with ESMTPS id 055BD385802A for ; Sun, 14 Mar 2021 04:46:24 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 055BD385802A 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 LIdxlIE6Or76ULIdyliJjI; Sun, 14 Mar 2021 04:46:23 +0000 Authentication-Results: charter.net; none X-Authority-Analysis: v=2.3 cv=dotv9Go4 c=1 sm=1 tr=0 a=40r4m8ZdyXnswhLz6cknGw==:117 a=40r4m8ZdyXnswhLz6cknGw==:17 a=IkcTkHD0fZMA:10 a=SkzTylzFLo6y9XGoyd8A:9 a=15OskjwHlNbFkwsG:21 a=zWp7XA4Kt7xErmaV:21 a=QEXdDO2ut3YA:10 Subject: Re: 12 PR fixed To: Steve Kargl References: <20210313213338.GA1350@troutmask.apl.washington.edu> Cc: gfortran From: Jerry DeLisle Message-ID: <407787d3-e6af-ed45-d02d-708dff36a9bb@charter.net> Date: Sat, 13 Mar 2021 20:46:21 -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: <20210313213338.GA1350@troutmask.apl.washington.edu> Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit Content-Language: en-US X-CMAE-Envelope: MS4wfGNDUZxEIyL7aOnorNOIREO65avWiAr8I1yhT4E69c9IHZpdSEvGK7zbzqCvzKlZvNYokXJqzfkiEZzadYsrbFvy030dq5w3YhUx/re7lFBuziCTCnWO dgNQT4fTMZJufPcuWiuhx9xQI6Wwqx42I0vMvSdQT/fpWhBSFy1byzC71QWdgZ1rc+5bxFGGlLt2A2RqtBs8QZjZnGoAwmP1W+HbA51q0qyEO19tjC+qpoQw X-Spam-Status: No, score=-10.3 required=5.0 tests=BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, KAM_DMARC_STATUS, NICE_REPLY_A, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H3, 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 04:46:26 -0000 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