public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-1629] Fortran: Fix some more blockers in associate meta-bug [PR87477]
@ 2023-06-08 6:11 Paul Thomas
0 siblings, 0 replies; only message in thread
From: Paul Thomas @ 2023-06-08 6:11 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d08f2e4f74583e27002368989bba197f8eb7f6d2
commit r14-1629-gd08f2e4f74583e27002368989bba197f8eb7f6d2
Author: Paul Thomas <pault@gcc.gnu.org>
Date: Thu Jun 8 07:11:32 2023 +0100
Fortran: Fix some more blockers in associate meta-bug [PR87477]
2023-06-08 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/87477
PR fortran/99350
PR fortran/107821
PR fortran/109451
* 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'.
(resolve_variable): Associate names with constant or structure
constructor targets cannot have array refs.
* 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/107821
* gfortran.dg/associate_5.f03 : Changed error message.
* gfortran.dg/pr107821.f90 : New test.
PR fortran/109451
* gfortran.dg/associate_61.f90 : New test
Diff:
---
gcc/fortran/decl.cc | 9 ++---
gcc/fortran/gfortran.h | 3 --
gcc/fortran/resolve.cc | 15 ++++++---
gcc/fortran/trans-array.cc | 12 ++++++-
gcc/fortran/trans-io.cc | 4 +++
gcc/fortran/trans-stmt.cc | 6 ++--
gcc/testsuite/gfortran.dg/associate_5.f03 | 2 +-
gcc/testsuite/gfortran.dg/associate_61.f90 | 54 ++++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/pr107821.f90 | 9 +++++
gcc/testsuite/gfortran.dg/pr99350.f90 | 16 +++++++++
10 files changed, 113 insertions(+), 17 deletions(-)
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 33ca4986f69..a58c60e9828 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2922,9 +2922,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 fd059dddf05..50b49d0cb83 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)
diff --git a/gcc/testsuite/gfortran.dg/associate_61.f90 b/gcc/testsuite/gfortran.dg/associate_61.f90
new file mode 100644
index 00000000000..da5528834d7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_61.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+! Test fixes for PR109451
+! Contributed by Harald Anlauf <anlauf@gcc.gnu.org>
+!
+program p
+ implicit none
+ character(4) :: c(2) = ["abcd","efgh"]
+ call dcs3 (c)
+ call dcs0 (c)
+contains
+ subroutine dcs3 (a)
+ character(len=*), intent(in) :: a(:)
+ character(:), allocatable :: b(:)
+ b = a(:)
+ call test (b, a, 1)
+ associate (q => b(:)) ! no ICE but print repeated first element
+ call test (q, a, 2)
+ print *, q ! Checked with dg-output
+ q = q(:)(2:3)
+ end associate
+ call test (b, ["bc ","fg "], 4)
+ b = a(:)
+ associate (q => b(:)(:)) ! ICE
+ call test (q, a, 3)
+ associate (r => q(:)(1:3))
+ call test (r, a(:)(1:3), 5)
+ end associate
+ end associate
+ associate (q => b(:)(2:3))
+ call test (q, a(:)(2:3), 6)
+ end associate
+ end subroutine dcs3
+
+! The associate vars in dsc0 had string length not set
+ subroutine dcs0 (a)
+ character(len=*), intent(in) :: a(:)
+ associate (q => a)
+ call test (q, a, 7)
+ end associate
+ associate (q => a(:))
+ call test (q, a, 8)
+ end associate
+ associate (q => a(:)(:))
+ call test (q, a, 9)
+ end associate
+ end subroutine dcs0
+
+ subroutine test (x, y, i)
+ character(len=*), intent(in) :: x(:), y(:)
+ integer, intent(in) :: i
+ if (any (x .ne. y)) stop i
+ end subroutine test
+end program p
+! { dg-output " abcdefgh" }
diff --git a/gcc/testsuite/gfortran.dg/pr107821.f90 b/gcc/testsuite/gfortran.dg/pr107821.f90
new file mode 100644
index 00000000000..5d86997d91f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107821.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+!
+! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
+!
+program p
+ associate (a => 1)
+ print *, [character((a(1))) :: '1'] ! { dg-error "has an array reference" }
+ end associate
+end
diff --git a/gcc/testsuite/gfortran.dg/pr99350.f90 b/gcc/testsuite/gfortran.dg/pr99350.f90
new file mode 100644
index 00000000000..7f751b9fdcc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr99350.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
+!
+program p
+ type t
+ character(:), pointer :: a
+ end type
+ type(t) :: z
+ character((0.)/0), target :: c = 'abc' ! { dg-error "Division by zero" }
+ z%a => c
+! The associate statement was not needed to trigger the ICE.
+ associate (y => z%a)
+ print *, y
+ end associate
+end
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-06-08 6:11 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-06-08 6:11 [gcc r14-1629] Fortran: Fix some more blockers in associate meta-bug [PR87477] Paul 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).