[Bug fortran/31692] New: function without result clause fails to compile prperly

[Bug fortran/31692] New: function without result clause fails to compile prperly

[rakuen_himawari at yahoo dot co dot jp]

The following code causes segfault on execution. 
(This code works with PGI, Intel, and Hitachi Fortrans)

    module one
    contains
        function foo1(n)
        integer :: n
        integer :: foo1(n)

        call bar1(n, foo1)
        return
        end function

        subroutine bar1(n, array)
          integer :: n
          integer :: array(*)
          integer :: i
          do i = 1, n
             array(i) = i
          enddo
        end subroutine
    end module

    program main
      use one
      integer :: n
      n = 3
      write(*,*) foo1(n)
    end program

If the defnition of function foo1 is modeified as following, The problem
disappear.

        function foo1(n) result(res)
        integer :: n
        integer :: res(n)

        call bar1(n, res)
        return
        end function


-- 
           Summary: function without result clause fails to compile prperly
           Product: gcc
           Version: 4.3.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: rakuen_himawari at yahoo dot co dot jp
 GCC build triplet: x86_64-unknown-linux-gnu
  GCC host triplet: x86_64-unknown-linux-gnu
GCC target triplet: x86_64-unknown-linux-gnu


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692

[Bug fortran/31692] Wrong code when passing function name as result to procedures

[burnus at gcc dot gnu dot org]

------- Comment #1 from burnus at gcc dot gnu dot org  2007-04-25 07:38 -------
foo1 (__result, n)
{
  bar1 ((int4 *) n, foo1);
  goto __return_foo1;
  __return_foo1:;

looks strange. Shouldn't this be:
  bar1 ((int4 *) n, __result)

In addition, the warning
  g.f90:8: warning: Function does not return a value
should be suppressed.


-- 

burnus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |burnus at gcc dot gnu dot
                   |                            |org
             Status|UNCONFIRMED                 |NEW
     Ever Confirmed|0                           |1
           Keywords|                            |wrong-code
   Last reconfirmed|0000-00-00 00:00:00         |2007-04-25 07:38:17
               date|                            |
            Summary|function without result     |Wrong code when passing
                   |clause fails to compile     |function name as result to
                   |prperly                     |procedures


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692

[Bug fortran/31692] Wrong code when passing function name as result to procedures

[burnus at gcc dot gnu dot org]

------- Comment #2 from burnus at gcc dot gnu dot org  2007-04-27 23:52 -------
trans-expr.c's gfc_conv_variable contains:
      /* Special case for assigning the return value of a function.
         Self recursive functions must have an explicit return value.  */
      if (return_value && (se->expr == current_function_decl || parent_flag))
        se_expr = gfc_get_fake_result_decl (sym, parent_flag);

I somehow fail to see why this works characters, but not with arrays (except
for pointers, which are treated differently).

Side note:
        function foo1(n)
        implicit none
        integer :: n
        integer,ALLOCATABLE :: foo1(:)
        external bar1
        call bar1(n, foo1)
        end function
gives an ICE: in gfc_conv_descriptor_data_get, at fortran/trans-array.c:148


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692

[Bug fortran/31692] Wrong code when passing function name as result to procedures

[pault at gcc dot gnu dot org]

------- Comment #3 from pault at gcc dot gnu dot org  2007-05-04 07:29 -------
This fixes it but needs some cleaning up:

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c    (revision 124354)
--- gcc/fortran/trans-expr.c    (working copy)
*************** conv_arglist_function (gfc_se *se, gfc_e
*** 1987,1992 ****
--- 1987,2068 ----
  }


+ /* Convert an array valued actual argument expression.  */
+ 
+ static void
+ gfc_conv_array_arg (gfc_se *se, gfc_se *parmse, gfc_ss *argss,
+                   gfc_expr *e, gfc_symbol *sym, gfc_symbol *fsym)
+ {
+   /* If the procedure requires an explicit interface, the actual argument
+      is passed according to the corresponding formal argument.  If the
+      corresponding formal argument is a POINTER, ALLOCATABLE or assumed
+      shape, we do not use g77's calling convention, and pass the address
+      of the array descriptor instead. Otherwise we use g77's calling
+      convention.  */
+   tree tmp;
+   tree parent;
+   gfc_symbol *psym;
+   int f;
+ 
+   if (e->expr_type == EXPR_VARIABLE)
+     psym = e->symtree->n.sym;
+   else
+     psym = NULL;
+ 
+   parent = DECL_CONTEXT (current_function_decl);
+ 
+   f = (fsym != NULL)
+       && !(fsym->attr.pointer || fsym->attr.allocatable)
+       && fsym->as->type != AS_ASSUMED_SHAPE;
+   f = f || !sym->attr.always_explicit;
+ 
+   /* The actual argument is a component reference to an array of derived
+      types.  In this case, the argument is converted to a temporary,
+      which is passed and then written back after the procedure call.  */
+   if (e->expr_type == EXPR_VARIABLE && is_aliased_array (e))
+     gfc_conv_aliased_arg (parmse, e, f,
+                         fsym ? fsym->attr.intent : INTENT_INOUT);
+ 
+   /* The actual argument is a reference to the procedure containing the
+      call, when it does not have an explicit result.  */
+   else if (psym && psym->attr.flavor == FL_PROCEDURE
+               && (psym->backend_decl == current_function_decl
+                     || 
+                   psym->backend_decl == parent))
+     {
+       int b = (parent == psym->backend_decl) ? 1 : 0;
+       parmse->expr = gfc_get_fake_result_decl (psym, b);
+ 
+       /* Pass a descriptor if required.  */
+       if (f == 0 && GFC_ARRAY_TYPE_P (TREE_TYPE (parmse->expr)))
+       {
+         tmp = gfc_conv_array_data (parmse->expr);
+         gfc_conv_expr_descriptor (parmse, e, argss);
+         parmse->expr = build_fold_addr_expr (parmse->expr);
+       }
+       else if (f == 1 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE
(parmse->expr))))
+       parmse->expr = gfc_conv_array_data (build_fold_indirect_ref
(parmse->expr));
+ 
+       if (psym->ts.type == BT_CHARACTER)
+       parmse->string_length = psym->ts.cl->backend_decl;
+     }
+ 
+   /* The actual argument is an ordinary, honest-to-goodness array.  */
+   else
+     gfc_conv_array_parameter (parmse, e, argss, f);
+ 
+   /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is allocated
+      on entry, it must be deallocated.  */
+   if (fsym && fsym->attr.allocatable
+         && fsym->attr.intent == INTENT_OUT)
+     {
+       tmp = build_fold_indirect_ref (parmse->expr);
+       tmp = gfc_trans_dealloc_allocated (tmp);
+       gfc_add_expr_to_block (&se->pre, tmp);
+     }
+ } 
+ 
+ 
  /* Generate code for a procedure call.  Note can return se->post != NULL.
     If se->direct_byref is set then se->expr contains the return parameter.
     Return nonzero, if the call has alternate specifiers.  */
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 2132,2172 ****
                }
            }
          else
!           {
!               /* If the procedure requires an explicit interface, the actual
!                  argument is passed according to the corresponding formal
!                  argument.  If the corresponding formal argument is a
POINTER,
!                  ALLOCATABLE or assumed shape, we do not use g77's calling
!                  convention, and pass the address of the array descriptor
!                  instead. Otherwise we use g77's calling convention.  */
!             int f;
!             f = (fsym != NULL)
!                 && !(fsym->attr.pointer || fsym->attr.allocatable)
!                 && fsym->as->type != AS_ASSUMED_SHAPE;
!             f = f || !sym->attr.always_explicit;
! 
!             if (e->expr_type == EXPR_VARIABLE
!                   && is_aliased_array (e))
!               /* The actual argument is a component reference to an
!                  array of derived types.  In this case, the argument
!                  is converted to a temporary, which is passed and then
!                  written back after the procedure call.  */
!               gfc_conv_aliased_arg (&parmse, e, f,
!                       fsym ? fsym->attr.intent : INTENT_INOUT);
!             else
!               gfc_conv_array_parameter (&parmse, e, argss, f);
! 
!               /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is 
!                  allocated on entry, it must be deallocated.  */
!               if (fsym && fsym->attr.allocatable
!                   && fsym->attr.intent == INTENT_OUT)
!                 {
!                   tmp = build_fold_indirect_ref (parmse.expr);
!                   tmp = gfc_trans_dealloc_allocated (tmp);
!                   gfc_add_expr_to_block (&se->pre, tmp);
!                 }
! 
!           } 
        }

        if (fsym)
--- 2208,2214 ----
                }
            }
          else
!           gfc_conv_array_arg (se, &parmse, argss, e, sym, fsym);
        }

        if (fsym)

Paul


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |pault at gcc dot gnu dot org
                   |dot org                     |
             Status|NEW                         |ASSIGNED
   Last reconfirmed|2007-04-25 07:38:17         |2007-05-04 07:29:09
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692

[Bug fortran/31692] Wrong code when passing function name as result to procedures

[patchapp at dberlin dot org]

------- Comment #4 from patchapp at dberlin dot org  2007-05-05 01:06 -------
Subject: Bug number PR31692

A patch for this bug has been added to the patch tracker.
The mailing list url for the patch is
http://gcc.gnu.org/ml/gcc-patches/2007-05/msg00246.html


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692

[Bug fortran/31692] Wrong code when passing function name as result to procedures

[pault at gcc dot gnu dot org]

------- Comment #5 from pault at gcc dot gnu dot org  2007-05-08 13:45 -------
Subject: Bug 31692

Author: pault
Date: Tue May  8 12:45:31 2007
New Revision: 124546

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=124546
Log:
2007-05-08  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/31692
        * trans-array.c (gfc_conv_array_parameter): Convert full array
        references to the result of the procedure enclusing the call.

2007-05-08  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/31692
        * gfortran.dg/actual_array_result_1.f90: New test.

Added:
    trunk/gcc/testsuite/gfortran.dg/actual_array_result_1.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/trans-array.c
    trunk/gcc/testsuite/ChangeLog


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692

[Bug fortran/31692] Wrong code when passing function name as result to procedures

[pault at gcc dot gnu dot org]

------- Comment #6 from pault at gcc dot gnu dot org  2007-05-08 13:49 -------
Fixed on trunk

Paul


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|ASSIGNED                    |RESOLVED
         Resolution|                            |FIXED


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692

[Bug fortran/31692] Wrong code when passing function name as result to procedures

[burnus at gcc dot gnu dot org]

------- Comment #7 from burnus at gcc dot gnu dot org  2007-05-14 20:06 -------
*** Bug 31921 has been marked as a duplicate of this bug. ***


-- 

burnus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |beliavsky at aol dot com


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31692