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

re PR fortran/85537 ([F08] Invalid memory reference at runtime when calling subroutine through procedure pointer)

Browse source 
fix PR 85537

2019-03-27  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/85537
	* expr.c (gfc_check_assign_symbol): Reject internal and dummy procedures
	in procedure pointer initialization.

2019-03-27  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/85537
	* gfortran.dg/dummy_procedure_11.f90: Fix test case.
	* gfortran.dg/pointer_init_11.f90: New test case.

From-SVN: r269980
This commit is contained in:
Janus Weil 2019-03-27 23:40:22 +01:00
parent 303d6cb276
commit 7076b27b74
5 changed files with 74 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -1,3 +1,9 @@
2019-03-27 Janus Weil <janus@gcc.gnu.org>
PR fortran/85537
* expr.c (gfc_check_assign_symbol): Reject internal and dummy procedures
in procedure pointer initialization.
2019-03-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/88247

14
gcc/fortran/expr.c
View file

@ -4407,6 +4407,20 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
"may not be a procedure pointer", &rvalue->where);
return false;
}
if (attr.proc == PROC_INTERNAL)
{
gfc_error ("Internal procedure %qs is invalid in "
"procedure pointer initialization at %L",
rvalue->symtree->name, &rvalue->where);
return false;
}
if (attr.dummy)
{
gfc_error ("Dummy procedure %qs is invalid in "
"procedure pointer initialization at %L",
rvalue->symtree->name, &rvalue->where);
return false;
}
}
return true;

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2019-03-27 Janus Weil <janus@gcc.gnu.org>
PR fortran/85537
* gfortran.dg/dummy_procedure_11.f90: Fix test case.
* gfortran.dg/pointer_init_11.f90: New test case.
2019-03-27 Mateusz B <mateuszb@poczta.onet.pl>
PR target/85667

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

@ -5,16 +5,18 @@
! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
type :: t
procedure(g), pointer, nopass :: ppc => g
procedure(g), pointer, nopass :: ppc
end type
procedure(g), pointer :: pp => g
procedure(g), pointer :: pp
type(t)::x
print *, f(g)
print *, f(g()) ! { dg-error "Expected a procedure for argument" }
pp => g
print *, f(pp)
print *, f(pp()) ! { dg-error "Expected a procedure for argument" }
x%ppc => g
print *, f(x%ppc)
print *, f(x%ppc()) ! { dg-error "Expected a procedure for argument" }

44
gcc/testsuite/gfortran.dg/pointer_init_11.f90 Normal file
View file

@ -0,0 +1,44 @@
! { dg-do compile }
!
! PR 85537: [F08] Invalid memory reference at runtime when calling subroutine through procedure pointer
!
! Contributed by Tiziano Müller <dev-zero@gentoo.org>
module m1
implicit none
contains
subroutine foo()
integer :: a
abstract interface
subroutine ibar()
end subroutine
end interface
procedure(ibar), pointer :: bar_ptr => bar_impl ! { dg-error "invalid in procedure pointer initialization" }
contains
subroutine bar_impl()
write (*,*) "foo"
a = a + 1
end subroutine
end subroutine
end module
module m2
implicit none
contains
subroutine foo(dbar)
interface
subroutine dbar()
end subroutine
end interface
procedure(dbar), pointer :: bar_ptr => dbar ! { dg-error "invalid in procedure pointer initialization" }
call bar_ptr()
end subroutine
end module