https://gcc.gnu.org/g:38dd703d368c9e60159e6f19cfc8303ad639b557

commit r12-10305-g38dd703d368c9e60159e6f19cfc8303ad639b557
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Mar 21 17:27:54 2024 +0100

    fortran: Ignore use statements on error [PR107426]
    
    This fixes an access to freed memory on the testcase from the PR.
    The problem comes from an invalid subroutine statement in an interface,
    which is ignored and causes the following statements forming the procedure
    body to be rejected.  One of them use-associates the intrinsic ISO_C_BINDING
    module, which imports new symbols in a namespace that is freed at the time
    the statement is rejected.  However, this creates dangling pointers as
    ISO_C_BINDING is special and its import creates a reference to the imported
    C_PTR symbol in the return type of the global intrinsic symbol for C_LOC
    (see the function create_intrinsic_function).
    
    This change saves and restores the list of use statements, so that rejected
    use statements are removed before they have a chance to be applied to the
    current namespace and create dangling pointers.
    
            PR fortran/107426
    
    gcc/fortran/ChangeLog:
    
            * gfortran.h (gfc_save_module_list, gfc_restore_old_module_list):
            New declarations.
            * module.cc (old_module_list_tail): New global variable.
            (gfc_save_module_list, gfc_restore_old_module_list): New functions.
            (gfc_use_modules): Set module_list and old_module_list_tail.
            * parse.cc (next_statement): Save module_list before doing any work.
            (reject_statement): Restore module_list to its saved value.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/pr89943_3.f90: Update error pattern.
            * gfortran.dg/pr89943_4.f90: Likewise.
            * gfortran.dg/use_31.f90: New test.
    
    (cherry picked from commit a44d7e8a52007c2d45217709ca02947c6600de87)

Diff:
---
 gcc/fortran/gfortran.h                  |  2 ++
 gcc/fortran/module.cc                   | 31 +++++++++++++++++++++++++++++++
 gcc/fortran/parse.cc                    |  4 ++++
 gcc/testsuite/gfortran.dg/pr89943_3.f90 |  2 +-
 gcc/testsuite/gfortran.dg/pr89943_4.f90 |  2 +-
 gcc/testsuite/gfortran.dg/use_31.f90    | 26 ++++++++++++++++++++++++++
 6 files changed, 65 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7bf1d5a0452..98c0cd39503 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3800,6 +3800,8 @@ void gfc_module_done_2 (void);
 void gfc_dump_module (const char *, int);
 bool gfc_check_symbol_access (gfc_symbol *);
 void gfc_free_use_stmts (gfc_use_list *);
+void gfc_save_module_list ();
+void gfc_restore_old_module_list ();
 const char *gfc_dt_lower_string (const char *);
 const char *gfc_dt_upper_string (const char *);
 
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 85aa153bd77..7b06acb3133 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -195,7 +195,12 @@ static const char *module_name;
 /* The name of the .smod file that the submodule will write to.  */
 static const char *submodule_name;
 
+/* The list of use statements to apply to the current namespace
+   before parsing the non-use statements.  */
 static gfc_use_list *module_list;
+/* The end of the MODULE_LIST list above at the time the recognition
+   of the current statement started.  */
+static gfc_use_list **old_module_list_tail;
 
 /* If we're reading an intrinsic module, this is its ID.  */
 static intmod_id current_intmod;
@@ -7542,6 +7547,8 @@ gfc_use_modules (void)
       gfc_use_module (module_list);
       free (module_list);
     }
+  module_list = NULL;
+  old_module_list_tail = &module_list;
   gfc_rename_list = NULL;
 }
 
@@ -7565,6 +7572,30 @@ gfc_free_use_stmts (gfc_use_list *use_stmts)
 }
 
 
+/* Remember the end of the MODULE_LIST list, so that the list can be restored
+   to its previous state if the current statement is erroneous.  */
+
+void
+gfc_save_module_list ()
+{
+  gfc_use_list **tail = &module_list;
+  while (*tail != NULL)
+    tail = &(*tail)->next;
+  old_module_list_tail = tail;
+}
+
+
+/* Restore the MODULE_LIST list to its previous value and free the use
+   statements that are no longer part of the list.  */
+
+void
+gfc_restore_old_module_list ()
+{
+  gfc_free_use_stmts (*old_module_list_tail);
+  *old_module_list_tail = NULL;
+}
+
+
 void
 gfc_module_init_2 (void)
 {
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 3e9c6514c80..2b3a1a91fd9 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1600,6 +1600,7 @@ next_statement (void)
   locus old_locus;
 
   gfc_enforce_clean_symbol_state ();
+  gfc_save_module_list ();
 
   gfc_new_block = NULL;
 
@@ -2875,6 +2876,9 @@ reject_statement (void)
 
   gfc_reject_data (gfc_current_ns);
 
+  /* Don't queue use-association of a module if we reject the use statement.  
*/
+  gfc_restore_old_module_list ();
+
   gfc_new_block = NULL;
   gfc_undo_symbols ();
   gfc_clear_warning ();
diff --git a/gcc/testsuite/gfortran.dg/pr89943_3.f90 
b/gcc/testsuite/gfortran.dg/pr89943_3.f90
index 38b723e2458..84a9fb74741 100644
--- a/gcc/testsuite/gfortran.dg/pr89943_3.f90
+++ b/gcc/testsuite/gfortran.dg/pr89943_3.f90
@@ -22,7 +22,7 @@ submodule(Foo_mod) Foo_smod
       module subroutine runFoo4C(ndim) bind(C, name="runFu")   ! { dg-error 
"Mismatch in BIND" }
          use, intrinsic :: iso_c_binding                 ! { dg-error 
"Unexpected USE statement" }
          implicit none                                   ! { dg-error 
"Unexpected IMPLICIT NONE statement" }
-         integer(c_int32_t) , intent(in) :: ndim         ! { dg-error 
"Unexpected data declaration" }
+         integer(c_int32_t) , intent(in) :: ndim         ! { dg-error "Symbol 
'c_int32_t' at .1. has no IMPLICIT type" }
       end subroutine runFoo4C                            ! { dg-error " 
Expecting END SUBMODULE" }
 
 end submodule Foo_smod
diff --git a/gcc/testsuite/gfortran.dg/pr89943_4.f90 
b/gcc/testsuite/gfortran.dg/pr89943_4.f90
index 8eba2eda171..cb955d01c88 100644
--- a/gcc/testsuite/gfortran.dg/pr89943_4.f90
+++ b/gcc/testsuite/gfortran.dg/pr89943_4.f90
@@ -23,7 +23,7 @@ submodule(Foo_mod) Foo_smod
       module function runFoo4C(ndim) bind(C, name="runFu")  ! { dg-error 
"Mismatch in BIND" }
          use, intrinsic :: iso_c_binding     ! { dg-error "Unexpected USE 
statement in" }
          implicit none                       ! { dg-error "Unexpected IMPLICIT 
NONE statement" }
-         integer(c_int32_t) , intent(in) :: ndim   ! { dg-error "Unexpected 
data declaration" }
+         integer(c_int32_t) , intent(in) :: ndim   ! { dg-error "Symbol 
'c_int32_t' at .1. has no IMPLICIT type" }
       end function runFoo4C                  ! { dg-error "Expecting END 
SUBMODULE" }
 
 end submodule Foo_smod
diff --git a/gcc/testsuite/gfortran.dg/use_31.f90 
b/gcc/testsuite/gfortran.dg/use_31.f90
new file mode 100644
index 00000000000..89a9ab30d11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_31.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/107426
+! This example used to generate an ICE, caused by the use stmt from the nested
+! procedure declaration setting the result of the C_LOC global intrinsic symbol
+! to the symbol of C_PTR from ISO_C_BINDING being imported, before freeing the
+! latter symbol because of the rejection of the use statement.
+!
+! Contributed by Gerhard Steinmetz <gs...@t-online.de>
+
+module m
+contains
+   subroutine p() bind(c)
+      use, intrinsic :: iso_c_binding
+      integer, target :: a = 1
+      type(c_ptr) :: z
+      interface
+         subroutine s(x) bind(cc)            ! { dg-error "Missing closing 
paren" }
+            use, intrinsic :: iso_c_binding  ! { dg-error "Unexpected USE 
statement in INTERFACE block" }
+            integer(c_int), value :: x       ! { dg-error "Parameter 'c_int' 
at .1. has not been declared" }
+         end                                 ! { dg-error "END INTERFACE 
statement expected" }
+      end interface
+      z = c_loc(a)
+      call s(z)
+   end
+end

Reply via email to