From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.smtpout.orange.fr (smtp-19.smtpout.orange.fr [80.12.242.19]) by sourceware.org (Postfix) with ESMTPS id 47BEC3858D3C for ; Sun, 27 Aug 2023 19:22:59 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 47BEC3858D3C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: sourceware.org; spf=fail smtp.mailfrom=gcc.gnu.org Received: from cyrano.home ([86.215.161.51]) by smtp.orange.fr with ESMTPA id aLLTqaukhQTQNaLLdqG0Ba; Sun, 27 Aug 2023 21:22:57 +0200 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=wanadoo.fr; s=t20230301; t=1693164177; bh=W6YmtxtZBBdR2Iy/vNIS4mttm7wMG+JVBzqAuHcDiSI=; h=From:To:Subject:Date; b=nWDrLSvJwbVhOPdYS+HMV/L8UYpxRtTNo0EERT3awuDgi96Hcf/MXeksKwn9EdET4 zj7UFV9A/xiCLur6Xcu3LI9Paioxp6idmlJbjw9Ci0o7uP7uic2bj8rQNMqrjE6kKS 3X3QK1yvxbUm43J1da2CU7XcvORjSodcXXX984JGCqNX3Jnp4CyRHEs8OBHfSHRFWK p1EcLvBzX+m6V06+jU8SkOTOCbLLojyNYtVCxE+fm6AFTBILmcplczy6zSihvyMpnz f9iiCAc5z7fO6lz7cJDXIWkUyi2ptYqp7TZWSurdChc9yCJ9tUF1s6Eqwa+TbTsbA1 P/JIjnMt+1gDQ== X-ME-Helo: cyrano.home X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Sun, 27 Aug 2023 21:22:57 +0200 X-ME-IP: 86.215.161.51 From: Mikael Morin To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] fortran: Restore interface to its previous state on error [PR48776] Date: Sun, 27 Aug 2023 21:22:46 +0200 Message-Id: <20230827192246.2514665-1-mikael@gcc.gnu.org> X-Mailer: git-send-email 2.40.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-10.2 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,FORGED_SPF_HELO,GIT_PATCH_0,JMQ_SPF_NEUTRAL,RCVD_IN_DNSWL_NONE,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,SPF_NEUTRAL,TXREP,URIBL_BLACK autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: Hello, this fixes an old error-recovery bug. Tested on x86_64-pc-linux-gnu. OK for master? -- >8 -- Keep memory of the content of the current interface body being parsed and restore it to its previous state if it has been modified at the time a parse attempt fails. This fixes memory errors and random segmentation faults caused by dangling symbol pointers kept in interfaces' linked lists of symbols. If a parsing attempt fails and symbols are freed, they should also be removed from the current interface linked list. As the list of symbol is a linked list, and parsing only adds new symbols to the head of the list, all that is needed to track the previous content of the list is a pointer to its previous head. This adds such a pointer, and the restoration of the list of symbols to that pointer on error. PR fortran/48776 gcc/fortran/ChangeLog: * gfortran.h (gfc_drop_interface_elements_before): New prototype. (gfc_current_interface_head): Return a reference to the pointer. * interface.cc (gfc_current_interface_head): Ditto. (free_interface_elements_until): New function, generalizing gfc_free_interface. (gfc_free_interface): Use free_interface_elements_until. (gfc_drop_interface_elements_before): New function. * parse.cc (current_interface_ptr, previous_interface_head): New static variables. (current_interface_valid_p, get_current_interface_ptr): New functions. (decode_statement): Initialize previous_interface_head. (reject_statement): Restore current interface pointer to point to previous_interface_head. gcc/testsuite/ChangeLog: * gfortran.dg/interface_procedure_1.f90: New test. --- gcc/fortran/gfortran.h | 3 +- gcc/fortran/interface.cc | 43 ++++++++++++--- gcc/fortran/parse.cc | 54 +++++++++++++++++++ .../gfortran.dg/interface_procedure_1.f90 | 23 ++++++++ 4 files changed, 115 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/interface_procedure_1.f90 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index fd47000a88e..0fabe7badde 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3824,6 +3824,7 @@ bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *); /* interface.cc -- FIXME: some of these should be in symbol.cc */ void gfc_free_interface (gfc_interface *); +void gfc_drop_interface_elements_before (gfc_interface **, gfc_interface *); bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *); bool gfc_compare_types (gfc_typespec *, gfc_typespec *); bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *, @@ -3843,7 +3844,7 @@ void gfc_free_formal_arglist (gfc_formal_arglist *); bool gfc_extend_assign (gfc_code *, gfc_namespace *); bool gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus); bool gfc_add_interface (gfc_symbol *); -gfc_interface *gfc_current_interface_head (void); +gfc_interface *&gfc_current_interface_head (void); void gfc_set_current_interface_head (gfc_interface *); gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*); bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*); diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index ea82056e9e3..c01df0460d7 100644 --- a/gcc/fortran/interface.cc +++ b/gcc/fortran/interface.cc @@ -78,18 +78,47 @@ along with GCC; see the file COPYING3. If not see gfc_interface_info current_interface; +/* Free the leading members of the gfc_interface linked list given in INTR + up to the END element (exclusive: the END element is not freed). + If END is not nullptr, it is assumed that END is in the linked list starting + with INTR. */ + +static void +free_interface_elements_until (gfc_interface *intr, gfc_interface *end) +{ + gfc_interface *next; + + for (; intr != end; intr = next) + { + next = intr->next; + free (intr); + } +} + + /* Free a singly linked list of gfc_interface structures. */ void gfc_free_interface (gfc_interface *intr) { - gfc_interface *next; + free_interface_elements_until (intr, nullptr); +} - for (; intr; intr = next) - { - next = intr->next; - free (intr); - } + +/* Update the interface pointer given by IFC_PTR to make it point to TAIL. + It is expected that TAIL (if non-null) is in the list pointed to by + IFC_PTR, hence the tail of it. The members of the list before TAIL are + freed before the pointer reassignment. */ + +void +gfc_drop_interface_elements_before (gfc_interface **ifc_ptr, + gfc_interface *tail) +{ + if (ifc_ptr == nullptr) + return; + + free_interface_elements_until (*ifc_ptr, tail); + *ifc_ptr = tail; } @@ -4953,7 +4982,7 @@ gfc_add_interface (gfc_symbol *new_sym) } -gfc_interface * +gfc_interface *& gfc_current_interface_head (void) { switch (current_interface.type) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index e797402b59f..8f09ddf753c 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -37,6 +37,13 @@ gfc_st_label *gfc_statement_label; static locus label_locus; static jmp_buf eof_buf; +/* Respectively pointer and content of the current interface body being parsed + as they were at the beginning of decode_statement. Used to restore the + interface to its previous state in case a parsed statement is rejected after + some symbols have been added to the interface. */ +static gfc_interface **current_interface_ptr = nullptr; +static gfc_interface *previous_interface_head = nullptr; + gfc_state_data *gfc_state_stack; static bool last_was_use_stmt = false; bool in_exec_part; @@ -291,6 +298,46 @@ end_of_block: return ST_GET_FCN_CHARACTERISTICS; } + +/* Tells whether gfc_get_current_interface_head can be used safely. */ + +static bool +current_interface_valid_p () +{ + switch (current_interface.type) + { + case INTERFACE_INTRINSIC_OP: + return current_interface.ns != nullptr; + + case INTERFACE_GENERIC: + case INTERFACE_DTIO: + return current_interface.sym != nullptr; + + case INTERFACE_USER_OP: + return current_interface.uop != nullptr; + + default: + return false; + } +} + + +/* Return a pointer to the interface currently being parsed, or nullptr if + we are not currently parsing an interface body. */ + +static gfc_interface ** +get_current_interface_ptr () +{ + if (current_interface_valid_p ()) + { + gfc_interface *& ifc_ptr = gfc_current_interface_head (); + return &ifc_ptr; + } + else + return nullptr; +} + + static bool in_specification_block; /* This is the primary 'decode_statement'. */ @@ -307,6 +354,11 @@ decode_statement (void) gfc_clear_error (); /* Clear any pending errors. */ gfc_clear_warning (); /* Clear any pending warnings. */ + current_interface_ptr = get_current_interface_ptr (); + previous_interface_head = current_interface_ptr == nullptr + ? nullptr + : *current_interface_ptr; + gfc_matching_function = false; if (gfc_match_eos () == MATCH_YES) @@ -3042,6 +3094,8 @@ reject_statement (void) { gfc_free_equiv_until (gfc_current_ns->equiv, gfc_current_ns->old_equiv); gfc_current_ns->equiv = gfc_current_ns->old_equiv; + gfc_drop_interface_elements_before (current_interface_ptr, + previous_interface_head); gfc_reject_data (gfc_current_ns); diff --git a/gcc/testsuite/gfortran.dg/interface_procedure_1.f90 b/gcc/testsuite/gfortran.dg/interface_procedure_1.f90 new file mode 100644 index 00000000000..6a58b6a7bcc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_procedure_1.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-additional-options "-std=f95" } +! +! PR fortran/48776 +! The following used to generate a segmentation fault in the front-end, +! because a pointer to the get1 symbol was remaining in the get interface +! after the procedure statement was rejected and the symbol freed. + + interface get + procedure get1 ! { dg-error "Fortran 2003: PROCEDURE statement" } + end interface + + integer :: h + call set1 (get (h)) ! { dg-error "no specific function for the generic 'get'" } +contains + subroutine set1 (a) + integer, intent(in) :: a + end subroutine + + integer function get1 (s) + integer :: s + end function +end -- 2.40.1