This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, fortran] PR28923, PR28959 and PR28947 - essential fixes for the 4.2.0 release


Steve,

PPS If people are sufficiently exercised by it for the release, I also have a patch for PR28890 that could be fielded very quickly.


Send me the patch.



With the enclosed patch, this works and nothing is broken:

character(*) function charrext (n)
 character(26) :: alpha ="abcdefghijklmnopqrstuvwxyz"
 charrext = alpha (1:n)
end function charrext

 character(26), external :: charrext
 interface
   integer*4 function test(charr, i)
    character(*), external :: charr
    integer :: i
   end function test
 end interface

 do j = 1 , 26
   m = test (charrext, j)
   m = ctest (charrext, 27 - j)
 end do
contains
 integer*4 function ctest(charr, i)
   character(*) :: charr
   integer :: i
   print *, charr(i)
   ctest = 1
 end function ctest
end

integer*4 function test(charr, i)
 character(*) :: charr
 integer :: i
 print *, charr(i)
 test = 1

end function test

It can be turned into a patch very quickly!

Paul



Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(révision 116559)
--- gcc/fortran/trans-expr.c	(copie de travail)
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 2024,2029 ****
--- 2024,2039 ----
  	  gfc_add_expr_to_block (&se->pre, tmp);
  	}
  
+       if (fsym && fsym->ts.type == BT_CHARACTER
+ 	     && parmse.string_length == NULL_TREE
+ 	     && e->ts.type == BT_PROCEDURE
+ 	     && e->symtree->n.sym->ts.type == BT_CHARACTER
+ 	     && e->symtree->n.sym->ts.cl->length != NULL)
+ 	{
+ 	  gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
+ 	  parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;
+ 	}
+ 
        /* Character strings are passed as two parameters, a length and a
           pointer.  */
        if (parmse.string_length != NULL_TREE)
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 2040,2051 ****
  	{
  	  /* Assumed character length results are not allowed by 5.1.1.5 of the
  	     standard and are trapped in resolve.c; except in the case of SPREAD
! 	     (and other intrinsics?).  In this case, we take the character length
! 	     of the first argument for the result.  */
! 	  cl.backend_decl = TREE_VALUE (stringargs);
! 	}
!       else
! 	{
  	  /* Calculate the length of the returned string.  */
  	  gfc_init_se (&parmse, NULL);
  	  if (need_interface_mapping)
--- 2050,2071 ----
  	{
  	  /* Assumed character length results are not allowed by 5.1.1.5 of the
  	     standard and are trapped in resolve.c; except in the case of SPREAD
! 	     (and other intrinsics?) and dummy functions.  In the case of SPREAD,
! 	     we take the character length of the first argument for the result.
! 	     For dummies, we have to look through the formal argument list for
! 	     this function and use the character length found there.*/
! 	  if (!sym->attr.dummy)
! 	    cl.backend_decl = TREE_VALUE (stringargs);
! 	  else
! 	    {
! 	      formal = sym->ns->proc_name->formal;
! 	      for (; formal; formal = formal->next)
! 		if (strcmp (formal->sym->name, sym->name) == 0)
! 		  cl.backend_decl = formal->sym->ts.cl->backend_decl;
! 	    }
!         }
!         else
!         {
  	  /* Calculate the length of the returned string.  */
  	  gfc_init_se (&parmse, NULL);
  	  if (need_interface_mapping)
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(révision 116559)
--- gcc/fortran/resolve.c	(copie de travail)
*************** resolve_function (gfc_expr * expr)
*** 1413,1418 ****
--- 1413,1419 ----
  	&& sym->ts.cl
  	&& sym->ts.cl->length == NULL
  	&& !sym->attr.dummy
+ 	&& expr->value.function.esym == NULL
  	&& !sym->attr.contained)
      {
        /* Internal procedures are taken care of in resolve_contained_fntype.  */

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]