diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
43 files changed, 940 insertions, 57 deletions
diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_5.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_5.f90 new file mode 100644 index 00000000000..379fbd7f8f9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_5.f90 @@ -0,0 +1,55 @@ +! { dg-do run } +! +! PR fortran/45019 +! +! Check that the compiler knows that +! "arg" and "arr" can alias. +! +MODULE m + IMPLICIT NONE + INTEGER, TARGET :: arr(3) +CONTAINS + SUBROUTINE foobar (arg) + INTEGER, TARGET :: arg(:) + arr(2:3) = arg(1:2) + END SUBROUTINE foobar +END MODULE m + +PROGRAM main + USE m + IMPLICIT NONE + arr = (/ 1, 2, 3 /) + CALL bar(arr) + if (any (arr /= (/ 1, 1, 2 /))) call abort() + CALL test() +contains + subroutine bar(x) + INTEGER, TARGET :: x(:) + CALL foobar (x) + end subroutine bar +END PROGRAM main + +MODULE m2 + IMPLICIT NONE + INTEGER, TARGET :: arr(3) +CONTAINS + SUBROUTINE foobar (arg) + INTEGER, TARGET :: arg(:) + arr(1) = 5 + arg(1) = 6 + if (arr(1) == 5) call abort() + END SUBROUTINE foobar +END MODULE m2 +subroutine test + USE m2 + IMPLICIT NONE + arr = (/ 1, 2, 3 /) + CALL bar(arr) +contains + subroutine bar(x) + INTEGER, TARGET :: x(:) + CALL foobar (x) + end subroutine bar +END subroutine test + +! { dg-final { cleanup-modules "m m2" } } diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_3.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_3.f90 index df6bd49ef26..78097308030 100644 --- a/gcc/testsuite/gfortran.dg/array_memcpy_3.f90 +++ b/gcc/testsuite/gfortran.dg/array_memcpy_3.f90 @@ -11,5 +11,5 @@ subroutine bar(x) x = (/ 3, 1, 4, 1 /) end subroutine -! { dg-final { scan-tree-dump-times "memcpy|ref-all" 2 "original" } } +! { dg-final { scan-tree-dump-times "memcpy|(ref-all.*ref-all)" 2 "original" } } ! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_4.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_4.f90 index 0f8b5cb15b0..9f2279d881c 100644 --- a/gcc/testsuite/gfortran.dg/array_memcpy_4.f90 +++ b/gcc/testsuite/gfortran.dg/array_memcpy_4.f90 @@ -9,5 +9,5 @@ d = s end -! { dg-final { scan-tree-dump-times "d = " 1 "original" } } +! { dg-final { scan-tree-dump-times "MEM.*d\\\] = MEM" 1 "original" } } ! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 new file mode 100644 index 00000000000..63f8816379e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_15.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! +! PR 44925: [OOP] C_LOC with CLASS pointer +! +! Contributed by Barron Bichon <barron.bichon@swri.org> + + use iso_c_binding + + type :: t + end type t + + type(c_ptr) :: tt_cptr + class(t), pointer :: tt_fptr + if (associated(tt_fptr)) tt_cptr = c_loc(tt_fptr) ! { dg-error "must not be polymorphic" } + +end diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_1.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_1.f90 index f2a5caf6864..b30bdc5285e 100644 --- a/gcc/testsuite/gfortran.dg/c_sizeof_1.f90 +++ b/gcc/testsuite/gfortran.dg/c_sizeof_1.f90 @@ -1,8 +1,12 @@ ! { dg-do run } ! Support F2008's c_sizeof() ! -integer(4) :: i, j(10) -character(4),parameter :: str(1) = "abcd" +use iso_c_binding, only: c_int, c_char, c_ptr, c_intptr_t, c_null_ptr + +integer(kind=c_int) :: i, j(10) +character(kind=c_char,len=4),parameter :: str(1) = "abcd" +type(c_ptr) :: cptr +integer(c_intptr_t) :: iptr ! Using F2008's C_SIZEOF i = c_sizeof(i) @@ -18,9 +22,10 @@ i = c_sizeof(str(1)) if (i /= 4) call abort() i = c_sizeof(str(1)(1:3)) -print *, i if (i /= 3) call abort() +write(*,*) c_sizeof(cptr), c_sizeof(iptr), c_sizeof(C_NULL_PTR) + ! Using GNU's SIZEOF i = sizeof(i) if (i /= 4) call abort() @@ -36,5 +41,6 @@ if (i /= 4) call abort() i = sizeof(str(1)(1:3)) if (i /= 3) call abort() + end diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 new file mode 100644 index 00000000000..98e5cdd070c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char4_iunit_1.f03 @@ -0,0 +1,32 @@ +! { dg-do run } +! PR37077 Implement Internal Unit I/O for character KIND=4 +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> +program char4_iunit_1 + implicit none + character(kind=4,len=42) :: string + integer(kind=4) :: i,j + real(kind=4) :: inf, nan, large + + large = huge(large) + inf = 2 * large + nan = 0 + nan = nan / nan + + string = 4_"123456789x" + write(string,'(a11)') 4_"abcdefg" + if (string .ne. 4_" abcdefg ") call abort + write(string,*) 12345 + if (string .ne. 4_" 12345 ") call abort + write(string, '(i6,5x,i8,a5)') 78932, 123456, "abc" + if (string .ne. 4_" 78932 123456 abc ") call abort + write(string, *) .true., .false. , .true. + if (string .ne. 4_" T F T ") call abort + write(string, *) 1.2345e-06, 4.2846e+10_8 + if (string .ne. 4_" 1.23450002E-06 42846000000.000000 ") call abort + write(string, *) nan, inf + if (string .ne. 4_" NaN +Infinity ") call abort + write(string, '(10x,f3.1,3x,f9.1)') nan, inf + if (string .ne. 4_" NaN +Infinity ") call abort + write(string, *) (1.2, 3.4 ) + if (string .ne. 4_" ( 1.2000000 , 3.4000001 ) ") call abort +end program char4_iunit_1 diff --git a/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 new file mode 100644 index 00000000000..074321274ca --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char4_iunit_2.f03 @@ -0,0 +1,47 @@ +! { dg-do run } +! PR37077 Implement Internal Unit I/O for character KIND=4 +! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org> +program char4_iunit_2 + implicit none + integer, parameter :: k = 4 + character(kind=4,len=80) :: widestring, str_char4 + character(kind=1,len=80) :: skinnystring + integer :: i,j + real :: x + character(9) :: str_default + + widestring = k_"12345 2.54360 hijklmnop qwertyuiopasdfg" + skinnystring = "12345 2.54360 hijklmnop qwertyuiopasdfg" + i = 77777 + x = 0.0 + str_default = "xxxxxxxxx" + str_char4 = k_"xyzzy" + read(widestring,'(i5,1x,f7.5,1x,a9,1x,a15)') i, x, str_default, str_char4 + if (i /= 12345 .or. (x - 2.5436001) > epsilon(x) .or. & + str_default /= "hijklmnop" .or. str_char4 /= k_"qwertyuiopasdfg")& + call abort + i = 77777 + x = 0.0 + str_default = "xxxxxxxxx" + str_char4 = k_"xyzzy" + read(widestring,'(2x,i4,tl3,1x,f7.5,1x,a9,1x,a15)')i, x, str_default,& + str_char4 + if (i /= 345 .or. (x - 52.542999) > epsilon(x) .or. & + str_default /= "0 hijklmn" .or. str_char4 /= k_"p qwertyuiopasd")& + call abort + read(skinnystring,'(2x,i4,tl3,1x,f7.5,1x,a9,1x,a15)')i, x, str_default,& + str_char4 + if (i /= 345 .or. (x - 52.542999) > epsilon(x) .or. & + str_default /= "0 hijklmn" .or. str_char4 /= k_"p qwertyuiopasd")& + call abort + write(widestring,'(2x,i4,tl3,1x,f10.5,1x,a9,1x,a15)')i, x, str_default,& + trim(str_char4) + if (widestring .ne. k_" 3 52.54300 0 hijklmn p qwertyuiopasd") call abort + write(skinnystring,'(2x,i4,tl3,1x,f10.5,1x,a9,1x,a15)')i, x, str_default,& + trim(str_char4) + if (skinnystring .ne. " 3 52.54300 0 hijklmn p qwertyuiopasd") call abort + write(widestring,*)"test",i, x, str_default,& + trim(str_char4) + if (widestring .ne. & + k_" test 345 52.542999 0 hijklmnp qwertyuiopasd") call abort +end program char4_iunit_2 diff --git a/gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90 b/gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90 index bd5552c0ea6..15d70215020 100644 --- a/gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90 +++ b/gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90 @@ -10,4 +10,4 @@ program bound_check zz(i:j) = 'abcdef' print * , zz end -! { dg-output "Substring out of bounds: upper bound exceeds string length.*at line 9)} +! { dg-output "At line 10.*Substring out of bounds: upper bound \\(11\\) of 'zz' exceeds string length" } diff --git a/gcc/testsuite/gfortran.dg/class_24.f03 b/gcc/testsuite/gfortran.dg/class_24.f03 new file mode 100644 index 00000000000..085e6d1e1ce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_24.f03 @@ -0,0 +1,22 @@ +! { dg-do compile } +! +! PR 44869: [OOP] Missing TARGET check - and wrong code or accepts-invalid? +! +! Contributed by Satish.BD <bdsatish@gmail.com> + + type :: test_case + end type + + type :: test_suite + type(test_case) :: list + end type + +contains + + subroutine sub(self) + class(test_suite), intent(inout) :: self + type(test_case), pointer :: tst_case + tst_case => self%list ! { dg-error "is neither TARGET nor POINTER" } + end subroutine + +end diff --git a/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03 b/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03 new file mode 100644 index 00000000000..008739e3f98 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03 @@ -0,0 +1,102 @@ +! { dg-do run } +! Test the fix for PR42385, in which CLASS defined operators +! compiled but were not correctly dynamically dispatched. +! +! Contributed by Janus Weil <janus@gcc.gnu.org> +! +module foo_module + implicit none + private + public :: foo + + type :: foo + integer :: foo_x + contains + procedure :: times => times_foo + procedure :: assign => assign_foo + generic :: operator(*) => times + generic :: assignment(=) => assign + end type + +contains + + function times_foo(this,factor) result(product) + class(foo) ,intent(in) :: this + class(foo) ,allocatable :: product + integer, intent(in) :: factor + allocate (product, source = this) + product%foo_x = -product%foo_x * factor + end function + + subroutine assign_foo(lhs,rhs) + class(foo) ,intent(inout) :: lhs + class(foo) ,intent(in) :: rhs + lhs%foo_x = -rhs%foo_x + end subroutine + +end module + +module bar_module + use foo_module ,only : foo + implicit none + private + public :: bar + + type ,extends(foo) :: bar + integer :: bar_x + contains + procedure :: times => times_bar + procedure :: assign => assign_bar + end type + +contains + subroutine assign_bar(lhs,rhs) + class(bar) ,intent(inout) :: lhs + class(foo) ,intent(in) :: rhs + select type(rhs) + type is (bar) + lhs%bar_x = rhs%bar_x + lhs%foo_x = -rhs%foo_x + end select + end subroutine + function times_bar(this,factor) result(product) + class(bar) ,intent(in) :: this + integer, intent(in) :: factor + class(foo), allocatable :: product + select type(this) + type is (bar) + allocate(product,source=this) + select type(product) + type is(bar) + product%bar_x = 2*this%bar_x*factor + end select + end select + end function +end module + +program main + use foo_module ,only : foo + use bar_module ,only : bar + implicit none + type(foo) :: unitf + type(bar) :: unitb + +! foo's assign negates, whilst its '*' negates and mutliplies. + unitf%foo_x = 1 + call rescale(unitf, 42) + if (unitf%foo_x .ne. 42) call abort + +! bar's assign negates foo_x, whilst its '*' copies foo_x +! and does a multiply by twice factor. + unitb%foo_x = 1 + unitb%bar_x = 2 + call rescale(unitb, 3) + if (unitb%bar_x .ne. 12) call abort + if (unitb%foo_x .ne. -1) call abort +contains + subroutine rescale(this,scale) + class(foo) ,intent(inout) :: this + integer, intent(in) :: scale + this = this*scale + end subroutine +end program diff --git a/gcc/testsuite/gfortran.dg/coarray_10.f90 b/gcc/testsuite/gfortran.dg/coarray_10.f90 index 7a50c89fc3c..6ee425d7bf9 100644 --- a/gcc/testsuite/gfortran.dg/coarray_10.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_10.f90 @@ -24,5 +24,23 @@ subroutine this_image_check() j = this_image(dim=3) ! { dg-error "DIM argument without ARRAY argument" } i = image_index(i, [ 1 ]) ! { dg-error "Expected coarray variable" } i = image_index(z, 2) ! { dg-error "must be a rank one array" } - end subroutine this_image_check + + +subroutine rank_mismatch() + implicit none + integer,allocatable :: A(:)[:,:,:,:] + allocate(A(1)[1,1,1:*]) ! { dg-error "Unexpected ... for codimension" } + allocate(A(1)[1,1,1,1,1,*]) ! { dg-error "Invalid codimension 5" } + allocate(A(1)[1,1,1,*]) + allocate(A(1)[1,1]) ! { dg-error "Too few codimensions" } + allocate(A(1)[1,*]) ! { dg-error "Too few codimensions" } + allocate(A(1)[1,1:*]) ! { dg-error "Unexpected ... for codimension" } + + A(1)[1,1,1] = 1 ! { dg-error "Too few codimensions" } + A(1)[1,1,1,1,1,1] = 1 ! { dg-error "Invalid codimension 5" } + A(1)[1,1,1,1] = 1 + A(1)[1,1] = 1 ! { dg-error "Too few codimensions" } + A(1)[1,1] = 1 ! { dg-error "Too few codimensions" } + A(1)[1,1:1] = 1 ! { dg-error "Too few codimensions" } +end subroutine rank_mismatch diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_3.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_3.f90 index 688c38d9192..0aa2e4e1c18 100644 --- a/gcc/testsuite/gfortran.dg/derived_constructor_comps_3.f90 +++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_3.f90 @@ -1,4 +1,4 @@ -! { dg-compile } +! { dg-do compile } ! ! gfortran was ICEing for the constructor of ! componentfree types. diff --git a/gcc/testsuite/gfortran.dg/dim_range_1.f90 b/gcc/testsuite/gfortran.dg/dim_range_1.f90 new file mode 100644 index 00000000000..59f3f431143 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dim_range_1.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! PR 44693 - check for invalid dim even in functions. +! Based on a test case by Dominique d'Humieres. +subroutine test1(esss,Ix,Iyz, n) + real(kind=kind(1.0d0)), dimension(n), intent(out) :: esss + real(kind=kind(1.0d0)), dimension(n,n,n) :: sp + real(kind=kind(1.0d0)), dimension(n,n) :: Ix,Iyz + esss = sum(Ix * Iyz, 0) ! { dg-error "is not a valid dimension index" } + esss = sum(Ix * Iyz, 1) + esss = sum(Ix * Iyz, 2) + esss = sum(Ix * Iyz, 3) ! { dg-error "is not a valid dimension index" } + sp = spread (ix * iyz, 0, n) ! { dg-error "is not a valid dimension index" } + sp = spread (ix * iyz, 1, n) + sp = spread (ix * iyz, 2, n) + sp = spread (ix * iyz, 3, n) + sp = spread (ix * iyz, 4, n) ! { dg-error "is not a valid dimension index" } +end subroutine diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03 index 4854b0ff08d..2182dce3e4f 100644 --- a/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03 +++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03 @@ -12,16 +12,14 @@ module m procedure, pass :: make_integer procedure, pass :: prod => i_m_j generic, public :: extract => real, make_integer - generic, public :: base_extract => real, make_integer end type t1 type, extends(t1) :: t2 integer :: j = 99 contains procedure, pass :: real => make_real2 - procedure, pass :: make_integer_2 + procedure, pass :: make_integer => make_integer_2 procedure, pass :: prod => i_m_j_2 - generic, public :: extract => real, make_integer_2 end type t2 contains real function make_real (arg) @@ -69,16 +67,13 @@ end module m if (a%real() .ne. real (42)) call abort if (a%prod() .ne. 42) call abort if (a%extract (2) .ne. 84) call abort - if (a%base_extract (2) .ne. 84) call abort a => c ! extension in module if (a%real() .ne. real (99)) call abort if (a%prod() .ne. 99) call abort if (a%extract (3) .ne. 297) call abort - if (a%base_extract (3) .ne. 126) call abort a => d ! extension in main if (a%real() .ne. real (42)) call abort if (a%prod() .ne. 42) call abort if (a%extract (4) .ne. 168) call abort - if (a%base_extract (4) .ne. 168) call abort end ! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03 index 989a2e0d3f0..95ce8372325 100644 --- a/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03 +++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03 @@ -12,16 +12,14 @@ module m procedure, pass :: make_integer procedure, pass :: prod => i_m_j generic, public :: extract => real, make_integer - generic, public :: base_extract => real, make_integer end type t1 type, extends(t1) :: t2 integer :: j = 99 contains procedure, pass :: real => make_real2 - procedure, pass :: make_integer_2 + procedure, pass :: make_integer => make_integer_2 procedure, pass :: prod => i_m_j_2 - generic, public :: extract => real, make_integer_2 end type t2 contains subroutine make_real (arg, arg2) @@ -79,8 +77,6 @@ end module m if (i .ne. 42) call abort call a%extract (2, i) if (i .ne. 84) call abort - call a%base_extract (2, i) - if (i .ne. 84) call abort a => c ! extension in module call a%real(r) @@ -89,8 +85,6 @@ end module m if (i .ne. 99) call abort call a%extract (3, i) if (i .ne. 297) call abort - call a%base_extract (3, i) - if (i .ne. 126) call abort a => d ! extension in main call a%real(r) @@ -99,7 +93,5 @@ end module m if (i .ne. 42) call abort call a%extract (4, i) if (i .ne. 168) call abort - call a%extract (4, i) - if (i .ne. 168) call abort end ! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03 index aa8713ef4d4..884d3426039 100644 --- a/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03 +++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03 @@ -15,7 +15,6 @@ module m1 procedure, pass :: make_integer procedure, pass :: prod => i_m_j generic, public :: extract => real, make_integer - generic, public :: base_extract => real, make_integer end type t1 contains real function make_real (arg) @@ -41,9 +40,8 @@ module m2 integer :: j = 99 contains procedure, pass :: real => make_real2 - procedure, pass :: make_integer_2 + procedure, pass :: make_integer => make_integer_2 procedure, pass :: prod => i_m_j_2 - generic, public :: extract => real, make_integer_2 end type t2 contains real function make_real2 (arg) @@ -76,16 +74,13 @@ end module m2 if (a%real() .ne. real (42)) call abort if (a%prod() .ne. 42) call abort if (a%extract (2) .ne. 84) call abort - if (a%base_extract (2) .ne. 84) call abort a => c ! extension in module m2 if (a%real() .ne. real (99)) call abort if (a%prod() .ne. 99) call abort if (a%extract (3) .ne. 297) call abort - if (a%base_extract (3) .ne. 126) call abort a => d ! extension in main if (a%real() .ne. real (42)) call abort if (a%prod() .ne. 42) call abort if (a%extract (4) .ne. 168) call abort - if (a%base_extract (4) .ne. 168) call abort end ! { dg-final { cleanup-modules "m1, m2" } } diff --git a/gcc/testsuite/gfortran.dg/endfile_2.f90 b/gcc/testsuite/gfortran.dg/endfile_2.f90 index ee911e89e9e..e91e80eb2aa 100644 --- a/gcc/testsuite/gfortran.dg/endfile_2.f90 +++ b/gcc/testsuite/gfortran.dg/endfile_2.f90 @@ -5,7 +5,7 @@ integer i endfile(8) rewind(8) - read(8,*,end=0023)i + read(8,end=0023)i call abort ! should never get here stop 0023 continue diff --git a/gcc/testsuite/gfortran.dg/exit_1.f08 b/gcc/testsuite/gfortran.dg/exit_1.f08 new file mode 100644 index 00000000000..9ebc2eccb50 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/exit_1.f08 @@ -0,0 +1,50 @@ +! { dg-do run } +! { dg-options "-std=f2008 -fall-intrinsics" } + +! PR fortran/44709 +! Check that exit and cycle from within a BLOCK works for loops as expected. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + INTEGER :: i + + ! Simple exit without loop name. + DO + BLOCK + EXIT + END BLOCK + CALL abort () + END DO + + ! Cycle without loop name. + DO i = 1, 1 + BLOCK + CYCLE + END BLOCK + CALL abort () + END DO + + ! Exit loop by name from within a BLOCK. + loop1: DO + DO + BLOCK + EXIT loop1 + END BLOCK + CALL abort () + END DO + CALL abort () + END DO loop1 + + ! Cycle loop by name from within a BLOCK. + loop2: DO i = 1, 1 + loop3: DO + BLOCK + CYCLE loop2 + END BLOCK + CALL abort () + END DO loop3 + CALL abort () + END DO loop2 +END PROGRAM main diff --git a/gcc/testsuite/gfortran.dg/exit_2.f08 b/gcc/testsuite/gfortran.dg/exit_2.f08 new file mode 100644 index 00000000000..23e7009cbf8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/exit_2.f08 @@ -0,0 +1,31 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } + +! PR fortran/44709 +! Check that the resolving of loop names in parent namespaces introduced to +! handle intermediate BLOCK's does not go too far and other sanity checks. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + + EXIT ! { dg-error "is not within a loop" } + EXIT foobar ! { dg-error "is unknown" } + EXIT main ! { dg-error "is not a loop name" } + + mainLoop: DO + CALL test () + END DO mainLoop + + otherLoop: DO + EXIT mainLoop ! { dg-error "is not within loop 'mainloop'" } + END DO otherLoop + +CONTAINS + + SUBROUTINE test () + EXIT mainLoop ! { dg-error "is unknown" } + END SUBROUTINE test + +END PROGRAM main diff --git a/gcc/testsuite/gfortran.dg/ftell_3.f90 b/gcc/testsuite/gfortran.dg/ftell_3.f90 index c16afe8ed16..16875d812a8 100644 --- a/gcc/testsuite/gfortran.dg/ftell_3.f90 +++ b/gcc/testsuite/gfortran.dg/ftell_3.f90 @@ -3,9 +3,10 @@ ! Contributed by Janne Blomqvist, Manfred Schwarb ! and Dominique d'Humieres. program ftell_3 - integer :: i + integer :: i, j + character(1) :: ch character(len=99) :: buffer - open(10, form='formatted', status='scratch', position='rewind') + open(10, form='formatted', position='rewind') write(10, '(a)') '123456' write(10, '(a)') '789' write(10, '(a)') 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' @@ -13,16 +14,29 @@ program ftell_3 rewind(10) read(10, '(a)') buffer call ftell(10, i) - if(i /= 7) then - call abort() +! Expected: On '\n' systems: 7, on \r\n systems: 8 + if(i /= 7 .and. i /= 8) then + call abort end if read(10,'(a)') buffer if (trim(buffer) /= "789") then call abort() end if - call ftell(10,i) - if (i /= 11) then - call abort() - end if + call ftell(10,j) close(10) + open(10, access="stream") +! Expected: On '\n' systems: 11, on \r\n systems: 13 + if (i == 7) then + read(10, pos=7) ch + if (ch /= char(10)) call abort + if (j /= 11) call abort + end if + if (i == 8) then + read(10, pos=7) ch + if (ch /= char(13)) call abort + read(10) ch + if (ch /= char(10)) call abort + if (j /= 13) call abort + end if + close(10, status="delete") end program ftell_3 diff --git a/gcc/testsuite/gfortran.dg/gomp/pr44847.f90 b/gcc/testsuite/gfortran.dg/gomp/pr44847.f90 new file mode 100644 index 00000000000..3da4311499e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr44847.f90 @@ -0,0 +1,86 @@ +! PR fortran/44847 +! { dg-do compile } +! { dg-options "-fopenmp" } + +subroutine pr44847_1 + integer :: i, j +!$omp parallel do collapse(2) +l:do i = 1, 2 + do j = 1, 2 + cycle l ! { dg-error "CYCLE statement" } + end do + end do l +end subroutine +subroutine pr44847_2 + integer :: i, j, k +!$omp parallel do collapse(3) + do i = 1, 2 + l:do j = 1, 2 + do k = 1, 2 + cycle l ! { dg-error "CYCLE statement" } + end do + end do l + end do +end subroutine +subroutine pr44847_3 + integer :: i, j +!$omp parallel do +l:do i = 1, 2 + do j = 1, 2 + cycle l + end do + end do l +end subroutine +subroutine pr44847_4 + integer :: i, j, k +!$omp parallel do collapse(2) + do i = 1, 2 + l:do j = 1, 2 + do k = 1, 2 + cycle l + end do + end do l + end do +end subroutine +subroutine pr44847_5 + integer :: i, j +!$omp parallel do collapse(2) +l:do i = 1, 2 + do j = 1, 2 + exit l ! { dg-error "EXIT statement" } + end do + end do l +end subroutine +subroutine pr44847_6 + integer :: i, j, k +!$omp parallel do collapse(3) + do i = 1, 2 + l:do j = 1, 2 + do k = 1, 2 + exit l ! { dg-error "EXIT statement" } + end do + end do l + end do +end subroutine +subroutine pr44847_7 + integer :: i, j, k +!$omp parallel do collapse(2) + do i = 1, 2 + l:do j = 1, 2 + do k = 1, 2 + exit l ! { dg-error "EXIT statement" } + end do + end do l + end do +end subroutine +subroutine pr44847_8 + integer :: i, j, k +!$omp parallel do + do i = 1, 2 + l:do j = 1, 2 + do k = 1, 2 + exit l + end do + end do l + end do +end subroutine diff --git a/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 b/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 index d0e1b017879..6fa6e303677 100644 --- a/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 +++ b/gcc/testsuite/gfortran.dg/graphite/pr42185.f90 @@ -1,4 +1,4 @@ -! { dg-compile } +! { dg-do compile } ! { dg-options "-fgraphite -O -ffast-math" } MODULE powell diff --git a/gcc/testsuite/gfortran.dg/initialization_20.f90 b/gcc/testsuite/gfortran.dg/initialization_20.f90 index 47d552834ae..6af1a00a45d 100644 --- a/gcc/testsuite/gfortran.dg/initialization_20.f90 +++ b/gcc/testsuite/gfortran.dg/initialization_20.f90 @@ -6,5 +6,5 @@ program pr19925 integer j integer, parameter :: n = 100000 integer, parameter :: i(n)=(/(j,j=1,n)/) ! { dg-error "number of elements" } - print *, i(5) + print *, i(5) ! { dg-error "has no IMPLICIT type" } end program pr19925 diff --git a/gcc/testsuite/gfortran.dg/initialization_24.f90 b/gcc/testsuite/gfortran.dg/initialization_24.f90 index 4c203312be4..0ab8dc624e4 100644 --- a/gcc/testsuite/gfortran.dg/initialization_24.f90 +++ b/gcc/testsuite/gfortran.dg/initialization_24.f90 @@ -3,7 +3,7 @@ ! Test case by Dominique d'Humieres INTEGER, PARAMETER ::N=65536 INTEGER, PARAMETER ::I(N)=(/(MOD(K,2),K=1,N)/)!{ dg-error "number of elements" } -INTEGER, PARAMETER ::M(N)=I(N:1:-1) +INTEGER, PARAMETER ::M(N)=I(N:1:-1) ! { dg-error "Syntax error in argument" } print *, I(1), M(1), I(N), M(N) END diff --git a/gcc/testsuite/gfortran.dg/intent_out_5.f90 b/gcc/testsuite/gfortran.dg/intent_out_5.f90 index acd2b606525..6a9c6f4bd39 100644 --- a/gcc/testsuite/gfortran.dg/intent_out_5.f90 +++ b/gcc/testsuite/gfortran.dg/intent_out_5.f90 @@ -1,4 +1,4 @@ -! { dg-do run} +! { dg-do run } ! ! PR fortran/41479 ! diff --git a/gcc/testsuite/gfortran.dg/ltrans-7.f90 b/gcc/testsuite/gfortran.dg/ltrans-7.f90 index 9c9bcf939eb..583edf216ba 100644 --- a/gcc/testsuite/gfortran.dg/ltrans-7.f90 +++ b/gcc/testsuite/gfortran.dg/ltrans-7.f90 @@ -27,5 +27,5 @@ Program FOO end Program FOO ! Please do not XFAIL. -! { dg-final { scan-tree-dump-times "transformed loop" 1 "ltrans"} } +! { dg-final { scan-tree-dump-times "transformed loop" 1 "ltrans" } } ! { dg-final { cleanup-tree-dump "ltrans" } } diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 index 2ea2e7b86ab..673739518dc 100644 --- a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 +++ b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 @@ -3,7 +3,6 @@ PROGRAM TST IMPLICIT NONE REAL :: A(1,3) - REAL :: B(3,1) A(:,1) = 10 A(:,2) = 20 A(:,3) = 30 @@ -13,9 +12,4 @@ PROGRAM TST if (minloc(sum(a(:,1:3),1),1) .ne. 1) call abort() if (maxloc(sum(a(:,1:3),1),1) .ne. 3) call abort() - B(1,:) = 10 - B(2,:) = 20 - B(3,:) = 30 - if (minloc(sum(b(1:3,:),2),2) .ne. 1) call abort() - if (maxloc(sum(b(1:3,:),2),2) .ne. 3) call abort() END PROGRAM TST diff --git a/gcc/testsuite/gfortran.dg/namelist_36.f90 b/gcc/testsuite/gfortran.dg/namelist_36.f90 index 61e88b6b3e9..b6a14e36bc3 100644 --- a/gcc/testsuite/gfortran.dg/namelist_36.f90 +++ b/gcc/testsuite/gfortran.dg/namelist_36.f90 @@ -1,4 +1,4 @@ -! { dg-compile } +! { dg-do compile } ! ! Private types and types with private components ! are acceptable in local namelists. diff --git a/gcc/testsuite/gfortran.dg/parameter_array_init_6.f90 b/gcc/testsuite/gfortran.dg/parameter_array_init_6.f90 new file mode 100644 index 00000000000..9a654db3f00 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/parameter_array_init_6.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! +! PR fortran/44742 +! +! Test case based on Juergen Reuter's and reduced by +! Janus Weil. +! +! The program creates a large array constructor, which +! exceeds -fmax-array-constructor - and caused an ICE. +! + +module proc8 + implicit none + integer, parameter :: N = 256 + logical, dimension(N**2), parameter :: A = .false. + logical, dimension(N,N), parameter :: B & + = reshape ( (/ A /), (/ N, N /) ) ! { dg-error "array constructor at .1. requires an increase" } +end module diff --git a/gcc/testsuite/gfortran.dg/pr44882.f90 b/gcc/testsuite/gfortran.dg/pr44882.f90 new file mode 100644 index 00000000000..ac22459dc08 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr44882.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-options "-O3 -ffast-math -funroll-loops -w" } + + SUBROUTINE TRUDGE(KDIR) +! There is a type mismatch here for TRUPAR which caused an ICE + COMMON /TRUPAR/ DR(10),V(10,10) + DO 110 I=1,NDIR + 110 DR(I)=V(I,JDIR) + END + SUBROUTINE TRUSRC(LEAVE) + IMPLICIT DOUBLE PRECISION (A-H,O-Z) + COMMON /TRUPAR/ DX(10),V(10,10) + END + diff --git a/gcc/testsuite/gfortran.dg/runtime_warning_1.f90 b/gcc/testsuite/gfortran.dg/runtime_warning_1.f90 index cff9eae7ae7..2894136a8b5 100644 --- a/gcc/testsuite/gfortran.dg/runtime_warning_1.f90 +++ b/gcc/testsuite/gfortran.dg/runtime_warning_1.f90 @@ -14,4 +14,4 @@ close (42) if (c /= 'abcde') call abort () end -! { dg-warning ".*descriptor" "" 10} + diff --git a/gcc/testsuite/gfortran.dg/select_char_2.f90 b/gcc/testsuite/gfortran.dg/select_char_2.f90 new file mode 100644 index 00000000000..22af1c76dfc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_char_2.f90 @@ -0,0 +1,45 @@ +! { dg-do run } +! { dg-options "-O -fdump-tree-original" } + + if (foo ('E') .ne. 1) call abort + if (foo ('e') .ne. 1) call abort + if (foo ('f') .ne. 2) call abort + if (foo ('g') .ne. 2) call abort + if (foo ('h') .ne. 2) call abort + if (foo ('Q') .ne. 3) call abort + if (foo (' ') .ne. 4) call abort + if (bar ('e') .ne. 1) call abort + if (bar ('f') .ne. 3) call abort +contains + function foo (c) + character :: c + integer :: foo + select case (c) + case ('E','e') + foo = 1 + case ('f':'h ') + foo = 2 + case default + foo = 3 + case ('') + foo = 4 + end select + end function + function bar (c) + character :: c + integer :: bar + select case (c) + case ('ea':'ez') + bar = 2 + case ('e') + bar = 1 + case default + bar = 3 + case ('fd') + bar = 4 + end select + end function +end + +! { dg-final { scan-tree-dump-not "_gfortran_select_string" "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/select_char_3.f90 b/gcc/testsuite/gfortran.dg/select_char_3.f90 new file mode 100644 index 00000000000..f0a7c874175 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_char_3.f90 @@ -0,0 +1,15 @@ +! PR fortran/40206 +! { dg-do compile } +! { dg-options "-O2 -Wuninitialized" } + +function char2type (char) + character, intent(in) :: char + integer :: char2type + + select case (char) + case ('E','e') + char2type=1 + case default + char2type=-1234 + end select +end function diff --git a/gcc/testsuite/gfortran.dg/storage_size_1.f08 b/gcc/testsuite/gfortran.dg/storage_size_1.f08 new file mode 100644 index 00000000000..ade9dfc30b0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/storage_size_1.f08 @@ -0,0 +1,31 @@ +! { dg-do run } +! +! PR 44649: [OOP] F2008: storage_size intrinsic +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +type :: t + integer(4) :: i + real(4) :: r +end type + +type,extends(t) :: t2 + integer(4) :: j +end type + +type(t) :: a +type(t), dimension(1:3) :: b +class(t), allocatable :: cp + +allocate(t2::cp) + +if (sizeof(a) /= 8) call abort() +if (storage_size(a) /= 64) call abort() + +if (sizeof(b) /= 24) call abort() +if (storage_size(b) /= 64) call abort() + +if (sizeof(cp) /= 8) call abort() +if (storage_size(cp) /= 96) call abort() + +end diff --git a/gcc/testsuite/gfortran.dg/storage_size_2.f08 b/gcc/testsuite/gfortran.dg/storage_size_2.f08 new file mode 100644 index 00000000000..50de9575e74 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/storage_size_2.f08 @@ -0,0 +1,27 @@ +! { dg-do compile } +! +! PR 44649: [OOP] F2008: storage_size intrinsic +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +use iso_c_binding, only: c_int + +type, bind(c) :: t + integer(c_int) :: j +end type + +integer(4) :: i1 +integer(c_int) :: i2 +type(t) :: x + +print *,c_sizeof(i1) ! { dg-error "must be be an interoperable data entity" } +print *,c_sizeof(i2) +print *,c_sizeof(x) +print *, c_sizeof(ran()) ! { dg-error "must be be an interoperable data entity" } + +print *,storage_size(1.0,4) +print *,storage_size(1.0,3.2) ! { dg-error "must be INTEGER" } +print *,storage_size(1.0,(/1,2/)) ! { dg-error "must be a scalar" } +print *,storage_size(1.0,irand()) ! { dg-error "must be a constant" } + +end diff --git a/gcc/testsuite/gfortran.dg/typebound_call_16.f03 b/gcc/testsuite/gfortran.dg/typebound_call_16.f03 new file mode 100644 index 00000000000..fdd60c603cc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_16.f03 @@ -0,0 +1,35 @@ +! { dg-do compile } +! +! PR 41685: [OOP] internal compiler error: verify_flow_info failed +! +! Contributed by Salvatore Filippone <sfilippone@uniroma2.it> + +module base_mat_mod + + type :: base_sparse_mat + contains + procedure, pass(a) :: get_nrows + end type base_sparse_mat + +contains + + integer function get_nrows(a) + implicit none + class(base_sparse_mat), intent(in) :: a + end function get_nrows + +end module base_mat_mod + + + use base_mat_mod + + type, extends(base_sparse_mat) :: s_coo_sparse_mat + end type s_coo_sparse_mat + + class(s_coo_sparse_mat), pointer :: a + Integer :: m + m = a%get_nrows() + +end + +! { dg-final { cleanup-modules "base_mat_mod" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_6.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_6.f03 new file mode 100644 index 00000000000..973e10a35e3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_generic_6.f03 @@ -0,0 +1,69 @@ +! { dg-do run } +! +! PR 43945: [OOP] Derived type with GENERIC: resolved to the wrong specific TBP +! +! Contributed by by Salvatore Filippone <sfilippone@uniroma2.it> + +module foo_mod + type foo + integer :: i + contains + procedure, pass(a) :: doit + procedure, pass(a) :: getit + generic, public :: do => doit + generic, public :: get => getit + end type foo + private doit,getit +contains + subroutine doit(a) + class(foo) :: a + a%i = 1 + write(*,*) 'FOO%DOIT base version' + end subroutine doit + function getit(a) result(res) + class(foo) :: a + integer :: res + res = a%i + end function getit +end module foo_mod + +module foo2_mod + use foo_mod + type, extends(foo) :: foo2 + integer :: j + contains + procedure, pass(a) :: doit => doit2 + procedure, pass(a) :: getit => getit2 + end type foo2 + private doit2, getit2 + +contains + + subroutine doit2(a) + class(foo2) :: a + a%i = 2 + a%j = 3 + end subroutine doit2 + function getit2(a) result(res) + class(foo2) :: a + integer :: res + res = a%j + end function getit2 +end module foo2_mod + +program testd15 + use foo2_mod + type(foo2) :: af2 + class(foo), allocatable :: afab + + allocate(foo2 :: afab) + call af2%do() + if (af2%i .ne. 2) call abort + if (af2%get() .ne. 3) call abort + call afab%do() + if (afab%i .ne. 2) call abort + if (afab%get() .ne. 3) call abort + +end program testd15 + +! { dg-final { cleanup-modules "foo_mod foo2_mod" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_7.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_7.f03 new file mode 100644 index 00000000000..2519ab09416 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_generic_7.f03 @@ -0,0 +1,28 @@ +! { dg-do compile } +! +! PR 44434: [OOP] ICE in in gfc_add_component_ref +! +! Contributed by Salvatore Filippone <sfilippone@uniroma2.it> + +module foo_mod + type foo + contains + procedure :: doit + generic :: do => doit + end type +contains + subroutine doit(a) + class(foo) :: a + end subroutine +end module + +program testd15 +contains + subroutine dodo(x) + use foo_mod + class(foo) :: x + call x%do() + end subroutine +end + +! { dg-final { cleanup-modules "foo_mod" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_8.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_8.f03 new file mode 100644 index 00000000000..0ee6610e173 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_generic_8.f03 @@ -0,0 +1,29 @@ +! { dg-do compile } +! +! PR 44565: [4.6 Regression] [OOP] ICE in gimplify_expr with array-valued generic TBP +! +! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de> + +module ice6 + + type :: t + contains + procedure :: get_array + generic :: get_something => get_array + end type + +contains + + function get_array(this) + class(t) :: this + real,dimension(2) :: get_array + end function get_array + + subroutine do_something(this) + class(t) :: this + print *,this%get_something() + end subroutine do_something + +end module ice6 + +! { dg-final { cleanup-modules "ice6" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_9.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_9.f03 new file mode 100644 index 00000000000..f85bb385706 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_generic_9.f03 @@ -0,0 +1,63 @@ +! { dg-do run } +! +! PR 44936: [OOP] Generic TBP not resolved correctly at compile time +! +! Contributed by Salvatore Filippone <sfilippone@uniroma2.it> + +module foo_mod + type foo + integer :: i + contains + procedure, pass(a) :: doit => doit1 + procedure, pass(a) :: getit=> getit1 + generic, public :: do => doit + generic, public :: get => getit + end type foo + private doit1,getit1 +contains + subroutine doit1(a) + class(foo) :: a + a%i = 1 + write(*,*) 'FOO%DOIT base version' + end subroutine doit1 + function getit1(a) result(res) + class(foo) :: a + integer :: res + res = a%i + end function getit1 +end module foo_mod + +module foo2_mod + use foo_mod + type, extends(foo) :: foo2 + integer :: j + contains + procedure, pass(a) :: doit => doit2 + procedure, pass(a) :: getit => getit2 + end type foo2 + private doit2, getit2 +contains + subroutine doit2(a) + class(foo2) :: a + a%i = 2 + a%j = 3 + end subroutine doit2 + function getit2(a) result(res) + class(foo2) :: a + integer :: res + res = a%j + end function getit2 +end module foo2_mod + +program testd15 + use foo2_mod + type(foo2) :: af2 + + call af2%do() + if (af2%i .ne. 2) call abort + if (af2%get() .ne. 3) call abort + +end program testd15 + +! { dg-final { cleanup-modules "foo_mod foo2_mod" } } + diff --git a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 index b35c024c08c..8a28490f7b2 100644 --- a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 +++ b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 @@ -7,12 +7,12 @@ ! intrinsic one. --Rickett, 09.26.06 module use_stmt_0 ! this is an error because c_ptr_2 does not exist - use, intrinsic :: iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) does not exist" } + use, intrinsic :: iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" } end module use_stmt_0 module use_stmt_1 ! this is an error because c_ptr_2 does not exist - use iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) does not exist" } + use iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" } end module use_stmt_1 module use_stmt_2 diff --git a/gcc/testsuite/gfortran.dg/use_rename_6.f90 b/gcc/testsuite/gfortran.dg/use_rename_6.f90 new file mode 100644 index 00000000000..02f25c36e97 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_rename_6.f90 @@ -0,0 +1,40 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/44702 +! +! Based on a test case by Joe Krahn. +! +! Multiple import of the same symbol was failing for +! intrinsic modules. +! +subroutine one() + use iso_c_binding, only: a => c_ptr, b => c_ptr, c_ptr + implicit none + type(a) :: x + type(b) :: y + type(c_ptr) :: z +end subroutine one + +subroutine two() + use iso_c_binding, a => c_ptr, b => c_ptr + implicit none + type(a) :: x + type(b) :: y +end subroutine two + +subroutine three() + use iso_fortran_env, only: a => error_unit, b => error_unit, error_unit + implicit none + if(a /= b) call shall_not_be_there() + if(a /= error_unit) call shall_not_be_there() +end subroutine three + +subroutine four() + use iso_fortran_env, a => error_unit, b => error_unit + implicit none + if(a /= b) call shall_not_be_there() +end subroutine four + +! { dg-final { scan-tree-dump-times "shall_not_be_there" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/vect/vect.exp b/gcc/testsuite/gfortran.dg/vect/vect.exp index 39a1f9d811a..5783e929496 100644 --- a/gcc/testsuite/gfortran.dg/vect/vect.exp +++ b/gcc/testsuite/gfortran.dg/vect/vect.exp @@ -68,11 +68,8 @@ if [istarget "powerpc-*paired*"] { } elseif { [istarget "spu-*-*"] } { set dg-do-what-default run } elseif { [istarget "i?86-*-*"] || [istarget "x86_64-*-*"] } { - if { ![check_effective_target_sse2] } then { - return - } lappend DEFAULT_VECTCFLAGS "-msse2" - if [check_sse2_hw_available] { + if { [check_effective_target_sse2_runtime] } { set dg-do-what-default run } else { set dg-do-what-default compile |