fortran/

2005-12-30  Erik Edelmann  <eedelman@gcc.gnu.org>

        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  <eedelman@gcc.gnu.org>

        PR fortran/22607
        * gfortran-dg/pure_byref_3.f90: New.

        fortran/PR 25396
        * gfortran.dg/userdef_operator_1.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@109171 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 73b11ea..4d7e648 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2005-12-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+       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  <pault@gcc.gnu.org>
 
        PR fortran/25532

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b58fb83..e3a13f5 100644 (file)
--- 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 b3f153b..aa4a3b0 100644 (file)
--- 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 4dbfe9b..9d8f608 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2005-12-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+       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  <nathan@codesourcery.com>
 
        * 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 (file)
index 0000000..cb2644f
--- /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 (file)
index 0000000..5bf99d0
--- /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
+