trans-intrinsic.c (gfc_conv_intrinsic_aint): Fix whitespace.

	* trans-intrinsic.c (gfc_conv_intrinsic_aint): Fix whitespace.
	(gfc_conv_intrinsic_ishft): Only evaluate arguments once.
	(gfc_conv_intrinsic_ishftc): Only evaluate arguments once.
	* intrinsic.texi (RSHIFT): Fix documentation.

	* gfortran.dg/ishft_4.f90: New test.

From-SVN: r163792

5 files changed, 65 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 61f57f1..477c839 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2010-09-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_aint): Fix whitespace.
+	(gfc_conv_intrinsic_ishft): Only evaluate arguments once.
+	(gfc_conv_intrinsic_ishftc): Only evaluate arguments once.
+	* intrinsic.texi (RSHIFT): Fix documentation.
+
 2010-09-02  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/45186
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 6603fb5..e78bb0d 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -9706,9 +9706,10 @@ The value returned is equal to
 @item @emph{Description}:
 @code{RSHIFT} returns a value corresponding to @var{I} with all of the
 bits shifted right by @var{SHIFT} places.  If the absolute value of
-@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined. 
-Bits shifted out from the left end are lost; zeros are shifted in from
-the opposite end.
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the right end are lost. The fill is arithmetic: the
+bits shifted in from the left end are equal to the leftmost bit, which in
+two's complement representation is the sign bit.
 
 This function has been superseded by the @code{ISHFT} intrinsic, which
 is standard in Fortran 95 and later.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 3f18883..8f50e6d 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -456,7 +456,7 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
   int kind;
 
   kind = expr->ts.kind;
-  nargs =  gfc_intrinsic_argument_list_length (expr);
+  nargs = gfc_intrinsic_argument_list_length (expr);
 
   decl = NULL_TREE;
   /* We have builtin functions for some cases.  */
@@ -3235,6 +3235,10 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
   tree rshift;
 
   gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  args[0] = gfc_evaluate_now (args[0], &se->pre);
+  args[1] = gfc_evaluate_now (args[1], &se->pre);
+
   type = TREE_TYPE (args[0]);
   utype = unsigned_type_for (type);
 
@@ -3320,7 +3324,7 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
 	  gcc_unreachable ();
 	}
       se->expr = build_call_expr_loc (input_location,
-				  tmp, 3, args[0], args[1], args[2]);
+				      tmp, 3, args[0], args[1], args[2]);
       /* Convert the result back to the original type, if we extended
 	 the first argument's width above.  */
       if (expr->ts.kind < 4)
@@ -3330,6 +3334,10 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
     }
   type = TREE_TYPE (args[0]);
 
+  /* Evaluate arguments only once.  */
+  args[0] = gfc_evaluate_now (args[0], &se->pre);
+  args[1] = gfc_evaluate_now (args[1], &se->pre);
+
   /* Rotate left if positive.  */
   lrot = fold_build2 (LROTATE_EXPR, type, args[0], args[1]);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e947d3c..34cccd1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2010-09-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* gfortran.dg/ishft_4.f90: New test.
+
 2010-09-02  Michael Meissner  <meissner@linux.vnet.ibm.com>
 
 	* gcc.target/powerpc/ppc-fpconv-10.c: New file to test generating
diff --git a/gcc/testsuite/gfortran.dg/ishft_4.f90 b/gcc/testsuite/gfortran.dg/ishft_4.f90
new file mode 100644
index 0000000..4e2ad2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishft_4.f90
@@ -0,0 +1,40 @@
+! We want to check that ISHFT evaluates its arguments only once
+!
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+
+program test
+
+  if (ishft (foo(), 2) /= 4) call abort
+  if (ishft (foo(), -1) /= 1) call abort
+  if (ishft (1, foo()) /= 8) call abort
+  if (ishft (16, -foo()) /= 1) call abort
+
+  if (ishftc (bar(), 2) /= 4) call abort
+  if (ishftc (bar(), -1) /= 1) call abort
+  if (ishftc (1, bar()) /= 8) call abort
+  if (ishftc (16, -bar()) /= 1) call abort
+
+contains
+  
+  integer function foo ()
+    integer, save :: i = 0
+    i = i + 1
+    foo = i
+  end function
+
+  integer function bar ()
+    integer, save :: i = 0
+    i = i + 1
+    bar = i
+  end function
+
+end program
+
+! The regexp "foo ()" should be seen once in the dump:
+!   -- once in the function definition itself
+!   -- plus as many times as the function is called
+!
+! { dg-final { scan-tree-dump-times "foo *\\\(\\\)" 5 "original" } }
+! { dg-final { scan-tree-dump-times "bar *\\\(\\\)" 5 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }