diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2007-11-14 00:59:09 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2007-11-14 00:59:09 +0000 |
| commit | 6cc309c9234d18f69b2c70ec0220becf3b0f58f5 (patch) | |
| tree | c296e0620442c1d321dbe2b55bcada779f15b955 /gcc/fortran/resolve.c | |
| parent | 7cbb9e290262fc10104e673248332e1a889ac1b4 (diff) | |
| download | gcc-6cc309c9234d18f69b2c70ec0220becf3b0f58f5.zip gcc-6cc309c9234d18f69b2c70ec0220becf3b0f58f5.tar.gz gcc-6cc309c9234d18f69b2c70ec0220becf3b0f58f5.tar.bz2 | |
re PR fortran/33162 (INTRINSIC functions as ACTUAL argument)
2007-11-11 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/33162
* decl.c (match_procedure_decl): Remove TODO and allow intrinsics in
PROCEDURE declarations. Set attr.untyped to allow the interface to be
resolved later where the symbol type will be set.
* interface.c (compare_intr_interfaces): Remove static from pointer
declarations. Add type and kind checks for dummy function arguments.
(compare_actual_formal_intr): New function to compare an actual
argument with an intrinsic function. (gfc_procedures_use): Add check for
interface that points to an intrinsic function, use the new function.
* resolve.c (resolve_specific_f0): Resolve the intrinsic interface.
(resolve_specific_s0): Ditto.
From-SVN: r130168
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 34 |
1 files changed, 34 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 198fec7..3f3ef03 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1074,6 +1074,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype) if (sym->ts.type == BT_UNKNOWN && sym->attr.intrinsic) { gfc_intrinsic_sym *isym; + isym = gfc_find_function (sym->name); if (isym == NULL || !isym->specific) { @@ -1083,6 +1084,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype) return FAILURE; } sym->ts = isym->ts; + sym->attr.intrinsic = 1; sym->attr.function = 1; } goto argument_list; @@ -1487,6 +1489,22 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr) { match m; + /* See if we have an intrinsic interface. */ + + if (sym->interface != NULL && sym->interface->attr.intrinsic) + { + gfc_intrinsic_sym *isym; + isym = gfc_find_function (sym->interface->name); + + /* Existance of isym should be checked already. */ + gcc_assert (isym); + + sym->ts = isym->ts; + sym->attr.function = 1; + sym->attr.proc = PROC_EXTERNAL; + goto found; + } + if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY) { if (sym->attr.dummy) @@ -2513,6 +2531,22 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym) { match m; + /* See if we have an intrinsic interface. */ + if (sym->interface != NULL && !sym->interface->attr.abstract + && !sym->interface->attr.subroutine) + { + gfc_intrinsic_sym *isym; + + isym = gfc_find_function (sym->interface->name); + + /* Existance of isym should be checked already. */ + gcc_assert (isym); + + sym->ts = isym->ts; + sym->attr.function = 1; + goto found; + } + if(sym->attr.is_iso_c) { m = gfc_iso_c_sub_interface (c,sym); |