diff options
Diffstat (limited to 'gcc-4.8/gcc/testsuite/gfortran.dg')
38 files changed, 1050 insertions, 2 deletions
diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/allocate_class_3.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/allocate_class_3.f90 new file mode 100644 index 000000000..ddc7e2328 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/allocate_class_3.f90 @@ -0,0 +1,107 @@ +! { dg-do run } +! Tests the fix for PR59414, comment #3, in which the allocate +! expressions were not correctly being stripped to provide the +! vpointer as an lhs to the pointer assignment of the vptr from +! the SOURCE expression. +! +! Contributed by Antony Lewis <antony@cosmologist.info> +! +module ObjectLists + implicit none + + type :: t + integer :: i + end type + + type Object_array_pointer + class(t), pointer :: p(:) + end type + +contains + + subroutine AddArray1 (P, Pt) + class(t) :: P(:) + class(Object_array_pointer) :: Pt + + select type (Pt) + class is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:SIZE(P)), source=P) + end select + end subroutine + + subroutine AddArray2 (P, Pt) + class(t) :: P(:) + class(Object_array_pointer) :: Pt + + select type (Pt) + type is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:SIZE(P)), source=P) + end select + end subroutine + + subroutine AddArray3 (P, Pt) + class(t) :: P + class(Object_array_pointer) :: Pt + + select type (Pt) + class is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:4), source=P) + end select + end subroutine + + subroutine AddArray4 (P, Pt) + type(t) :: P(:) + class(Object_array_pointer) :: Pt + + select type (Pt) + class is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:SIZE(P)), source=P) + end select + end subroutine +end module + + use ObjectLists + type(Object_array_pointer), pointer :: Pt + class(t), pointer :: P(:) + + allocate (P(2), source = [t(1),t(2)]) + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray1 (P, Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [1,2])) call abort + end select + deallocate (P) + deallocate (pt) + + allocate (P(3), source = [t(3),t(4),t(5)]) + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray2 (P, Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [3,4,5])) call abort + end select + deallocate (P) + deallocate (pt) + + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray3 (t(6), Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [6,6,6,6])) call abort + end select + deallocate (pt) + + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray4 ([t(7), t(8)], Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [7,8])) call abort + end select + deallocate (pt) + end + diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/arrayio_13.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/arrayio_13.f90 new file mode 100644 index 000000000..92a856bc8 --- /dev/null +++ b/gcc-4.8/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.8/gcc/testsuite/gfortran.dg/constructor_9.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/constructor_9.f90 new file mode 100644 index 000000000..519670303 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/constructor_9.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-Wall" } +! +! PR 58471: [4.8/4.9 Regression] ICE on invalid with missing type constructor and -Wall +! +! Contributed by Andrew Benson <abensonca@gmail.com> + +module cf + implicit none + type :: cfmde + end type + interface cfmde + module procedure mdedc ! { dg-error "is neither function nor subroutine" } + end interface +contains + subroutine cfi() + type(cfmde), pointer :: cfd + cfd=cfmde() ! { dg-error "Can't convert" } + end subroutine +end module + +! { dg-final { cleanup-modules "cf" } } diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/default_initialization_7.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/default_initialization_7.f90 new file mode 100644 index 000000000..fc8be98b1 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/default_initialization_7.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! +! PR fortran/57033 +! ICE on a structure constructor of an extended derived type whose parent +! type last component has a default initializer +! +! Contributed by Tilo Schwarz <tilo@tilo-schwarz.de> + +program ice + +type m + integer i + logical :: f = .false. +end type m + +type, extends(m) :: me +end type me + +type(me) meo + +meo = me(1) ! ICE +end program ice diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/derived_external_function_1.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/derived_external_function_1.f90 new file mode 100644 index 000000000..7421c4c0f --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/derived_external_function_1.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! +! PR fortran/58771 +! +! Contributed by Vittorio Secca <zeccav@gmail.com> +! +! ICEd on the write statement with f() because the derived type backend +! declaration not built. +! +module m + type t + integer(4) g + end type +end + +type(t) function f() result(ff) + use m + ff%g = 42 +end + + use m + character (20) :: line1, line2 + type(t) f + write (line1, *) f() + write (line2, *) 42_4 + if (line1 .ne. line2) call abort +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90 new file mode 100644 index 000000000..d37e1f6a9 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90 @@ -0,0 +1,74 @@ +! { dg-do run } +! +! PR 59654: [4.8/4.9 Regression] [OOP] Broken function table with complex OO use case +! +! Contributed by Thomas Clune <Thomas.L.Clune@nasa.gov> + +module TestResult_mod + implicit none + + type TestResult + integer :: numRun = 0 + contains + procedure :: run + procedure, nopass :: getNumRun + end type + +contains + + subroutine run (this) + class (TestResult) :: this + this%numRun = this%numRun + 1 + end subroutine + + subroutine getNumRun() + end subroutine + +end module + + +module BaseTestRunner_mod + implicit none + + type :: BaseTestRunner + contains + procedure, nopass :: norun + end type + +contains + + function norun () result(result) + use TestResult_mod, only: TestResult + type (TestResult) :: result + end function + +end module + + +module TestRunner_mod + use BaseTestRunner_mod, only: BaseTestRunner + implicit none +end module + + +program main + use TestRunner_mod, only: BaseTestRunner + use TestResult_mod, only: TestResult + implicit none + + type (TestResult) :: result + + call runtest (result) + +contains + + subroutine runtest (result) + use TestResult_mod, only: TestResult + class (TestResult) :: result + call result%run() + if (result%numRun /= 1) call abort() + end subroutine + +end + +! { dg-final { cleanup-modules "TestResult_mod BaseTestRunner_mod TestRunner_mod" } } diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/elemental_subroutine_9.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/elemental_subroutine_9.f90 new file mode 100644 index 000000000..8f574bf59 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/elemental_subroutine_9.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! +! PR fortran/59906 +! +! Contributed by H Anlauf <anlauf@gmx.de> +! +! Failed generate character scalar for scalarized loop for elemantal call. +! +program x + implicit none + call y('bbb') +contains + + subroutine y(str) + character(len=*), intent(in) :: str + character(len=len_trim(str)) :: str_aux + character(len=3) :: str3 = 'abc' + + str_aux = str + + ! Compiled but did not give correct result + if (any (str_cmp((/'aaa','bbb'/), str) .neqv. [.FALSE.,.TRUE.])) call abort + + ! Did not compile + if (any (str_cmp((/'bbb', 'aaa'/), str_aux) .neqv. [.TRUE.,.FALSE.])) call abort + + ! Verify patch + if (any (str_cmp((/'bbb', 'aaa'/), str3) .neqv. [.FALSE.,.FALSE.])) call abort + if (any (str_cmp((/'bbb', 'aaa'/), 'aaa') .neqv. [.FALSE.,.TRUE.])) call abort + + end subroutine y + + elemental logical function str_cmp(str1, str2) + character(len=*), intent(in) :: str1 + character(len=*), intent(in) :: str2 + str_cmp = (str1 == str2) + end function str_cmp + +end program x diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/extends_15.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/extends_15.f90 new file mode 100644 index 000000000..06c31799a --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/extends_15.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! +! PR 58355: [4.7/4.8/4.9 Regression] [F03] ICE with TYPE, EXTENDS before parent TYPE defined +! +! Contributed by Andrew Benson <abensonca@gmail.com> + +module ct + public :: t1 + + type, extends(t1) :: t2 ! { dg-error "has not been previously defined" } + + type :: t1 + end type +end + +! { dg-final { cleanup-modules "ct" } } diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/fmt_en.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/fmt_en.f90 new file mode 100644 index 000000000..d0aed23d8 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/fmt_en.f90 @@ -0,0 +1,186 @@ +! { dg-do run { target fd_truncate } } +! PR60128 Invalid outputs with EN descriptors +! Test case provided by Walt Brainerd. +program pr60128 +use ISO_FORTRAN_ENV + implicit none + 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, 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. + do i=1,size(real_kinds) + if (i == 1) then + 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.' .or. s1 /= ' 987.4E+03 98.76E+03') then + l_skip(i) = .true. +! print "('Unsupported rounding for real(',i0,')')", j(i) + end if + end do + + +! Original test. + call checkfmt("(en15.2)", -.44444, " -444.44E-03") + +! Test for the bug in comment 6. + call checkfmt("(en15.0)", 1.0, " 1.E+00") + call checkfmt("(en15.0)", 1.00000012, " 1.E+00") + call checkfmt("(en15.0)", 0.99999994, " 1.E+00") + call checkfmt("(en15.0)", 10.0, " 10.E+00") + call checkfmt("(en15.0)", 10.0000010, " 10.E+00") + call checkfmt("(en15.0)", 9.99999905, " 10.E+00") + call checkfmt("(en15.0)", 100.0, " 100.E+00") + call checkfmt("(en15.0)", 100.000008, " 100.E+00") + call checkfmt("(en15.0)", 99.9999924, " 100.E+00") + call checkfmt("(en15.0)", 1000.0, " 1.E+03") + call checkfmt("(en15.0)", 1000.00006, " 1.E+03") + call checkfmt("(en15.0)", 999.999939, " 1.E+03") + call checkfmt("(en15.0)", 9.5, " 10.E+00") + call checkfmt("(en15.0)", 9.50000095, " 10.E+00") + call checkfmt("(en15.0)", 9.49999905, " 9.E+00") + call checkfmt("(en15.0)", 99.5, " 100.E+00") + call checkfmt("(en15.0)", 99.5000076, " 100.E+00") + call checkfmt("(en15.0)", 99.4999924, " 99.E+00") + call checkfmt("(en15.0)", 999.5, " 1.E+03") + call checkfmt("(en15.0)", 999.500061, " 1.E+03") + call checkfmt("(en15.0)", 999.499939, " 999.E+00") + call checkfmt("(en15.0)", 9500.0, " 10.E+03") + call checkfmt("(en15.0)", 9500.00098, " 10.E+03") + call checkfmt("(en15.0)", 9499.99902, " 9.E+03") + call checkfmt("(en15.1)", 9950.0, " 10.0E+03") + call checkfmt("(en15.2)", 9995.0, " 10.00E+03") + call checkfmt("(en15.3)", 9999.5, " 10.000E+03") + call checkfmt("(en15.1)", 9.5, " 9.5E+00") + call checkfmt("(en15.1)", 9.50000095, " 9.5E+00") + call checkfmt("(en15.1)", 9.49999905, " 9.5E+00") + call checkfmt("(en15.1)", 0.099951, " 100.0E-03") + call checkfmt("(en15.1)", 0.009951, " 10.0E-03") + call checkfmt("(en15.1)", 0.000999951," 1.0E-03") + + call checkfmt("(en15.0)", -1.0, " -1.E+00") + call checkfmt("(en15.0)", -1.00000012, " -1.E+00") + call checkfmt("(en15.0)", -0.99999994, " -1.E+00") + call checkfmt("(en15.0)", -10.0, " -10.E+00") + call checkfmt("(en15.0)", -10.0000010, " -10.E+00") + call checkfmt("(en15.0)", -9.99999905, " -10.E+00") + call checkfmt("(en15.0)", -100.0, " -100.E+00") + call checkfmt("(en15.0)", -100.000008, " -100.E+00") + call checkfmt("(en15.0)", -99.9999924, " -100.E+00") + call checkfmt("(en15.0)", -1000.0, " -1.E+03") + call checkfmt("(en15.0)", -1000.00006, " -1.E+03") + call checkfmt("(en15.0)", -999.999939, " -1.E+03") + call checkfmt("(en15.0)", -9.5, " -10.E+00") + call checkfmt("(en15.0)", -9.50000095, " -10.E+00") + call checkfmt("(en15.0)", -9.49999905, " -9.E+00") + call checkfmt("(en15.0)", -99.5, " -100.E+00") + call checkfmt("(en15.0)", -99.5000076, " -100.E+00") + call checkfmt("(en15.0)", -99.4999924, " -99.E+00") + call checkfmt("(en15.0)", -999.5, " -1.E+03") + call checkfmt("(en15.0)", -999.500061, " -1.E+03") + call checkfmt("(en15.0)", -999.499939, " -999.E+00") + call checkfmt("(en15.0)", -9500.0, " -10.E+03") + call checkfmt("(en15.0)", -9500.00098, " -10.E+03") + call checkfmt("(en15.0)", -9499.99902, " -9.E+03") + call checkfmt("(en15.1)", -9950.0, " -10.0E+03") + call checkfmt("(en15.2)", -9995.0, " -10.00E+03") + call checkfmt("(en15.3)", -9999.5, " -10.000E+03") + call checkfmt("(en15.1)", -9.5, " -9.5E+00") + call checkfmt("(en15.1)", -9.50000095, " -9.5E+00") + call checkfmt("(en15.1)", -9.49999905, " -9.5E+00") + call checkfmt("(en15.1)", -0.099951, " -100.0E-03") + call checkfmt("(en15.1)", -0.009951, " -10.0E-03") + call checkfmt("(en15.1)", -0.000999951," -1.0E-03") + + call checkfmt("(en15.1)", 987350., " 987.4E+03") + call checkfmt("(en15.2)", 98735., " 98.74E+03") + call checkfmt("(en15.3)", 9873.5, " 9.874E+03") + call checkfmt("(en15.1)", 987650., " 987.6E+03") + call checkfmt("(en15.2)", 98765., " 98.76E+03") + call checkfmt("(en15.3)", 9876.5, " 9.876E+03") + call checkfmt("(en15.1)", 3.125E-02, " 31.2E-03") + call checkfmt("(en15.1)", 9.375E-02, " 93.8E-03") + call checkfmt("(en15.2)", 1.5625E-02, " 15.62E-03") + call checkfmt("(en15.2)", 4.6875E-02, " 46.88E-03") + call checkfmt("(en15.3)", 7.8125E-03, " 7.812E-03") + call checkfmt("(en15.3)", 2.34375E-02, " 23.438E-03") + call checkfmt("(en15.3)", 9.765625E-04," 976.562E-06") + call checkfmt("(en15.6)", 2.9296875E-03," 2.929688E-03") + + call checkfmt("(en15.1)", -987350., " -987.4E+03") + call checkfmt("(en15.2)", -98735., " -98.74E+03") + call checkfmt("(en15.3)", -9873.5, " -9.874E+03") + call checkfmt("(en15.1)", -987650., " -987.6E+03") + call checkfmt("(en15.2)", -98765., " -98.76E+03") + call checkfmt("(en15.3)", -9876.5, " -9.876E+03") + call checkfmt("(en15.1)", -3.125E-02, " -31.2E-03") + call checkfmt("(en15.1)", -9.375E-02, " -93.8E-03") + call checkfmt("(en15.2)", -1.5625E-02, " -15.62E-03") + call checkfmt("(en15.2)", -4.6875E-02, " -46.88E-03") + call checkfmt("(en15.3)", -7.8125E-03, " -7.812E-03") + call checkfmt("(en15.3)", -2.34375E-02, " -23.438E-03") + 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, n_skip + if (n_cnt /= 0) call abort + if (all(.not. l_skip)) write (10, *) "All kinds rounded to nearest" + close (10) + +contains + subroutine checkfmt(fmt, x, cmp) + implicit none + integer :: i + character(len=*), intent(in) :: fmt + real, intent(in) :: x + character(len=*), intent(in) :: cmp + do i=1,size(real_kinds) + if (i == 1) then + write(s, fmt) real(x,kind=j(1)) + else if (i == 2) then + write(s, fmt) real(x,kind=j(2)) + else if (i == 3) then + write(s, fmt) real(x,kind=j(3)) + else if (i == 4) then + write(s, fmt) real(x,kind=j(4)) + end if + n_tst = n_tst + 1 + if (s /= cmp) then + 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* hppa*-*-hpux* } } } } +! { dg-final { cleanup-saved-temps } } diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/fmt_g_1.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/fmt_g_1.f90 new file mode 100644 index 000000000..715df0dfc --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/fmt_g_1.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! PR59771 Cleanup handling of Gw.0 and Gw.0Ee format +! Test case prepared by Dominique d'Humieres <dominiq@lps.ens.fr> + PROGRAM FOO + character(len=60) :: buffer, buffer1 + + write (buffer ,'(6(1X,1PG9.0e2))') 0.0, 0.04, 0.06, 0.4, 0.6, 243.0 + write (buffer1,'(6(1X,1PE9.0e2))') 0.0, 0.04, 0.06, 0.4, 0.6, 243.0 + + if (buffer /= buffer1) call abort + end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/generic_28.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/generic_28.f90 new file mode 100644 index 000000000..5ddc9798f --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/generic_28.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! +! PR 58998: [4.8/4.9 Regression] Generic interface problem with gfortran +! +! Contributed by Paul van Delst + + interface iargc + procedure iargc_8 + end interface + +contains + + integer(8) function iargc_8() + integer(4) iargc + iargc_8 = iargc() + end function + +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/gomp/pr59467.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/gomp/pr59467.f90 new file mode 100644 index 000000000..e69c9eb49 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/gomp/pr59467.f90 @@ -0,0 +1,24 @@ +! PR libgomp/59467 +! { dg-do compile } +! { dg-options "-fopenmp" } + FUNCTION t() + INTEGER :: a, b, t + a = 0 + b = 0 + !$OMP PARALLEL REDUCTION(+:b) + !$OMP SINGLE ! { dg-error "is not threadprivate or private in outer context" } + !$OMP ATOMIC WRITE + a = 6 + !$OMP END SINGLE COPYPRIVATE (a) + b = a + !$OMP END PARALLEL + t = b + b = 0 + !$OMP PARALLEL REDUCTION(+:b) + !$OMP SINGLE + !$OMP ATOMIC WRITE + b = 6 + !$OMP END SINGLE COPYPRIVATE (b) + !$OMP END PARALLEL + t = t + b + END FUNCTION diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/graphite/pr59817.f b/gcc-4.8/gcc/testsuite/gfortran.dg/graphite/pr59817.f new file mode 100644 index 000000000..a9ee8f19d --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/graphite/pr59817.f @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-options "-O2 -floop-interchange" } + SUBROUTINE PREPD(ICAST,ICAS,ICASX,ICAS1,ICAS2,NDET,NM,III,IMP, + * CASMIN) + LOGICAL CASMIN + DIMENSION ICAST(NDET,NM),IMP(NM) + IF(CASMIN) THEN + DO K=1,NDET + DO L=1,NM + IF(L.EQ.K-1) ICAST(K,L) = 1 + END DO + END DO + END IF + END SUBROUTINE diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/ichar_3.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/ichar_3.f90 new file mode 100644 index 000000000..d0f5c8b8c --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/ichar_3.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! +! PR fortran/59599 +! The call to ichar was triggering an ICE. +! +! Original testcase from Fran Martinez Fadrique <fmartinez@gmv.com> + +character(1) cpk(2) +integer res(2) +cpk = 'a' +res = ichar( cpk, kind=1 ) +print *, ichar( cpk, kind=1 ) +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/implicit_pure_4.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/implicit_pure_4.f90 new file mode 100644 index 000000000..8563dd721 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/implicit_pure_4.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! +! PR fortran/60543 +! PR fortran/60283 +! +module m +contains + REAL(8) FUNCTION random() + CALL RANDOM_NUMBER(random) + END FUNCTION random + REAL(8) FUNCTION random2() + block + block + block + CALL RANDOM_NUMBER(random2) + end block + end block + end block + END FUNCTION random2 +end module m + +! { dg-final { scan-module-absence "m" "IMPLICIT_PURE" } } diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/init_flag_12.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/init_flag_12.f90 new file mode 100644 index 000000000..5844398d5 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/init_flag_12.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-options "-fno-automatic -finit-local-zero" } +! +! PR 55907: [4.7/4.8/4.9 Regression] ICE with -fno-automatic -finit-local-zero +! +! Contributed by J.R. Garcia <garcia.espinosa.jr@gmail.com> + +subroutine cchaine (i) + implicit none + integer :: i + character(len=i) :: chaine + write(*,*) chaine +end subroutine diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/list_read_12.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/list_read_12.f90 new file mode 100644 index 000000000..811ef152a --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/list_read_12.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! PR58324 Bogus end of file condition +integer :: i, ios +open(99, access='stream', form='unformatted') +write(99) "5 a" +close(99) + +open(99, access='sequential', form='formatted') +read(99, *, iostat=ios) i +if (ios /= 0) call abort +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/lto/pr60635_0.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/lto/pr60635_0.f90 new file mode 100644 index 000000000..e12187985 --- /dev/null +++ b/gcc-4.8/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.8/gcc/testsuite/gfortran.dg/lto/pr60635_1.c b/gcc-4.8/gcc/testsuite/gfortran.dg/lto/pr60635_1.c new file mode 100644 index 000000000..eddc569e6 --- /dev/null +++ b/gcc-4.8/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.8/gcc/testsuite/gfortran.dg/nan_7.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/nan_7.f90 index 12c7b3ce4..4c2f62eea 100644 --- a/gcc-4.8/gcc/testsuite/gfortran.dg/nan_7.f90 +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/nan_7.f90 @@ -2,6 +2,7 @@ ! { dg-options "-fno-range-check" } ! { dg-require-effective-target fortran_real_16 } ! { dg-require-effective-target fortran_integer_16 } +! { dg-skip-if "" { "powerpc*le-*-*" } { "*" } { "" } } ! PR47293 NAN not correctly read character(len=200) :: str real(16) :: r diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/null_5.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/null_5.f90 index 886a6a1ff..50b41c3e8 100644 --- a/gcc-4.8/gcc/testsuite/gfortran.dg/null_5.f90 +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/null_5.f90 @@ -34,7 +34,7 @@ subroutine test_PR34547_1 () end subroutine test_PR34547_1 subroutine test_PR34547_2 () - print *, null () ! { dg-error "in data transfer statement requires MOLD" } + print *, null () ! { dg-error "Invalid context" } end subroutine test_PR34547_2 subroutine test_PR34547_3 () diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/null_6.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/null_6.f90 index dd517cfa3..6b8f21e63 100644 --- a/gcc-4.8/gcc/testsuite/gfortran.dg/null_6.f90 +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/null_6.f90 @@ -30,5 +30,5 @@ end subroutine test_PR50375_2 subroutine test_PR34547_3 () integer, allocatable :: i(:) - print *, NULL(i) + print *, NULL(i) ! { dg-error "Invalid context for NULL" } end subroutine test_PR34547_3 diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/optional_class_1.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/optional_class_1.f90 new file mode 100644 index 000000000..589fc6023 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/optional_class_1.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! +! PR fortran/57445 +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> +! +! Spurious assert was added at revision 192495 +! +module m + implicit none + type t + integer :: i + end type t +contains + subroutine opt(xa, xc, xaa, xca) + type(t), allocatable, intent(out), optional :: xa + class(t), allocatable, intent(out), optional :: xc + type(t), allocatable, intent(out), optional :: xaa(:) + class(t), allocatable, intent(out), optional :: xca(:) + if (present (xca)) call foo_opt(xca=xca) + end subroutine opt + subroutine foo_opt(xa, xc, xaa, xca) + type(t), allocatable, intent(out), optional :: xa + class(t), allocatable, intent(out), optional :: xc + type(t), allocatable, intent(out), optional :: xaa(:) + class(t), allocatable, intent(out), optional :: xca(:) + if (present (xca)) then + if (allocated (xca)) deallocate (xca) + allocate (xca(3), source = [t(9),t(99),t(999)]) + end if + end subroutine foo_opt +end module m + use m + class(t), allocatable :: xca(:) + allocate (xca(1), source = t(42)) + select type (xca) + type is (t) + if (any (xca%i .ne. [42])) call abort + end select + call opt (xca = xca) + select type (xca) + type is (t) + if (any (xca%i .ne. [9,99,999])) call abort + end select +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/pr52370.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/pr52370.f90 new file mode 100644 index 000000000..66a6fe2b8 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/pr52370.f90 @@ -0,0 +1,21 @@ +! PR fortran/52370 +! { dg-do compile } +! { dg-options "-O1 -Wall" } + +module pr52370 +contains + subroutine foo(a,b) + real, intent(out) :: a + real, dimension(:), optional, intent(out) :: b + a=0.5 + if (present(b)) then + b=1.0 + end if + end subroutine foo +end module pr52370 + +program prg52370 + use pr52370 + real :: a + call foo(a) +end program prg52370 diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/pr59700.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/pr59700.f90 new file mode 100644 index 000000000..579d8a48c --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/pr59700.f90 @@ -0,0 +1,40 @@ +! { dg-do run } +! PR59700 Test case by Steve Kargl +program foo + + implicit none + + character(len=80) msg + integer, parameter :: fd = 10 + integer i1, i2, i3, i4 + real x1, x2, x3, x4 + complex c1, c2 + logical a + + open(unit=fd, status='scratch') + write(fd, '(A)') '1 2 3.4 q' + + rewind(fd) + msg = 'ok' + read(fd, *, err=10, iomsg=msg) i1, i2, i3, i4 +10 if (msg /= 'Bad integer for item 3 in list input') call abort + rewind(fd) + msg = 'ok' + read(fd, *, err=20, iomsg=msg) x1, x2, x3, x4 +20 if (msg /= 'Bad real number in item 4 of list input') call abort + rewind(fd) + msg = 'ok' + read(fd, *, err=30, iomsg=msg) i1, x2, x1, a +30 if (msg /= 'Bad logical value while reading item 4') call abort + rewind(fd) + read(fd, *, err=31, iomsg=msg) i1, x2, a, x1 +31 if (msg /= 'Bad repeat count in item 3 of list input') call abort + close(fd) + open(unit=fd, status='scratch') + write(fd, '(A)') '(1, 2) (3.4, q)' + rewind(fd) + msg = 'ok' + read(fd, *, err=40, iomsg=msg) c1, c2 +40 if (msg /= 'Bad floating point number for item 2') call abort + close(fd) +end program foo diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_43.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_43.f90 new file mode 100644 index 000000000..b1f77a06e --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_43.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! PR 58099: [4.8/4.9 Regression] [F03] over-zealous procedure-pointer error checking +! +! Contributed by Daniel Price <daniel.price@monash.edu> + + implicit none + procedure(real), pointer :: wfunc + + wfunc => w_cubic + +contains + + pure real function w_cubic(q2) + real, intent(in) :: q2 + w_cubic = 0. + end function + +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_45.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_45.f90 new file mode 100644 index 000000000..a506473ad --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_45.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! +! PR fortran/49397 +! +! Valid per IR F08/0060 and F2008Corr2, C729 +! +Program m5 + Print *,f() +Contains + Subroutine s + Procedure(Real),Pointer :: p + Print *,g() + p => f ! (1) + Print *,p() + p => g ! (2) + Print *,p() + End Subroutine +End Program +Function f() + f = 1 +End Function +Function g() + g = 2 +End Function diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_46.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_46.f90 new file mode 100644 index 000000000..2c05f59d8 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_46.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! +! PR fortran/49397 +! +! Invalid per IR F08/0060 and F2008Corr2, C729 +! + +! Print *,f() ! << Valid when uncommented +Contains + Subroutine s + Procedure(Real),Pointer :: p + p => f ! { dg-error "Procedure pointer target 'f' at .1. must be either an intrinsic, host or use associated, referenced or have the EXTERNAL attribute" } + End Subroutine +End diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_comp_38.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_comp_38.f90 new file mode 100644 index 000000000..2a71ca052 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/proc_ptr_comp_38.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! +! PR fortran/58803 +! +! Contributed by Vittorio Zecca +! +! Was before ICEing due to a double free +! + type t + procedure(real), pointer, nopass :: f1, f2 + end type + end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/reshape_6.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/reshape_6.f90 new file mode 100644 index 000000000..149f31efe --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/reshape_6.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! PR fortran/58989 +! +program test + + real(8), dimension(4,4) :: fluxes + real(8), dimension(2,2,2,2) :: f + integer, dimension(3) :: dmmy + integer, parameter :: indx(4)=(/2,2,2,2/) + + fluxes = 1 + + dmmy = (/2,2,2/) + + f = reshape(fluxes,(/dmmy,2/)) ! Caused an ICE + f = reshape(fluxes,(/2,2,2,2/)) ! Works as expected + f = reshape(fluxes,indx) ! Works as expected + +end program test diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/round_3.f08 b/gcc-4.8/gcc/testsuite/gfortran.dg/round_3.f08 index 8b03ce562..62da1eae6 100644 --- a/gcc-4.8/gcc/testsuite/gfortran.dg/round_3.f08 +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/round_3.f08 @@ -16,8 +16,33 @@ program pr48615 call checkfmt("(RU,1P,G6.0E2)", 2.0, "2.E+00") call checkfmt("(RU,1P,G10.4E2)", 2.3456e5, "2.3456E+05") + call checkfmt("(RC,G10.2)", 99.5, " 0.10E+03") ! pr59774 + call checkfmt("(RC,G10.2)", 995., " 0.10E+04") ! pr59774 + call checkfmt("(RC,G10.3)", 999.5, " 0.100E+04") ! pr59774 + call checkfmt("(RC,G10.3)", 9995., " 0.100E+05") ! pr59774 + call checkfmt("(RU,G10.2)", .099, " 0.10 ") ! pr59774 + call checkfmt("(RC,G10.1)", .095, " 0.1 ") ! pr59774 + call checkfmt("(RU,G10.3)", .0999, " 0.100 ") ! pr59774 + call checkfmt("(RC,G10.2)", .0995, " 0.10 ") ! pr59774 + + call checkfmt("(RU,G9.3)", 891.1, " 892.") ! pr59836 + call checkfmt("(RD,G9.3)", -891.1, "-892.") ! pr59836 + + call checkfmt("(RU,F6.4)", 0.00006, "0.0001")! 0. + call checkfmt("(RU,F5.3)", 0.0007, "0.001") ! 0. + call checkfmt("(RU,F4.2)", 0.008, "0.01") ! 0. + call checkfmt("(RU,F3.1)", 0.09, "0.1") ! 0. + call checkfmt("(RU,F2.0)", 0.09, "1.") ! 0. call checkfmt("(RD,F3.0)", -0.09, "-1.") ! -0. + call checkfmt("(RU,F2.0)", 0.9, "1.") ! pr59836 + call checkfmt("(RC,F2.0)", 0.4, "0.") ! pr59836 + call checkfmt("(RC,F2.0)", 0.5, "1.") ! pr59836 + call checkfmt("(RC,F2.0)", 0.6, "1.") ! pr59836 + call checkfmt("(RD,F3.0)", -0.9, "-1.") ! pr59836 + call checkfmt("(RC,F3.0)", -0.4, "-0.") ! pr59836 + call checkfmt("(RC,F3.0)", -0.5, "-1.") ! pr59836 + call checkfmt("(RC,F3.0)", -0.6, "-1.") ! pr59836 call checkfmt("(RU,F2.0)", 2.0, "2.") ! 3. call checkfmt("(RD,F3.0)", -2.0, "-2.") ! -3. call checkfmt("(RU,F6.4)", 2.0, "2.0000") ! 2.0001 diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/shape_8.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/shape_8.f90 new file mode 100644 index 000000000..edeb5fd8e --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/shape_8.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! +! PR 60450: [4.7/4.8 Regression] ICE with SHAPE intrinsic +! +! Contributed by Dave Allured <dave.allured@noaa.gov> + + real, allocatable :: x(:,:) + allocate (x(3,2), source=99.) + print *, shape (x / 10.0) +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/str_comp_optimize_1.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/str_comp_optimize_1.f90 new file mode 100644 index 000000000..84287b475 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/str_comp_optimize_1.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! { dg-options "-ffrontend-optimize" } +! +! PR fortran/60341 +! An unguarded union access was wrongly enabling a frontend optimization on a +! string comparison, leading to an ICE. +! +! Original testcase from Steve Chapel <steve.chapel@a2pg.com>. +! Reduced by Steven G. Kargl <kargl@gcc.gnu.org>. +! + + subroutine modelg(ncm) + implicit none + integer, parameter :: pc = 30, pm = pc - 1 + integer i + character*4 catt(pm,2) + integer ncm,iatt(pm,pc) + do i=1,ncm + if (catt(i,1)//catt(i,2).eq.'central') exit + end do + iatt(i,4)=1 + end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/typebound_generic_15.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/typebound_generic_15.f90 new file mode 100644 index 000000000..f71ffd9e8 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/typebound_generic_15.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! +! PR 60231: [4.8/4.9 Regression] ICE on undefined generic +! +! Contributed by Antony Lewis <antony@cosmologist.info> + +module Objects + + Type TObjectList + contains + procedure :: Add1 ! { dg-error "must be a module procedure" } + procedure :: Add2 ! { dg-error "must be a module procedure" } + generic :: Add => Add1, Add2 ! { dg-error "are ambiguous" } + end Type + +end module + +! { dg-final { cleanup-modules "Objects" } } diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/unlimited_polymorphic_15.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/unlimited_polymorphic_15.f90 new file mode 100644 index 000000000..1dfebdce3 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/unlimited_polymorphic_15.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! +! PR 59493: [OOP] ICE: Segfault on Class(*) pointer association +! +! Contributed by Hossein Talebi <talebi.hossein@gmail.com> + + implicit none + + type ty_mytype1 + end type + + class(ty_mytype1), allocatable, target:: cla1 + class(*), pointer :: ptr + + ptr => cla1 + +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 new file mode 100644 index 000000000..07fbce3d5 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! +! PR fortran/58007 +! Unresolved fixup while loading a module. +! +! This tests that the specification expression A%MAX_DEGREE in module BSR is +! correctly loaded and resolved in program MAIN. +! +! Original testcase from Daniel Shapiro <shapero@uw.edu> +! Reduced by Tobias Burnus <burnus@net-b.de> and Janus Weil <janus@gcc.gnu.org> + +module matrix + type :: sparse_matrix + integer :: max_degree + end type +contains + subroutine init_interface (A) + class(sparse_matrix), intent(in) :: A + end subroutine + real function get_value_interface() + end function +end module + +module ellpack + use matrix +end module + +module bsr + use matrix + type, extends(sparse_matrix) :: bsr_matrix + contains + procedure :: get_neighbors + end type +contains + function get_neighbors (A) + class(bsr_matrix), intent(in) :: A + integer :: get_neighbors(A%max_degree) + end function +end module + +program main + use ellpack + use bsr +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 new file mode 100644 index 000000000..ca0a05a62 --- /dev/null +++ b/gcc-4.8/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! +! PR fortran/58007 +! Unresolved fiixup while loading a module. +! +! This tests that the specification expression A%MAX_DEGREE in module BSR is +! correctly loaded and resolved in program MAIN. +! +! Original testcase from Daniel Shapiro <shapero@uw.edu> + +module matrix + type :: sparse_matrix + integer :: max_degree + end type +end module + +module bsr + use matrix + + type, extends(sparse_matrix) :: bsr_matrix + end type + + integer :: i1 + integer :: i2 + integer :: i3 +contains + function get_neighbors (A) + type(bsr_matrix), intent(in) :: A + integer :: get_neighbors(A%max_degree) + end function +end module + +program main + use matrix + use bsr +end diff --git a/gcc-4.8/gcc/testsuite/gfortran.dg/where_4.f90 b/gcc-4.8/gcc/testsuite/gfortran.dg/where_4.f90 new file mode 100644 index 000000000..1ff2e4ca3 --- /dev/null +++ b/gcc-4.8/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 |