1! { dg-do run } 2! 3! PR fortran/52151 4! 5! Check that the bounds/shape/strides are correctly set 6! for (re)alloc on assignment, if the LHS is either not 7! allocated or has the wrong shape. This test is for 8! code which is only invoked for libgfortran intrinsic 9! such as RESHAPE. 10! 11! Based on the example of PR 52117 by Steven Hirshman 12! 13 PROGRAM RESHAPEIT 14 call unalloc () 15 call wrong_shape () 16 contains 17 subroutine unalloc () 18 INTEGER, PARAMETER :: n1=2, n2=2, n3=2 19 INTEGER :: m1, m2, m3, lc 20 REAL, ALLOCATABLE :: A(:,:), B(:,:,:) 21 REAL :: val 22 23 ALLOCATE (A(n1,n2*n3)) 24! << B is not allocated 25 26 val = 0 27 lc = 0 28 DO m3=1,n3 29 DO m2=1,n2 30 lc = lc+1 31 DO m1=1,n1 32 val = val+1 33 A(m1, lc) = val 34 END DO 35 END DO 36 END DO 37 38 B = RESHAPE(A, [n1,n2,n3]) 39 40 if (any (shape (B) /= [n1,n2,n3])) call abort () 41 if (any (ubound (B) /= [n1,n2,n3])) call abort () 42 if (any (lbound (B) /= [1,1,1])) call abort () 43 44 lc = 0 45 DO m3=1,n3 46 DO m2=1,n2 47 lc = lc+1 48 DO m1=1,n1 49! PRINT *,'A(',m1,',',lc,') = ',A(m1,lc),' B = ',B(m1,m2,m3) 50 if (A(m1,lc) /= B(m1,m2,m3)) call abort () 51 END DO 52 END DO 53 END DO 54 DEALLOCATE(A, B) 55 end subroutine unalloc 56 57 subroutine wrong_shape () 58 INTEGER, PARAMETER :: n1=2, n2=2, n3=2 59 INTEGER :: m1, m2, m3, lc 60 REAL, ALLOCATABLE :: A(:,:), B(:,:,:) 61 REAL :: val 62 63 ALLOCATE (A(n1,n2*n3)) 64 ALLOCATE (B(1,1,1)) ! << shape differs from RHS 65 66 val = 0 67 lc = 0 68 DO m3=1,n3 69 DO m2=1,n2 70 lc = lc+1 71 DO m1=1,n1 72 val = val+1 73 A(m1, lc) = val 74 END DO 75 END DO 76 END DO 77 78 B = RESHAPE(A, [n1,n2,n3]) 79 80 if (any (shape (B) /= [n1,n2,n3])) call abort () 81 if (any (ubound (B) /= [n1,n2,n3])) call abort () 82 if (any (lbound (B) /= [1,1,1])) call abort () 83 84 lc = 0 85 DO m3=1,n3 86 DO m2=1,n2 87 lc = lc+1 88 DO m1=1,n1 89! PRINT *,'A(',m1,',',lc,') = ',A(m1,lc),' B = ',B(m1,m2,m3) 90 if (A(m1,lc) /= B(m1,m2,m3)) call abort () 91 END DO 92 END DO 93 END DO 94 DEALLOCATE(A, B) 95 end subroutine wrong_shape 96 END PROGRAM RESHAPEIT 97