https://gcc.gnu.org/g:200bfefd3d8bce5b9097470c8a4fba01afbd4ad8
commit r16-2281-g200bfefd3d8bce5b9097470c8a4fba01afbd4ad8
Author: Paul Thomas <pa...@gcc.gnu.org>
Date: Wed Jul 16 06:11:25 2025 +0100
Fortran: Fix ICE in F2018 IMPORT statements.
2025-07-16 Steve Kargl <s...@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:
---
gcc/fortran/decl.cc | 9 ++++++---
gcc/testsuite/gfortran.dg/import13.f90 | 21 +++++++++++++++++++++
2 files changed, 27 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 111ebc5f845b..af425754d086 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 000000000000..3bcfec33723d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import13.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! Contributed by Steve Kargl <s...@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
