[patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 955 bytes --]

Hello world,

after the dicsussion on c.l.f, it become clear that passing a DO loop
variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error.
The attached patch throws an error for both cases.

I chose to issue the errors as a front-end pass because we cannot check
for formal arguments during parsing (where the other checks are
implemented).

Regression-tested.  OK for trunk?

	Thomas

2012-11-01  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/30146
         * frontend-passes.c (do_warn):  New function.
         (do_list):  New static variable.
         (do_size):  New static variable.
         (do_list):  New static variable.
         (gfc_run_passes): Call do_warn.
         (do_code):  New function.
         (do_function):  New function.
         (gfc_code_walker):  Keep track fo DO level.

2012-11-01  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/30146
         * gfortran.dg/do_check_6.f90:  New test.

[-- Attachment #2: p5.diff --]
[-- Type: text/x-patch, Size: 5694 bytes --]

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 192894)
+++ frontend-passes.c	(Arbeitskopie)
@@ -39,6 +39,7 @@ static bool optimize_trim (gfc_expr *);
 static bool optimize_lexical_comparison (gfc_expr *);
 static void optimize_minmaxloc (gfc_expr **);
 static bool empty_string (gfc_expr *e);
+static void do_warn (gfc_namespace *);
 
 /* How deep we are inside an argument list.  */
 
@@ -76,12 +77,30 @@ static bool in_omp_workshare;
 
 static int iterator_level;
 
-/* Entry point - run all passes for a namespace.  So far, only an
-   optimization pass is run.  */
+/* Keep track of DO loop levels.  */
 
+static gfc_code **do_list;
+static int do_size, do_level;
+
+/* Vector of gfc_expr * to keep track of DO loops.  */
+
+struct my_struct *evec;
+
+/* Entry point - run all passes for a namespace. */
+
 void
 gfc_run_passes (gfc_namespace *ns)
 {
+
+  /* Warn about dubious DO loops where the index might
+     change.  */
+
+  do_size = 20;
+  do_level = 0;
+  do_list = XNEWVEC(gfc_code *, do_size);
+  do_warn (ns);
+  XDELETEVEC (do_list);
+
   if (gfc_option.flag_frontend_optimize)
     {
       expr_size = 20;
@@ -1225,6 +1244,160 @@ optimize_minmaxloc (gfc_expr **e)
   mpz_set_ui (a->expr->value.integer, 1);
 }
 
+/* Callback function for code checking that we do not pass a DO variable to an
+   INTENT(OUT) or INTENT(INOUT) dummy variable.  */
+
+static int
+do_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+	 void *data ATTRIBUTE_UNUSED)
+{
+  gfc_code *co;
+  int i;
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+
+  co = *c;
+
+  switch (co->op)
+    {
+    case EXEC_DO:
+
+      /* Grow the temporary storage if necessary.  */
+      if (do_level >= do_size)
+	{
+	  do_size = 2 * do_size;
+	  do_list = XRESIZEVEC (gfc_code *, do_list, do_size);
+	}
+
+      /* Mark the DO loop variable if there is one.  */
+      if (co->ext.iterator && co->ext.iterator->var)
+	do_list[do_level] = co;
+      else
+	do_list[do_level] = NULL;
+      break;
+
+    case EXEC_CALL:
+      f = co->symtree->n.sym->formal;
+
+      /* Withot a formal arglist, there is only unknown INTENT,
+	 which we don't check for.  */
+      if (f == NULL)
+	break;
+
+      a = co->ext.actual;
+
+      while (a && f)
+	{
+	  for (i=0; i<do_level; i++)
+	    {
+	      gfc_symbol *do_sym;
+	      
+	      if (do_list[i] == NULL)
+		break;
+
+	      do_sym = do_list[i]->ext.iterator->var->symtree->n.sym;
+	      
+	      if (a->expr && a->expr->symtree
+		  && a->expr->symtree->n.sym == do_sym)
+		{
+		  if (f->sym->attr.intent == INTENT_OUT)
+		    gfc_error_now("Variable '%s' at %L set to undefined value "
+				  "inside loop  beginning at %L as INTENT(OUT) "
+				  "argument to subroutine '%s'", do_sym->name,
+				  &a->expr->where, &do_list[i]->loc,
+				  co->symtree->n.sym->name);
+		  else if (f->sym->attr.intent == INTENT_INOUT)
+		    gfc_error_now("Variable '%s' at %L not definable inside loop "
+				  "beginning at %L as INTENT(INOUT) argument to "
+				  "subroutine '%s'", do_sym->name,
+				  &a->expr->where, &do_list[i]->loc,
+				  co->symtree->n.sym->name);
+		}
+	    }
+	  a = a->next;
+	  f = f->next;
+	}
+      break;
+
+    default:
+      break;
+    }
+  return 0;
+}
+
+/* Callback function for functions checking that we do not pass a DO variable
+   to an INTENt(OUT) or INTENT(INOUT) dummy variable.  */
+
+static int
+do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+	     void *data ATTRIBUTE_UNUSED)
+{
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+  gfc_expr *expr;
+  int i;
+
+  expr = *e;
+  if (expr->expr_type != EXPR_FUNCTION)
+    return 0;
+
+  /* Intrinsic functions don't modify their arguments.  */
+
+  if (expr->value.function.isym)
+    return 0;
+
+  f = expr->symtree->n.sym->formal;
+
+  /* Withot a formal arglist, there is only unknown INTENT,
+     which we don't check for.  */
+  if (f == NULL)
+    return 0;
+
+  a = expr->value.function.actual;
+
+  while (a && f)
+    {
+      for (i=0; i<do_level; i++)
+	{
+	  gfc_symbol *do_sym;
+	 
+    
+	  if (do_list[i] == NULL)
+	    break;
+
+	  do_sym = do_list[i]->ext.iterator->var->symtree->n.sym;
+	  
+	  if (a->expr && a->expr->symtree
+	      && a->expr->symtree->n.sym == do_sym)
+	    {
+	      if (f->sym->attr.intent == INTENT_OUT)
+		gfc_error_now("Variable '%s' at %L set to undefined value "
+			      "inside loop  beginning at %L as INTENT(OUT) "
+			      "argument to function '%s'", do_sym->name,
+			      &a->expr->where, &do_list[i]->loc,
+			      expr->symtree->n.sym->name);
+	      else if (f->sym->attr.intent == INTENT_INOUT)
+		gfc_error_now("Variable '%s' at %L not definable inside loop "
+			      "beginning at %L as INTENT(INOUT) argument to "
+			      "function '%s'", do_sym->name,
+			      &a->expr->where, &do_list[i]->loc,
+			      expr->symtree->n.sym->name);
+	    }
+	}
+      a = a->next;
+      f = f->next;
+    }
+
+  return 0;
+}
+
+static void
+do_warn (gfc_namespace *ns)
+{
+  gfc_code_walker (&ns->code, do_code, do_function, NULL);
+}
+
+
 #define WALK_SUBEXPR(NODE) \
   do							\
     {							\
@@ -1383,6 +1556,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	      break;
 
 	    case EXEC_DO:
+	      do_level ++;
 	      WALK_SUBEXPR (co->ext.iterator->var);
 	      WALK_SUBEXPR (co->ext.iterator->start);
 	      WALK_SUBEXPR (co->ext.iterator->end);
@@ -1601,6 +1775,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	  if (co->op == EXEC_FORALL)
 	    forall_level --;
 
+	  if (co->op == EXEC_DO)
+	    do_level --;
+
 	  in_omp_workshare = saved_in_omp_workshare;
 	}
     }

[-- Attachment #3: do_check_6.f90 --]
[-- Type: text/x-fortran, Size: 1161 bytes --]

! { dg-do compile }
! PR 30146 - warn about DO variables as argument to INTENT(IN) and
! INTENT(INOUT) dummy arguments
program main
  implicit none
  integer :: i,j, k, l
  do k=1,2                      ! { dg-error "undefined value" }
     do i=1,10                  ! { dg-error "definable" }
        do j=1,10               ! { dg-error "undefined value" }
           do l=1,10            ! { dg-error "definable" }
              call s_out(k)      ! { dg-error "undefined" }
              call s_inout(i)    ! { dg-error "definable" }
              print *,f_out(j)   ! { dg-error "undefined" }
              print *,f_inout(l) ! { dg-error "definable" }
           end do
        end do
     end do
  end do
contains
  subroutine s_out(i_arg)
    integer, intent(out) :: i_arg
  end subroutine s_out

  subroutine s_inout(i_arg)
    integer, intent(inout) :: i_arg
  end subroutine s_inout

  function f_out(i_arg)
    integer, intent(out) :: i_arg
    integer :: f_out
    f_out = i_arg
  end function f_out

  function f_inout(i_arg)
    integer, intent(inout) :: i_arg
    integer :: f_inout
    f_inout = i_arg
  end function f_inout

end program main

Re: [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Tobias Schlüter]

Hi Thomas,

there are already lots of places that check for do variables, 
gfc_check_do_variable() does the hard work.  Couldn't the same result be 
achieved in a much simpler way during resolution?

Cheers,
- Tobi

On 2012-11-01 13:58, Thomas Koenig wrote:
> Hello world,
>
> after the dicsussion on c.l.f, it become clear that passing a DO loop
> variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error.
> The attached patch throws an error for both cases.
>
> I chose to issue the errors as a front-end pass because we cannot check
> for formal arguments during parsing (where the other checks are
> implemented).
>
> Regression-tested.  OK for trunk?
>
>      Thomas
>
> 2012-11-01  Thomas Koenig  <tkoenig@gcc.gnu.org>
>
>          PR fortran/30146
>          * frontend-passes.c (do_warn):  New function.
>          (do_list):  New static variable.
>          (do_size):  New static variable.
>          (do_list):  New static variable.
>          (gfc_run_passes): Call do_warn.
>          (do_code):  New function.
>          (do_function):  New function.
>          (gfc_code_walker):  Keep track fo DO level.
>
> 2012-11-01  Thomas Koenig  <tkoenig@gcc.gnu.org>
>
>          PR fortran/30146
>          * gfortran.dg/do_check_6.f90:  New test.

Re: [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Thomas Koenig]

Hi Tobias,

>
> Hi Thomas,
>
> there are already lots of places that check for do variables,
> gfc_check_do_variable() does the hard work.

gfc_check_do_uses gfc_state_stack, which is built up (and
destroyed) during parsing.  This is too early because we
need to have the formal arglists resolved before we can
do the checks.

> Couldn't the same result be
> achieved in a much simpler way during resolution?

We would have to do the same work, building up a stack
of DO loops, during resolution.  I don't think there is
an advantage in simplicity doing this in resolution;
we would also have to make sure that the subroutine calls
within the DO loops and the loop variables are  resolved before
doing the check on the INTENT.

Regards

	Thomas

Re: [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Thomas Koenig]

Ping ** 0.2857?

I won't be able to commit this for about a week starting tomorrow, so
I would be obliged if I could so so now.

Regards

	Thomas

> after the dicsussion on c.l.f, it become clear that passing a DO loop
> variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error.
> The attached patch throws an error for both cases.
>
> I chose to issue the errors as a front-end pass because we cannot check
> for formal arguments during parsing (where the other checks are
> implemented).
>
> Regression-tested.  OK for trunk?

*ping* [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Thomas Koenig]

I wrote:

> after the dicsussion on c.l.f, it become clear that passing a DO loop
> variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error.
> The attached patch throws an error for both cases.
>
> I chose to issue the errors as a front-end pass because we cannot check
> for formal arguments during parsing (where the other checks are
> implemented).
>
> Regression-tested.  OK for trunk?

Ping ** 1.4285 ?

	Thomas

Re: *ping* [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Steven Bosscher]

On Sat, Nov 10, 2012 at 3:00 PM, Thomas Koenig wrote:
> I wrote:
>
>> after the dicsussion on c.l.f, it become clear that passing a DO loop
>> variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error.
>> The attached patch throws an error for both cases.

But should we really isse an error for INTENT(INOUT)? IMHO a warning
suffices, with maybe an error only for strict (i.e. non-GNU) standard
settings.


>> I chose to issue the errors as a front-end pass because we cannot check
>> for formal arguments during parsing (where the other checks are
>> implemented).
>>
>> Regression-tested.  OK for trunk?
>
>
> Ping ** 1.4285 ?

You don't have to list do_list twice in the ChangeLog, you probably
wanted one of those to be do_level ;-)


>> +  do_list = XNEWVEC(gfc_code *, do_size);

Taste nit: Why not just toss do_list, do_level, and do_size around as
a function argument, instead of making them global variable? Just
define a struct containing them and pass it around via the "data"
argument for gfc_code_walker should work, I think.

IMHO names like "do_warn" and "do_list" are not very descriptive, if
not to say confusing. do_* names are used elsewhere in the compiler
for functions that perform ("do") a task, whereas your do_* functions
are for the Fortran DO construct. I'd prefer different names.


>> +   to an INTENt(OUT) or INTENT(INOUT) dummy variable.  */

s/INTENt/INTENT/


>> +  /* Withot a formal arglist, there is only unknown INTENT,

s/Withot/Without/


>> +      for (i=0; i<do_level; i++)

for (i = 0; i < do_level; i++)


>> +			      "inside loop  beginning at %L as INTENT(OUT) "

Extraneous space after loop.

How do you handle OPTIONAL args?

Ciao!
Steven

Re: *ping* [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 3997 bytes --]

Hi Steven,

> On Sat, Nov 10, 2012 at 3:00 PM, Thomas Koenig wrote:
>> I wrote:
>>
>>> after the dicsussion on c.l.f, it become clear that passing a DO loop
>>> variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error.
>>> The attached patch throws an error for both cases.
>
> But should we really isse an error for INTENT(INOUT)? IMHO a warning
> suffices, with maybe an error only for strict (i.e. non-GNU) standard
> settings.

This was the result of a discussion on c.l.f.  The summary can be found
http://groups.google.com/group/comp.lang.fortran/msg/7107f24b8980fad3?hl=de

Basically, passing an index variable to an INTENT(INOUT) variable
violates a requirement on the program, and than an error would be
the best course of action.

>>> I chose to issue the errors as a front-end pass because we cannot check
>>> for formal arguments during parsing (where the other checks are
>>> implemented).
>>>
>>> Regression-tested.  OK for trunk?
>>
>>
>> Ping ** 1.4285 ?
>
> You don't have to list do_list twice in the ChangeLog, you probably
> wanted one of those to be do_level ;-)

OK.

>
>>> +  do_list = XNEWVEC(gfc_code *, do_size);
>
> Taste nit: Why not just toss do_list, do_level, and do_size around as
> a function argument, instead of making them global variable? Just
> define a struct containing them and pass it around via the "data"
> argument for gfc_code_walker should work, I think.

The problem is with do_level.  This could be incremented in do_warn,
but we only know when to decrement it in gfc_code_walker (because there
is no EXEC_ENDDO). So, we need a static variable in any case.

The rest is a question of taste. If we need one static variable, I think
we might as well use some other static variables.  The only alternative
I thought about was using a VEC, but frankly the documentation on that
left me baffled as to how to implement this.


> IMHO names like "do_warn" and "do_list" are not very descriptive, if
> not to say confusing. do_* names are used elsewhere in the compiler
> for functions that perform ("do") a task, whereas your do_* functions
> are for the Fortran DO construct. I'd prefer different names.

Changed to doloop_*.

>
>>> +   to an INTENt(OUT) or INTENT(INOUT) dummy variable.  */
>
> s/INTENt/INTENT/

Fixed.

>
>>> +  /* Withot a formal arglist, there is only unknown INTENT,
>
> s/Withot/Without/
>
>
>>> +      for (i=0; i<do_level; i++)
>
> for (i = 0; i < do_level; i++)
>
>
>>> +			      "inside loop  beginning at %L as INTENT(OUT) "
>
> Extraneous space after loop.

Fixed.

> How do you handle OPTIONAL args?

As far as I have been able to determine, they work:

ig25@linux-fd1f:~/Krempel/Do> cat optional.f90
module opt
   implicit none
contains
   subroutine opt_in(a,b)
   integer, intent(in), optional :: a
   integer, intent(out) :: b
   end subroutine opt_in
end module opt
program main
   use opt
   implicit none
   integer :: i
   do i=1,10
     call opt_in(b=i)
   end do
end program main
ig25@linux-fd1f:~/Krempel/Do> gfortran optional.f90
optional.f90:14.18:

     call opt_in(b=i)
                   1
optional.f90:13.11:

   do i=1,10
            2
Fehler: Variable 'i' at (1) set to undefined value inside loop 
beginning at (2) as INTENT(OUT) argument to subroutine 'opt_in'

Or were you thinking of another case?

Attached is the new version of the patch, regression-tested.

Thanks for the review!

OK for trunk?

	Thomas

2012-11-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/30146
         * frontend-passes.c (do_warn):  New function.
         (doloop_list):  New static variable.
         (doloop_size):  New static variable.
         (doloop_level):  New static variable.
         (gfc_run_passes): Call doloop_warn.
         (doloop_code):  New function.
         (doloop_function):  New function.
         (gfc_code_walker):  Keep track of DO level.

2012-11-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/30146
         * gfortran.dg/do_check_6.f90:  New test.


[-- Attachment #2: p6.diff --]
[-- Type: text/x-patch, Size: 5838 bytes --]

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 192894)
+++ frontend-passes.c	(Arbeitskopie)
@@ -39,6 +39,7 @@ static bool optimize_trim (gfc_expr *);
 static bool optimize_lexical_comparison (gfc_expr *);
 static void optimize_minmaxloc (gfc_expr **);
 static bool empty_string (gfc_expr *e);
+static void doloop_warn (gfc_namespace *);
 
 /* How deep we are inside an argument list.  */
 
@@ -76,12 +77,30 @@ static bool in_omp_workshare;
 
 static int iterator_level;
 
-/* Entry point - run all passes for a namespace.  So far, only an
-   optimization pass is run.  */
+/* Keep track of DO loop levels.  */
 
+static gfc_code **doloop_list;
+static int doloop_size, doloop_level;
+
+/* Vector of gfc_expr * to keep track of DO loops.  */
+
+struct my_struct *evec;
+
+/* Entry point - run all passes for a namespace. */
+
 void
 gfc_run_passes (gfc_namespace *ns)
 {
+
+  /* Warn about dubious DO loops where the index might
+     change.  */
+
+  doloop_size = 20;
+  doloop_level = 0;
+  doloop_list = XNEWVEC(gfc_code *, doloop_size);
+  doloop_warn (ns);
+  XDELETEVEC (doloop_list);
+
   if (gfc_option.flag_frontend_optimize)
     {
       expr_size = 20;
@@ -1225,6 +1244,160 @@ optimize_minmaxloc (gfc_expr **e)
   mpz_set_ui (a->expr->value.integer, 1);
 }
 
+/* Callback function for code checking that we do not pass a DO variable to an
+   INTENT(OUT) or INTENT(INOUT) dummy variable.  */
+
+static int
+doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+	 void *data ATTRIBUTE_UNUSED)
+{
+  gfc_code *co;
+  int i;
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+
+  co = *c;
+
+  switch (co->op)
+    {
+    case EXEC_DO:
+
+      /* Grow the temporary storage if necessary.  */
+      if (doloop_level >= doloop_size)
+	{
+	  doloop_size = 2 * doloop_size;
+	  doloop_list = XRESIZEVEC (gfc_code *, doloop_list, doloop_size);
+	}
+
+      /* Mark the DO loop variable if there is one.  */
+      if (co->ext.iterator && co->ext.iterator->var)
+	doloop_list[doloop_level] = co;
+      else
+	doloop_list[doloop_level] = NULL;
+      break;
+
+    case EXEC_CALL:
+      f = co->symtree->n.sym->formal;
+
+      /* Withot a formal arglist, there is only unknown INTENT,
+	 which we don't check for.  */
+      if (f == NULL)
+	break;
+
+      a = co->ext.actual;
+
+      while (a && f)
+	{
+	  for (i=0; i<doloop_level; i++)
+	    {
+	      gfc_symbol *do_sym;
+	      
+	      if (doloop_list[i] == NULL)
+		break;
+
+	      do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym;
+	      
+	      if (a->expr && a->expr->symtree
+		  && a->expr->symtree->n.sym == do_sym)
+		{
+		  if (f->sym->attr.intent == INTENT_OUT)
+		    gfc_error_now("Variable '%s' at %L set to undefined value "
+				  "inside loop  beginning at %L as INTENT(OUT) "
+				  "argument to subroutine '%s'", do_sym->name,
+				  &a->expr->where, &doloop_list[i]->loc,
+				  co->symtree->n.sym->name);
+		  else if (f->sym->attr.intent == INTENT_INOUT)
+		    gfc_error_now("Variable '%s' at %L not definable inside loop "
+				  "beginning at %L as INTENT(INOUT) argument to "
+				  "subroutine '%s'", do_sym->name,
+				  &a->expr->where, &doloop_list[i]->loc,
+				  co->symtree->n.sym->name);
+		}
+	    }
+	  a = a->next;
+	  f = f->next;
+	}
+      break;
+
+    default:
+      break;
+    }
+  return 0;
+}
+
+/* Callback function for functions checking that we do not pass a DO variable
+   to an INTENT(OUT) or INTENT(INOUT) dummy variable.  */
+
+static int
+do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+	     void *data ATTRIBUTE_UNUSED)
+{
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+  gfc_expr *expr;
+  int i;
+
+  expr = *e;
+  if (expr->expr_type != EXPR_FUNCTION)
+    return 0;
+
+  /* Intrinsic functions don't modify their arguments.  */
+
+  if (expr->value.function.isym)
+    return 0;
+
+  f = expr->symtree->n.sym->formal;
+
+  /* Without a formal arglist, there is only unknown INTENT,
+     which we don't check for.  */
+  if (f == NULL)
+    return 0;
+
+  a = expr->value.function.actual;
+
+  while (a && f)
+    {
+      for (i=0; i<doloop_level; i++)
+	{
+	  gfc_symbol *do_sym;
+	 
+    
+	  if (doloop_list[i] == NULL)
+	    break;
+
+	  do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym;
+	  
+	  if (a->expr && a->expr->symtree
+	      && a->expr->symtree->n.sym == do_sym)
+	    {
+	      if (f->sym->attr.intent == INTENT_OUT)
+		gfc_error_now("Variable '%s' at %L set to undefined value "
+			      "inside loop beginning at %L as INTENT(OUT) "
+			      "argument to function '%s'", do_sym->name,
+			      &a->expr->where, &doloop_list[i]->loc,
+			      expr->symtree->n.sym->name);
+	      else if (f->sym->attr.intent == INTENT_INOUT)
+		gfc_error_now("Variable '%s' at %L not definable inside loop "
+			      "beginning at %L as INTENT(INOUT) argument to "
+			      "function '%s'", do_sym->name,
+			      &a->expr->where, &doloop_list[i]->loc,
+			      expr->symtree->n.sym->name);
+	    }
+	}
+      a = a->next;
+      f = f->next;
+    }
+
+  return 0;
+}
+
+static void
+doloop_warn (gfc_namespace *ns)
+{
+  gfc_code_walker (&ns->code, doloop_code, do_function, NULL);
+}
+
+
 #define WALK_SUBEXPR(NODE) \
   do							\
     {							\
@@ -1383,6 +1556,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	      break;
 
 	    case EXEC_DO:
+	      doloop_level ++;
 	      WALK_SUBEXPR (co->ext.iterator->var);
 	      WALK_SUBEXPR (co->ext.iterator->start);
 	      WALK_SUBEXPR (co->ext.iterator->end);
@@ -1601,6 +1775,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	  if (co->op == EXEC_FORALL)
 	    forall_level --;
 
+	  if (co->op == EXEC_DO)
+	    doloop_level --;
+
 	  in_omp_workshare = saved_in_omp_workshare;
 	}
     }

[-- Attachment #3: do_check_6.f90 --]
[-- Type: text/x-fortran, Size: 1161 bytes --]

! { dg-do compile }
! PR 30146 - warn about DO variables as argument to INTENT(IN) and
! INTENT(INOUT) dummy arguments
program main
  implicit none
  integer :: i,j, k, l
  do k=1,2                      ! { dg-error "undefined value" }
     do i=1,10                  ! { dg-error "definable" }
        do j=1,10               ! { dg-error "undefined value" }
           do l=1,10            ! { dg-error "definable" }
              call s_out(k)      ! { dg-error "undefined" }
              call s_inout(i)    ! { dg-error "definable" }
              print *,f_out(j)   ! { dg-error "undefined" }
              print *,f_inout(l) ! { dg-error "definable" }
           end do
        end do
     end do
  end do
contains
  subroutine s_out(i_arg)
    integer, intent(out) :: i_arg
  end subroutine s_out

  subroutine s_inout(i_arg)
    integer, intent(inout) :: i_arg
  end subroutine s_inout

  function f_out(i_arg)
    integer, intent(out) :: i_arg
    integer :: f_out
    f_out = i_arg
  end function f_out

  function f_inout(i_arg)
    integer, intent(inout) :: i_arg
    integer :: f_inout
    f_inout = i_arg
  end function f_inout

end program main

*ping* [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Thomas Koenig]

I wrote:

> Attached is the new version of the patch, regression-tested.

http://gcc.gnu.org/ml/gcc-patches/2012-11/msg00836.html

> Thanks for the review!
>
> OK for trunk?

Ping?

Re: *ping* [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Thomas Koenig]

Am 17.11.2012 10:09, schrieb Thomas Koenig:
> I wrote:
>
>> Attached is the new version of the patch, regression-tested.
>
> http://gcc.gnu.org/ml/gcc-patches/2012-11/msg00836.html
>
>> Thanks for the review!
>>
>> OK for trunk?
>
> Ping?
>

Ping**2?

	Thomas	

Re: *ping* [patch, fortran] PR 30146, errors for INTENT(OUT) and INTENT(INOUT) for DO loop variables

[Steven Bosscher]

On Sun, Nov 25, 2012 at 2:11 PM, Thomas Koenig wrote:
> Ping**2?

This is OK.

Ciao!
Steven