[patch, fortran] Fix PR 99345, ICE with DO loop checking

[Thomas Koenig <tkoenig@netcologne.de>]

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

Hello world,

the attached, rather obvious patch fixes an ICE on valid which
came about because I did not handle EXEC_IOLENGTH as start of
an I/O statement when checking for the DO loop variable.
This is an 11 regression.

Thanks to Harald for reducing this down to the bare
minimum.

Regression-tested on x86_64-pc-linux-gnu.

OK for trunk?

Best regards

	Thomas

Handle EXEC_IOLENGTH in doloop_contained_procedure_code.

gcc/fortran/ChangeLog:

         PR fortran/99345
         * frontend-passes.c (doloop_contained_procedure_code):
         Properly handle EXEC_IOLENGTH.

gcc/testsuite/ChangeLog:

         PR fortran/99345
         * gfortran.dg/do_check_16.f90: New test.
         * gfortran.dg/do_check_17.f90: New test.


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

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 2b9c2d179bb..cfc47471cf1 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -2405,6 +2405,7 @@ doloop_contained_procedure_code (gfc_code **c,
     case EXEC_READ:
     case EXEC_WRITE:
     case EXEC_INQUIRE:
+    case EXEC_IOLENGTH:
       saved_io_op = last_io_op;
       last_io_op = co->op;
       break;
@@ -2460,6 +2461,12 @@ doloop_contained_procedure_code (gfc_code **c,
 			   info->procedure->name, &info->where_do);
 	  break;
 
+	case EXEC_IOLENGTH:
+	  if (co->expr1 && co->expr1->symtree->n.sym == do_var)
+	    gfc_error_now (errmsg, do_var->name, &co->expr1->where,
+			   info->procedure->name, &info->where_do);
+	  break;
+
 	default:
 	  gcc_unreachable ();
 	}
diff --git a/gcc/testsuite/gfortran.dg/do_check_16.f90 b/gcc/testsuite/gfortran.dg/do_check_16.f90
new file mode 100644
index 00000000000..db0d45cb581
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_16.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+program main
+  implicit none
+  integer :: iq,nq,recl
+  DO iq = 1, nq
+     call foobar  ! { dg-error "redefined" }     
+  ENDDO  
+CONTAINS
+
+  subroutine foobar
+    inquire (iolength=nq) iq ! { dg-error "redefined" }
+  end subroutine foobar
+END program main
diff --git a/gcc/testsuite/gfortran.dg/do_check_17.f90 b/gcc/testsuite/gfortran.dg/do_check_17.f90
new file mode 100644
index 00000000000..02b8993de38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_check_17.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR 99345 - this used to cause an ICE.
+! Original test case by Matthias Klose
+program main
+  implicit none
+  integer :: iq,nq,recl
+  DO iq = 1, nq
+     CALL calc_upper_fan (iq)
+  ENDDO  
+CONTAINS
+  SUBROUTINE calc_upper_fan (iq)
+    INTEGER :: iq
+    INTEGER :: recl
+    INQUIRE(IOLENGTH=recl) iq
+  END SUBROUTINE calc_upper_fan
+END