re PR fortran/56261 ([OOP] seg fault call procedure pointer on polymorphic array)

2013-04-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56261
	* gfortran.h (gfc_explicit_interface_required): New prototype.
	* expr.c (gfc_check_pointer_assign): Check if an explicit interface is
	required in a proc-ptr assignment.
	* interface.c (check_result_characteristics): Extra check.
	* resolve.c (gfc_explicit_interface_required): New function.
	(resolve_global_procedure): Use new function
	'gfc_explicit_interface_required'. Do a full interface check.


2013-04-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56261
	* gfortran.dg/auto_char_len_4.f90: Add -pedantic. Changed error.
	* gfortran.dg/assumed_rank_4.f90: Modified error wording.
	* gfortran.dg/block_11.f90: Fix invalid test case.
	* gfortran.dg/function_types_3.f90: Add new error message.
	* gfortran.dg/global_references_1.f90: Ditto.
	* gfortran.dg/import2.f90: Remove unneeded parts.
	* gfortran.dg/import6.f90: Fix invalid test case.
	* gfortran.dg/proc_decl_2.f90: Ditto.
	* gfortran.dg/proc_decl_9.f90: Ditto.
	* gfortran.dg/proc_decl_18.f90: Ditto.
	* gfortran.dg/proc_ptr_40.f90: New.
	* gfortran.dg/whole_file_7.f90: Modified error wording.
	* gfortran.dg/whole_file_16.f90: Ditto.
	* gfortran.dg/whole_file_17.f90: Add -pedantic.
	* gfortran.dg/whole_file_18.f90: Modified error wording.
	* gfortran.dg/whole_file_20.f03: Ditto.
	* gfortran.fortran-torture/execute/intrinsic_associated.f90: Fix
	invalid test case.

From-SVN: r197922

gcc/fortran/ChangeLog

@@ -1,3 +1,14 @@
+2013-04-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56261
+	* gfortran.h (gfc_explicit_interface_required): New prototype.
+	* expr.c (gfc_check_pointer_assign): Check if an explicit interface is
+	required in a proc-ptr assignment.
+	* interface.c (check_result_characteristics): Extra check.
+	* resolve.c (gfc_explicit_interface_required): New function.
+	(resolve_global_procedure): Use new function
+	'gfc_explicit_interface_required'. Do a full interface check.
+
 2013-04-12  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/56845

gcc/fortran/expr.c

@@ -3556,6 +3556,22 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
       if (s1 == s2 || !s1 || !s2)
 	return true;
 
+      /* F08:7.2.2.4 (4)  */
+      if (s1->attr.if_source == IFSRC_UNKNOWN
+	  && gfc_explicit_interface_required (s2, err, sizeof(err)))
+	{
+	  gfc_error ("Explicit interface required for '%s' at %L: %s",
+		     s1->name, &lvalue->where, err);
+	  return false;
+	}
+      if (s2->attr.if_source == IFSRC_UNKNOWN
+	  && gfc_explicit_interface_required (s1, err, sizeof(err)))
+	{
+	  gfc_error ("Explicit interface required for '%s' at %L: %s",
+		     s2->name, &rvalue->where, err);
+	  return false;
+	}
+
       if (!gfc_compare_interfaces (s1, s2, name, 0, 1,
 				   err, sizeof(err), NULL, NULL))
 	{

gcc/fortran/gfortran.h

@@ -2843,6 +2843,7 @@ match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
 gfc_expr *gfc_expr_to_initialize (gfc_expr *);
 bool gfc_type_is_extensible (gfc_symbol *);
 bool gfc_resolve_intrinsic (gfc_symbol *, locus *);
+bool gfc_explicit_interface_required (gfc_symbol *, char *, int);
 
 
 /* array.c */

gcc/fortran/interface.c

@@ -1239,7 +1239,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
 	  return false;
 	}
 
-      if (r1->ts.u.cl->length)
+      if (r1->ts.u.cl->length && r2->ts.u.cl->length)
 	{
 	  int compval = gfc_dep_compare_expr (r1->ts.u.cl->length,
 					      r2->ts.u.cl->length);

gcc/fortran/resolve.c

@@ -2118,6 +2118,126 @@ not_entry_self_reference  (gfc_symbol *sym, gfc_namespace *gsym_ns)
   return true;
 }
 
+
+/* Check for the requirement of an explicit interface. F08:12.4.2.2.  */
+
+bool
+gfc_explicit_interface_required (gfc_symbol *sym, char *errmsg, int err_len)
+{
+  gfc_formal_arglist *arg = gfc_sym_get_dummy_args (sym);
+
+  for ( ; arg; arg = arg->next)
+    {
+      if (!arg->sym)
+	continue;
+
+      if (arg->sym->attr.allocatable)  /* (2a)  */
+	{
+	  strncpy (errmsg, _("allocatable argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->attr.asynchronous)
+	{
+	  strncpy (errmsg, _("asynchronous argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->attr.optional)
+	{
+	  strncpy (errmsg, _("optional argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->attr.pointer)
+	{
+	  strncpy (errmsg, _("pointer argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->attr.target)
+	{
+	  strncpy (errmsg, _("target argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->attr.value)
+	{
+	  strncpy (errmsg, _("value argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->attr.volatile_)
+	{
+	  strncpy (errmsg, _("volatile argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->as && arg->sym->as->type == AS_ASSUMED_SHAPE)  /* (2b)  */
+	{
+	  strncpy (errmsg, _("assumed-shape argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->as && arg->sym->as->type == AS_ASSUMED_RANK)  /* TS 29113, 6.2.  */
+	{
+	  strncpy (errmsg, _("assumed-rank argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->attr.codimension)  /* (2c)  */
+	{
+	  strncpy (errmsg, _("coarray argument"), err_len);
+	  return true;
+	}
+      else if (false)  /* (2d) TODO: parametrized derived type  */
+	{
+	  strncpy (errmsg, _("parametrized derived type argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->ts.type == BT_CLASS)  /* (2e)  */
+	{
+	  strncpy (errmsg, _("polymorphic argument"), err_len);
+	  return true;
+	}
+      else if (arg->sym->ts.type == BT_ASSUMED)
+	{
+	  /* As assumed-type is unlimited polymorphic (cf. above).
+	     See also TS 29113, Note 6.1.  */
+	  strncpy (errmsg, _("assumed-type argument"), err_len);
+	  return true;
+	}
+    }
+
+  if (sym->attr.function)
+    {
+      gfc_symbol *res = sym->result ? sym->result : sym;
+
+      if (res->attr.dimension)  /* (3a)  */
+	{
+	  strncpy (errmsg, _("array result"), err_len);
+	  return true;
+	}
+      else if (res->attr.pointer || res->attr.allocatable)  /* (3b)  */
+	{
+	  strncpy (errmsg, _("pointer or allocatable result"), err_len);
+	  return true;
+	}
+      else if (res->ts.type == BT_CHARACTER && res->ts.u.cl
+	       && res->ts.u.cl->length
+	       && res->ts.u.cl->length->expr_type != EXPR_CONSTANT)  /* (3c)  */
+	{
+	  strncpy (errmsg, _("result with non-constant character length"), err_len);
+	  return true;
+	}
+    }
+
+  if (sym->attr.elemental)  /* (4)  */
+    {
+      strncpy (errmsg, _("elemental procedure"), err_len);
+      return true;
+    }
+  else if (sym->attr.is_bind_c)  /* (5)  */
+    {
+      strncpy (errmsg, _("bind(c) procedure"), err_len);
+      return true;
+    }
+
+  return false;
+}
+
+
 static void
 resolve_global_procedure (gfc_symbol *sym, locus *where,
 			  gfc_actual_arglist **actual, int sub)
@@ -2125,6 +2245,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
   gfc_gsymbol * gsym;
   gfc_namespace *ns;
   enum gfc_symbol_type type;
+  char reason[200];
 
   type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
 
@@ -2195,160 +2316,32 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 	      }
 	}
 
-      /* Differences in constant character lengths.  */
+      if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
-      if (sym->attr.function && sym->ts.type == BT_CHARACTER)
 	{
-	  long int l1 = 0, l2 = 0;
+	  gfc_error ("Return type mismatch of function '%s' at %L (%s/%s)",
-	  gfc_charlen *cl1 = sym->ts.u.cl;
+		     sym->name, &sym->declared_at, gfc_typename (&sym->ts),
-	  gfc_charlen *cl2 = def_sym->ts.u.cl;
+		     gfc_typename (&def_sym->ts));
-
+	  goto done;
-	  if (cl1 != NULL
-	      && cl1->length != NULL
-	      && cl1->length->expr_type == EXPR_CONSTANT)
-	    l1 = mpz_get_si (cl1->length->value.integer);
-
-  	  if (cl2 != NULL
-	      && cl2->length != NULL
-	      && cl2->length->expr_type == EXPR_CONSTANT)
-	    l2 = mpz_get_si (cl2->length->value.integer);
-
-	  if (l1 && l2 && l1 != l2)
-	    gfc_error ("Character length mismatch in return type of "
-		       "function '%s' at %L (%ld/%ld)", sym->name,
-		       &sym->declared_at, l1, l2);
 	}
 
-     /* Type mismatch of function return type and expected type.  */
+      if (sym->attr.if_source == IFSRC_UNKNOWN
-     if (sym->attr.function
+	  && gfc_explicit_interface_required (def_sym, reason, sizeof(reason)))
-	 && !gfc_compare_types (&sym->ts, &def_sym->ts))
-	gfc_error ("Return type mismatch of function '%s' at %L (%s/%s)",
-		   sym->name, &sym->declared_at, gfc_typename (&sym->ts),
-		   gfc_typename (&def_sym->ts));
-
-      if (def_sym->formal && sym->attr.if_source != IFSRC_IFBODY)
 	{
-	  gfc_formal_arglist *arg = def_sym->formal;
+	  gfc_error ("Explicit interface required for '%s' at %L: %s",
-	  for ( ; arg; arg = arg->next)
+		     sym->name, &sym->declared_at, reason);
-	    if (!arg->sym)
+	  goto done;
-	      continue;
-	    /* F2003, 12.3.1.1 (2a); F2008, 12.4.2.2 (2a)  */
-	    else if (arg->sym->attr.allocatable
-		     || arg->sym->attr.asynchronous
-		     || arg->sym->attr.optional
-		     || arg->sym->attr.pointer
-		     || arg->sym->attr.target
-		     || arg->sym->attr.value
-		     || arg->sym->attr.volatile_)
-	      {
-		gfc_error ("Dummy argument '%s' of procedure '%s' at %L "
-			   "has an attribute that requires an explicit "
-			   "interface for this procedure", arg->sym->name,
-			   sym->name, &sym->declared_at);
-		break;
-	      }
-	    /* F2003, 12.3.1.1 (2b); F2008, 12.4.2.2 (2b)  */
-	    else if (arg->sym && arg->sym->as
-		     && arg->sym->as->type == AS_ASSUMED_SHAPE)
-	      {
-		gfc_error ("Procedure '%s' at %L with assumed-shape dummy "
-			   "argument '%s' must have an explicit interface",
-			   sym->name, &sym->declared_at, arg->sym->name);
-		break;
-	      }
-	    /* TS 29113, 6.2.  */
-	    else if (arg->sym && arg->sym->as
-		     && arg->sym->as->type == AS_ASSUMED_RANK)
-	      {
-		gfc_error ("Procedure '%s' at %L with assumed-rank dummy "
-			   "argument '%s' must have an explicit interface",
-			   sym->name, &sym->declared_at, arg->sym->name);
-		break;
-	      }
-	    /* F2008, 12.4.2.2 (2c)  */
-	    else if (arg->sym->attr.codimension)
-	      {
-		gfc_error ("Procedure '%s' at %L with coarray dummy argument "
-			   "'%s' must have an explicit interface",
-			   sym->name, &sym->declared_at, arg->sym->name);
-		break;
-	      }
-	    /* F2003, 12.3.1.1 (2c); F2008, 12.4.2.2 (2d)   */
-	    else if (false) /* TODO: is a parametrized derived type  */
-	      {
-		gfc_error ("Procedure '%s' at %L with parametrized derived "
-			   "type argument '%s' must have an explicit "
-			   "interface", sym->name, &sym->declared_at,
-			   arg->sym->name);
-		break;
-	      }
-	    /* F2003, 12.3.1.1 (2d); F2008, 12.4.2.2 (2e)   */
-	    else if (arg->sym->ts.type == BT_CLASS)
-	      {
-		gfc_error ("Procedure '%s' at %L with polymorphic dummy "
-			   "argument '%s' must have an explicit interface",
-			   sym->name, &sym->declared_at, arg->sym->name);
-		break;
-	      }
-	    /* As assumed-type is unlimited polymorphic (cf. above).
-	       See also  TS 29113, Note 6.1.  */
-	    else if (arg->sym->ts.type == BT_ASSUMED)
-	      {
-		gfc_error ("Procedure '%s' at %L with assumed-type dummy "
-			   "argument '%s' must have an explicit interface",
-			   sym->name, &sym->declared_at, arg->sym->name);
-		break;
-	      }
 	}
 
-      if (def_sym->attr.function)
+      if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU))
-	{
+	/* Turn erros into warnings with -std=gnu and -std=legacy.  */
-	  /* F2003, 12.3.1.1 (3a); F2008, 12.4.2.2 (3a) */
+	gfc_errors_to_warnings (1);
-	  if (def_sym->as && def_sym->as->rank
-	      && (!sym->as || sym->as->rank != def_sym->as->rank))
-	    gfc_error ("The reference to function '%s' at %L either needs an "
-		       "explicit INTERFACE or the rank is incorrect", sym->name,
-		       where);
 
-	  /* F2003, 12.3.1.1 (3b); F2008, 12.4.2.2 (3b) */
+      if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
-	  if ((def_sym->result->attr.pointer
+				   reason, sizeof(reason), NULL, NULL))
-	       || def_sym->result->attr.allocatable)
+	{	
-	       && (sym->attr.if_source != IFSRC_IFBODY
+	  gfc_error ("Interface mismatch in global procedure '%s' at %L: %s ",
-		   || def_sym->result->attr.pointer
+		    sym->name, &sym->declared_at, reason);
-			!= sym->result->attr.pointer
+	  goto done;
-		   || def_sym->result->attr.allocatable
-			!= sym->result->attr.allocatable))
-	    gfc_error ("Function '%s' at %L with a POINTER or ALLOCATABLE "
-		       "result must have an explicit interface", sym->name,
-		       where);
-
-	  /* F2003, 12.3.1.1 (3c); F2008, 12.4.2.2 (3c)  */
-	  if (sym->ts.type == BT_CHARACTER && sym->attr.if_source != IFSRC_IFBODY
-	      && def_sym->ts.type == BT_CHARACTER && def_sym->ts.u.cl->length != NULL)
-	    {
-	      gfc_charlen *cl = sym->ts.u.cl;
-
-	      if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
-		  && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
-		{
-		  gfc_error ("Nonconstant character-length function '%s' at %L "
-			     "must have an explicit interface", sym->name,
-			     &sym->declared_at);
-		}
-	    }
-	}
-
-      /* F2003, 12.3.1.1 (4); F2008, 12.4.2.2 (4) */
-      if (def_sym->attr.elemental && !sym->attr.elemental)
-	{
-	  gfc_error ("ELEMENTAL procedure '%s' at %L must have an explicit "
-		     "interface", sym->name, &sym->declared_at);
-	}
-
-      /* F2003, 12.3.1.1 (5); F2008, 12.4.2.2 (5) */
-      if (def_sym->attr.is_bind_c && !sym->attr.is_bind_c)
-	{
-	  gfc_error ("Procedure '%s' at %L with BIND(C) attribute must have "
-		     "an explicit interface", sym->name, &sym->declared_at);
 	}
 
       if (!pedantic
@@ -2358,9 +2351,10 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 
       if (sym->attr.if_source != IFSRC_IFBODY)
 	gfc_procedure_use (def_sym, actual, where);
-
-      gfc_errors_to_warnings (0);
     }
+    
+done:
+  gfc_errors_to_warnings (0);
 
   if (gsym->type == GSYM_UNKNOWN)
     {

gcc/testsuite/ChangeLog

@@ -1,3 +1,25 @@
+2013-04-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56261
+	* gfortran.dg/auto_char_len_4.f90: Add -pedantic. Changed error.
+	* gfortran.dg/assumed_rank_4.f90: Modified error wording.
+	* gfortran.dg/block_11.f90: Fix invalid test case.
+	* gfortran.dg/function_types_3.f90: Add new error message.
+	* gfortran.dg/global_references_1.f90: Ditto.
+	* gfortran.dg/import2.f90: Remove unneeded parts.
+	* gfortran.dg/import6.f90: Fix invalid test case.
+	* gfortran.dg/proc_decl_2.f90: Ditto.
+	* gfortran.dg/proc_decl_9.f90: Ditto.
+	* gfortran.dg/proc_decl_18.f90: Ditto.
+	* gfortran.dg/proc_ptr_40.f90: New.
+	* gfortran.dg/whole_file_7.f90: Modified error wording.
+	* gfortran.dg/whole_file_16.f90: Ditto.
+	* gfortran.dg/whole_file_17.f90: Add -pedantic.
+	* gfortran.dg/whole_file_18.f90: Modified error wording.
+	* gfortran.dg/whole_file_20.f03: Ditto.
+	* gfortran.fortran-torture/execute/intrinsic_associated.f90: Fix
+	invalid test case.
+
 2013-04-12  Richard Biener  <rguenther@suse.de>
 
 	Revert

gcc/testsuite/gfortran.dg/assumed_rank_4.f90

@@ -20,8 +20,8 @@ end subroutine valid2
 
 subroutine foo99(x)
   integer  x(99)
-  call valid1(x) ! { dg-error "Procedure 'valid1' at .1. with assumed-rank dummy argument 'x' must have an explicit interface" }
+  call valid1(x) ! { dg-error "Explicit interface required" }
-  call valid2(x(1)) ! { dg-error "Procedure 'valid2' at .1. with assumed-type dummy argument 'x' must have an explicit interface" }
+  call valid2(x(1)) ! { dg-error "Explicit interface required" }
 end subroutine foo99
 
 subroutine foo(x)

gcc/testsuite/gfortran.dg/auto_char_len_4.f90

@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fwhole-file" }
+! { dg-options "-pedantic -fwhole-file" }
 !
 ! Tests the fix for PR25087, in which the following invalid code
 ! was not detected.
@@ -14,8 +14,8 @@ FUNCTION a()
 END FUNCTION a
 
 SUBROUTINE s(n)
-  CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "must have an explicit interface" }
+  CHARACTER(LEN=n), EXTERNAL :: a  ! { dg-error "Character length mismatch" }
-  CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "must have an explicit interface" }
+  CHARACTER(LEN=n), EXTERNAL :: d  ! { dg-error "Character length mismatch" }
   interface
     function b (m)                ! This is OK
       CHARACTER(LEN=m) :: b

gcc/testsuite/gfortran.dg/block_11.f90

@@ -50,7 +50,7 @@ module m3
   implicit none
 contains
   subroutine my_test()
-    procedure(), pointer :: ptr
+    procedure(sub), pointer :: ptr
     ! Before the fix, one had the link error
     ! "undefined reference to `sub.1909'"
     block

gcc/testsuite/gfortran.dg/function_types_3.f90

@@ -5,7 +5,7 @@
 ! PR 50401: SIGSEGV in resolve_transfer
 
   interface 
-    function f()      ! { dg-error "must be a dummy argument" }
+    function f()      ! { dg-error "must be a dummy argument|Interface mismatch in global procedure" }
       dimension f(*)
     end function
   end interface

gcc/testsuite/gfortran.dg/global_references_1.f90

@@ -23,7 +23,7 @@ function g(x)       ! Global entity
 ! Function 'f' cannot be referenced as a subroutine. The previous
 ! definition is in 'line 12'.
 
-  call f(g) ! { dg-error "is already being used as a FUNCTION" }
+  call f(g) ! { dg-error "is already being used as a FUNCTION|Interface mismatch in global procedure" }
 end function g
 ! Error only appears once but testsuite associates with both lines.
 function h(x)       ! { dg-error "is already being used as a FUNCTION" }
@@ -59,7 +59,7 @@ END SUBROUTINE TT
 ! Function 'h' cannot be referenced as a subroutine. The previous
 ! definition is in 'line 29'.
 
-  call h (x) ! { dg-error "is already being used as a FUNCTION" }
+  call h (x) ! { dg-error "is already being used as a FUNCTION|Interface mismatch in global procedure" }
 
 ! PR23308===========================================================
 ! Lahey - 2521-S: "SOURCE.F90", line 68: Intrinsic procedure name or

gcc/testsuite/gfortran.dg/import2.f90

@@ -4,30 +4,6 @@
 ! Test whether import does not work with -std=f95
 ! PR fortran/29601
 
-subroutine test(x)
-  type myType3
-    sequence
-    integer :: i
-  end type myType3
-  type(myType3) :: x
-  if(x%i /= 7) call abort()
-  x%i = 1
-end subroutine test
-
-
-subroutine bar(x,y)
-  type myType
-    sequence
-    integer :: i
-  end type myType
-  type(myType) :: x
-  integer(8) :: y
-  if(y /= 8) call abort()
-  if(x%i /= 2) call abort()
-  x%i = 5
-  y   = 42
-end subroutine bar
-
 module testmod
   implicit none
   integer, parameter :: kind = 8
@@ -66,14 +42,4 @@ program foo
     end subroutine test
   end interface
 
-  type(myType) :: y
-  type(myType3) :: z
-  integer(dp) :: i8
-  y%i = 2
-  i8 = 8
-  call bar(y,i8) ! { dg-error "Type mismatch in argument" }
-  if(y%i /= 5 .or. i8/= 42) call abort()
-  z%i = 7
-  call test(z) ! { dg-error "Type mismatch in argument" }
-  if(z%i /= 1) call abort()
 end program foo

gcc/testsuite/gfortran.dg/import6.f90

@@ -7,6 +7,7 @@
 !
 subroutine func1(param)
   type :: my_type
+    sequence
     integer :: data
   end type my_type
   type(my_type) :: param
@@ -15,6 +16,7 @@ end subroutine func1
 
 subroutine func2(param)
   type :: my_type
+    sequence
     integer :: data
   end type my_type
   type(my_type) :: param
@@ -22,6 +24,7 @@ subroutine func2(param)
 end subroutine func2
 
   type :: my_type
+    sequence
     integer :: data
   end type my_type
 

gcc/testsuite/gfortran.dg/proc_decl_18.f90

@@ -23,7 +23,7 @@ implicit none
 
 abstract interface
   function abs_fun(x,sz)
-    integer :: x(:)
+    integer,intent(in) :: x(:)
     interface
       pure integer function sz(b)
         integer,intent(in) :: b(:)

gcc/testsuite/gfortran.dg/proc_decl_2.f90

@@ -124,12 +124,12 @@ integer function p2(x)
 end function
 
 subroutine p3(x)
-  real,intent(inout):: x
+  real :: x
   x=x+1.0
 end subroutine
 
 subroutine p4(x)
-  real,intent(inout):: x
+  real :: x
   x=x-1.5
 end subroutine
 
@@ -137,7 +137,7 @@ subroutine p5()
 end subroutine
 
 subroutine p6(x)
-  real,intent(inout):: x
+  real :: x
   x=x*2.
 end subroutine
 

gcc/testsuite/gfortran.dg/proc_decl_9.f90

@@ -2,7 +2,7 @@
 ! PR33162 INTRINSIC functions as ACTUAL argument
 ! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
 real function t(x)
-  real ::x
+  real, intent(in) ::x
   t = x
 end function
 

gcc/testsuite/gfortran.dg/proc_ptr_40.f90

@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR 56261: [OOP] seg fault call procedure pointer on polymorphic array
+!
+! Contributed by Andrew Benson <abensonca@gmail.com>
+
+  implicit none
+  type :: nc
+  end type
+  external :: qq
+  procedure(  ), pointer :: f1
+  procedure(ff), pointer :: f2
+  
+  f1 => ff  ! { dg-error "Explicit interface required" }
+  f2 => qq  ! { dg-error "Explicit interface required" }
+
+contains
+
+  subroutine ff (self)
+    class(nc) :: self
+  end subroutine
+
+end

gcc/testsuite/gfortran.dg/whole_file_16.f90

@@ -5,7 +5,7 @@
 !
 program main
   real, dimension(2) :: a
-  call foo(a)                ! { dg-error "must have an explicit interface" }
+  call foo(a)                ! { dg-error "Explicit interface required" }
 end program main
 
 subroutine foo(a)

gcc/testsuite/gfortran.dg/whole_file_17.f90

@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fwhole-file" }
+! { dg-options "-pedantic -fwhole-file" }
 !
 ! PR fortran/30668
 !

gcc/testsuite/gfortran.dg/whole_file_18.f90

@@ -5,7 +5,7 @@
 !
       PROGRAM MAIN
       REAL A
-      CALL SUB(A)             ! { dg-error "requires an explicit interface" }
+      CALL SUB(A)             ! { dg-error "Explicit interface required" }
       END PROGRAM
 
       SUBROUTINE SUB(A,I)

gcc/testsuite/gfortran.dg/whole_file_20.f03

@@ -17,8 +17,8 @@ PROGRAM main
 
   INTEGER :: coarr[*]
 
-  CALL coarray(coarr)         ! { dg-error " must have an explicit interface" }
+  CALL coarray(coarr)         ! { dg-error "Explicit interface required" }
-  CALL polymorph(tt)          ! { dg-error " must have an explicit interface" }
+  CALL polymorph(tt)          ! { dg-error "Explicit interface required" }
 END PROGRAM
 
 SUBROUTINE coarray(a)

gcc/testsuite/gfortran.dg/whole_file_7.f90

@@ -29,6 +29,6 @@ end function test
 
 program arr     ! The error was not picked up causing an ICE
   real, dimension(2) :: res
-  res = test(2) ! { dg-error "needs an explicit INTERFACE" }
+  res = test(2) ! { dg-error "Explicit interface required" }
   print *, res
 end program

gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90

@@ -121,7 +121,7 @@ subroutine associated_2 ()
    interface
       subroutine sub1 (a, ap)
          integer, pointer :: ap(:, :)
-         integer, target  :: a(10, 1)
+         integer, target  :: a(10, 10)
       end
    endinterface