Fortran: Fix ICE on invalid code

This patch tests whether a symbol imported into an interface
is already available in local scope.

	PR fortran/123375

gcc/fortran/ChangeLog:

	* decl.cc (gfc_match_import): Check that imported entity within
	a interface is not from local scope.

gcc/testsuite/ChangeLog:

	* gfortran.dg/import.f90: Run code testing for a warning that
	is now an error.
	* gfortran.dg/pr123375.f90: New test.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 3d0410501b65dd4328815cdedda8c0e24cf2e00f..903d4d2b617821fc0012af98e4c31d20b5ba5e89 100644 (file)
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -5557,6 +5557,19 @@ gfc_match_import (void)
       switch (m)
        {
        case MATCH_YES:
+         /* Before checking if the symbol is available from host
+            association into a SUBROUTINE or FUNCTION within an
+            INTERFACE, check if it is already in local scope.  */
+         gfc_find_symbol (name, gfc_current_ns, 1, &sym);
+         if (sym
+             && gfc_state_stack->previous
+             && gfc_state_stack->previous->state == COMP_INTERFACE)
+           {
+              gfc_error ("import-name %qs at %C is in the "
+                         "local scope", name);
+              return MATCH_ERROR;
+           }
+
          if (gfc_current_ns->parent != NULL
              && gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
            {

diff --git a/gcc/testsuite/gfortran.dg/import.f90 b/gcc/testsuite/gfortran.dg/import.f90
index 4830eccc87d85db7746457b9bb9962d6f7ade37a..12c0c64fa12918ac542d932ee55deaaae062b9fb 100644 (file)
--- a/gcc/testsuite/gfortran.dg/import.f90
+++ b/gcc/testsuite/gfortran.dg/import.f90
@@ -57,11 +57,6 @@ program foo
       type(myType) :: x
       integer(dp)     :: y
     end subroutine bar
-    subroutine test(x)
-      import :: myType3
-      import myType3 ! { dg-warning "already IMPORTed from" }
-      type(myType3) :: x
-    end subroutine test
   end interface
 
   type(myType) :: y

diff --git a/gcc/testsuite/gfortran.dg/pr123375.f90 b/gcc/testsuite/gfortran.dg/pr123375.f90
new file mode 100644 (file)
index 0000000..42b6cbc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr123375.f90
@@ -0,0 +1,67 @@
+! { dg-do compile }
+   module foo
+      implicit none
+      integer aa
+   end module foo
+   !
+   ! AA made available by USE association in bar2, and imported into
+   ! the interface.  This compiles with gfortran and flang21.
+   !
+   module bar2
+      use foo
+      implicit none
+      interface
+         subroutine bah
+            import aa
+         end subroutine bah
+      end interface
+   end module bar2
+   !
+   ! AA made available by USE association within bah, and then an
+   ! import statement is invalid as is in the current scoping unit.
+   !
+   ! gfortran -c vv.f90
+   ! vv.f90:40:17:
+   !
+   !   40 |          import aa
+   !      |                 1
+   ! Error: Cannot IMPORT 'aa' from host scoping unit at (1)...
+   !
+   ! flang21 -c vv.f90
+   ! error: Semantic errors in vv.f90
+   ! ./vv.f90:40:17: error: 'a' not found in host scope
+   !           import aa
+   !                  ^^
+   module bar3
+      implicit none
+      interface
+         subroutine bah
+            use foo
+            import aa      ! { dg-error "in the local scope" }
+         end subroutine bah
+      end interface
+   end module bar3
+   !
+   ! AA made available by USE association within foo and bah.  The
+   ! import statement should be invalid as AA is  the current scoping
+   ! unit.
+   !
+   ! F2023:C8105 Within an interface body, an entity that is accessed
+   ! by host association shall be accessible by host or use association
+   ! within the host scoping unit, or explicitly declared prior to the
+   ! interface body.
+   !
+   ! flang21 compiles this example.
+   ! gfortran has an ICE.
+   !
+   module bar4
+      use foo
+      implicit none
+      interface
+         subroutine bah
+            ! This brings aa into the interface, and should be an error.
+            use foo
+            import aa      ! { dg-error "in the local scope" }
+         end subroutine bah
+      end interface
+   end module bar4