[Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Paul Richard Thomas]

[-- 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));
 

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Steve Kargl]

On Sat, Jun 17, 2023 at 10:14:43AM +0100, Paul Richard Thomas via Fortran wrote:
> 
> PS This leaves 89645 and 99065 as the only real blockers to PR87477.
>  

Hate to be the bearer of bad news, but Neil Carlson has added
a couple PRs about associate that may not be listed in 87447.

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=110224
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=110033


For the second one, if I suppress the bogus error message,
the compiler runs into a new error message.  The second
error message indicates the associate-name is not an
unexpected coarray.  I haven't determined how to propagate
the information that the selector is a coarray to the 
associate-name.

-- 
Steve

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Harald Anlauf]

Hi Paul,

On 6/17/23 11:14, Paul Richard Thomas via Gcc-patches wrote:
> 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?

I hate to say it, but you forgot to add the testcase again... :-(

The patch fixes your "extended" testcase in

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=107900#c2

but the original one in comment ICEs for me here:

% gfc-14 pr107900.f90
f951: internal compiler error: Segmentation fault
0x1025c2f crash_signal
         ../../gcc-trunk/gcc/toplev.cc:314
0x9d31d3 resolve_select_type
         ../../gcc-trunk/gcc/fortran/resolve.cc:9791
0x9cef5e gfc_resolve_code(gfc_code*, gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:12588
0x9d2431 resolve_codes
         ../../gcc-trunk/gcc/fortran/resolve.cc:18057
0x9d24fe gfc_resolve(gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:18092
0x9cf0ee gfc_resolve(gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:18077
0x9cf0ee resolve_block_construct
         ../../gcc-trunk/gcc/fortran/resolve.cc:10971
0x9cf0ee gfc_resolve_code(gfc_code*, gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:12596
0x9d2431 resolve_codes
         ../../gcc-trunk/gcc/fortran/resolve.cc:18057
0x9d24fe gfc_resolve(gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:18092
0x9b11f1 resolve_all_program_units
         ../../gcc-trunk/gcc/fortran/parse.cc:6864
0x9b11f1 gfc_parse_file()
         ../../gcc-trunk/gcc/fortran/parse.cc:7120
0xa033ef gfc_be_parse_file
         ../../gcc-trunk/gcc/fortran/f95-lang.cc:229

It hits an assert here:

9790          st = gfc_find_symtree (ns->sym_root, name);
9791          gcc_assert (st->n.sym->assoc);

My tree is slightly modified, but the changes should not have
any effect here.

Can you please have a look, too?

Thanks,
Harald

> 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.

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Harald Anlauf]

Hi Paul,

On 6/17/23 11:14, Paul Richard Thomas via Gcc-patches wrote:
> 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?

I hate to say it, but you forgot to add the testcase again... :-(

The patch fixes your "extended" testcase in

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=107900#c2

but the original one in comment ICEs for me here:

% gfc-14 pr107900.f90
f951: internal compiler error: Segmentation fault
0x1025c2f crash_signal
         ../../gcc-trunk/gcc/toplev.cc:314
0x9d31d3 resolve_select_type
         ../../gcc-trunk/gcc/fortran/resolve.cc:9791
0x9cef5e gfc_resolve_code(gfc_code*, gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:12588
0x9d2431 resolve_codes
         ../../gcc-trunk/gcc/fortran/resolve.cc:18057
0x9d24fe gfc_resolve(gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:18092
0x9cf0ee gfc_resolve(gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:18077
0x9cf0ee resolve_block_construct
         ../../gcc-trunk/gcc/fortran/resolve.cc:10971
0x9cf0ee gfc_resolve_code(gfc_code*, gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:12596
0x9d2431 resolve_codes
         ../../gcc-trunk/gcc/fortran/resolve.cc:18057
0x9d24fe gfc_resolve(gfc_namespace*)
         ../../gcc-trunk/gcc/fortran/resolve.cc:18092
0x9b11f1 resolve_all_program_units
         ../../gcc-trunk/gcc/fortran/parse.cc:6864
0x9b11f1 gfc_parse_file()
         ../../gcc-trunk/gcc/fortran/parse.cc:7120
0xa033ef gfc_be_parse_file
         ../../gcc-trunk/gcc/fortran/f95-lang.cc:229

It hits an assert here:

9790          st = gfc_find_symtree (ns->sym_root, name);
9791          gcc_assert (st->n.sym->assoc);

My tree is slightly modified, but the changes should not have
any effect here.

Can you please have a look, too?

Thanks,
Harald

> 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.

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Paul Richard Thomas]

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

Hi Harald,

Fixing the original testcase in this PR turned out to be slightly more
involved than I expected. However, it resulted in an open door to fix
some other PRs and the attached much larger patch.

This time, I did remember to include the testcases in the .diff :-)

I believe that, between the Change.Logs and the comments, it is
reasonably self-explanatory.

OK for trunk?

Regards

Paul

Fortran: Fix some bugs in associate [PR87477]

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

gcc/fortran
PR fortran/87477
PR fortran/88688
PR fortran/94380
PR fortran/107900
PR fortran/110224
* decl.cc (char_len_param_value): Fix memory leak.
(resolve_block_construct): Remove unnecessary static decls.
* expr.cc (gfc_is_ptr_fcn): New function.
(gfc_check_vardef_context): Use it to permit pointer function
result selectors to be used for associate names in variable
definition context.
* gfortran.h: Prototype for gfc_is_ptr_fcn.
* match.cc (build_associate_name): New function.
(gfc_match_select_type): Use the new function to replace inline
version and to build a new associate name for the case where
the supplied associate name is already used for that purpose.
* resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
associate names with pointer function targets to be used in
variable definition context.
* trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
variables need deferred initialisation of the vptr.
(gfc_trans_deferred_vars): Do the vptr initialisation.
* trans-stmt.cc (trans_associate_var): Ensure that a pointer
associate name points to the target of the selector and not
the selector itself.

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

PR fortran/110224
* gfortran.dg/pr110224.f90 : New test

PR fortran/88688
* gfortran.dg/pr88688.f90 : New test

PR fortran/94380
* gfortran.dg/pr94380.f90 : New test

PR fortran/95398
* gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
numbers in the error tests by two and change the text in two.

[-- Attachment #2: submit200623.diff --]
[-- Type: text/x-patch, Size: 15429 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/expr.cc b/gcc/fortran/expr.cc
index d5cfbe0cc55..c960dfeabd9 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -812,6 +812,16 @@ gfc_has_vector_index (gfc_expr *e)
 }


+bool
+gfc_is_ptr_fcn (gfc_expr *e)
+{
+  return e != NULL && e->expr_type == EXPR_FUNCTION
+	      && (gfc_expr_attr (e).pointer
+		  || (e->ts.type == BT_CLASS
+		      && CLASS_DATA (e)->attr.class_pointer));
+}
+
+
 /* Copy a shape array.  */

 mpz_t *
@@ -6470,6 +6480,22 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	    }
 	  return false;
 	}
+      else if (context && gfc_is_ptr_fcn (assoc->target))
+	{
+	  if (!gfc_notify_std (GFC_STD_F2018, "%qs at %L associated to "
+			       "pointer function target being used in a "
+			       "variable definition context (%s)", name,
+			       &e->where, context))
+	    return false;
+	  else if (gfc_has_vector_index (e))
+	    {
+	      gfc_error ("%qs at %L associated to vector-indexed target"
+			 " cannot be used in a variable definition"
+			 " context (%s)",
+			 name, &e->where, context);
+	      return false;
+	    }
+	}

       /* Target must be allowed to appear in a variable definition context.  */
       if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a58c60e9828..30631abd788 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3659,6 +3659,7 @@ bool gfc_is_constant_expr (gfc_expr *);
 bool gfc_simplify_expr (gfc_expr *, int);
 bool gfc_try_simplify_expr (gfc_expr *, int);
 bool gfc_has_vector_index (gfc_expr *);
+bool gfc_is_ptr_fcn (gfc_expr *);

 gfc_expr *gfc_get_expr (void);
 gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index e7be7fddc64..0e4b5440393 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6377,6 +6377,39 @@ build_class_sym:
 }


+/* Build the associate name  */
+static int
+build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2)
+{
+  gfc_expr *expr1 = *e1;
+  gfc_expr *expr2 = *e2;
+  gfc_symbol *sym;
+
+  /* For the case where the associate name is already an associate name.  */
+  if (!expr2)
+    expr2 = expr1;
+  expr1 = gfc_get_expr ();
+  expr1->expr_type = EXPR_VARIABLE;
+  expr1->where = expr2->where;
+  if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false))
+    return 1;
+
+  sym = expr1->symtree->n.sym;
+  if (expr2->ts.type == BT_UNKNOWN)
+      sym->attr.untyped = 1;
+  else
+  copy_ts_from_selector_to_associate (expr1, expr2);
+
+  sym->attr.flavor = FL_VARIABLE;
+  sym->attr.referenced = 1;
+  sym->attr.class_ok = 1;
+
+  *e1 = expr1;
+  *e2 = expr2;
+  return 0;
+}
+
+
 /* Push the current selector onto the SELECT TYPE stack.  */

 static void
@@ -6532,7 +6565,6 @@ gfc_match_select_type (void)
   match m;
   char name[GFC_MAX_SYMBOL_LEN + 1];
   bool class_array;
-  gfc_symbol *sym;
   gfc_namespace *ns = gfc_current_ns;

   m = gfc_match_label ();
@@ -6554,24 +6586,11 @@ gfc_match_select_type (void)
   m = gfc_match (" %n => %e", name, &expr2);
   if (m == MATCH_YES)
     {
-      expr1 = gfc_get_expr ();
-      expr1->expr_type = EXPR_VARIABLE;
-      expr1->where = expr2->where;
-      if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false))
+      if (build_associate_name (name, &expr1, &expr2))
 	{
 	  m = MATCH_ERROR;
 	  goto cleanup;
 	}
-
-      sym = expr1->symtree->n.sym;
-      if (expr2->ts.type == BT_UNKNOWN)
-	sym->attr.untyped = 1;
-      else
-	copy_ts_from_selector_to_associate (expr1, expr2);
-
-      sym->attr.flavor = FL_VARIABLE;
-      sym->attr.referenced = 1;
-      sym->attr.class_ok = 1;
     }
   else
     {
@@ -6618,6 +6637,17 @@ gfc_match_select_type (void)
       goto cleanup;
     }

+  /* Prevent an existing associate name from reuse here by pushing expr1 to
+     expr2 and building a new associate name.  */
+  if (!expr2 && expr1->symtree->n.sym->assoc
+      && !expr1->symtree->n.sym->attr.select_type_temporary
+      && !expr1->symtree->n.sym->attr.select_rank_temporary
+      && build_associate_name (expr1->symtree->n.sym->name, &expr1, &expr2))
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
   new_st.op = EXEC_SELECT_TYPE;
   new_st.expr1 = expr1;
   new_st.expr2 = expr2;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 50b49d0cb83..82e6ac53aa1 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9254,9 +9254,10 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   gcc_assert (sym->ts.type != BT_UNKNOWN);

   /* See if this is a valid association-to-variable.  */
-  sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
-			  && !parentheses
-			  && !gfc_has_vector_subscript (target));
+  sym->assoc->variable = ((target->expr_type == EXPR_VARIABLE
+			   && !parentheses
+			   && !gfc_has_vector_subscript (target))
+			  || gfc_is_ptr_fcn (target));

   /* Finally resolve if this is an array or not.  */
   if (sym->attr.dimension && target->rank == 0)
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e6a4337c0d2..18589e17843 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1875,6 +1875,15 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 	  && !(sym->attr.use_assoc && !intrinsic_array_parameter)))
     gfc_defer_symbol_init (sym);

+  /* Set the vptr of unlimited polymorphic pointer variables so that
+     they do not cause segfaults in select type, when the selector
+     is an intrinsic type.  Arrays are captured above.  */
+  if (sym->ts.type == BT_CLASS && UNLIMITED_POLY (sym)
+      && CLASS_DATA (sym)->attr.class_pointer
+      && !CLASS_DATA (sym)->attr.dimension && !sym->attr.dummy
+      && sym->attr.flavor == FL_VARIABLE && !sym->assoc)
+    gfc_defer_symbol_init (sym);
+
   if (sym->ts.type == BT_CHARACTER
       && sym->attr.allocatable
       && !sym->attr.dimension
@@ -1906,6 +1915,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 +4662,29 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
       if (sym->assoc)
 	continue;

+      /* Set the vptr of unlimited polymorphic pointer 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_symbol *vtab;
+	  gfc_init_block (&tmpblock);
+	  vtab = gfc_find_vtab (&sym->ts);
+	  if (!vtab->backend_decl)
+	    {
+	      if (!vtab->attr.referenced)
+		gfc_set_sym_referenced (vtab);
+	      gfc_get_symbol_decl (vtab);
+	    }
+	  tmp = gfc_class_vptr_get (sym->backend_decl);
+	  gfc_add_modify (&tmpblock, tmp,
+			  gfc_build_addr_expr (TREE_TYPE (tmp),
+					       vtab->backend_decl));
+	  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL);
+	}
+
       if (sym->ts.type == BT_DERIVED
 	  && sym->ts.u.derived
 	  && sym->ts.u.derived->attr.pdt_type)
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index dcabeca0078..7e768343a57 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2139,11 +2139,14 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 	  tree ctree = gfc_get_class_from_expr (se.expr);
 	  tmp = TREE_TYPE (sym->backend_decl);

-	  /* Coarray scalar component expressions can emerge from
-	     the front end as array elements of the _data field.  */
+	  /* F2018:19.5.1.6 "If a selector has the POINTER attribute,
+	     it shall be associated; the associate name is associated
+	     with the target of the pointer and does not have the
+	     POINTER attribute."  */
 	  if (sym->ts.type == BT_CLASS
-	      && e->ts.type == BT_CLASS && e->rank == 0
-	      && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)) && ctree)
+	      && e->ts.type == BT_CLASS && e->rank == 0 && ctree
+	      && (!GFC_CLASS_TYPE_P (TREE_TYPE (se.expr))
+		  || CLASS_DATA (e)->attr.class_pointer))
 	    {
 	      tree stmp;
 	      tree dtmp;
@@ -2153,10 +2156,10 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 	      ctree = gfc_create_var (dtmp, "class");

 	      stmp = gfc_class_data_get (se.expr);
-	      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)));
-
-	      /* Set the fields of the target class variable.  */
-	      stmp = gfc_conv_descriptor_data_get (stmp);
+	      /* Coarray scalar component expressions can emerge from
+		 the front end as array elements of the _data field.  */
+	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)))
+		stmp = gfc_conv_descriptor_data_get (stmp);
 	      dtmp = gfc_class_data_get (ctree);
 	      stmp = fold_convert (TREE_TYPE (dtmp), stmp);
 	      gfc_add_modify (&se.pre, dtmp, stmp);
@@ -2170,6 +2173,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 		  dtmp = gfc_class_len_get (ctree);
 		  stmp = fold_convert (TREE_TYPE (dtmp), stmp);
 		  gfc_add_modify (&se.pre, dtmp, stmp);
+		  need_len_assign = false;
 		}
 	      se.expr = ctree;
 	    }
diff --git a/gcc/testsuite/gfortran.dg/pr107900.f90 b/gcc/testsuite/gfortran.dg/pr107900.f90
new file mode 100644
index 00000000000..2bd80a7d5a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107900.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! Contributed by Karl Kaiser  <kaiserkarl31@yahoo.com>
+!
+program test
+
+   class(*), pointer :: ptr1, ptr2(:)
+   integer, target :: i = 42
+   integer :: check = 0
+! First with associate name and no selector in select types
+   associate (c => ptr1)
+        select type (c)  ! Segfault - vptr not set
+           type is (integer)
+              stop 1
+           class default
+              check = 1
+        end select
+   end associate
+! Now do the same with the array version
+   associate (c => ptr2)
+        select type (d =>c)  ! Segfault - vptr not set
+           type is (integer)
+              stop 2
+           class default
+              check = check + 10
+        end select
+   end associate
+
+! And now with the associate name and selector
+   associate (c => ptr1)
+        select type (d => c)  ! Segfault - vptr not set
+           type is (integer)
+              stop 3
+           class default
+              check = check + 100
+        end select
+   end associate
+! Now do the same with the array version
+!   ptr2 => NULL()            !This did not fix the problem
+   associate (c => ptr2)
+        select type (d => c)  ! Segfault - vptr not set
+           type is (integer)
+              stop 4
+           class default
+              check = check + 1000
+        end select
+   end associate
+   if (check .ne. 1111) stop 5
+end program test
diff --git a/gcc/testsuite/gfortran.dg/pr110224.f90 b/gcc/testsuite/gfortran.dg/pr110224.f90
new file mode 100644
index 00000000000..186bbf5fe27
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr110224.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
+!
+module mod
+  type :: foo
+    real, pointer :: var
+  contains
+    procedure :: var_ptr
+  end type
+contains
+  function var_ptr(this) result(ref)
+    class(foo) :: this
+    real, pointer :: ref
+    ref => this%var
+  end function
+end module
+program main
+  use mod
+  type(foo) :: x
+  allocate (x%var, source = 2.0)
+  associate (var => x%var_ptr())
+    var = 1.0
+  end associate
+  if (x%var .ne. 1.0) stop 1
+  x%var_ptr() = 2.0
+  if (x%var .ne. 2.0) stop 2
+  deallocate (x%var)
+end program
diff --git a/gcc/testsuite/gfortran.dg/pr88688.f90 b/gcc/testsuite/gfortran.dg/pr88688.f90
new file mode 100644
index 00000000000..3d65118aaf0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr88688.f90
@@ -0,0 +1,62 @@
+! { dg-do run }
+!
+! Contributed by Thomas Fanning <thfanning@gmail.com>
+!
+!
+module mod
+
+    type test
+        class(*), pointer :: ptr
+    contains
+        procedure :: setref
+    end type
+
+contains
+
+    subroutine setref(my,ip)
+    implicit none
+        class(test) :: my
+        integer, pointer :: ip
+        my%ptr => ip
+    end subroutine
+
+    subroutine set7(ptr)
+    implicit none
+        class(*), pointer :: ptr
+        select type (ptr)
+            type is (integer)
+                ptr = 7
+        end select
+    end subroutine
+
+end module
+!---------------------------------------
+
+!---------------------------------------
+program bug
+use mod
+implicit none
+
+    integer, pointer :: i, j
+    type(test) :: tp
+    class(*), pointer :: lp
+
+    allocate(i,j)
+    i = 3; j = 4
+
+    call tp%setref(i)
+    select type (ap => tp%ptr)
+        class default
+            call tp%setref(j)
+            lp => ap
+            call set7(lp)
+    end select
+
+! gfortran used to give i=3 and j=7 because the associate name was not pointing
+! to the target of tp%ptr as required by F2018:19.5.1.6 but, rather, to the
+! selector itself.
+    if (i .ne. 7) stop 1
+    if (j .ne. 4) stop 2
+
+end program
+!---------------------------------------
diff --git a/gcc/testsuite/gfortran.dg/pr94380.f90 b/gcc/testsuite/gfortran.dg/pr94380.f90
new file mode 100644
index 00000000000..e29594f2ff9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr94380.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!
+! Contributed by Vladimir Nikishkin  <lockywolf@gmail.com>
+!
+module test
+  type testtype
+     class(*), allocatable :: t
+  end type testtype
+contains
+  subroutine testproc( x )
+    class(testtype) :: x
+    associate ( temp => x%t)
+      select type (temp)
+         type is (integer)
+      end select
+    end associate
+  end subroutine testproc
+end module test
diff --git a/gcc/testsuite/gfortran.dg/pr95398.f90 b/gcc/testsuite/gfortran.dg/pr95398.f90
index 81cc076c15c..7576f3844b2 100644
--- a/gcc/testsuite/gfortran.dg/pr95398.f90
+++ b/gcc/testsuite/gfortran.dg/pr95398.f90
@@ -1,5 +1,7 @@
 ! { dg-do compile }

+! { dg-options "-std=f2008" }
+
 program test
    implicit none

@@ -46,8 +48,8 @@ program test

 end

-! { dg-error "cannot be used in a variable definition context .assignment."  " " { target *-*-* } 21 }
-! { dg-error "cannot be used in a variable definition context .actual argument to INTENT = OUT.INOUT."  " " { target *-*-* } 23 }
-! { dg-error "Pointer assignment target is neither TARGET nor POINTER" " " { target *-*-* } 35 }
+! { dg-error "being used in a variable definition context .assignment."  " " { target *-*-* } 23 }
+! { dg-error "being used in a variable definition context .actual argument to INTENT = OUT.INOUT."  " " { target *-*-* } 25 }
 ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" " " { target *-*-* } 37 }
+! { dg-error "Pointer assignment target is neither TARGET nor POINTER" " " { target *-*-* } 39 }

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Harald Anlauf]

Hi Paul,

On 6/20/23 12:54, Paul Richard Thomas via Gcc-patches wrote:
> Hi Harald,
> 
> Fixing the original testcase in this PR turned out to be slightly more
> involved than I expected. However, it resulted in an open door to fix
> some other PRs and the attached much larger patch.
> 
> This time, I did remember to include the testcases in the .diff :-)

indeed! :-)

I've only had a superficial look so far although it looks very good.
(I have to trust your experience with unlimited polymorphism.)

However, I was wondering about the following helper function:

+bool
+gfc_is_ptr_fcn (gfc_expr *e)
+{
+  return e != NULL && e->expr_type == EXPR_FUNCTION
+	      && (gfc_expr_attr (e).pointer
+		  || (e->ts.type == BT_CLASS
+		      && CLASS_DATA (e)->attr.class_pointer));
+}
+
+
  /* Copy a shape array.  */

Is there a case where gfc_expr_attr (e).pointer returns false
and you really need the || part?  Looking at gfc_expr_attr
and the present context, it might just not be necessary.

> I believe that, between the Change.Logs and the comments, it is
> reasonably self-explanatory.
> 
> OK for trunk?

OK from my side.

Thanks for the patch!

Harald

> Regards
> 
> Paul
> 
> Fortran: Fix some bugs in associate [PR87477]
> 
> 2023-06-20  Paul Thomas  <pault@gcc.gnu.org>
> 
> gcc/fortran
> PR fortran/87477
> PR fortran/88688
> PR fortran/94380
> PR fortran/107900
> PR fortran/110224
> * decl.cc (char_len_param_value): Fix memory leak.
> (resolve_block_construct): Remove unnecessary static decls.
> * expr.cc (gfc_is_ptr_fcn): New function.
> (gfc_check_vardef_context): Use it to permit pointer function
> result selectors to be used for associate names in variable
> definition context.
> * gfortran.h: Prototype for gfc_is_ptr_fcn.
> * match.cc (build_associate_name): New function.
> (gfc_match_select_type): Use the new function to replace inline
> version and to build a new associate name for the case where
> the supplied associate name is already used for that purpose.
> * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> associate names with pointer function targets to be used in
> variable definition context.
> * trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
> variables need deferred initialisation of the vptr.
> (gfc_trans_deferred_vars): Do the vptr initialisation.
> * trans-stmt.cc (trans_associate_var): Ensure that a pointer
> associate name points to the target of the selector and not
> the selector itself.
> 
> gcc/testsuite/
> PR fortran/87477
> PR fortran/107900
> * gfortran.dg/pr107900.f90 : New test
> 
> PR fortran/110224
> * gfortran.dg/pr110224.f90 : New test
> 
> PR fortran/88688
> * gfortran.dg/pr88688.f90 : New test
> 
> PR fortran/94380
> * gfortran.dg/pr94380.f90 : New test
> 
> PR fortran/95398
> * gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
> numbers in the error tests by two and change the text in two.

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Harald Anlauf]

Hi Paul,

On 6/20/23 12:54, Paul Richard Thomas via Gcc-patches wrote:
> Hi Harald,
>
> Fixing the original testcase in this PR turned out to be slightly more
> involved than I expected. However, it resulted in an open door to fix
> some other PRs and the attached much larger patch.
>
> This time, I did remember to include the testcases in the .diff :-)

indeed! :-)

I've only had a superficial look so far although it looks very good.
(I have to trust your experience with unlimited polymorphism.)

However, I was wondering about the following helper function:

+bool
+gfc_is_ptr_fcn (gfc_expr *e)
+{
+  return e != NULL && e->expr_type == EXPR_FUNCTION
+	      && (gfc_expr_attr (e).pointer
+		  || (e->ts.type == BT_CLASS
+		      && CLASS_DATA (e)->attr.class_pointer));
+}
+
+
  /* Copy a shape array.  */

Is there a case where gfc_expr_attr (e).pointer returns false
and you really need the || part?  Looking at gfc_expr_attr
and the present context, it might just not be necessary.

> I believe that, between the Change.Logs and the comments, it is
> reasonably self-explanatory.
>
> OK for trunk?

OK from my side.

Thanks for the patch!

Harald

> Regards
>
> Paul
>
> Fortran: Fix some bugs in associate [PR87477]
>
> 2023-06-20  Paul Thomas  <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/87477
> PR fortran/88688
> PR fortran/94380
> PR fortran/107900
> PR fortran/110224
> * decl.cc (char_len_param_value): Fix memory leak.
> (resolve_block_construct): Remove unnecessary static decls.
> * expr.cc (gfc_is_ptr_fcn): New function.
> (gfc_check_vardef_context): Use it to permit pointer function
> result selectors to be used for associate names in variable
> definition context.
> * gfortran.h: Prototype for gfc_is_ptr_fcn.
> * match.cc (build_associate_name): New function.
> (gfc_match_select_type): Use the new function to replace inline
> version and to build a new associate name for the case where
> the supplied associate name is already used for that purpose.
> * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> associate names with pointer function targets to be used in
> variable definition context.
> * trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
> variables need deferred initialisation of the vptr.
> (gfc_trans_deferred_vars): Do the vptr initialisation.
> * trans-stmt.cc (trans_associate_var): Ensure that a pointer
> associate name points to the target of the selector and not
> the selector itself.
>
> gcc/testsuite/
> PR fortran/87477
> PR fortran/107900
> * gfortran.dg/pr107900.f90 : New test
>
> PR fortran/110224
> * gfortran.dg/pr110224.f90 : New test
>
> PR fortran/88688
> * gfortran.dg/pr88688.f90 : New test
>
> PR fortran/94380
> * gfortran.dg/pr94380.f90 : New test
>
> PR fortran/95398
> * gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
> numbers in the error tests by two and change the text in two.

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Paul Richard Thomas]

Committed as r14-2022-g577223aebc7acdd31e62b33c1682fe54a622ae27

Thanks for the help and the review Harald. Thanks to Steve too for
picking up Neil Carlson's bugs.

Cheers

Paul

On Tue, 20 Jun 2023 at 22:57, Harald Anlauf <anlauf@gmx.de> wrote:
>
> Hi Paul,
>
> On 6/20/23 12:54, Paul Richard Thomas via Gcc-patches wrote:
> > Hi Harald,
> >
> > Fixing the original testcase in this PR turned out to be slightly more
> > involved than I expected. However, it resulted in an open door to fix
> > some other PRs and the attached much larger patch.
> >
> > This time, I did remember to include the testcases in the .diff :-)
>
> indeed! :-)
>
> I've only had a superficial look so far although it looks very good.
> (I have to trust your experience with unlimited polymorphism.)
>
> However, I was wondering about the following helper function:
>
> +bool
> +gfc_is_ptr_fcn (gfc_expr *e)
> +{
> +  return e != NULL && e->expr_type == EXPR_FUNCTION
> +             && (gfc_expr_attr (e).pointer
> +                 || (e->ts.type == BT_CLASS
> +                     && CLASS_DATA (e)->attr.class_pointer));
> +}
> +
> +
>   /* Copy a shape array.  */
>
> Is there a case where gfc_expr_attr (e).pointer returns false
> and you really need the || part?  Looking at gfc_expr_attr
> and the present context, it might just not be necessary.
>
> > I believe that, between the Change.Logs and the comments, it is
> > reasonably self-explanatory.
> >
> > OK for trunk?
>
> OK from my side.
>
> Thanks for the patch!
>
> Harald
>
> > Regards
> >
> > Paul
> >
> > Fortran: Fix some bugs in associate [PR87477]
> >
> > 2023-06-20  Paul Thomas  <pault@gcc.gnu.org>
> >
> > gcc/fortran
> > PR fortran/87477
> > PR fortran/88688
> > PR fortran/94380
> > PR fortran/107900
> > PR fortran/110224
> > * decl.cc (char_len_param_value): Fix memory leak.
> > (resolve_block_construct): Remove unnecessary static decls.
> > * expr.cc (gfc_is_ptr_fcn): New function.
> > (gfc_check_vardef_context): Use it to permit pointer function
> > result selectors to be used for associate names in variable
> > definition context.
> > * gfortran.h: Prototype for gfc_is_ptr_fcn.
> > * match.cc (build_associate_name): New function.
> > (gfc_match_select_type): Use the new function to replace inline
> > version and to build a new associate name for the case where
> > the supplied associate name is already used for that purpose.
> > * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
> > associate names with pointer function targets to be used in
> > variable definition context.
> > * trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
> > variables need deferred initialisation of the vptr.
> > (gfc_trans_deferred_vars): Do the vptr initialisation.
> > * trans-stmt.cc (trans_associate_var): Ensure that a pointer
> > associate name points to the target of the selector and not
> > the selector itself.
> >
> > gcc/testsuite/
> > PR fortran/87477
> > PR fortran/107900
> > * gfortran.dg/pr107900.f90 : New test
> >
> > PR fortran/110224
> > * gfortran.dg/pr110224.f90 : New test
> >
> > PR fortran/88688
> > * gfortran.dg/pr88688.f90 : New test
> >
> > PR fortran/94380
> > * gfortran.dg/pr94380.f90 : New test
> >
> > PR fortran/95398
> > * gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
> > numbers in the error tests by two and change the text in two.
>


-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Steve Kargl]

On Wed, Jun 21, 2023 at 05:12:22PM +0100, Paul Richard Thomas wrote:
> Committed as r14-2022-g577223aebc7acdd31e62b33c1682fe54a622ae27
> 
> Thanks for the help and the review Harald. Thanks to Steve too for
> picking up Neil Carlson's bugs.
> 

It's only natural.  You fix bugs in a long desired feature,
and people will start to use that feature more. 

I always look at Neil's bug reports.  They're typically
concise code snippets and have cross references to the
Fortran standard.  Unfortunately, I lack the ability to
fix them. :( 

-- 
Steve

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Harald Anlauf]

Hi Paul,

while I only had a minor question regarding gfc_is_ptr_fcn(),
can you still try to enlighten me why that second part
was necessary?  (I believed it to be redundant and may have
overlooked the obvious.)

Cheers,
Harald

On 6/21/23 18:12, Paul Richard Thomas via Gcc-patches wrote:
> Committed as r14-2022-g577223aebc7acdd31e62b33c1682fe54a622ae27
>
> Thanks for the help and the review Harald. Thanks to Steve too for
> picking up Neil Carlson's bugs.
>
> Cheers
>
> Paul
>
> On Tue, 20 Jun 2023 at 22:57, Harald Anlauf <anlauf@gmx.de> wrote:
>>
>> Hi Paul,
>>
>> On 6/20/23 12:54, Paul Richard Thomas via Gcc-patches wrote:
>>> Hi Harald,
>>>
>>> Fixing the original testcase in this PR turned out to be slightly more
>>> involved than I expected. However, it resulted in an open door to fix
>>> some other PRs and the attached much larger patch.
>>>
>>> This time, I did remember to include the testcases in the .diff :-)
>>
>> indeed! :-)
>>
>> I've only had a superficial look so far although it looks very good.
>> (I have to trust your experience with unlimited polymorphism.)
>>
>> However, I was wondering about the following helper function:
>>
>> +bool
>> +gfc_is_ptr_fcn (gfc_expr *e)
>> +{
>> +  return e != NULL && e->expr_type == EXPR_FUNCTION
>> +             && (gfc_expr_attr (e).pointer
>> +                 || (e->ts.type == BT_CLASS
>> +                     && CLASS_DATA (e)->attr.class_pointer));
>> +}
>> +
>> +
>>    /* Copy a shape array.  */
>>
>> Is there a case where gfc_expr_attr (e).pointer returns false
>> and you really need the || part?  Looking at gfc_expr_attr
>> and the present context, it might just not be necessary.
>>
>>> I believe that, between the Change.Logs and the comments, it is
>>> reasonably self-explanatory.
>>>
>>> OK for trunk?
>>
>> OK from my side.
>>
>> Thanks for the patch!
>>
>> Harald
>>
>>> Regards
>>>
>>> Paul
>>>
>>> Fortran: Fix some bugs in associate [PR87477]
>>>
>>> 2023-06-20  Paul Thomas  <pault@gcc.gnu.org>
>>>
>>> gcc/fortran
>>> PR fortran/87477
>>> PR fortran/88688
>>> PR fortran/94380
>>> PR fortran/107900
>>> PR fortran/110224
>>> * decl.cc (char_len_param_value): Fix memory leak.
>>> (resolve_block_construct): Remove unnecessary static decls.
>>> * expr.cc (gfc_is_ptr_fcn): New function.
>>> (gfc_check_vardef_context): Use it to permit pointer function
>>> result selectors to be used for associate names in variable
>>> definition context.
>>> * gfortran.h: Prototype for gfc_is_ptr_fcn.
>>> * match.cc (build_associate_name): New function.
>>> (gfc_match_select_type): Use the new function to replace inline
>>> version and to build a new associate name for the case where
>>> the supplied associate name is already used for that purpose.
>>> * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
>>> associate names with pointer function targets to be used in
>>> variable definition context.
>>> * trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
>>> variables need deferred initialisation of the vptr.
>>> (gfc_trans_deferred_vars): Do the vptr initialisation.
>>> * trans-stmt.cc (trans_associate_var): Ensure that a pointer
>>> associate name points to the target of the selector and not
>>> the selector itself.
>>>
>>> gcc/testsuite/
>>> PR fortran/87477
>>> PR fortran/107900
>>> * gfortran.dg/pr107900.f90 : New test
>>>
>>> PR fortran/110224
>>> * gfortran.dg/pr110224.f90 : New test
>>>
>>> PR fortran/88688
>>> * gfortran.dg/pr88688.f90 : New test
>>>
>>> PR fortran/94380
>>> * gfortran.dg/pr94380.f90 : New test
>>>
>>> PR fortran/95398
>>> * gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
>>> numbers in the error tests by two and change the text in two.
>>
>
>

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Harald Anlauf]

Hi Paul,

while I only had a minor question regarding gfc_is_ptr_fcn(),
can you still try to enlighten me why that second part
was necessary?  (I believed it to be redundant and may have
overlooked the obvious.)

Cheers,
Harald

On 6/21/23 18:12, Paul Richard Thomas via Gcc-patches wrote:
> Committed as r14-2022-g577223aebc7acdd31e62b33c1682fe54a622ae27
> 
> Thanks for the help and the review Harald. Thanks to Steve too for
> picking up Neil Carlson's bugs.
> 
> Cheers
> 
> Paul
> 
> On Tue, 20 Jun 2023 at 22:57, Harald Anlauf <anlauf@gmx.de> wrote:
>>
>> Hi Paul,
>>
>> On 6/20/23 12:54, Paul Richard Thomas via Gcc-patches wrote:
>>> Hi Harald,
>>>
>>> Fixing the original testcase in this PR turned out to be slightly more
>>> involved than I expected. However, it resulted in an open door to fix
>>> some other PRs and the attached much larger patch.
>>>
>>> This time, I did remember to include the testcases in the .diff :-)
>>
>> indeed! :-)
>>
>> I've only had a superficial look so far although it looks very good.
>> (I have to trust your experience with unlimited polymorphism.)
>>
>> However, I was wondering about the following helper function:
>>
>> +bool
>> +gfc_is_ptr_fcn (gfc_expr *e)
>> +{
>> +  return e != NULL && e->expr_type == EXPR_FUNCTION
>> +             && (gfc_expr_attr (e).pointer
>> +                 || (e->ts.type == BT_CLASS
>> +                     && CLASS_DATA (e)->attr.class_pointer));
>> +}
>> +
>> +
>>    /* Copy a shape array.  */
>>
>> Is there a case where gfc_expr_attr (e).pointer returns false
>> and you really need the || part?  Looking at gfc_expr_attr
>> and the present context, it might just not be necessary.
>>
>>> I believe that, between the Change.Logs and the comments, it is
>>> reasonably self-explanatory.
>>>
>>> OK for trunk?
>>
>> OK from my side.
>>
>> Thanks for the patch!
>>
>> Harald
>>
>>> Regards
>>>
>>> Paul
>>>
>>> Fortran: Fix some bugs in associate [PR87477]
>>>
>>> 2023-06-20  Paul Thomas  <pault@gcc.gnu.org>
>>>
>>> gcc/fortran
>>> PR fortran/87477
>>> PR fortran/88688
>>> PR fortran/94380
>>> PR fortran/107900
>>> PR fortran/110224
>>> * decl.cc (char_len_param_value): Fix memory leak.
>>> (resolve_block_construct): Remove unnecessary static decls.
>>> * expr.cc (gfc_is_ptr_fcn): New function.
>>> (gfc_check_vardef_context): Use it to permit pointer function
>>> result selectors to be used for associate names in variable
>>> definition context.
>>> * gfortran.h: Prototype for gfc_is_ptr_fcn.
>>> * match.cc (build_associate_name): New function.
>>> (gfc_match_select_type): Use the new function to replace inline
>>> version and to build a new associate name for the case where
>>> the supplied associate name is already used for that purpose.
>>> * resolve.cc (resolve_assoc_var): Call gfc_is_ptr_fcn to allow
>>> associate names with pointer function targets to be used in
>>> variable definition context.
>>> * trans-decl.cc (gfc_get_symbol_decl): Unlimited polymorphic
>>> variables need deferred initialisation of the vptr.
>>> (gfc_trans_deferred_vars): Do the vptr initialisation.
>>> * trans-stmt.cc (trans_associate_var): Ensure that a pointer
>>> associate name points to the target of the selector and not
>>> the selector itself.
>>>
>>> gcc/testsuite/
>>> PR fortran/87477
>>> PR fortran/107900
>>> * gfortran.dg/pr107900.f90 : New test
>>>
>>> PR fortran/110224
>>> * gfortran.dg/pr110224.f90 : New test
>>>
>>> PR fortran/88688
>>> * gfortran.dg/pr88688.f90 : New test
>>>
>>> PR fortran/94380
>>> * gfortran.dg/pr94380.f90 : New test
>>>
>>> PR fortran/95398
>>> * gfortran.dg/pr95398.f90 : Set -std=f2008, bump the line
>>> numbers in the error tests by two and change the text in two.
>>
> 
> 

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Bernhard Reutner-Fischer]

Hi!

First of all, many thanks for the patch!
If i may, i have a question concerning the chosen style in the error
message and one nitpick concerning a return type though, the latter
primarily prompting this reply.

On Tue, 20 Jun 2023 11:54:25 +0100
Paul Richard Thomas via Fortran <fortran@gcc.gnu.org> wrote:

> diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
> index d5cfbe0cc55..c960dfeabd9 100644
> --- a/gcc/fortran/expr.cc
> +++ b/gcc/fortran/expr.cc

> @@ -6470,6 +6480,22 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
>  	    }
>  	  return false;
>  	}
> +      else if (context && gfc_is_ptr_fcn (assoc->target))
> +	{
> +	  if (!gfc_notify_std (GFC_STD_F2018, "%qs at %L associated to "
> +			       "pointer function target being used in a "
> +			       "variable definition context (%s)", name,
> +			       &e->where, context))

I'm curious why you decided to put context in braces and not simply use
quotes as per %qs?

> +	    return false;
> +	  else if (gfc_has_vector_index (e))
> +	    {
> +	      gfc_error ("%qs at %L associated to vector-indexed target"
> +			 " cannot be used in a variable definition"
> +			 " context (%s)",
> +			 name, &e->where, context);

Ditto.

> diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
> index e7be7fddc64..0e4b5440393 100644
> --- a/gcc/fortran/match.cc
> +++ b/gcc/fortran/match.cc
> @@ -6377,6 +6377,39 @@ build_class_sym:
>  }
> 
> 
> +/* Build the associate name  */
> +static int
> +build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2)
> +{

> +    return 1;

> +  return 0;
> +}

I've gone through the frontend recently and changed several such
boolean functions to use bool where appropriate. May i ask folks to use
narrower types in new code, please?
Iff later in the pipeline it is considered appropriate or benefical to
promote types, these will eventually be promoted.

> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> index e6a4337c0d2..18589e17843 100644
> --- a/gcc/fortran/trans-decl.cc
> +++ b/gcc/fortran/trans-decl.cc

> @@ -1906,6 +1915,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
>  	gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL);
>      }
> 
> +

ISTM that the addition of vertical whitespace like here is in
contradiction with the coding style.

Please kindly excuse my comment and, again, thanks!

>    gfc_finish_var_decl (decl, sym);
> 
>    if (sym->ts.type == BT_CHARACTER)

Re: [Patch, fortran] PR107900 Select type with intrinsic type inside associate causes ICE / Segmenation fault

[Paul Richard Thomas]

Hi Both,

> while I only had a minor question regarding gfc_is_ptr_fcn(),
> can you still try to enlighten me why that second part
> was necessary?  (I believed it to be redundant and may have
> overlooked the obvious.)

Blast! I forgot about checking that. Lurking in the back of my mind
and going back to the first days of OOP in gfortran is a distinction
between a class entity with the pointer attribute and one whose data
component has the class_pointer attribute. I'll check it out and do
whatever is needed.


> > +      else if (context && gfc_is_ptr_fcn (assoc->target))
> > +     {
> > +       if (!gfc_notify_std (GFC_STD_F2018, "%qs at %L associated to "
> > +                            "pointer function target being used in a "
> > +                            "variable definition context (%s)", name,
> > +                            &e->where, context))
>
> I'm curious why you decided to put context in braces and not simply use
> quotes as per %qs?

That's the way it's done in the preceding errors. I had to keep the
context in context, so to speak.

> > +/* Build the associate name  */
> > +static int
> > +build_associate_name (const char *name, gfc_expr **e1, gfc_expr **e2)
> > +{
>
> > +    return 1;
>
> > +  return 0;
> > +}
>
> I've gone through the frontend recently and changed several such
> boolean functions to use bool where appropriate. May i ask folks to use
> narrower types in new code, please?
> Iff later in the pipeline it is considered appropriate or benefical to
> promote types, these will eventually be promoted.
>
> > diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> > index e6a4337c0d2..18589e17843 100644
> > --- a/gcc/fortran/trans-decl.cc
> > +++ b/gcc/fortran/trans-decl.cc
>
> > @@ -1906,6 +1915,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
> >       gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL);
> >      }
> >
> > +
>

'twas accidental. There had previously been another version of the fix
that I commented out and the extra line crept in when I deleted it.
Thanks for the spot.

>
> Please kindly excuse my comment and, again, thanks!
>
> >    gfc_finish_var_decl (decl, sym);
> >
> >    if (sym->ts.type == BT_CHARACTER)

Regards

Paul