Patchwork [fortran] PR 49074 ICE on defined assignment with class arrays.

login
register
mail settings
Submitter Mikael Morin
Date June 12, 2013, 8:38 p.m.
Message ID <51B8DC30.9020100@sfr.fr>
Download mbox | patch
Permalink /patch/250878/
State New
Headers show

Comments

Mikael Morin - June 12, 2013, 8:38 p.m.
Hello,

this is a fix for PR49074, where the temporary created by
gfc_conv_elemental_dependencies was leading to an ICE because it didn't
have the array reference expected by the scalarization code.

There was a bypass in gfc_conv_procedure_call avoiding exactly this
problem, but it is not reached when polymorphic entities are involved.
To avoid duplicating that, the patch proposed here adds support for null
references in gfc_conv_variable and removes the gfc_conv_procedure_call
bypass.  The patch also removes a useless reference walk in
gfc_conv_variable.

The test is the PR's; it's a runtime test as this area of the compiler
doesn't get much coverage from the test-suite.

Regression tested on x86_64-unknown-linux-gnu. OK for trunk?

Mikael
2013-06-12  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/49074
	* trans-expr.c (gfc_conv_variable): Don't walk the reference chain.
	Handle NULL references.
	(gfc_conv_procedure_call): Remove code handling NULL references.

2013-06-12  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/49074
	* gfortran.dg/typebound_assignment_5.f03: New.
! { dg-do run }
!
! PR fortran/49074
! ICE on defined assignment with class arrays.

      module foo
        type bar
          integer :: i

          contains

          generic :: assignment (=) => assgn_bar
          procedure, private :: assgn_bar
        end type bar

        contains

        elemental subroutine assgn_bar (a, b)
          class (bar), intent (inout) :: a
          class (bar), intent (in) :: b

          select type (b)
          type is (bar)
            a%i = b%i
          end select

          return
        end subroutine assgn_bar
      end module foo

      program main
        use foo

        type (bar), allocatable :: foobar(:)

        allocate (foobar(2))
        foobar = [bar(1), bar(2)]
        if (any(foobar%i /= [1, 2])) call abort
      end program
Tobias Burnus - June 12, 2013, 9 p.m.
Hello Mikael,

Mikael Morin wrote:
> Regression tested on x86_64-unknown-linux-gnu. OK for trunk?

OK - looks good to me. The test case is also nice and a bit tricky, I 
tried it with three compilers: Two segfaulted at run time and only one 
passed the test.

Tobias

Patch

diff --git a/trans-expr.c b/trans-expr.c
index 9d07345..bd8886c 100644
--- a/trans-expr.c
+++ b/trans-expr.c
@@ -1761,9 +1761,12 @@  gfc_conv_variable (gfc_se * se, gfc_expr * expr)
       /* A scalarized term.  We already know the descriptor.  */
       se->expr = ss_info->data.array.descriptor;
       se->string_length = ss_info->string_length;
-      for (ref = ss_info->data.array.ref; ref; ref = ref->next)
-	if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
-	  break;
+      ref = ss_info->data.array.ref;
+      if (ref)
+	gcc_assert (ref->type == REF_ARRAY
+		    && ref->u.ar.type != AR_ELEMENT);
+      else
+	gfc_conv_tmp_array_ref (se);
     }
   else
     {
@@ -4041,23 +4044,11 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  gfc_init_se (&parmse, se);
 	  parm_kind = ELEMENTAL;
 
-	  if (ss->dimen > 0 && e->expr_type == EXPR_VARIABLE
-	      && ss->info->data.array.ref == NULL)
-	    {
-	      gfc_conv_tmp_array_ref (&parmse);
-	      if (e->ts.type == BT_CHARACTER)
-		gfc_conv_string_parameter (&parmse);
-	      else
-		parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
-	    }
-	  else
-	    {
-	      gfc_conv_expr_reference (&parmse, e);
-	      if (e->ts.type == BT_CHARACTER && !e->rank
-		  && e->expr_type == EXPR_FUNCTION)
-		parmse.expr = build_fold_indirect_ref_loc (input_location,
-							   parmse.expr);
-	    }
+	  gfc_conv_expr_reference (&parmse, e);
+	  if (e->ts.type == BT_CHARACTER && !e->rank
+	      && e->expr_type == EXPR_FUNCTION)
+	    parmse.expr = build_fold_indirect_ref_loc (input_location,
+						       parmse.expr);
 
 	  if (fsym && fsym->ts.type == BT_DERIVED
 	      && gfc_is_class_container_ref (e))