Skip to content

R
riscv-gcc-1
Commit 96486998 by Janus Weil
Options

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
parent 41b83758
Showing with 241 additions and 205 deletions
gcc/fortran/ChangeLog
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/testsuite/ChangeLog
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 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)
......
gcc/testsuite/gfortran.dg/auto_char_len_4.f90
! { 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
......
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 → 100644
! { 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
! { 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 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)
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment