From cf013e9fdbd98b7798cbd88f126000c72361c56c Mon Sep 17 00:00:00 2001 From: Erik Edelmann Date: Fri, 30 Dec 2005 15:02:44 +0000 Subject: [PATCH] re PR fortran/22607 (Elemental character functions don't work) fortran/ 2005-12-30 Erik Edelmann PR fortran/22607 * trans-decl.c(gfc_get_extern_function_decl): Don't set DECL_IS_PURE (fndecl) = 1 for return-by-reference functions. fortran/PR 25396 * interface.c (gfc_extend_expr): Initialize e->value.function.name to NULL. testsuite/ 2005-12-30 Erik Edelmann PR fortran/22607 * gfortran-dg/pure_byref_3.f90: New. fortran/PR 25396 * gfortran.dg/userdef_operator_1.f90: New. From-SVN: r109171 --- gcc/fortran/ChangeLog | 11 ++++++ gcc/fortran/interface.c | 1 + gcc/fortran/trans-decl.c | 2 +- gcc/testsuite/ChangeLog | 8 +++++ gcc/testsuite/gfortran.dg/pure_byref_3.f90 | 33 +++++++++++++++++ .../gfortran.dg/userdef_operator_1.f90 | 35 +++++++++++++++++++ 6 files changed, 89 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/pure_byref_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/userdef_operator_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 73b11ea65da..4d7e648d672 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2005-12-30 Erik Edelmann + + PR fortran/22607 + * trans-decl.c(gfc_get_extern_function_decl): Don't set + DECL_IS_PURE (fndecl) = 1 for return-by-reference + functions. + + fortran/PR 25396 + * interface.c (gfc_extend_expr): Initialize + e->value.function.name to NULL. + 2005-12-29 Paul Thomas PR fortran/25532 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index b58fb835a47..e3a13f5d9e4 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1718,6 +1718,7 @@ gfc_extend_expr (gfc_expr * e) e->value.function.actual = actual; e->value.function.esym = NULL; e->value.function.isym = NULL; + e->value.function.name = NULL; if (gfc_pure (NULL) && !gfc_pure (sym)) { diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b3f153bad2b..aa4a3b01e04 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1093,7 +1093,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym) sense. */ if (sym->attr.pure || sym->attr.elemental) { - if (sym->attr.function) + if (sym->attr.function && !gfc_return_by_reference (sym)) DECL_IS_PURE (fndecl) = 1; /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT) parameters and don't use alternate returns (is this diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4dbfe9beb62..9d8f60845ad 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2005-12-30 Erik Edelmann + + PR fortran/22607 + * gfortran-dg/pure_byref_3.f90: New. + + fortran/PR 25396 + * gfortran.dg/userdef_operator_1.f90: New. + 2005-12-29 Nathan Sidwell * g++.dg/abi/thunk3.C: New. diff --git a/gcc/testsuite/gfortran.dg/pure_byref_3.f90 b/gcc/testsuite/gfortran.dg/pure_byref_3.f90 new file mode 100644 index 00000000000..cb2644ff898 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pure_byref_3.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! PR 22607: External/module pure return-by-reference functions + +pure function hoj() + integer :: hoj(3) + hoj = (/1, 2, 3/) +end function hoj + +module huj_mod +contains + pure function huj() + integer :: huj(3) + huj = (/1, 2, 3/) + end function huj +end module huj_mod + +program pure_byref_3 + use huj_mod + implicit none + + interface + pure function hoj() + integer :: hoj(3) + end function hoj + end interface + integer :: a(3) + + a = huj() + if (.not. all(a == (/1, 2, 3/))) call abort() + + a = hoj() + if (.not. all(a == (/1, 2, 3/))) call abort() +end program pure_byref_3 diff --git a/gcc/testsuite/gfortran.dg/userdef_operator_1.f90 b/gcc/testsuite/gfortran.dg/userdef_operator_1.f90 new file mode 100644 index 00000000000..5bf99d04acd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/userdef_operator_1.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! Testcase from PR 25396: User defined operators returning arrays. +module geometry + + implicit none + + interface operator(.cross.) + module procedure cross + end interface + +contains + + ! Cross product between two 3d vectors. + pure function cross(a, b) + real, dimension(3), intent(in) :: a,b + real, dimension(3) :: cross + + cross = (/ a(2) * b(3) - a(3) * b(2), & + a(3) * b(1) - a(1) * b(3), & + a(1) * b(2) - a(2) * b(1) /) + end function cross + +end module geometry + +program opshape + use geometry + + implicit none + + real :: t(3,3), a + + a = dot_product (t(:,1), t(:,2) .cross. t(:,3)) + +end program opshape +