[patch, fortran] PR31162 missing warning for real do-loops with implicit typed variables

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

This patch moves the check for REAL one level down so that the loop variable's 
and the loop specifiers get checked for REAL all in the same place within the 
common code of gfc_resolve_iterator_expr.

The patch also modifies three test cases to accommodate the additional and or 
changed error messages.   No new test case is needed.

If you look at the changes to real_do_1.f90 you will see a handy way to deal 
with multiple error or warnings from a single line of code.  I think the gcc 
wiki may need to be updated to describe this.

Regression tested on x86-64-gnu-linux.

OK for trunk?  (After "Lockdown"???)

2007-06-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/31162
	* resolve.c (gfc_resolve_iterator_expr): Add check for REAL using
	gfc_notify_standard. (gfc_resolve_iterator): Remove check.

Index: testsuite/gfortran.dg/real_do_1.f90
===================================================================
*** testsuite/gfortran.dg/real_do_1.f90	(revision 125686)
--- testsuite/gfortran.dg/real_do_1.f90	(working copy)
***************
*** 1,4 ****
--- 1,8 ----
  ! { dg-do run }
+ ! { dg-warning "Loop variable" "Loop" { target *-*-* } 13 }
+ ! { dg-warning "Start expression" "Start" { target *-*-* } 13 }
+ ! { dg-warning "End expression" "End" { target *-*-* } 13 }
+ ! { dg-warning "Step expression" "Step" { target *-*-* } 13 }
  ! Test REAL type iterators in DO loops
  program real_do_1
    real x, y
*************** program real_do_1
*** 6,12 ****
  
    n = 0
    y = 1.0
!   do x = 1.0, 2.05, 0.1 ! { dg-warning "REAL DO loop" "" }
      call check (x, y)
      y = y + 0.1
      n = n + 1
--- 10,16 ----
  
    n = 0
    y = 1.0
!   do x = 1.0, 2.05, 0.1
      call check (x, y)
      y = y + 0.1
      n = n + 1
Index: testsuite/gfortran.dg/gomp/omp_do1.f90
===================================================================
*** testsuite/gfortran.dg/gomp/omp_do1.f90	(revision 125686)
--- testsuite/gfortran.dg/gomp/omp_do1.f90	(working copy)
*************** subroutine foo
*** 24,34 ****
      i = i + 1
    end do
  !$omp do
!   do 300 d = 1, 30, 6 ! { dg-warning "Obsolete: REAL DO loop iterator" }
      i = d
  300 a(i) = 1
  !$omp do
!   do d = 1, 30, 5 ! { dg-warning "Obsolete: REAL DO loop iterator" }
      i = d
      a(i) = 2
    end do
--- 24,34 ----
      i = i + 1
    end do
  !$omp do
!   do 300 d = 1, 30, 6 ! { dg-warning "Obsolete: Loop variable" }
      i = d
  300 a(i) = 1
  !$omp do
!   do d = 1, 30, 5 ! { dg-warning "Obsolete: Loop variable" }
      i = d
      a(i) = 2
    end do
Index: testsuite/gfortran.dg/warnings_are_errors_1.f
===================================================================
*** testsuite/gfortran.dg/warnings_are_errors_1.f	(revision 125686)
--- testsuite/gfortran.dg/warnings_are_errors_1.f	(working copy)
***************
*** 12,18 ****
  !
  34 5   i=0 
  ! gfc_notify_std(GFC_STD_F95_DEL):
!        do r1 = 1.0, 2 ! { dg-warning "Obsolete: REAL DO loop iterator" }
           i = i+1
         end do
         call foo j bar
--- 12,18 ----
  !
  34 5   i=0 
  ! gfc_notify_std(GFC_STD_F95_DEL):
!        do r1 = 1, 2 ! { dg-error "Obsolete: Loop variable" }
           i = i+1
         end do
         call foo j bar
Index: fortran/resolve.c
===================================================================
*** fortran/resolve.c	(revision 125686)
--- fortran/resolve.c	(working copy)
*************** gfc_resolve_iterator_expr (gfc_expr *exp
*** 3373,3387 ****
        return FAILURE;
      }
  
!   if (!(expr->ts.type == BT_INTEGER
! 	|| (expr->ts.type == BT_REAL && real_ok)))
      {
!       if (real_ok)
! 	gfc_error ("%s at %L must be INTEGER or REAL", _(name_msgid),
! 		   &expr->where);
        else
! 	gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where);
!       return FAILURE;
      }
    return SUCCESS;
  }
--- 3373,3396 ----
        return FAILURE;
      }
  
!   if (expr->ts.type != BT_INTEGER)
      {
!       if (expr->ts.type == BT_REAL)
! 	{
! 	  if (real_ok)
! 	    return gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: %s at %L should"
! 				   " be integer", _(name_msgid), &expr->where);
! 	  else
! 	    {
! 	      gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where);
! 	      return FAILURE;
! 	    }
! 	}
        else
! 	{
! 	  gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where);
! 	  return FAILURE;
! 	}
      }
    return SUCCESS;
  }
*************** gfc_resolve_iterator_expr (gfc_expr *exp
*** 3393,3403 ****
  try
  gfc_resolve_iterator (gfc_iterator *iter, bool real_ok)
  {
- 
-   if (iter->var->ts.type == BT_REAL)
-     gfc_notify_std (GFC_STD_F95_DEL, "Obsolete: REAL DO loop iterator at %L",
- 		    &iter->var->where);
- 
    if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable")
        == FAILURE)
      return FAILURE;
--- 3402,3407 ----