diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-09-20 23:42:54 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-09-20 23:42:54 +0200 |
| commit | 48dbbcd6e29e7520b91dce52f492fa07fb6e4aad (patch) | |
| tree | e6777450f7b259237fcf188c6329216d441178a5 /gcc/fortran/trans-expr.c | |
| parent | ad78b8a6887aef944aae522884f8c9e7b91fb860 (diff) | |
| download | gcc-48dbbcd6e29e7520b91dce52f492fa07fb6e4aad.zip gcc-48dbbcd6e29e7520b91dce52f492fa07fb6e4aad.tar.gz gcc-48dbbcd6e29e7520b91dce52f492fa07fb6e4aad.tar.bz2 | |
re PR fortran/45438 ([OOP] ICE with -fcheck=pointer)
2010-09-20 Janus Weil <janus@gcc.gnu.org>
PR fortran/45438
* trans-expr.c (gfc_conv_procedure_call): Fix pointer checking for
TBPs, PPCs and pointer/allocatable components.
2010-09-20 Janus Weil <janus@gcc.gnu.org>
PR fortran/45438
* gfortran.dg/pointer_check_7.f90: New.
From-SVN: r164462
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 31 |
1 files changed, 10 insertions, 21 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 8d4295f..9b24cad 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3169,27 +3169,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (gfc_option.rtcheck & GFC_RTCHECK_POINTER && e != NULL) { - symbol_attribute *attr; + symbol_attribute attr; char *msg; tree cond; - if (e->expr_type == EXPR_VARIABLE) - attr = &e->symtree->n.sym->attr; - else if (e->expr_type == EXPR_FUNCTION) - { - /* For intrinsic functions, the gfc_attr are not available. */ - if (e->symtree->n.sym->attr.generic && e->value.function.isym) - goto end_pointer_check; - - if (e->symtree->n.sym->attr.generic) - attr = &e->value.function.esym->attr; - else - attr = &e->symtree->n.sym->result->attr; - } + if (e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION) + attr = gfc_expr_attr (e); else goto end_pointer_check; - if (attr->optional) + if (attr.optional) { /* If the actual argument is an optional pointer/allocatable and the formal argument takes an nonpointer optional value, @@ -3198,16 +3187,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, See Fortran 2003, Section 12.4.1.6 item (7)+(8). */ tree present, null_ptr, type; - if (attr->allocatable + if (attr.allocatable && (fsym == NULL || !fsym->attr.allocatable)) asprintf (&msg, "Allocatable actual argument '%s' is not " "allocated or not present", e->symtree->n.sym->name); - else if (attr->pointer + else if (attr.pointer && (fsym == NULL || !fsym->attr.pointer)) asprintf (&msg, "Pointer actual argument '%s' is not " "associated or not present", e->symtree->n.sym->name); - else if (attr->proc_pointer + else if (attr.proc_pointer && (fsym == NULL || !fsym->attr.proc_pointer)) asprintf (&msg, "Proc-pointer actual argument '%s' is not " "associated or not present", @@ -3231,15 +3220,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } else { - if (attr->allocatable + if (attr.allocatable && (fsym == NULL || !fsym->attr.allocatable)) asprintf (&msg, "Allocatable actual argument '%s' is not " "allocated", e->symtree->n.sym->name); - else if (attr->pointer + else if (attr.pointer && (fsym == NULL || !fsym->attr.pointer)) asprintf (&msg, "Pointer actual argument '%s' is not " "associated", e->symtree->n.sym->name); - else if (attr->proc_pointer + else if (attr.proc_pointer && (fsym == NULL || !fsym->attr.proc_pointer)) asprintf (&msg, "Proc-pointer actual argument '%s' is not " "associated", e->symtree->n.sym->name); |