public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
From: Jerry DeLisle <jvdelisle@charter.net>
To: Steve Kargl <sgk@troutmask.apl.washington.edu>
Cc: gfortran <fortran@gcc.gnu.org>
Subject: Re: 12 PR fixed
Date: Sat, 13 Mar 2021 20:46:21 -0800	[thread overview]
Message-ID: <407787d3-e6af-ed45-d02d-708dff36a9bb@charter.net> (raw)
In-Reply-To: <20210313213338.GA1350@troutmask.apl.washington.edu>

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


  reply	other threads:[~2021-03-14  4:46 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-03-13 21:33 Steve Kargl
2021-03-14  4:46 ` Jerry DeLisle [this message]
2021-03-14  5:13   ` Jerry DeLisle
2021-03-14  6:05     ` Steve Kargl
2021-03-14 11:38     ` Tobias Burnus
2021-03-14 12:01       ` Tobias Burnus
2021-03-14 15:22         ` Jerry DeLisle
2021-03-15 22:17           ` Steve Kargl
2021-03-14 16:46       ` Steve Kargl

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=407787d3-e6af-ed45-d02d-708dff36a9bb@charter.net \
    --to=jvdelisle@charter.net \
    --cc=fortran@gcc.gnu.org \
    --cc=sgk@troutmask.apl.washington.edu \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).