public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: Paul Richard Thomas <paul.richard.thomas@gmail.com>
To: "fortran@gcc.gnu.org" <fortran@gcc.gnu.org>,
	gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault
Date: Sat, 17 Jun 2023 10:14:43 +0100	[thread overview]
Message-ID: <CAGkQGiJyZDofE5VhYpCgKKyHg8YSQBLBZMYJspfJ40Kf6J+PcA@mail.gmail.com> (raw)

[-- Attachment #1: Type: text/plain, Size: 764 bytes --]

Hi All,

The attached patch is amply described by the comments and the
changelog. It also includes the fix for the memory leak in decl.cc, as
promised some days ago.

OK for trunk?

Regards

Paul

PS This leaves 89645 and 99065 as the only real blockers to PR87477.
These will take a little while to fix. They come about because the
type of the associate name is determined by that of a derived type
function that hasn't been parsed at the time that component references
are being parsed. If the order of the contained procedures is
reversed, both test cases compile correctly. The fix will comprise
matching the component name to the accessible derived types, while
keeping track of all the references in case the match is ambiguous and
has to be fixed up later.

[-- Attachment #2: Change107900.Logs --]
[-- Type: application/octet-stream, Size: 519 bytes --]

Fortran: Fix some a bug in associate [PR87477]

2023-06-17  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/87477
	PR fortran/107900
	* decl.cc (char_len_param_value): Fix memory leak.
	(resolve_block_construct): Remove unnecessary static decls.
	* trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
	variables need deferred initialisation of the vptr.
	(gfc_trans_deferred_vars): Do the vptr initialisation.

gcc/testsuite/
	PR fortran/87477
	PR fortran/107900
	* gfortran.dg/pr107900.f90 : New test

[-- Attachment #3: pr107900.diff --]
[-- Type: text/x-patch, Size: 3240 bytes --]

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d09c8bc97d9..844345df77e 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1086,6 +1086,8 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
   p = gfc_copy_expr (*expr);
   if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
     gfc_replace_expr (*expr, p);
+  else
+    gfc_free_expr (p);
 
   if ((*expr)->expr_type == EXPR_FUNCTION)
     {
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e6a4337c0d2..ab5f94e9f03 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1875,6 +1875,13 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  && !(sym->attr.use_assoc && !intrinsic_array_parameter)))
     gfc_defer_symbol_init (sym);
 
+  /* Nullify so that select type doesn't fall over if the variable
+     is not associated.  */
+  if (sym->ts.type == BT_CLASS && UNLIMITED_POLY (sym)
+      && sym->attr.flavor == FL_VARIABLE && !sym->assoc
+      && !sym->attr.dummy && CLASS_DATA (sym)->attr.class_pointer)
+    gfc_defer_symbol_init (sym);
+
   if (sym->ts.type == BT_CHARACTER
       && sym->attr.allocatable
       && !sym->attr.dimension
@@ -1906,6 +1913,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL);
     }
 
+
   gfc_finish_var_decl (decl, sym);
 
   if (sym->ts.type == BT_CHARACTER)
@@ -4652,6 +4660,21 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
       if (sym->assoc)
 	continue;
 
+      /* Nullify unlimited polymorphic variables so that they do not cause
+	 segfaults in select type, when the selector is an intrinsic type.  */
+      if (sym->ts.type == BT_CLASS && UNLIMITED_POLY (sym)
+	  && sym->attr.flavor == FL_VARIABLE && !sym->assoc
+	  && !sym->attr.dummy && CLASS_DATA (sym)->attr.class_pointer)
+	{
+	  gfc_expr *lhs = gfc_lval_expr_from_sym (sym);
+	  gfc_expr *rhs = gfc_get_null_expr (NULL);
+	  tmp = gfc_trans_pointer_assignment (lhs, rhs);
+	  gfc_init_block (&tmpblock);
+	  gfc_add_expr_to_block (&tmpblock, tmp);
+	  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL);
+	  continue;
+	}
+
       if (sym->ts.type == BT_DERIVED
 	  && sym->ts.u.derived
 	  && sym->ts.u.derived->attr.pdt_type)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 45a984b6bdb..eeae13998a3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10034,6 +10034,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 			    build_zero_cst (TREE_TYPE (lse.string_length)));
 	}
 
+      /* Unlimited polymorphic arrays, nullified in gfc_trans_deferred_vars,
+         arrive here as a scalar expr. Find the descriptor data field.  */
+      if (expr1->ts.type == BT_CLASS && UNLIMITED_POLY (expr1)
+	  && expr2->expr_type == EXPR_NULL
+	  && !expr1->ref && !expr1->rank
+	  && (CLASS_DATA (expr1)->attr.dimension
+	      || CLASS_DATA (expr1)->attr.codimension))
+	{
+	  lse.expr = gfc_get_class_from_expr (lse.expr);
+	  lse.expr = gfc_class_data_get (lse.expr);
+	  lse.expr = gfc_conv_descriptor_data_get (lse.expr);
+	}
+
       gfc_add_modify (&block, lse.expr,
 		      fold_convert (TREE_TYPE (lse.expr), rse.expr));
 

             reply	other threads:[~2023-06-17  9:14 UTC|newest]

Thread overview: 13+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-06-17  9:14 Paul Richard Thomas [this message]
2023-06-17 15:33 ` Steve Kargl
2023-06-17 18:01 ` Harald Anlauf
2023-06-17 18:01   ` Harald Anlauf
     [not found]   ` <CAGkQGi+A5OuESANYKB=SOv1a4VqogCinV5+YCijn3+y+Pbq+mA@mail.gmail.com>
2023-06-20 10:54     ` Paul Richard Thomas
2023-06-20 21:57       ` Harald Anlauf
2023-06-20 21:57         ` Harald Anlauf
2023-06-21 16:12         ` Paul Richard Thomas
2023-06-21 16:46           ` Steve Kargl
2023-06-21 18:40           ` Harald Anlauf
2023-06-21 18:40             ` Harald Anlauf
2023-06-21 19:17       ` Bernhard Reutner-Fischer
2023-06-22  6:19         ` Paul Richard Thomas

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=CAGkQGiJyZDofE5VhYpCgKKyHg8YSQBLBZMYJspfJ40Kf6J+PcA@mail.gmail.com \
    --to=paul.richard.thomas@gmail.com \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).