Fortran: Fix ICE in F2018 IMPORT statements.

2025-07-16  Steve Kargl  <sgk@troutmask.apl.washington.edu>

gcc/fortran
	* decl.cc (gfc_match_import): Correct minor whitespace snafu
	and fix NULL pointer dereferences in two places.

gcc/testsuite/
	* gfortran.dg/import13.f90: New test.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 111ebc5f845bfd83ec9b03d044dd025b5137d546..af425754d0861fe65fb3f6f7594f5ab71edb2784 100644 (file)
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -5272,13 +5272,15 @@ gfc_match_import (void)
       switch (m)
        {
        case MATCH_YES:
-         if (gfc_current_ns->parent !=  NULL
+         if (gfc_current_ns->parent != NULL
              && gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
            {
               gfc_error ("Type name %qs at %C is ambiguous", name);
               return MATCH_ERROR;
            }
-         else if (!sym && gfc_current_ns->proc_name->ns->parent !=  NULL
+         else if (!sym
+                  && gfc_current_ns->proc_name
+                  && gfc_current_ns->proc_name->ns->parent
                   && gfc_find_symbol (name,
                                       gfc_current_ns->proc_name->ns->parent,
                                       1, &sym))
@@ -5289,7 +5291,8 @@ gfc_match_import (void)
 
          if (sym == NULL)
            {
-             if (gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
+             if (gfc_current_ns->proc_name
+                 && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY)
                {
                  gfc_error ("Cannot IMPORT %qs from host scoping unit "
                             "at %C - does not exist.", name);

diff --git a/gcc/testsuite/gfortran.dg/import13.f90 b/gcc/testsuite/gfortran.dg/import13.f90
new file mode 100644 (file)
index 0000000..3bcfec3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import13.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! Contributed by Steve Kargl  <sgk@troutmask.apl.washington.edu>
+!
+program foo
+   implicit none
+   integer i
+   i = 42
+   if (i /= 42) stop 1
+   call bah
+   contains
+      subroutine bah       ! { dg-error "is already defined at" }
+         i = 43
+         if (i /= 43) stop 2
+      end subroutine bah
+      subroutine bah       ! { dg-error "is already defined at" }
+         ! import statement missing a comma
+         import none       ! { dg-error "Unexpected IMPORT statement" }
+         i = 44            ! { dg-error "Unexpected assignment" }
+      end subroutine bah   ! { dg-error "Expecting END PROGRAM" }
+end program foo