public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, fortran] PR87477 - (associate) - [meta-bug] [F03] issues concerning the ASSOCIATE statement
@ 2023-06-07 16:10 Paul Richard Thomas
  2023-06-07 18:38 ` Harald Anlauf
  0 siblings, 1 reply; 6+ messages in thread
From: Paul Richard Thomas @ 2023-06-07 16:10 UTC (permalink / raw)
  To: fortran, gcc-patches

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

Hi All,

Three more fixes for PR87477. Please note that PR99350 was a blocker
but, as pointed out in comment #5 of the PR, this has nothing to do
with the associate construct.

All three fixes are straight forward and the .diff + ChangeLog suffice
to explain them. 'rankguessed' was made redundant by the last PR87477
fix.

Regtests on x86_64 - good for mainline?

Paul

Fortran: Fix some more blockers in associate meta-bug [PR87477]

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

gcc/fortran
PR fortran/99350
* decl.cc (char_len_param_value): Simplify a copy of the expr
and replace the original if there is no error.
* gfortran.h : Remove the redundant field 'rankguessed' from
'gfc_association_list'.
* resolve.cc (resolve_assoc_var): Remove refs to 'rankguessed'.

PR fortran/107281
* resolve.cc (resolve_variable): Associate names with constant
or structure constructor targets cannot have array refs.

PR fortran/109451
* trans-array.cc (gfc_conv_expr_descriptor): Guard expression
character length backend decl before using it. Suppress the
assignment if lhs equals rhs.
* trans-io.cc (gfc_trans_transfer): Scalarize transfer of
associate variables pointing to a variable. Add comment.
* trans-stmt.cc (trans_associate_var): Remove requirement that
the character length be deferred before assigning the value
returned by gfc_conv_expr_descriptor. Also, guard the backend
decl before testing with VAR_P.

gcc/testsuite/
PR fortran/99350
* gfortran.dg/pr99350.f90 : New test.

PR fortran/107281
* gfortran.dg/associate_5.f03 : Changed error message.
* gfortran.dg/pr107281.f90 : New test.

PR fortran/109451
* gfortran.dg/associate_61.f90 : New test

[-- Attachment #2: pr109451.diff --]
[-- Type: text/x-patch, Size: 6188 bytes --]

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index f5d39e2a3d8..d09c8bc97d9 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1056,6 +1056,7 @@ static match
 char_len_param_value (gfc_expr **expr, bool *deferred)
 {
   match m;
+  gfc_expr *p;
 
   *expr = NULL;
   *deferred = false;
@@ -1081,10 +1082,10 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
   if (!gfc_expr_check_typed (*expr, gfc_current_ns, false))
     return MATCH_ERROR;
 
-  /* If gfortran gets an EXPR_OP, try to simplify it.  This catches things
-     like CHARACTER(([1])).   */
-  if ((*expr)->expr_type == EXPR_OP)
-    gfc_simplify_expr (*expr, 1);
+  /* Try to simplify the expression to catch things like CHARACTER(([1])).   */
+  p = gfc_copy_expr (*expr);
+  if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
+    gfc_replace_expr (*expr, p);
 
   if ((*expr)->expr_type == EXPR_FUNCTION)
     {
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3e5f942d7fd..a65dd571591 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2914,9 +2914,6 @@ typedef struct gfc_association_list
      for memory handling.  */
   unsigned dangling:1;
 
-  /* True when the rank of the target expression is guessed during parsing.  */
-  unsigned rankguessed:1;
-
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symtree *st; /* Symtree corresponding to name.  */
   locus where;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 2ba3101f1fe..f2604314570 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5872,7 +5872,15 @@ resolve_variable (gfc_expr *e)
       if (sym->ts.type == BT_CLASS)
 	gfc_fix_class_refs (e);
       if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
-	return false;
+	{
+	  /* Unambiguously scalar!  */
+	  if (sym->assoc->target
+	      && (sym->assoc->target->expr_type == EXPR_CONSTANT
+		  || sym->assoc->target->expr_type == EXPR_STRUCTURE))
+	    gfc_error ("Scalar variable %qs has an array reference at %L",
+		       sym->name, &e->where);
+	  return false;
+	}
       else if (sym->attr.dimension && (!e->ref || e->ref->type != REF_ARRAY))
 	{
 	  /* This can happen because the parser did not detect that the
@@ -9279,7 +9287,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
       gfc_array_spec *as;
       /* The rank may be incorrectly guessed at parsing, therefore make sure
 	 it is corrected now.  */
-      if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed))
+      if (sym->ts.type != BT_CLASS && !sym->as)
 	{
 	  if (!sym->as)
 	    sym->as = gfc_get_array_spec ();
@@ -9292,8 +9300,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	    sym->attr.codimension = 1;
 	}
       else if (sym->ts.type == BT_CLASS
-	       && CLASS_DATA (sym)
-	       && (!CLASS_DATA (sym)->as || sym->assoc->rankguessed))
+	       && CLASS_DATA (sym) && !CLASS_DATA (sym)->as)
 	{
 	  if (!CLASS_DATA (sym)->as)
 	    CLASS_DATA (sym)->as = gfc_get_array_spec ();
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1c7ea900ea1..e1c75e9fe02 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7934,7 +7934,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  else
 	    tmp = se->string_length;
 
-	  if (expr->ts.deferred && VAR_P (expr->ts.u.cl->backend_decl))
+	  if (expr->ts.deferred && expr->ts.u.cl->backend_decl
+	      && VAR_P (expr->ts.u.cl->backend_decl))
 	    gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp);
 	  else
 	    expr->ts.u.cl->backend_decl = tmp;
@@ -7999,6 +8000,15 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	    }
 	}
 
+      if (expr->ts.type == BT_CHARACTER
+	  && VAR_P (TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (parm)))))
+	{
+	  tree elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (parm)));
+	  gfc_add_modify (&loop.pre, elem_len,
+			  fold_convert (TREE_TYPE (elem_len),
+			  gfc_get_array_span (desc, expr)));
+	}
+
       /* Set the span field.  */
       tmp = NULL_TREE;
       if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 0c0e3332778..e36ad0e3db4 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2620,9 +2620,13 @@ gfc_trans_transfer (gfc_code * code)
 	  gcc_assert (ref && ref->type == REF_ARRAY);
 	}
 
+      /* These expressions don't always have the dtype element length set
+	 correctly, rendering them useless for array transfer.  */
       if (expr->ts.type != BT_CLASS
 	 && expr->expr_type == EXPR_VARIABLE
 	 && ((expr->symtree->n.sym->ts.type == BT_DERIVED && expr->ts.deferred)
+	     || (expr->symtree->n.sym->assoc
+		 && expr->symtree->n.sym->assoc->variable)
 	     || gfc_expr_attr (expr).pointer))
 	goto scalarize;
 
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index b5b82941b41..dcabeca0078 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1930,15 +1930,13 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       gfc_conv_expr_descriptor (&se, e);
 
       if (sym->ts.type == BT_CHARACTER
-	  && sym->ts.deferred
 	  && !sym->attr.select_type_temporary
+	  && sym->ts.u.cl->backend_decl
 	  && VAR_P (sym->ts.u.cl->backend_decl)
 	  && se.string_length != sym->ts.u.cl->backend_decl)
-	{
-	  gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
+	gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
 			  fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
 					se.string_length));
-	}
 
       /* If we didn't already do the pointer assignment, set associate-name
 	 descriptor to the one generated for the temporary.  */
diff --git a/gcc/testsuite/gfortran.dg/associate_5.f03 b/gcc/testsuite/gfortran.dg/associate_5.f03
index 64345d323f3..c91f88f4e12 100644
--- a/gcc/testsuite/gfortran.dg/associate_5.f03
+++ b/gcc/testsuite/gfortran.dg/associate_5.f03
@@ -11,7 +11,7 @@ PROGRAM main
   INTEGER, POINTER :: ptr
 
   ASSOCIATE (a => 5) ! { dg-error "is used as array" }
-    PRINT *, a(3)
+    PRINT *, a(3) ! { dg-error "has an array reference" }
   END ASSOCIATE
 
   ASSOCIATE (a => nontarget)

^ permalink raw reply	[flat|nested] 6+ messages in thread
end of thread, other threads:[~2023-06-08  9:12 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-06-07 16:10 [Patch, fortran] PR87477 - (associate) - [meta-bug] [F03] issues concerning the ASSOCIATE statement Paul Richard Thomas
2023-06-07 18:38 ` Harald Anlauf
2023-06-08  5:57   ` Paul Richard Thomas
2023-06-08  7:46     ` Mikael Morin
2023-06-08  8:30       ` Harald Anlauf
2023-06-08  9:11         ` Paul Richard Thomas

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