[4.9] GCC 4.9.0 official release refresh

Change-Id: Ic99a7da8b44b789a48aeec93b33e93944d6e6767

10 files changed, 244 insertions, 13 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_13.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_13.f90
new file mode 100644
index 000000000..92a856bc8
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/arrayio_13.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR60810 Bogus end-of-file
+program readstrlist
+  character(len=80), dimension(2) :: ver
+  integer :: a, b, c
+  a = 1
+  b = 2
+  c = 3
+  ver(1) = '285 383'
+  ver(2) = '985'
+  read( ver, *) a, b, c
+  if (a /= 285 .or. b /= 383 .or. c /= 985) call abort
+  !write ( *, *) a, b, c
+end
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/associate_15.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/associate_15.f90
new file mode 100644
index 000000000..7e34eb518
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/associate_15.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! Test the fix for PR58085, where the offset for 'x' was set to zero,
+! rather than -1.
+!
+! Contributed by Vladimir Fuka  <vladimir.fuka@gmail.com>
+!
+module foo
+contains
+  function bar (arg) result (res)
+    integer arg, res(3)
+    res = [arg, arg+1, arg +2]
+  end function
+end module
+  use foo
+  real d(3,3)
+  integer a,b,c
+  character(48) line1, line2
+  associate (x=>shape(d))
+    a = x(1)
+    b = x(2)
+    write (line1, *) a, b
+    write (line2, *) x
+    if (trim (line1) .ne. trim (line2)) call abort
+  end associate
+  associate (x=>[1,2])
+    a = x(1)
+    b = x(2)
+    write (line1, *) a, b
+    write (line2, *) x
+    if (trim (line1) .ne. trim (line2)) call abort
+  end associate
+  associate (x=>bar(5)) ! make sure that we haven't broken function association
+    a = x(1)
+    b = x(2)
+    c = x(3)
+    write (line1, *) a, b, c
+    write (line2, *) x
+    if (trim (line1) .ne. trim (line2)) call abort
+  end associate
+end
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/class_nameclash.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/class_nameclash.f90
new file mode 100644
index 000000000..227d86596
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/class_nameclash.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! try to provoke class name clashes in gfc_build_class_symbol
+!
+module test_module
+
+  implicit none
+
+  type, public :: test_p
+    private
+    class (test_p), pointer :: next => null()
+  end type test_p
+
+  type, public :: test
+!   Error in "call do_it (x)" below:
+!   Type mismatch in argument 'x' at (1); passed CLASS(test_p) to CLASS(test)
+    class (test), pointer :: next => null()
+  end type test
+
+contains
+
+  subroutine do_it (x)
+    class (test_p), target :: x
+
+    x%next => x
+    return
+  end subroutine do_it
+
+end module test_module
+
+use test_module
+
+  implicit none
+  class (test_p), pointer :: x
+
+  allocate (x)
+  call do_it (x)
+  deallocate (x)
+end
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_24.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_24.f90
new file mode 100644
index 000000000..2a218584a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_24.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/58880
+!
+! Contributed by Andrew Benson
+!
+
+module gn
+  type sl
+     integer, allocatable, dimension(:) :: lv
+   contains
+     final :: sld
+  end type sl
+  type :: nde
+     type(sl) :: r
+  end type nde
+contains
+  subroutine ndm(s)
+    type(nde), intent(inout) :: s
+    type(nde)                :: i    
+    i=s
+  end subroutine ndm
+  subroutine sld(s)
+    implicit none
+    type(sl), intent(inout) :: s
+    return
+  end subroutine sld
+end module gn
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/fmt_en.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/fmt_en.f90
index 7d9c8aa61..4c5b72123 100644
--- a/gcc-4.9/gcc/testsuite/gfortran.dg/fmt_en.f90
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/fmt_en.f90
@@ -7,8 +7,8 @@ use ISO_FORTRAN_ENV
     integer, parameter :: j(size(real_kinds)+4)=[REAL_KINDS, [4, 4, 4, 4]]
     logical :: l_skip(4) = .false.
     integer :: i
-    integer :: n_tst = 0, n_cnt = 0
-    character(len=20) :: s
+    integer :: n_tst = 0, n_cnt = 0, n_skip = 0
+    character(len=20) :: s, s1
 
     open (unit = 10, file = 'fmt_en.res')
 !   Check that the default rounding mode is to nearest and to even on tie.
@@ -17,22 +17,30 @@ use ISO_FORTRAN_ENV
         write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(1)), &
                                   real(9.49999905,kind=j(1)),  &
                                   real(9.5,kind=j(1)), real(8.5,kind=j(1))
+        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(1)), &
+                                       real(98765.0,kind=j(1))
       else if (i == 2) then
         write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(2)), &
                                   real(9.49999905,kind=j(2)),  &
                                   real(9.5,kind=j(2)), real(8.5,kind=j(2))
+        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(2)), &
+                                       real(98765.0,kind=j(2))
       else if (i == 3) then
         write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(3)), &
                                   real(9.49999905,kind=j(3)),  &
                                   real(9.5,kind=j(3)), real(8.5,kind=j(3))
+        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(3)), &
+                                       real(98765.0,kind=j(3))
       else if (i == 4) then
         write(s, '(2F4.1,2F4.0)') real(-9.49999905,kind=j(4)), &
                                   real(9.49999905,kind=j(4)),  &
                                   real(9.5,kind=j(4)), real(8.5,kind=j(4))
+        write(s1, '(3PE10.3,2PE10.3)') real(987350.,kind=j(4)), &
+                                       real(98765.0,kind=j(4))
       end if
-      if (s /= '-9.5 9.5 10.  8.') then
+      if (s /= '-9.5 9.5 10.  8.' .or. s1 /= ' 987.4E+03 98.76E+03') then
         l_skip(i) = .true.
-        print "('Unsupported rounding for real(',i0,')')", j(i)
+!        print "('Unsupported rounding for real(',i0,')')", j(i)
       end if
     end do
         
@@ -139,7 +147,7 @@ use ISO_FORTRAN_ENV
     call checkfmt("(en15.3)", -9.765625E-04,"   -976.562E-06")
     call checkfmt("(en15.6)", -2.9296875E-03,"  -2.929688E-03")
 
-    !print *, n_tst, n_cnt
+    ! print *, n_tst, n_cnt, n_skip
     if (n_cnt /= 0) call abort
     if (all(.not. l_skip)) write (10, *) "All kinds rounded to nearest"
     close (10)
@@ -152,7 +160,6 @@ contains
         real, intent(in) :: x
         character(len=*), intent(in) :: cmp
         do i=1,size(real_kinds)
-          if (l_skip(i)) cycle
           if (i == 1) then
             write(s, fmt) real(x,kind=j(1))
           else if (i == 2) then
@@ -164,12 +171,16 @@ contains
           end if
           n_tst = n_tst + 1
           if (s /= cmp) then
-             print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
-             n_cnt = n_cnt + 1
-           end if
+            if (l_skip(i)) then
+              n_skip = n_skip + 1
+            else
+              print "(a,1x,a,' expected: ',1x,a)", fmt, s, cmp
+              n_cnt = n_cnt + 1
+            end if
+          end if
         end do
         
     end subroutine
 end program
-! { dg-final { scan-file fmt_en.res "All kinds rounded to nearest" { xfail i?86-*-solaris2.9* } } }
+! { dg-final { scan-file fmt_en.res "All kinds rounded to nearest" { xfail { i?86-*-solaris2.9* hppa*-*-hpux* } } } }
 ! { dg-final { cleanup-saved-temps } }
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/lto/pr60635_0.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/lto/pr60635_0.f90
new file mode 100644
index 000000000..e12187985
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/lto/pr60635_0.f90
@@ -0,0 +1,16 @@
+! { dg-lto-do link }
+program test
+  use iso_fortran_env
+
+  interface
+    integer(int16) function bigendc16(x) bind(C)
+      import
+      integer(int16), intent(in) :: x
+    end function
+  end interface
+  
+  integer(int16) :: x16 = 12345
+  x16 = bigendc16(x16)
+  print *,x16
+end program
+
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/lto/pr60635_1.c b/gcc-4.9/gcc/testsuite/gfortran.dg/lto/pr60635_1.c
new file mode 100644
index 000000000..eddc569e6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/lto/pr60635_1.c
@@ -0,0 +1,14 @@
+#include <stdint.h>
+#include <stdbool.h>
+
+static bool littleendian=true;
+
+uint16_t bigendc16(union{uint16_t * n;uint8_t* b;}x){
+
+    if (!littleendian) return *x.n;
+
+    uint16_t res = ((uint16_t)(x.b[1])<<0) |
+	((uint16_t)(x.b[0])<<8);
+    return res;
+}
+
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/unlimited_polymorphic_17.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/unlimited_polymorphic_17.f90
new file mode 100644
index 000000000..0fcff74b9
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/unlimited_polymorphic_17.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! Tests fix for PR60717 in which offsets in recursive calls below
+! were not being set correctly.
+!
+! Reported on comp.lang.fortran by Thomas Schnurrenberger
+!
+module m
+  implicit none
+  real :: chksum0 = 0, chksum1 = 0, chksum2 = 0
+contains
+  recursive subroutine show_real(a)
+    real, intent(in) :: a(:)
+    if (size (a) > 0) then
+      chksum0 = a(1) + chksum0
+      call show_real (a(2:))
+    end if
+    return
+  end subroutine show_real
+  recursive subroutine show_generic1(a)
+    class(*), intent(in) :: a(:)
+    if (size (a) > 0) then
+      select type (a)
+      type is (real)
+        chksum1 = a(1) + chksum1
+      end select
+      call show_generic1 (a(2:)) ! recursive call outside SELECT TYPE
+    end if
+    return
+  end subroutine show_generic1
+  recursive subroutine show_generic2(a)
+    class(*), intent(in) :: a(:)
+    if (size (a) > 0) then
+      select type (a)
+      type is (real)
+        chksum2 = a(1) + chksum2
+        call show_generic2 (a(2:)) ! recursive call inside SELECT TYPE
+      end select
+    end if
+    return
+  end subroutine show_generic2
+end module m
+program test
+  use :: m
+  implicit none
+  real :: array(1:6) = (/ 0, 1, 2, 3, 4, 5 /)
+  call show_real (array)
+  call show_generic1 (array)
+  call show_generic2 (array)
+  if (chksum0 .ne. chksum1) call abort
+  if (chksum0 .ne. chksum2) call abort
+end program test
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/warn_conversion_4.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/warn_conversion_4.f90
index f911741f5..3d1b12582 100644
--- a/gcc-4.9/gcc/testsuite/gfortran.dg/warn_conversion_4.f90
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/warn_conversion_4.f90
@@ -11,8 +11,8 @@ contains
   subroutine test
     integer :: x
     x = int (abs (cmplx(2.3,0.1)))
-    x = int (abs (cmplx(2.3_dp,0.1))) ! { dg-warning "Conversion from REAL.8. to default-kind COMPLEX.4. at .1. might loose precision, consider using the KIND argument" }
-    x = int (abs (cmplx(2.3,0.1_dp))) ! { dg-warning "Conversion from REAL.8. to default-kind COMPLEX.4. at .1. might loose precision, consider using the KIND argument" }
-    x = int (abs (cmplx(2.3_dp,0.1_dp))) ! { dg-warning "Conversion from REAL.8. to default-kind COMPLEX.4. at .1. might loose precision, consider using the KIND argument" }
+    x = int (abs (cmplx(2.3_dp,0.1))) ! { dg-warning "Conversion from REAL.8. to default-kind COMPLEX.4. at .1. might lose precision, consider using the KIND argument" }
+    x = int (abs (cmplx(2.3,0.1_dp))) ! { dg-warning "Conversion from REAL.8. to default-kind COMPLEX.4. at .1. might lose precision, consider using the KIND argument" }
+    x = int (abs (cmplx(2.3_dp,0.1_dp))) ! { dg-warning "Conversion from REAL.8. to default-kind COMPLEX.4. at .1. might lose precision, consider using the KIND argument" }
   end subroutine test
 end module fft_mod
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/where_4.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/where_4.f90
new file mode 100644
index 000000000..1ff2e4ca3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/where_4.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR 60522 - this used to ICE.
+! Original test case Roger Ferrer Ibanez
+subroutine foo(a, b)
+   implicit none
+   integer, dimension(:), intent(inout) :: a
+   integer, dimension(:), intent(in) :: b
+
+   where (b(:) > 0)
+      where (b(:) > 100)
+         a(lbound(a, 1):ubound(a, 1)) = b(lbound(b, 1):ubound(b, 1)) * b(lbound(b, 1):ubound(b, 1)) - 100
+      elsewhere
+         a(lbound(a, 1):ubound(a, 1)) = b(lbound(b, 1):ubound(b, 1)) * b(lbound(b, 1):ubound(b, 1))
+      end where
+   elsewhere
+      a(lbound(a, 1):ubound(a, 1)) = - b(lbound(b, 1):ubound(b, 1)) * b(lbound(b, 1):ubound(b, 1))
+   end where
+end subroutine foo