public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [Patch, fortran] PR104625 ICE in fixup_array_ref, at fortran/resolve.cc:9275 since r10-2912-g70570ec192745095
@ 2023-10-26 17:14 Paul Richard Thomas
  2023-10-26 19:22 ` Harald Anlauf
  0 siblings, 1 reply; 2+ messages in thread
From: Paul Richard Thomas @ 2023-10-26 17:14 UTC (permalink / raw)
  To: fortran, gcc-patches, Harald Anlauf


[-- Attachment #1.1: Type: text/plain, Size: 1528 bytes --]

Hi All,

The attached patch fixes the original problem, in which parentheses around
the selector in select type constructs caused ICES. Stacked parentheses
caused problems in trans-stmt.cc. Rather than tracking this down, the
redundant parentheses were removed on resolution of the selector
expression.

Fixing the primary problem revealed "Unclassifiable statement" errors when
using array references of the associate variable and this was fixed as
well. Finally, the error triggered by using associate variables associated
with non-variable selectors was corrected to ensure that only vector
indexed selectors were flagged up as such. The secondary error in
associate_55.f90 was corrected for this, since the selector might or might
not be vector indexed.

Regtests fine - OK for trunk?

Paul

Fortran: Fix some problems with SELECT TYPE selectors [PR104625].

2023-10-26  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/104625
* expr.cc (gfc_check_vardef_context): Check that the target
does have a vector index before emitting the specific error.
* match.cc (copy_ts_from_selector_to_associate): Ensure that
class valued operator expressions set the selector rank and
use the rank to provide the associate variable with an
appropriate array spec.
* resolve.cc (resolve_operator): Reduce stacked parentheses to
a single pair.
(fixup_array_ref): Extract selector symbol from parentheses.

gcc/testsuite/
PR fortran/104625
* gfortran.dg/pr104625.f90: New test.
* gfortran.dg/associate_55.f90: Change error check text.

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

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 663fe63dea6..c668baeef8c 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -6474,7 +6474,8 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	{
 	  if (context)
 	    {
-	      if (assoc->target->expr_type == EXPR_VARIABLE)
+	      if (assoc->target->expr_type == EXPR_VARIABLE
+		  && gfc_has_vector_index (assoc->target))
 		gfc_error ("%qs at %L associated to vector-indexed target"
 			   " cannot be used in a variable definition"
 			   " context (%s)",
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index c926f38058f..05995c6f97f 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6341,12 +6341,13 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
   else if (selector->ts.type == BT_CLASS
 	   && CLASS_DATA (selector)
 	   && CLASS_DATA (selector)->as
-	   && ref && ref->type == REF_ARRAY)
+	   && ((ref && ref->type == REF_ARRAY)
+	       || selector->expr_type == EXPR_OP))
     {
       /* Ensure that the array reference type is set.  We cannot use
 	 gfc_resolve_expr at this point, so the usable parts of
 	 resolve.cc(resolve_array_ref) are employed to do it.  */
-      if (ref->u.ar.type == AR_UNKNOWN)
+      if (ref && ref->u.ar.type == AR_UNKNOWN)
 	{
 	  ref->u.ar.type = AR_ELEMENT;
 	  for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
@@ -6360,7 +6361,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
 	      }
 	}
 
-      if (ref->u.ar.type == AR_FULL)
+      if (!ref || ref->u.ar.type == AR_FULL)
 	selector->rank = CLASS_DATA (selector)->as->rank;
       else if (ref->u.ar.type == AR_SECTION)
 	selector->rank = ref->u.ar.dimen;
@@ -6372,12 +6373,15 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector)
 
   if (rank)
     {
-      for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
-	if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT
-	    || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
-		&& ref->u.ar.end[i] == NULL
-		&& ref->u.ar.stride[i] == NULL))
-	  rank--;
+      if (ref)
+	{
+	  for (int i = 0; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
+	    if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT
+	      || (ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
+		  && ref->u.ar.end[i] == NULL
+		  && ref->u.ar.stride[i] == NULL))
+	      rank--;
+	}
 
       if (rank)
 	{
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 861f69ac20f..9f4dc072645 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -4138,6 +4138,16 @@ resolve_operator (gfc_expr *e)
   bool dual_locus_error;
   bool t = true;
 
+  /* Reduce stacked parentheses to single pair  */
+  while (e->expr_type == EXPR_OP
+	 && e->value.op.op == INTRINSIC_PARENTHESES
+	 && e->value.op.op1->expr_type == EXPR_OP
+	 && e->value.op.op1->value.op.op == INTRINSIC_PARENTHESES)
+    {
+      gfc_expr *tmp = gfc_copy_expr (e->value.op.op1);
+      gfc_replace_expr (e, tmp);
+    }
+
   /* Resolve all subnodes-- give them types.  */
 
   switch (e->value.op.op)
@@ -9451,8 +9461,25 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2,
 {
   gfc_ref *nref = (*expr1)->ref;
   gfc_symbol *sym1 = (*expr1)->symtree->n.sym;
-  gfc_symbol *sym2 = expr2 ? expr2->symtree->n.sym : NULL;
+  gfc_symbol *sym2;
+  gfc_expr *selector = gfc_copy_expr (expr2);
+
   (*expr1)->rank = rank;
+  if (selector)
+    {
+      gfc_resolve_expr (selector);
+      if (selector->expr_type == EXPR_OP
+	  && selector->value.op.op == INTRINSIC_PARENTHESES)
+	sym2 = selector->value.op.op1->symtree->n.sym;
+      else if (selector->expr_type == EXPR_VARIABLE
+	       || selector->expr_type == EXPR_FUNCTION)
+	sym2 = selector->symtree->n.sym;
+      else
+	gcc_unreachable ();
+    }
+  else
+    sym2 = NULL;
+
   if (sym1->ts.type == BT_CLASS)
     {
       if ((*expr1)->ts.type != BT_CLASS)
diff --git a/gcc/testsuite/gfortran.dg/associate_55.f90 b/gcc/testsuite/gfortran.dg/associate_55.f90
index 2b9e8c727f9..245dbfc7218 100644
--- a/gcc/testsuite/gfortran.dg/associate_55.f90
+++ b/gcc/testsuite/gfortran.dg/associate_55.f90
@@ -26,7 +26,7 @@ contains
     class(test_t), intent(inout) :: obj
     integer, intent(in) :: a
     associate (state => obj%state(TEST_STATES)) ! { dg-error "no IMPLICIT type" }
-      state = a                                 ! { dg-error "vector-indexed target" }
+      state = a  ! { dg-error "cannot be used in a variable definition context" }
 !      state(TEST_STATE) = a
     end associate
   end subroutine test_alter_state2

[-- Attachment #3: pr104625.f90 --]
[-- Type: text/x-fortran, Size: 988 bytes --]

! { dg-do compile }
!
! Check the fix for PR104625 in which the selectors in parentheses used
! to cause ICEs. The "Unclassifiable statement" errors were uncovered once
! the ICEs were fixed.
!
program p
  implicit none
  type t
     integer :: a
  end type
contains
  subroutine s(x)
!   class(t) :: x          ! Was OK
    class(t) :: x(:)       ! Used to ICE in combination with below
    class(t), allocatable :: r(:)

    select type (y =>  x)  ! OK
      type is (t)
        y%a = 99
    end select
    select type (z => (x))  ! Used to ICE
      type is (t)
        r = z(1)            ! Used to give "Unclassifiable statement" error
        z%a = 99            ! { dg-error "cannot be used in a variable definition" }
    end select
    select type (u => ((x))) ! Used to ICE
      type is (t)
        r = u(1)            ! Used to give "Unclassifiable statement" error
        u%a = 99            ! { dg-error "cannot be used in a variable definition" }
    end select
  end
end

^ permalink raw reply	[flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-10-26 19:22 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-10-26 17:14 [Patch, fortran] PR104625 ICE in fixup_array_ref, at fortran/resolve.cc:9275 since r10-2912-g70570ec192745095 Paul Richard Thomas
2023-10-26 19:22 ` Harald Anlauf

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