Patchwork [Fortran] Some more trim optimizatins

login
register
mail settings
Submitter Thomas Koenig
Date March 26, 2011, 9:43 a.m.
Message ID <4D8DB548.7090803@netcologne.de>
Download mbox | patch
Permalink /patch/88458/
State New
Headers show

Comments

Thomas Koenig - March 26, 2011, 9:43 a.m.
Hello world,

the following patch extends the trim optimization to variables like 
trim(a%x).

Going for trim(a(1)) led to a very strange regression, so I took that 
out (for now).

Regression-tested. OK for trunk?

	Thomas

2011-03-26  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/47065
         * frontend-passes (optimize_trim): Also follow references, except
         when they are substring references or array references.

2011-03-26  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/47065
         * gfortran.dg/trim_optimize_5.f90:  New test.
         * gfortran.dg/trim_optimize_6.f90:  New test.
! { dg-do run }
! { dg-options "-O -fdump-tree-original" }
! PR 47065 - replace trim with substring expressions even with references.
program main
  use foo
  implicit none
  type t
     character(len=2) :: x
  end type t
  type(t) :: a
  character(len=3) :: b
  character(len=10) :: line
  a%x = 'a'
  write(unit=line,fmt='(A,A)') trim(a%x),"X"
  if (line /= 'aX        ') call abort
  b = 'ab'
  write (unit=line,fmt='(A,A)') trim(b),"Y"
  if (line /= 'abY       ') call abort
end program main
! { dg-final { scan-tree-dump-times "string_len_trim" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-do run }
! PR 47065 - make sure that impure functions are not evaluated twice when
! replacing calls to trim with expression(1:len_trim)
module foo
  implicit none
contains
  function f()
    integer :: f
    integer :: s=0
    s = s + 1
    f = s
  end function f
end module foo

program main
  use foo
  implicit none
  character(len=10) :: line
  character(len=4) :: b(2)
  b(1) = 'a'
  b(2) = 'bc'
  write(unit=line,fmt='(A,A)') trim(b(f())), "X"
  if (line /= "aX          ") call abort
  if (f() .ne. 2) call abort
end program main
Tobias Burnus - March 27, 2011, 1:03 p.m.
Thomas Koenig wrote:
> the following patch extends the trim optimization to variables like 
> trim(a%x).
>
> Regression-tested. OK for trunk?

OK.

Tobias
Thomas Koenig - March 27, 2011, 5:41 p.m.
Hi Tobias,

> Thomas Koenig wrote:
>> the following patch extends the trim optimization to variables like
>> trim(a%x).
>>
>> Regression-tested. OK for trunk?
>
> OK.

Sending        fortran/ChangeLog
Sending        fortran/frontend-passes.c
Sending        testsuite/ChangeLog
Adding         testsuite/gfortran.dg/trim_optimize_5.f90
Adding         testsuite/gfortran.dg/trim_optimize_6.f90
Transmitting file data .....
Committed revision 171575.

Thanks for the review!

	Thomas

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 171207)
+++ frontend-passes.c	(Arbeitskopie)
@@ -664,6 +664,7 @@ 
   gfc_ref *ref;
   gfc_expr *fcn;
   gfc_actual_arglist *actual_arglist, *next;
+  gfc_ref **rr = NULL;
 
   /* Don't do this optimization within an argument list, because
      otherwise aliasing issues may occur.  */
@@ -681,46 +682,54 @@ 
   if (a->expr_type != EXPR_VARIABLE)
     return false;
 
+  /* Follow all references to find the correct place to put the newly
+     created reference.  FIXME:  Also handle substring references and
+     array references.  Array references cause strange regressions at
+     the moment.  */
+
   if (a->ref)
     {
-      /* FIXME - also handle substring references, by modifying the
-	 reference itself.  Make sure not to evaluate functions in
-	 the references twice.  */
-      return false;
+      for (rr = &(a->ref); *rr; rr = &((*rr)->next))
+	{
+	  if ((*rr)->type == REF_SUBSTRING || (*rr)->type == REF_ARRAY)
+	    return false;
+	}
     }
-  else
-    {
-      strip_function_call (e);
 
-      /* Create the reference.  */
+  strip_function_call (e);
 
-      ref = gfc_get_ref ();
-      ref->type = REF_SUBSTRING;
+  if (e->ref == NULL)
+    rr = &(e->ref);
 
-      /* Set the start of the reference.  */
+  /* Create the reference.  */
 
-      ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+  ref = gfc_get_ref ();
+  ref->type = REF_SUBSTRING;
 
-      /* Build the function call to len_trim(x, gfc_defaul_integer_kind).  */
+  /* Set the start of the reference.  */
 
-      fcn = gfc_get_expr ();
-      fcn->expr_type = EXPR_FUNCTION;
-      fcn->value.function.isym =
-	gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
-      actual_arglist = gfc_get_actual_arglist ();
-      actual_arglist->expr = gfc_copy_expr (e);
-      next = gfc_get_actual_arglist ();
-      next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
-				     gfc_default_integer_kind);
-      actual_arglist->next = next;
-      fcn->value.function.actual = actual_arglist;
+  ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
 
-      /* Set the end of the reference to the call to len_trim.  */
+  /* Build the function call to len_trim(x, gfc_defaul_integer_kind).  */
 
-      ref->u.ss.end = fcn;
-      e->ref = ref;
-      return true;
-    }
+  fcn = gfc_get_expr ();
+  fcn->expr_type = EXPR_FUNCTION;
+  fcn->value.function.isym =
+    gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
+  actual_arglist = gfc_get_actual_arglist ();
+  actual_arglist->expr = gfc_copy_expr (e);
+  next = gfc_get_actual_arglist ();
+  next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+				 gfc_default_integer_kind);
+  actual_arglist->next = next;
+  fcn->value.function.actual = actual_arglist;
+
+  /* Set the end of the reference to the call to len_trim.  */
+
+  ref->u.ss.end = fcn;
+  gcc_assert (*rr == NULL);
+  *rr = ref;
+  return true;
 }
 
 #define WALK_SUBEXPR(NODE) \