From: Paul Thomas <pault@gcc.gnu.org>
Date: Wed, 16 Jul 2025 05:11:25 +0000 (+0100)
Subject: Fortran: Fix ICE in F2018 IMPORT statements.
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=200bfefd3d8bce5b9097470c8a4fba01afbd4ad8;p=thirdparty%2Fgcc.git

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 111ebc5f845..af425754d08 100644
--- 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
index 00000000000..3bcfec33723
--- /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