re PR fortran/17244 (gfortran fatal error: gfc_todo: Not Implemented: Returning derived types)

fortran/
PR fortran/17244
* trans-types.c (gfc_return_by_reference): Remove TODO error,
add comment pointing out possible issue WRT compatibility with g77.

testsuite/
PR fortran/17244
* gfortran.dg/func_derived_1.f90: New test.

From-SVN: r86832

gcc/fortran/ChangeLog

 2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
+	PR fortran/17244
+	* trans-types.c (gfc_return_by_reference): Remove TODO error,
+	add comment pointing out possible issue WRT compatibility with g77.
+
+2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
 	* trans-decl.c, trans-expr.c, trans-io.c, trans-types.c: Replace
 	all occurences of 'gfc_strlen_type_node' by
 	'gfc_charlen_type_node'.

gcc/fortran/trans-types.c

@@ -1451,9 +1451,7 @@ gfc_return_by_reference (gfc_symbol * sym)
   if (sym->ts.type == BT_CHARACTER)
     return 1;
 
-  if (sym->ts.type == BT_DERIVED)
-    gfc_todo_error ("Returning derived types");
-  /* Possibly return derived types by reference.  */
+  /* Possibly return complex numbers by reference for g77 compatibility.  */
   return 0;
 }
 

gcc/testsuite/ChangeLog

+2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17244
+	* gfortran.dg/func_derived_1.f90: New test.
+
 2004-08-31  Paul Brook  <paul@codesourcery.com>
 
 	* gfortran.dg/eof_1.f90: New test.

gcc/testsuite/gfortran.dg/func_derived_1.f90

+! { dg-do run }
+! PR 17244
+! verifies that functions returning derived type work
+module m
+  type t
+     integer i
+     real x
+     character*5 c
+     integer arr(5,5)
+  end type t
+end module m
+
+use m
+type(t) :: r
+integer arr(5,5), vect(25), vect2(25)
+do i=1,25
+   vect = 0
+   vect(i) = i
+   arr = reshape (vect, shape(arr))
+   r = f(i,real(i),"HALLO",arr)
+
+   if (r%i .ne. i) call abort()
+   if (r%x .ne. real(i)) call abort()
+   if (r%c .ne. "HALLO") call abort()
+   vect2 = reshape (r%arr, shape(vect2))
+   if (any(vect2.ne.vect)) call abort()
+end do
+contains
+
+function f(i,x,c,arr)
+  type(t) :: f
+  character*5 c
+  integer arr(5,5)
+  
+  f = t(i,x,c,arr)
+end function f
+
+end