re PR fortran/35681 (wrong result for vector subscripted array expression in MVBITS)

2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/35681
	* ChangeLog-2008: Fix function name.

	PR fortran/38487
	* dependency.c (gfc_check_argument_var_dependency):
	Move the check for pointerness inside the if block
	so that it doesn't affect the return value.

	PR fortran/38669
	* trans-stmt.c (gfc_trans_call):
	Add the dependency code after the loop bounds calculation one.

2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/38669
	* gfortran.dg/elemental_dependency_3.f90: New test.
	* gfortran.dg/elemental_subroutine_7.f90: New test.

From-SVN: r143057

gcc/fortran/ChangeLog

+2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/35681
+	* ChangeLog-2008: Fix function name.
+
+	PR fortran/38487
+	* dependency.c (gfc_check_argument_var_dependency):
+	Move the check for pointerness inside the if block
+	so that it doesn't affect the return value.
+
+	PR fortran/38669
+	* trans-stmt.c (gfc_trans_call):
+	Add the dependency code after the loop bounds calculation one.
+
 2009-01-04  Daniel Franke  <franke.daniel@gmail.com>
 
 	* intrinsic.c (do_simplify): Removed already implemented TODO.

gcc/fortran/ChangeLog-2008

@@ -322,9 +322,9 @@
 	(gfc_check_fncall_dependency): Add elemental check flag.
 	Update call to gfc_check_argument_dependency.
 	* trans-stmt.c (gfc_trans_call): Make call to
-	gfc_conv_elemental_dependency unconditional, but with a flag
+	gfc_conv_elemental_dependencies unconditional, but with a flag
 	whether we should check dependencies between variables.
-	(gfc_conv_elemental_dependency): Add elemental check flag.
+	(gfc_conv_elemental_dependencies): Add elemental check flag.
 	Update call to gfc_check_fncall_dependency.
 	* trans-expr.c (gfc_trans_arrayfunc_assign): Update call to
 	gfc_check_fncall_dependency.

gcc/fortran/dependency.c

@@ -469,23 +469,25 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
       if (gfc_ref_needs_temporary_p (expr->ref)
 	  || gfc_check_dependency (var, expr, !elemental))
 	{
-	  if (elemental == ELEM_DONT_CHECK_VARIABLE
-	      && !gfc_is_data_pointer (var)
-	      && !gfc_is_data_pointer (expr))
+	  if (elemental == ELEM_DONT_CHECK_VARIABLE)
 	    {
-	      /* Elemental procedures forbid unspecified intents, 
-		 and we don't check dependencies for INTENT_IN args.  */
-	      gcc_assert (intent == INTENT_OUT || intent == INTENT_INOUT);
-
-	      /* We are told not to check dependencies. 
-		 We do it, however, and issue a warning in case we find one. 
-		 If a dependency is found in the case 
-		 elemental == ELEM_CHECK_VARIABLE, we will generate
-		 a temporary, so we don't need to bother the user.  */
-	      gfc_warning ("INTENT(%s) actual argument at %L might interfere "
-			   "with actual argument at %L.", 
-			   intent == INTENT_OUT ? "OUT" : "INOUT", 
-			   &var->where, &expr->where);
+	      /* Too many false positive with pointers.  */
+	      if (!gfc_is_data_pointer (var) && !gfc_is_data_pointer (expr))
+		{
+		  /* Elemental procedures forbid unspecified intents, 
+		     and we don't check dependencies for INTENT_IN args.  */
+		  gcc_assert (intent == INTENT_OUT || intent == INTENT_INOUT);
+
+		  /* We are told not to check dependencies. 
+		     We do it, however, and issue a warning in case we find one.
+		     If a dependency is found in the case 
+		     elemental == ELEM_CHECK_VARIABLE, we will generate
+		     a temporary, so we don't need to bother the user.  */
+		  gfc_warning ("INTENT(%s) actual argument at %L might "
+			       "interfere with actual argument at %L.", 
+		   	       intent == INTENT_OUT ? "OUT" : "INOUT", 
+		   	       &var->where, &expr->where);
+		}
 	      return 0;
 	    }
 	  else

gcc/fortran/trans-stmt.c

@@ -386,6 +386,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check)
       stmtblock_t body;
       stmtblock_t block;
       gfc_se loopse;
+      gfc_se depse;
 
       /* gfc_walk_elemental_function_args renders the ss chain in the
 	 reverse order to the actual argument order.  */
@@ -413,9 +414,14 @@ gfc_trans_call (gfc_code * code, bool dependency_check)
 	check_variable = ELEM_CHECK_VARIABLE;
       else
 	check_variable = ELEM_DONT_CHECK_VARIABLE;
-      gfc_conv_elemental_dependencies (&se, &loopse, code->resolved_sym,
+
+      gfc_init_se (&depse, NULL);
+      gfc_conv_elemental_dependencies (&depse, &loopse, code->resolved_sym,
 				       code->ext.actual, check_variable);
 
+      gfc_add_block_to_block (&loop.pre,  &depse.pre);
+      gfc_add_block_to_block (&loop.post, &depse.post);
+
       /* Generate the loop body.  */
       gfc_start_scalarized_body (&loop, &body);
       gfc_init_block (&block);

gcc/testsuite/ChangeLog

+2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38669
+	* gfortran.dg/elemental_dependency_3.f90: New test.
+	* gfortran.dg/elemental_subroutine_7.f90: New test.
+
 2009-01-04  Uros Bizjak  <ubizjak@gmail.com>
 
 	* gcc.dg/struct-ret-3.c: Include unistd.h.

gcc/testsuite/gfortran.dg/elemental_dependency_3.f90

+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/38669
+! Temporary created for pointer as actual argument of an elemental subroutine
+!
+! Original testcase by Harald Anlauf <anlauf@gmx.de>
+
+program gfcbu84_main
+  implicit none
+  integer           :: jplev, k_lev
+  real :: p(42)
+  real, pointer :: q(:)
+  jplev = 42
+  k_lev = 1
+  allocate (q(jplev))
+  call tq_tvgh (q(k_lev:), p(k_lev:))
+  deallocate (q)
+
+  contains
+  elemental subroutine tq_tvgh (t, p)
+    real ,intent (out)            :: t
+    real ,intent (in)             :: p
+    t=p
+  end subroutine tq_tvgh
+end program gfcbu84_main
+! { dg-final { scan-tree-dump-times "atmp" 0 "original" } }

gcc/testsuite/gfortran.dg/elemental_subroutine_7.f90

+! { dg-do run }
+!
+! PR fortran/38669
+! Loop bounds temporaries used before being defined for elemental subroutines
+!
+! Original testcase by Harald Anlauf <anlauf@gmx.de>
+
+program gfcbu84_main
+  implicit none
+  integer           :: jplev, k_lev
+  integer :: p(42)
+  real    :: r(42)
+  integer, pointer :: q(:)
+  jplev = 42
+  k_lev = 1
+  call random_number (r)
+  p = 20 * r - 10
+  allocate (q(jplev))
+
+  q = 0
+  call tq_tvgh (q(k_lev:), p(k_lev:))
+  if (any (p /= q)) call abort
+
+  q = 0
+  call tq_tvgh (q(k_lev:), (p(k_lev:)))
+  if (any (p /= q)) call abort
+
+  q = 0
+  call tq_tvgh (q(k_lev:), (p(p(k_lev:))))
+  if (any (p(p) /= q)) call abort
+
+  deallocate (q)
+
+  contains
+  elemental subroutine tq_tvgh (t, p)
+    integer ,intent (out)            :: t
+    integer ,intent (in)             :: p
+    t=p
+  end subroutine tq_tvgh
+end program gfcbu84_main