diff gcc/testsuite/gfortran.dg/pr69739.f90 @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/pr69739.f90	Thu Oct 25 07:37:49 2018 +0900
@@ -0,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])) STOP 1
+end