[Patch, fortran] PR69739 - [6/7/8 Regression] ICE during array result, allocatable assignment

[Patch, fortran] PR69739 - [6/7/8 Regression] ICE during array result, allocatable assignment

[Paul Richard Thomas]

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

Dear All,

This is a heads up that, in a few hours, I will apply a patch for
PR69739 as 'obvious' unless there are any objections in the mean time.

This regression dates back to the time, nearly seven years ago, when I
did some work on gfc_map_intrinsic_function. I couldn't figure out how
to deal with array valued ubound/lbound. I put in the
gcc_unreachable() to check if it caused any regressions and then I
forgot about it.

Return false means that all the symbol substitutions are made and the
expression gets converted as is.

John reported this boo-boo in February 2016 but I missed it until
Dominique brought it to my attention. I apologise for leaving this
rather embarrassing 'feature'.

Cheers and thanks, Dominique.

Paul

 2017-11-06  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/69739
    * trans-expr.c (gfc_map_intrinsic_function): Return false for
    bounds without the DIM argument instead of ICEing.

2017-11-06  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/69739
    * gfortran.dg/pr69739.f90: New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 1937 bytes --]

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 254427)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_map_intrinsic_function (gfc_expr *ex
*** 4178,4186 ****
        if (arg2 && arg2->expr_type == EXPR_CONSTANT)
  	d = mpz_get_si (arg2->value.integer) - 1;
        else
! 	/* TODO: If the need arises, this could produce an array of
! 	   ubound/lbounds.  */
! 	gcc_unreachable ();
  
        if (expr->value.function.isym->id == GFC_ISYM_LBOUND)
  	{
--- 4178,4184 ----
        if (arg2 && arg2->expr_type == EXPR_CONSTANT)
  	d = mpz_get_si (arg2->value.integer) - 1;
        else
! 	return false;
  
        if (expr->value.function.isym->id == GFC_ISYM_LBOUND)
  	{
Index: gcc/testsuite/gfortran.dg/pr69739.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pr69739.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/pr69739.f90	(working copy)
***************
*** 0 ****
--- 1,39 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR69739 in which the statement
+ ! R = operate(A, X) caused an ICE.
+ !
+ ! Contributed by John  <jwmwalrus@gmail.com>
+ !
+ module test
+ 
+   implicit none
+   type, public :: sometype
+     real :: a    =  0.
+   end type
+ contains
+ 
+   function dosomething(A) result(r)
+     type(sometype), intent(IN) :: A(:,:,:)
+     integer :: N
+     real, allocatable ::   R(:), X(:)
+ 
+     N = PRODUCT(UBOUND(A))
+     allocate (R(N),X(N))
+     X = [(real(N), N = 1, size(X, 1))]
+     R = operate(A, X)
+   end function
+ 
+   function operate(A, X)
+     type(sometype), intent(IN) :: A(:,:,:)
+     real, intent(IN) :: X(:)
+     real :: operate(1:PRODUCT(UBOUND(A)))
+ 
+     operate = x
+   end function
+ end module test
+ 
+   use test
+   type(sometype) :: a(2, 2, 2)
+   if (any(int (dosomething(a)) .ne. [1,2,3,4,5,6])) call abort
+ end