diff options
| author | Tobias Burnus <burnus@net-b.de> | 2009-06-29 23:02:17 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2009-06-29 23:02:17 +0200 |
| commit | 20460eb94863954cf7ebdc7bf2193038ac0b781a (patch) | |
| tree | f4b9667f6f491ec9edcb2471c4bf08b3e532f635 /gcc/fortran/trans-expr.c | |
| parent | a61a36ab30b7711b5d5cf002d52e6e9514499739 (diff) | |
| download | gcc-20460eb94863954cf7ebdc7bf2193038ac0b781a.zip gcc-20460eb94863954cf7ebdc7bf2193038ac0b781a.tar.gz gcc-20460eb94863954cf7ebdc7bf2193038ac0b781a.tar.bz2 | |
re PR fortran/40580 (Add -fcheck=pointer with runtime check for using an unallocated argument)
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.
From-SVN: r149063
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6a38f10..19ac139 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2772,6 +2772,48 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, 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) |