From c2de0c194e27767937fe5fbae12aa96638768c4c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 27 May 2007 23:24:48 +0200 Subject: [PATCH] re PR fortran/32088 (ICE (doesn't occur if given function standalone instead on internal)) fortran/ 2007-05-27 Paul Thomas Tobias Burnus PR fortran/32088 * symbol.c (gfc_check_function_type): Copy dimensions of result variable. * resolve.c (resolve_contained_fntype): Improve symbol output in the error message. testsuite/ 2007-05-27 Tobias Burnus PR fortran/32088 * gfortran.dg/func_result_3.f90: New. -- Diese und die falgenden Zeilen werden ignoriert -- M gcc/testsuite/ChangeLog A gcc/testsuite/gfortran.dg/func_result_3.f90 M gcc/fortran/symbol.c M gcc/fortran/ChangeLog M gcc/fortran/resolve.c From-SVN: r125118 --- gcc/fortran/ChangeLog | 9 ++++++++ gcc/fortran/resolve.c | 24 +++++++++++--------- gcc/fortran/symbol.c | 13 +++++++---- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/func_result_3.f90 | 25 +++++++++++++++++++++ 5 files changed, 61 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/func_result_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e86556f668b..11b6e925108 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2007-05-27 Paul Thomas + Tobias Burnus + + PR fortran/32088 + * symbol.c (gfc_check_function_type): Copy dimensions of + result variable. + * resolve.c (resolve_contained_fntype): Improve symbol output in + the error message. + 2007-05-26 Jerry DeLisle PR fortran/31813 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 60da300e5bd..6142081ec40 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -289,18 +289,20 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) return; /* Try to find out of what the return type is. */ - if (sym->result != NULL) - sym = sym->result; - - if (sym->ts.type == BT_UNKNOWN) + if (sym->result->ts.type == BT_UNKNOWN) { - t = gfc_set_default_type (sym, 0, ns); + t = gfc_set_default_type (sym->result, 0, ns); - if (t == FAILURE && !sym->attr.untyped) + if (t == FAILURE && !sym->result->attr.untyped) { - gfc_error ("Contained function '%s' at %L has no IMPLICIT type", - sym->name, &sym->declared_at); /* FIXME */ - sym->attr.untyped = 1; + if (sym->result == sym) + gfc_error ("Contained function '%s' at %L has no IMPLICIT type", + sym->name, &sym->declared_at); + else + gfc_error ("Result '%s' of contained function '%s' at %L has " + "no IMPLICIT type", sym->result->name, sym->name, + &sym->result->declared_at); + sym->result->attr.untyped = 1; } } @@ -310,9 +312,9 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns) in external functions. Internal function results are not on that list; ergo, not permitted. */ - if (sym->ts.type == BT_CHARACTER) + if (sym->result->ts.type == BT_CHARACTER) { - gfc_charlen *cl = sym->ts.cl; + gfc_charlen *cl = sym->result->ts.cl; if (!cl || !cl->length) gfc_error ("Character-valued internal function '%s' at %L must " "not be assumed length", sym->name, &sym->declared_at); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 71f89123e95..ba48e547a1c 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -271,13 +271,18 @@ gfc_check_function_type (gfc_namespace *ns) == SUCCESS) { if (proc->result != proc) - proc->ts = proc->result->ts; + { + proc->ts = proc->result->ts; + proc->as = gfc_copy_array_spec (proc->result->as); + proc->attr.dimension = proc->result->attr.dimension; + proc->attr.pointer = proc->result->attr.pointer; + proc->attr.allocatable = proc->result->attr.allocatable; + } } else { - gfc_error ("unable to implicitly type the function result " - "'%s' at %L", proc->result->name, - &proc->result->declared_at); + gfc_error ("Function result '%s' at %L has no IMPLICIT type", + proc->result->name, &proc->result->declared_at); proc->result->attr.untyped = 1; } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 29b1eac0db9..710c62c5fda 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-05-27 Tobias Burnus + + PR fortran/32088 + * gfortran.dg/func_result_3.f90: New. + 2007-05-27 Tobias Burnus PR middle-end/32083 diff --git a/gcc/testsuite/gfortran.dg/func_result_3.f90 b/gcc/testsuite/gfortran.dg/func_result_3.f90 new file mode 100644 index 00000000000..d0f8c7192cd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/func_result_3.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! PR fortran/32088 +! +! Test implicitly defined result variables +! +subroutine dummy +contains + function quadric(a,b) result(c) + intent(in) a,b; dimension a(0:3),b(0:3),c(0:9) + c(0)=a(0)*b(0); c(1:3)=a(1:)*b(0)+a(0)*b(1:); c(4:6)=a(1:)*b(1:) + c(7:9)=(/a(1)*b(2)+b(1)*a(2),a(1)*b(3)+b(1)*a(3),a(2)*b(3)+b(2)*a(3)/) + end function +end subroutine dummy + +subroutine dummy2 +implicit none +contains + function quadric(a,b) result(c) ! { dg-error "no IMPLICIT type" } + real :: a, b + intent(in) a,b; dimension a(0:3),b(0:3),c(0:9) + c(0)=a(0)*b(0); c(1:3)=a(1:)*b(0)+a(0)*b(1:); c(4:6)=a(1:)*b(1:) + c(7:9)=(/a(1)*b(2)+b(1)*a(2),a(1)*b(3)+b(1)*a(3),a(2)*b(3)+b(2)*a(3)/) + end function +end subroutine dummy2 +end