This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch,Fortran] PR 40580 - add -fcheck=pointer for some actual argument checks
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Mon, 29 Jun 2009 21:57:34 +0200
- Subject: [Patch,Fortran] PR 40580 - add -fcheck=pointer for some actual argument checks
Hello,
after spending some time today to pinpoint a problem, I decided having a
-fcheck=pointer makes sense. The checking happens if one passes an
ALLOCATABLE or POINTER (or proc-pointer) actual argument to a dummy
which is not allocatable nor a pointer. In that case, the actual
argument needs to be allocated / associated, which this patch checks.
Build and regtested on x86-64-linux.
OK for the trunk?
Tobias
PS: The patch contains two other small changes; one to *def is trivial
and one to *.texi brings the words closer to the standard and describes
better what is actually done (e.g. copy-in/out is not really call by
reference, though the effect is [almost] the same).
2009-06-29 Tobias Burnus <burnus@net-b.de>
PR fortran/40580
* trans-expr.c (gfc_conv_procedure_call): Add -fcheck=pointer check.
* libgfortran.h: Add GFC_RTCHECK_POINTER.
* invoke.texi (-fcheck): Document new pointer option.
* options.c (gfc_handle_runtime_check_option): Handle pointer option.
* gfortran.texi (C Binding): Improve wording.
* iso-c-binding.def: Remove obsolete comment.
2009-06-29 Tobias Burnus <burnus@net-b.de>
PR fortran/40580
* pointer_check_1.f90: New test.
* pointer_check_2.f90: New test.
* pointer_check_3.f90: New test.
* pointer_check_4.f90: New test.
* pointer_check_5.f90: New test.
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 149051)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -2772,6 +2772,48 @@ gfc_conv_procedure_call (gfc_se * se, gf
gfc_add_expr_to_block (&se->post, tmp);
}
+ /* Add argument checking of passing an unallocated/NULL actual to
+ a nonallocatable/nonpointer dummy. */
+
+ if (gfc_option.rtcheck & GFC_RTCHECK_POINTER)
+ {
+ gfc_symbol *sym;
+ char *msg;
+ tree cond;
+
+ if (e->expr_type == EXPR_VARIABLE)
+ sym = e->symtree->n.sym;
+ else if (e->expr_type == EXPR_FUNCTION)
+ sym = e->symtree->n.sym->result;
+ else
+ goto end_pointer_check;
+
+ if (sym->attr.allocatable
+ && (fsym == NULL || !fsym->attr.allocatable))
+ asprintf (&msg, "Allocatable actual argument '%s' is not "
+ "allocated", sym->name);
+ else if (sym->attr.pointer
+ && (fsym == NULL || !fsym->attr.pointer))
+ asprintf (&msg, "Pointer actual argument '%s' is not "
+ "associated", sym->name);
+ else if (sym->attr.proc_pointer
+ && (fsym == NULL || !fsym->attr.proc_pointer))
+ asprintf (&msg, "Proc-pointer actual argument '%s' is not "
+ "associated", sym->name);
+ else
+ goto end_pointer_check;
+
+ cond = fold_build2 (EQ_EXPR, boolean_type_node, parmse.expr,
+ fold_convert (TREE_TYPE (parmse.expr),
+ null_pointer_node));
+
+ gfc_trans_runtime_check (true, false, cond, &se->pre, &e->where,
+ msg);
+ gfc_free (msg);
+ }
+ end_pointer_check:
+
+
/* Character strings are passed as two parameters, a length and a
pointer - except for Bind(c) which only passes the pointer. */
if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (revision 149051)
+++ gcc/fortran/gfortran.texi (working copy)
@@ -1965,10 +1965,10 @@ a macro. Use the @code{IERRNO} intrinsic
Subroutines and functions have to have the @code{BIND(C)} attribute to
be compatible with C. The dummy argument declaration is relatively
straightforward. However, one needs to be careful because C uses
-call-by-value by default while GNU Fortran uses call-by-reference.
-Furthermore, strings and pointers are handled differently. Note that
-only explicit size and assumed-size arrays are supported but not
-assumed-shape or allocatable arrays.
+call-by-value by default while Fortran behaves usually similar to
+call-by-reference" Furthermore, strings and pointers are handled
+differently. Note that only explicit size and assumed-size arrays are
+supported but not assumed-shape or allocatable arrays.
To pass a variable by value, use the @code{VALUE} attribute.
Thus the following C prototype
@@ -2277,7 +2277,7 @@ initialization using @code{_gfortran_set
Default: enabled.
@item @var{option}[6] @tab Enables run-time checking. Possible values
are (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), GFC_RTCHECK_ARRAY_TEMPS (2),
-GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16).
+GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), GFC_RTCHECK_POINTER (32).
Default: disabled.
@item @var{option}[7] @tab If non zero, range checking is enabled.
Default: enabled. See -frange-check (@pxref{Code Gen Options}).
Index: gcc/fortran/iso-c-binding.def
===================================================================
--- gcc/fortran/iso-c-binding.def (revision 149051)
+++ gcc/fortran/iso-c-binding.def (working copy)
@@ -160,8 +160,6 @@ PROCEDURE (ISOCBINDING_F_POINTER, "c_f_p
PROCEDURE (ISOCBINDING_ASSOCIATED, "c_associated")
PROCEDURE (ISOCBINDING_LOC, "c_loc")
PROCEDURE (ISOCBINDING_FUNLOC, "c_funloc")
-
-/* Insert c_f_procpointer, though unsupported for now. */
PROCEDURE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer")
#undef NAMED_INTCST
Index: gcc/fortran/libgfortran.h
===================================================================
--- gcc/fortran/libgfortran.h (revision 149051)
+++ gcc/fortran/libgfortran.h (working copy)
@@ -47,8 +47,10 @@ along with GCC; see the file COPYING3.
#define GFC_RTCHECK_ARRAY_TEMPS (1<<1)
#define GFC_RTCHECK_RECURSION (1<<2)
#define GFC_RTCHECK_DO (1<<3)
+#define GFC_RTCHECK_POINTER (1<<4)
#define GFC_RTCHECK_ALL (GFC_RTCHECK_BOUNDS | GFC_RTCHECK_ARRAY_TEMPS \
- | GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO)
+ | GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \
+ | GFC_RTCHECK_POINTER)
/* Possible values for the CONVERT I/O specifier. */
Index: gcc/fortran/invoke.texi
===================================================================
--- gcc/fortran/invoke.texi (revision 149051)
+++ gcc/fortran/invoke.texi (working copy)
@@ -166,7 +166,7 @@ and warnings}.
@gccoptlist{-fno-automatic -ff2c -fno-underscoring @gol
-fwhole-file -fsecond-underscore @gol
-fbounds-check -fcheck-array-temporaries -fmax-array-constructor =@var{n} @gol
--fcheck=@var{<all|array-temps|bounds|do|recursion>}
+-fcheck=@var{<all|array-temps|bounds|do|pointer|recursion>}
-fmax-stack-var-size=@var{n} @gol
-fpack-derived -frepack-arrays -fshort-enums -fexternal-blas @gol
-fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol
@@ -1203,6 +1203,7 @@ by use of the @option{-ff2c} option.
@opindex @code{fcheck}
@cindex array, bounds checking
@cindex bounds checking
+@cindex pointer checking
@cindex range checking
@cindex subscript checking
@cindex checking subscripts
@@ -1241,6 +1242,9 @@ checking substring references.
Enable generation of run-time checks for invalid modification of loop
iteration variables.
+@item @samp{pointer}
+Enable generation of run-time checks for pointers and allocatables.
+
@item @samp{recursion}
Enable generation of run-time checks for recursively called subroutines and
functions which are not marked as recursive. See also @option{-frecursive}.
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c (revision 149051)
+++ gcc/fortran/options.c (working copy)
@@ -471,10 +471,11 @@ gfc_handle_runtime_check_option (const c
{
int result, pos = 0, n;
static const char * const optname[] = { "all", "bounds", "array-temps",
- "recursion", "do", NULL };
+ "recursion", "do", "pointer", NULL };
static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
GFC_RTCHECK_ARRAY_TEMPS,
GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
+ GFC_RTCHECK_POINTER,
0 };
while (*arg)
Index: gcc/testsuite/gfortran.dg/pointer_check_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_check_1.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/pointer_check_1.f90 (revision 0)
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 53 .*Allocatable actual argument 'alloc2' is not allocated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+ integer :: a
+ a = 4444
+end subroutine test1
+
+subroutine test2(a)
+ integer :: a(2)
+ a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+ implicit none
+ external f
+ call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+ implicit none
+ external :: test1, test2, ppTest
+ integer, pointer :: ptr1, ptr2(:)
+ integer, allocatable :: alloc2(:)
+ procedure(), pointer :: pptr
+
+ allocate(ptr1,ptr2(2),alloc2(2))
+ pptr => sub
+ ! OK
+ call test1(ptr1)
+ call test3(ptr1)
+
+ call test2(ptr2)
+ call test2(alloc2)
+ call test4(ptr2)
+ call test4(alloc2)
+ call ppTest(pptr)
+ call ppTest2(pptr)
+
+ ! Invalid 1:
+ deallocate(alloc2)
+ call test2(alloc2)
+! call test4(alloc2)
+
+ ! Invalid 2:
+ deallocate(ptr1,ptr2)
+ nullify(ptr1,ptr2)
+! call test1(ptr1)
+! call test3(ptr1)
+! call test2(ptr2)
+! call test4(ptr2)
+
+ ! Invalid 3:
+ nullify(pptr)
+! call ppTest(pptr)
+ call ppTest2(pptr)
+
+contains
+ subroutine test3(b)
+ integer :: b
+ b = 333
+ end subroutine test3
+ subroutine test4(b)
+ integer :: b(2)
+ b = 333
+ end subroutine test4
+ subroutine sub()
+ print *, 'Hello World'
+ end subroutine sub
+ subroutine ppTest2(f)
+ implicit none
+ procedure(sub) :: f
+ call f()
+ end subroutine ppTest2
+end Program RunTimeCheck
Index: gcc/testsuite/gfortran.dg/pointer_check_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_check_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/pointer_check_2.f90 (revision 0)
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 60.*Pointer actual argument 'ptr1' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+ integer :: a
+ a = 4444
+end subroutine test1
+
+subroutine test2(a)
+ integer :: a(2)
+ a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+ implicit none
+ external f
+ call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+ implicit none
+ external :: test1, test2, ppTest
+ integer, pointer :: ptr1, ptr2(:)
+ integer, allocatable :: alloc2(:)
+ procedure(), pointer :: pptr
+
+ allocate(ptr1,ptr2(2),alloc2(2))
+ pptr => sub
+ ! OK
+ call test1(ptr1)
+ call test3(ptr1)
+
+ call test2(ptr2)
+ call test2(alloc2)
+ call test4(ptr2)
+ call test4(alloc2)
+ call ppTest(pptr)
+ call ppTest2(pptr)
+
+ ! Invalid 1:
+ deallocate(alloc2)
+! call test2(alloc2)
+! call test4(alloc2)
+
+ ! Invalid 2:
+ deallocate(ptr1,ptr2)
+ nullify(ptr1,ptr2)
+! call test1(ptr1)
+ call test3(ptr1)
+! call test2(ptr2)
+! call test4(ptr2)
+
+ ! Invalid 3:
+ nullify(pptr)
+! call ppTest(pptr)
+ call ppTest2(pptr)
+
+contains
+ subroutine test3(b)
+ integer :: b
+ b = 333
+ end subroutine test3
+ subroutine test4(b)
+ integer :: b(2)
+ b = 333
+ end subroutine test4
+ subroutine sub()
+ print *, 'Hello World'
+ end subroutine sub
+ subroutine ppTest2(f)
+ implicit none
+ procedure(sub) :: f
+ call f()
+ end subroutine ppTest2
+end Program RunTimeCheck
Index: gcc/testsuite/gfortran.dg/pointer_check_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_check_3.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/pointer_check_3.f90 (revision 0)
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 61.*Pointer actual argument 'ptr2' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+ integer :: a
+ a = 4444
+end subroutine test1
+
+subroutine test2(a)
+ integer :: a(2)
+ a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+ implicit none
+ external f
+ call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+ implicit none
+ external :: test1, test2, ppTest
+ integer, pointer :: ptr1, ptr2(:)
+ integer, allocatable :: alloc2(:)
+ procedure(), pointer :: pptr
+
+ allocate(ptr1,ptr2(2),alloc2(2))
+ pptr => sub
+ ! OK
+ call test1(ptr1)
+ call test3(ptr1)
+
+ call test2(ptr2)
+ call test2(alloc2)
+ call test4(ptr2)
+ call test4(alloc2)
+ call ppTest(pptr)
+ call ppTest2(pptr)
+
+ ! Invalid 1:
+ deallocate(alloc2)
+! call test2(alloc2)
+! call test4(alloc2)
+
+ ! Invalid 2:
+ deallocate(ptr1,ptr2)
+ nullify(ptr1,ptr2)
+! call test1(ptr1)
+! call test3(ptr1)
+ call test2(ptr2)
+! call test4(ptr2)
+
+ ! Invalid 3:
+ nullify(pptr)
+! call ppTest(pptr)
+ call ppTest2(pptr)
+
+contains
+ subroutine test3(b)
+ integer :: b
+ b = 333
+ end subroutine test3
+ subroutine test4(b)
+ integer :: b(2)
+ b = 333
+ end subroutine test4
+ subroutine sub()
+ print *, 'Hello World'
+ end subroutine sub
+ subroutine ppTest2(f)
+ implicit none
+ procedure(sub) :: f
+ call f()
+ end subroutine ppTest2
+end Program RunTimeCheck
Index: gcc/testsuite/gfortran.dg/pointer_check_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_check_4.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/pointer_check_4.f90 (revision 0)
@@ -0,0 +1,86 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 66.*Proc-pointer actual argument 'pptr' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for variable actuals
+!
+
+subroutine test1(a)
+ integer :: a
+ a = 4444
+end subroutine test1
+
+subroutine test2(a)
+ integer :: a(2)
+ a = 4444
+end subroutine test2
+
+subroutine ppTest(f)
+ implicit none
+ external f
+ call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+ implicit none
+ external :: test1, test2, ppTest
+ integer, pointer :: ptr1, ptr2(:)
+ integer, allocatable :: alloc2(:)
+ procedure(), pointer :: pptr
+
+ allocate(ptr1,ptr2(2),alloc2(2))
+ pptr => sub
+ ! OK
+ call test1(ptr1)
+ call test3(ptr1)
+
+ call test2(ptr2)
+ call test2(alloc2)
+ call test4(ptr2)
+ call test4(alloc2)
+ call ppTest(pptr)
+ call ppTest2(pptr)
+
+ ! Invalid 1:
+ deallocate(alloc2)
+! call test2(alloc2)
+! call test4(alloc2)
+
+ ! Invalid 2:
+ deallocate(ptr1,ptr2)
+ nullify(ptr1,ptr2)
+! call test1(ptr1)
+! call test3(ptr1)
+! call test2(ptr2)
+! call test4(ptr2)
+
+ ! Invalid 3:
+ nullify(pptr)
+ call ppTest(pptr)
+! call ppTest2(pptr)
+
+contains
+ subroutine test3(b)
+ integer :: b
+ b = 333
+ end subroutine test3
+ subroutine test4(b)
+ integer :: b(2)
+ b = 333
+ end subroutine test4
+ subroutine sub()
+ print *, 'Hello World'
+ end subroutine sub
+ subroutine ppTest2(f)
+ implicit none
+ procedure(sub) :: f
+ call f()
+ end subroutine ppTest2
+end Program RunTimeCheck
Index: gcc/testsuite/gfortran.dg/pointer_check_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_check_5.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/pointer_check_5.f90 (revision 0)
@@ -0,0 +1,100 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Unassociated/unallocated actual argument" }
+!
+! { dg-output ".*At line 46 .*Pointer actual argument 'getptr' is not associated" }
+!
+! PR fortran/40580
+!
+! Run-time check of passing deallocated/nonassociated actuals
+! to nonallocatable/nonpointer dummies.
+!
+! Check for function actuals
+!
+
+subroutine test1(a)
+ integer :: a
+ print *, a
+end subroutine test1
+
+subroutine test2(a)
+ integer :: a(2)
+ print *, a
+end subroutine test2
+
+subroutine ppTest(f)
+ implicit none
+ external f
+ call f()
+end subroutine ppTest
+
+Program RunTimeCheck
+ implicit none
+ external :: test1, test2, ppTest
+ procedure(), pointer :: pptr
+
+ ! OK
+ call test1(getPtr(.true.))
+ call test2(getPtrArray(.true.))
+ call test2(getAlloc(.true.))
+
+ ! OK but fails due to PR 40593
+! call ppTest(getProcPtr(.true.))
+! call ppTest2(getProcPtr(.true.))
+
+ ! Invalid:
+ call test1(getPtr(.false.))
+! call test2(getAlloc(.false.)) - fails because the check is inserted after
+! _gfortran_internal_pack, which fails with out of memory
+! call ppTest(getProcPtr(.false.)) - fails due to PR 40593
+! call ppTest2(getProcPtr(.false.)) - fails due to PR 40593
+
+contains
+ function getPtr(alloc)
+ integer, pointer :: getPtr
+ logical, intent(in) :: alloc
+ if (alloc) then
+ allocate (getPtr)
+ getPtr = 1
+ else
+ nullify (getPtr)
+ end if
+ end function getPtr
+ function getPtrArray(alloc)
+ integer, pointer :: getPtrArray(:)
+ logical, intent(in) :: alloc
+ if (alloc) then
+ allocate (getPtrArray(2))
+ getPtrArray = 1
+ else
+ nullify (getPtrArray)
+ end if
+ end function getPtrArray
+ function getAlloc(alloc)
+ integer, allocatable :: getAlloc(:)
+ logical, intent(in) :: alloc
+ if (alloc) then
+ allocate (getAlloc(2))
+ getAlloc = 2
+ else if (allocated(getAlloc)) then
+ deallocate(getAlloc)
+ end if
+ end function getAlloc
+ subroutine sub()
+ print *, 'Hello World'
+ end subroutine sub
+ function getProcPtr(alloc)
+ procedure(sub), pointer :: getProcPtr
+ logical, intent(in) :: alloc
+ if (alloc) then
+ getProcPtr => sub
+ else
+ nullify (getProcPtr)
+ end if
+ end function getProcPtr
+ subroutine ppTest2(f)
+ implicit none
+ procedure(sub) :: f
+ call f()
+ end subroutine ppTest2
+end Program RunTimeCheck