From 20a037d5f58c824cb402275fa47f241377a5fde5 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 31 Dec 2006 07:51:47 +0000 Subject: [PATCH] re PR fortran/27900 ([4.1 only] ICE using intrinsics as arguments) 2006-12-31 Paul Thomas PR fortran/27900 * resolve.c (resolve_actual_arglist): If all else fails and a procedure actual argument has no type, see if a specific intrinsic matches. PR fortran/24325 * resolve.c (resolve_function): If the function reference is FL_VARIABLE this is an error. 2006-12-31 Paul Thomas PR fortran/27900 * gfortran.dg/intrinsic_actual_4.f90: New test. PR fortran/24325 * gfortran.dg/func_decl_3.f90: New test. From-SVN: r120296 --- gcc/fortran/ChangeLog | 11 ++++++ gcc/fortran/resolve.c | 37 +++++++++++++++++++ gcc/testsuite/ChangeLog | 8 ++++ gcc/testsuite/gfortran.dg/func_decl_3.f90 | 15 ++++++++ .../gfortran.dg/intrinsic_actual_4.f90 | 18 +++++++++ 5 files changed, 89 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/func_decl_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7aa22fe1809..de32f26fd6c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2006-12-31 Paul Thomas + + PR fortran/27900 + * resolve.c (resolve_actual_arglist): If all else fails and a + procedure actual argument has no type, see if a specific + intrinsic matches. + + PR fortran/24325 + * resolve.c (resolve_function): If the function reference is + FL_VARIABLE this is an error. + 2006-12-31 Paul Thomas PR fortran/23060 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1b46a10ca5f..ba547f20c55 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -140,6 +140,21 @@ resolve_formal_arglist (gfc_symbol * proc) continue; } + if (sym->attr.function + && sym->ts.type == BT_UNKNOWN + && sym->attr.intrinsic) + { + gfc_intrinsic_sym *isym; + isym = gfc_find_function (sym->name); + if (isym == NULL || !isym->specific) + { + gfc_error ("Unable to find a specific INTRINSIC procedure " + "for the reference '%s' at %L", sym->name, + &sym->declared_at); + } + sym->ts = isym->ts; + } + continue; } @@ -937,6 +952,21 @@ resolve_actual_arglist (gfc_actual_arglist * arg, procedure_type ptype) && sym->ns->parent->proc_name == sym))) goto got_variable; + /* If all else fails, see if we have a specific intrinsic. */ + if (sym->attr.function + && sym->ts.type == BT_UNKNOWN + && sym->attr.intrinsic) + { + gfc_intrinsic_sym *isym; + isym = gfc_find_function (sym->name); + if (isym == NULL || !isym->specific) + { + gfc_error ("Unable to find a specific INTRINSIC procedure " + "for the reference '%s' at %L", sym->name, + &e->where); + } + sym->ts = isym->ts; + } goto argument_list; } @@ -1512,6 +1542,13 @@ resolve_function (gfc_expr * expr) if (expr->symtree) sym = expr->symtree->n.sym; + if (sym && sym->attr.flavor == FL_VARIABLE) + { + gfc_error ("'%s' at %L is not a function", + sym->name, &expr->where); + return FAILURE; + } + /* If the procedure is not internal, a statement function or a module procedure,it must be external and should be checked for usage. */ if (sym && !sym->attr.dummy && !sym->attr.contained diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5ba52bad237..564312da934 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2006-12-31 Paul Thomas + + PR fortran/27900 + * gfortran.dg/intrinsic_actual_4.f90: New test. + + PR fortran/24325 + * gfortran.dg/func_decl_3.f90: New test. + 2006-12-31 Paul Thomas PR fortran/23060 diff --git a/gcc/testsuite/gfortran.dg/func_decl_3.f90 b/gcc/testsuite/gfortran.dg/func_decl_3.f90 new file mode 100644 index 00000000000..4e458f47d88 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/func_decl_3.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! Tests the fix for PR24325 in which the lack of any declaration +! that foo is a function or even a procedure was not detected. +! +! Contributed by Jakub Jelinek +! + integer foo + call test +contains + subroutine test + integer :: i + i = foo () ! { dg-error "is not a function" } + end subroutine test +end + diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90 b/gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90 new file mode 100644 index 00000000000..4ba4b79c72d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_4.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! Tests the fix for PR27900, in which an ICE would be caused because +! the actual argument LEN had no type. +! +! Contributed by Klaus Ramstöck +! + subroutine sub (proc, chr) + external proc + integer proc + character*(*) chr + if (proc (chr) .ne. 6) call abort () + end subroutine sub + + implicit none + integer i + i = len ("123") + call sub (len, "abcdef") + end