public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* 12 PR fixed
@ 2021-03-13 21:33 Steve Kargl
  2021-03-14  4:46 ` Jerry DeLisle
  0 siblings, 1 reply; 9+ messages in thread
From: Steve Kargl @ 2021-03-13 21:33 UTC (permalink / raw)
  To: fortran

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

^ permalink raw reply	[flat|nested] 9+ messages in thread
end of thread, other threads:[~2021-03-15 22:17 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-03-13 21:33 12 PR fixed Steve Kargl
2021-03-14  4:46 ` Jerry DeLisle
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

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