Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 143 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/assumed_rank_bounds_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/assumed_rank_bounds_1.f90
new file mode 100644
index 000000000..11d15f6a5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/assumed_rank_bounds_1.f90
@@ -0,0 +1,143 @@
+! { dg-do run }
+!
+! Test the behaviour of lbound, ubound of shape with assumed rank arguments
+! in an array context (without DIM argument).
+!
+
+program test
+
+  integer              :: a(2:4,-2:5)
+  integer, allocatable :: b(:,:)
+  integer, pointer     :: c(:,:)
+  character(52)        :: buffer
+
+  call foo(a)
+
+  allocate(b(2:4,-2:5))
+  call foo(b)
+  call bar(b)
+
+  allocate(c(2:4,-2:5))
+  call foo(c)
+  call baz(c)
+
+contains
+  subroutine foo(arg)
+    integer :: arg(..)
+
+    !print *, lbound(arg)
+    !print *, id(lbound(arg))
+    if (any(lbound(arg) /= [1, 1])) call abort
+    if (any(id(lbound(arg)) /= [1, 1])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) lbound(arg)
+    if (buffer /= '           1           1') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(lbound(arg))
+    if (buffer /= '           1           1') call abort
+
+    !print *, ubound(arg)
+    !print *, id(ubound(arg))
+    if (any(ubound(arg) /= [3, 8])) call abort
+    if (any(id(ubound(arg)) /= [3, 8])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) ubound(arg)
+    if (buffer /= '           3           8') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(ubound(arg))
+    if (buffer /= '           3           8') call abort
+
+    !print *, shape(arg)
+    !print *, id(shape(arg))
+    if (any(shape(arg) /= [3, 8])) call abort
+    if (any(id(shape(arg)) /= [3, 8])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) shape(arg)
+    if (buffer /= '           3           8') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(shape(arg))
+    if (buffer /= '           3           8') call abort
+
+  end subroutine foo
+  subroutine bar(arg)
+    integer, allocatable :: arg(:,:)
+
+    !print *, lbound(arg)
+    !print *, id(lbound(arg))
+    if (any(lbound(arg) /= [2, -2])) call abort
+    if (any(id(lbound(arg)) /= [2, -2])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) lbound(arg)
+    if (buffer /= '           2          -2') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(lbound(arg))
+    if (buffer /= '           2          -2') call abort
+
+    !print *, ubound(arg)
+    !print *, id(ubound(arg))
+    if (any(ubound(arg) /= [4, 5])) call abort
+    if (any(id(ubound(arg)) /= [4, 5])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) ubound(arg)
+    if (buffer /= '           4           5') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(ubound(arg))
+    if (buffer /= '           4           5') call abort
+
+    !print *, shape(arg)
+    !print *, id(shape(arg))
+    if (any(shape(arg) /= [3, 8])) call abort
+    if (any(id(shape(arg)) /= [3, 8])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) shape(arg)
+    if (buffer /= '           3           8') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(shape(arg))
+    if (buffer /= '           3           8') call abort
+
+  end subroutine bar
+  subroutine baz(arg)
+    integer, pointer :: arg(..)
+
+    !print *, lbound(arg)
+    !print *, id(lbound(arg))
+    if (any(lbound(arg) /= [2, -2])) call abort
+    if (any(id(lbound(arg)) /= [2, -2])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) lbound(arg)
+    if (buffer /= '           2          -2') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(lbound(arg))
+    if (buffer /= '           2          -2') call abort
+
+    !print *, ubound(arg)
+    !print *, id(ubound(arg))
+    if (any(ubound(arg) /= [4, 5])) call abort
+    if (any(id(ubound(arg)) /= [4, 5])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) ubound(arg)
+    if (buffer /= '           4           5') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(ubound(arg))
+    if (buffer /= '           4           5') call abort
+
+    !print *, shape(arg)
+    !print *, id(shape(arg))
+    if (any(shape(arg) /= [3, 8])) call abort
+    if (any(id(shape(arg)) /= [3, 8])) call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) shape(arg)
+    if (buffer /= '           3           8') call abort
+    buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
+    write(buffer,*) id(shape(arg))
+    if (buffer /= '           3           8') call abort
+
+  end subroutine baz
+  elemental function id(arg)
+    integer, intent(in) :: arg
+    integer             :: id
+
+    id = arg
+  end function id
+end program test
+