diff options
| author | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-06-29 21:02:17 +0000 |
|---|---|---|
| committer | burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2009-06-29 21:02:17 +0000 |
| commit | 91cf6ba3f39e8d8ae45283cb3af328c1583eeb75 (patch) | |
| tree | f4b9667f6f491ec9edcb2471c4bf08b3e532f635 /gcc/fortran/trans-expr.c | |
| parent | 8d60cc468e8c1956cef570588d4297ce3a740328 (diff) | |
| download | ppe42-gcc-91cf6ba3f39e8d8ae45283cb3af328c1583eeb75.tar.gz ppe42-gcc-91cf6ba3f39e8d8ae45283cb3af328c1583eeb75.zip | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149063 138bc75d-0d04-0410-961f-82ee72b054a4
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 6a38f10f656..19ac1390f82 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) |
