procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Janus Weil 2013-04-12 16:21:39 +02:00
parent 41b83758ed
commit 96486998bc
23 changed files with 241 additions and 205 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View file

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

16
gcc/fortran/expr.c
View file

@ -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))
{

1
gcc/fortran/gfortran.h
View file

@ -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 */

2
gcc/fortran/interface.c
View file

@ -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);

292
gcc/fortran/resolve.c
View file

@ -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 && sym->ts.type == BT_CHARACTER)
if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
{
long int l1 = 0, l2 = 0;
gfc_charlen *cl1 = sym->ts.u.cl;
gfc_charlen *cl2 = def_sym->ts.u.cl;
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);
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));
goto done;
}
/* Type mismatch of function return type and expected type. */
if (sym->attr.function
&& !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)
if (sym->attr.if_source == IFSRC_UNKNOWN
&& gfc_explicit_interface_required (def_sym, reason, sizeof(reason)))
{
gfc_formal_arglist *arg = def_sym->formal;
for ( ; arg; arg = arg->next)
if (!arg->sym)
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;
}
gfc_error ("Explicit interface required for '%s' at %L: %s",
sym->name, &sym->declared_at, reason);
goto done;
}
if (def_sym->attr.function)
{
/* F2003, 12.3.1.1 (3a); F2008, 12.4.2.2 (3a) */
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);
if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU))
/* Turn erros into warnings with -std=gnu and -std=legacy. */
gfc_errors_to_warnings (1);
/* F2003, 12.3.1.1 (3b); F2008, 12.4.2.2 (3b) */
if ((def_sym->result->attr.pointer
|| def_sym->result->attr.allocatable)
&& (sym->attr.if_source != IFSRC_IFBODY
|| def_sym->result->attr.pointer
!= sym->result->attr.pointer
|| 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 (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
reason, sizeof(reason), NULL, NULL))
{
gfc_error ("Interface mismatch in global procedure '%s' at %L: %s ",
sym->name, &sym->declared_at, reason);
goto done;
}
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)
{

22
gcc/testsuite/ChangeLog
View file

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

4
gcc/testsuite/gfortran.dg/assumed_rank_4.f90
View file

@ -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 valid2(x(1)) ! { dg-error "Procedure 'valid2' at .1. with assumed-type dummy argument 'x' must have an explicit interface" }
call valid1(x) ! { dg-error "Explicit interface required" }
call valid2(x(1)) ! { dg-error "Explicit interface required" }
end subroutine foo99
subroutine foo(x)

6
gcc/testsuite/gfortran.dg/auto_char_len_4.f90
View file

@ -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 :: d ! { dg-error "must have an explicit interface" }
CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "Character length mismatch" }
CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "Character length mismatch" }
interface
function b (m) ! This is OK
CHARACTER(LEN=m) :: b

2
gcc/testsuite/gfortran.dg/block_11.f90
View file

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

2
gcc/testsuite/gfortran.dg/function_types_3.f90
View file

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

4
gcc/testsuite/gfortran.dg/global_references_1.f90
View file

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

34
gcc/testsuite/gfortran.dg/import2.f90
View file

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

3
gcc/testsuite/gfortran.dg/import6.f90
View file

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

2
gcc/testsuite/gfortran.dg/proc_decl_18.f90
View file

@ -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(:)

6
gcc/testsuite/gfortran.dg/proc_decl_2.f90
View file

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

2
gcc/testsuite/gfortran.dg/proc_decl_9.f90
View file

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

23
gcc/testsuite/gfortran.dg/proc_ptr_40.f90 Normal file
View file

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

2
gcc/testsuite/gfortran.dg/whole_file_16.f90
View file

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

2
gcc/testsuite/gfortran.dg/whole_file_17.f90
View file

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

2
gcc/testsuite/gfortran.dg/whole_file_18.f90
View file

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

4
gcc/testsuite/gfortran.dg/whole_file_20.f03
View file

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

2
gcc/testsuite/gfortran.dg/whole_file_7.f90
View file

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

2
gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_associated.f90
View file

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