diff options
Diffstat (limited to 'gcc-4.6/gcc/testsuite/gfortran.dg')
36 files changed, 851 insertions, 2 deletions
diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/abstract_type_6.f03 b/gcc-4.6/gcc/testsuite/gfortran.dg/abstract_type_6.f03 index 53116df..de1cea3 100644 --- a/gcc-4.6/gcc/testsuite/gfortran.dg/abstract_type_6.f03 +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/abstract_type_6.f03 @@ -31,7 +31,7 @@ TYPE, EXTENDS(middle) :: bottom CONTAINS ! useful proc to satisfy deferred procedure in top. Because we've ! extended middle we wouldn't get told off if we forgot this. - PROCEDURE :: proc_a => bottom_a + PROCEDURE :: proc_a => bottom_a ! { dg-error "must be a module procedure" } ! calls middle%proc_b and then provides extra behaviour PROCEDURE :: proc_b => bottom_b ! calls top_c and then provides extra behaviour diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90 new file mode 100644 index 0000000..014b069 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/alloc_comp_initializer_3.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! +! PR fortran/50050 +! Out of bound whilst releasing initialization of allocate object +! +! Contributed by someone <sigurdkn@gmail.com> + +program bug + implicit none + type foo + integer, pointer :: a => null() + end type + type(foo), dimension(:,:), allocatable :: data + allocate(data(1:1,1)) ! This used to lead to an ICE +end program diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/allocate_error_3.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/allocate_error_3.f90 new file mode 100644 index 0000000..7616caa --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/allocate_error_3.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! +! PR 49708: [4.5/4.6/4.7 Regression] ICE with allocate and no dimensions +! +! Contributed by <fnordxyz@yahoo.com> + + real, pointer :: x(:) + allocate(x) ! { dg-error "Array specification required" } +end diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/assumed_charlen_arg_2.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/assumed_charlen_arg_2.f90 new file mode 100644 index 0000000..e9481d8 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/assumed_charlen_arg_2.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! +! PR 50585: [4.6/4.7 Regression] ICE with assumed length character array argument +! +! Contributed by Stuart Mentzer <sgm@objexx.com> + +SUBROUTINE SUB1( str ) + IMPLICIT NONE + CHARACTER(len=*) :: str(2) + CALL SUB2( str(1)(:3) ) +END SUBROUTINE + +SUBROUTINE SUB2( str ) + IMPLICIT NONE + CHARACTER(*) :: str +END SUBROUTINE diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/auto_char_dummy_array_3.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/auto_char_dummy_array_3.f90 new file mode 100644 index 0000000..053956c --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/auto_char_dummy_array_3.f90 @@ -0,0 +1,25 @@ +! { dg-do run } + +! PR fortran/49885 +! Check that character arrays with non-constant char-length are handled +! correctly. + +! Contributed by Daniel Kraft <d@domob.eu>, +! based on original test case and variant by Tobias Burnus in comment 2. + +PROGRAM main + IMPLICIT NONE + + CALL s (10) + +CONTAINS + + SUBROUTINE s (nb) + INTEGER :: nb + CHARACTER(MAX (80, nb)) :: bad_rec(1) + + bad_rec(1)(1:2) = 'abc' + IF (bad_rec(1)(1:2) /= 'ab') CALL abort () + END SUBROUTINE s + +END PROGRAM main diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/bessel_6.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/bessel_6.f90 index 3c1a6f4..1671d11 100644 --- a/gcc-4.6/gcc/testsuite/gfortran.dg/bessel_6.f90 +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/bessel_6.f90 @@ -12,7 +12,7 @@ implicit none real,parameter :: values(*) = [0.0, 0.5, 1.0, 0.9, 1.8,2.0,3.0,4.0,4.25,8.0,34.53, 475.78] real,parameter :: myeps(size(values)) = epsilon(0.0) & - * [2, 7, 5, 6, 9, 12, 12, 7, 7, 8, 75, 15 ] + * [2, 7, 5, 6, 9, 12, 12, 7, 7, 8, 92, 15 ] ! The following is sufficient for me - the values above are a bit ! more tolerant ! * [0, 5, 3, 4, 6, 7, 7, 5, 5, 6, 66, 4 ] diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 b/gcc-4.6/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 new file mode 100644 index 0000000..5d5f3ab --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/c_kind_tests_3.f03 @@ -0,0 +1,11 @@ +! { dg-do compile } +! +! PR 47023: [4.6/4.7 regression] C_Sizeof: Rejects valid code +! +! Contributed by <florian.rathgeber@gmail.com> + + use iso_c_binding + real(c_double) x + print *, c_sizeof(x) + print *, c_sizeof(0.0_c_double) +end diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/class_46.f03 b/gcc-4.6/gcc/testsuite/gfortran.dg/class_46.f03 new file mode 100644 index 0000000..4719c25 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/class_46.f03 @@ -0,0 +1,18 @@ +! { dg-do run } +! +! PR 50625: [4.6/4.7 Regression][OOP] ALLOCATABLE attribute lost for module CLASS variables +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + +module m +type t +end type t +class(t), allocatable :: x +end module m + +use m +implicit none +if (allocated(x)) call abort() +end + +! { dg-final { cleanup-modules "m" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/common_16.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/common_16.f90 new file mode 100644 index 0000000..3314e80 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/common_16.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-pedantic -mdalign" { target sh*-*-* } } +! +! PR fortran/50273 +! +subroutine test() + character :: a + integer :: b + character :: c + common /global_var/ a, b, c ! { dg-warning "Padding of 3 bytes required before 'b' in COMMON" } + print *, a, b, c +end subroutine test diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/default_initialization_5.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/default_initialization_5.f90 new file mode 100644 index 0000000..1192761 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/default_initialization_5.f90 @@ -0,0 +1,66 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/51435 +! +! Contributed by darmar.xxl@gmail.com +! +module arr_m + type arr_t + real(8), dimension(:), allocatable :: rsk + end type + type arr_t2 + integer :: a = 77 + end type +end module arr_m +!********************* +module list_m + use arr_m + implicit none + + type(arr_t2), target :: tgt + + type my_list + type(arr_t), pointer :: head => null() + end type my_list + type my_list2 + type(arr_t2), pointer :: head => tgt + end type my_list2 +end module list_m +!*********************** +module worker_mod + use list_m + implicit none + + type data_all_t + type(my_list) :: my_data + end type data_all_t + type data_all_t2 + type(my_list2) :: my_data + end type data_all_t2 +contains + subroutine do_job() + type(data_all_t) :: dum + type(data_all_t2) :: dum2 + + if (associated(dum%my_data%head)) then + call abort() + else + print *, 'OK: do_job my_data%head is NOT associated' + end if + + if (dum2%my_data%head%a /= 77) & + call abort() + end subroutine +end module +!*************** +program hello + use worker_mod + implicit none + call do_job() +end program + +! { dg-final { scan-tree-dump-times "my_data.head = 0B" 1 "original" } } +! { dg-final { scan-tree-dump-times "my_data.head = &tgt" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } +! { dg-final { cleanup-modules "arr_m list_m worker_mod" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/extends_12.f03 b/gcc-4.6/gcc/testsuite/gfortran.dg/extends_12.f03 new file mode 100644 index 0000000..a93f6d0 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/extends_12.f03 @@ -0,0 +1,24 @@ +! { dg-do compile } +! +! PR 48706: Type extension inside subroutine +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + +module mod_diff_01 + implicit none + type :: foo + end type +contains + subroutine create_ext + type, extends(foo) :: foo_e + end type + end subroutine +end module + +program diff_01 + use mod_diff_01 + implicit none + call create_ext() +end program + +! { dg-final { cleanup-modules "mod_diff_01" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/implicit_pure_1.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/implicit_pure_1.f90 new file mode 100644 index 0000000..d4a5a36 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/implicit_pure_1.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! +! PR fortran/51218 +! +! Contributed by Harald Anlauf +! + +module a + implicit none + integer :: neval = 0 +contains + subroutine inc_eval + neval = neval + 1 + end subroutine inc_eval +end module a + +module b + use a + implicit none +contains + function f(x) ! Should be implicit pure + real :: f + real, intent(in) :: x + f = x + end function f + + function g(x) ! Should NOT be implicit pure + real :: g + real, intent(in) :: x + call inc_eval + g = x + end function g +end module b + +program gfcbug114a + use a + use b + implicit none + real :: x = 1, y = 1, t, u, v, w + if (neval /= 0) call abort () + t = f(x)*f(y) + if (neval /= 0) call abort () + u = f(x)*f(y) + f(x)*f(y) + if (neval /= 0) call abort () + v = g(x)*g(y) + if (neval /= 2) call abort () + w = g(x)*g(y) + g(x)*g(y) + if (neval /= 6) call abort () + if (t /= 1.0 .or. u /= 2.0 .or. v /= 1.0 .or. w /= 2) call abort () +end program gfcbug114a + +! { dg-final { scan-module "b" "IMPLICIT_PURE" } } +! { dg-final { cleanup-modules "b" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/implicit_pure_2.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/implicit_pure_2.f90 new file mode 100644 index 0000000..496e856 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/implicit_pure_2.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! PR 51502 - this was wrongly detected to be implicit pure. +module m + integer :: i +contains + subroutine foo(x) + integer, intent(inout) :: x + outer: block + block + i = 5 + end block + end block outer + end subroutine foo +end module m + +! { dg-final { scan-module-absence "m" "IMPLICIT_PURE" } } +! { dg-final { cleanup-modules "m" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/initialization_28.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/initialization_28.f90 new file mode 100644 index 0000000..f533053 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/initialization_28.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! +! PR fortran/50163 +! +! Contributed by Philip Mason +! +character(len=2) :: xx ='aa' +integer :: iloc=index(xx,'bb') ! { dg-error "has not been declared or is a variable" } +end diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/lto/pr45586-2_0.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/lto/pr45586-2_0.f90 new file mode 100644 index 0000000..52e2bb1 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/lto/pr45586-2_0.f90 @@ -0,0 +1,34 @@ +! { dg-lto-do link } +! +! PR fortran/45586 (comment 53) +! + +MODULE M1 + INTEGER, PARAMETER :: dp=8 + TYPE realspace_grid_type + REAL(KIND=dp), DIMENSION ( :, :, : ), ALLOCATABLE :: r + END TYPE realspace_grid_type + TYPE realspace_grid_p_type + TYPE(realspace_grid_type), POINTER :: rs_grid + END TYPE realspace_grid_p_type + TYPE realspaces_grid_p_type + TYPE(realspace_grid_p_type), DIMENSION(:), POINTER :: rs + END TYPE realspaces_grid_p_type +END MODULE + +MODULE M2 + USE M1 +CONTAINS + SUBROUTINE S1() + INTEGER :: i,j + TYPE(realspaces_grid_p_type), DIMENSION(:), POINTER :: rs_gauge + REAL(dp), DIMENSION(:, :, :), POINTER :: y + y=>rs_gauge(i)%rs(j)%rs_grid%r + END SUBROUTINE +END MODULE + +USE M2 + CALL S1() +END + +! { dg-final { cleanup-modules "m1 m2" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/move_alloc_8.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/move_alloc_8.f90 new file mode 100644 index 0000000..2fa5306 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/move_alloc_8.f90 @@ -0,0 +1,106 @@ +! { dg-do compile } +! +! PR fortran/50684 +! +! Module "bug" contributed by Martin Steghöfer. +! + +MODULE BUG + TYPE MY_TYPE + INTEGER, ALLOCATABLE :: VALUE + END TYPE +CONTAINS + SUBROUTINE POINTER_INTENT_IN_BUG_WORKING(POINTER_INTENT_IN_VARIABLE) + TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE + TYPE(MY_TYPE), POINTER :: POINTER_VARIABLE_LOCAL + INTEGER, ALLOCATABLE :: LOCAL_VALUE + + POINTER_VARIABLE_LOCAL=>POINTER_INTENT_IN_VARIABLE + CALL MOVE_ALLOC(POINTER_VARIABLE_LOCAL%VALUE, LOCAL_VALUE) + + RETURN + END SUBROUTINE POINTER_INTENT_IN_BUG_WORKING + + SUBROUTINE POINTER_INTENT_IN_BUG_FAILING(POINTER_INTENT_IN_VARIABLE) + TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE + INTEGER, ALLOCATABLE :: LOCAL_VALUE + + CALL MOVE_ALLOC(POINTER_INTENT_IN_VARIABLE%VALUE, LOCAL_VALUE) + + RETURN + END SUBROUTINE POINTER_INTENT_IN_BUG_FAILING +end module bug + +subroutine test1() + TYPE MY_TYPE + INTEGER, ALLOCATABLE :: VALUE + END TYPE +CONTAINS + SUBROUTINE sub (dt) + type(MY_TYPE), intent(in) :: dt + INTEGER, ALLOCATABLE :: lv + call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." } + END SUBROUTINE +end subroutine test1 + +subroutine test2 (x, px) + implicit none + type t + integer, allocatable :: a + end type t + + type t2 + type(t), pointer :: ptr + integer, allocatable :: a + end type t2 + + type(t2), intent(in) :: x + type(t2), pointer, intent(in) :: px + + integer, allocatable :: a + type(t2), pointer :: ta + + call move_alloc (px, ta) ! { dg-error "cannot be INTENT.IN." } + call move_alloc (x%a, a) ! { dg-error "cannot be INTENT.IN." } + call move_alloc (x%ptr%a, a) ! OK (3) + call move_alloc (px%a, a) ! OK (4) + call move_alloc (px%ptr%a, a) ! OK (5) +end subroutine test2 + +subroutine test3 (x, px) + implicit none + type t + integer, allocatable :: a + end type t + + type t2 + class(t), pointer :: ptr + integer, allocatable :: a + end type t2 + + type(t2), intent(in) :: x + class(t2), pointer, intent(in) :: px + + integer, allocatable :: a + class(t2), pointer :: ta + + call move_alloc (px, ta) ! { dg-error "cannot be INTENT.IN." } + call move_alloc (x%a, a) ! { dg-error "cannot be INTENT.IN." } + call move_alloc (x%ptr%a, a) ! OK (6) + call move_alloc (px%a, a) ! OK (7) + call move_alloc (px%ptr%a, a) ! OK (8) +end subroutine test3 + +subroutine test4() + TYPE MY_TYPE + INTEGER, ALLOCATABLE :: VALUE + END TYPE +CONTAINS + SUBROUTINE sub (dt) + CLASS(MY_TYPE), intent(in) :: dt + INTEGER, ALLOCATABLE :: lv + call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." } + END SUBROUTINE +end subroutine test4 + +! { dg-final { cleanup-modules "bug" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/namelist_72.f b/gcc-4.6/gcc/testsuite/gfortran.dg/namelist_72.f new file mode 100644 index 0000000..22c0880 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/namelist_72.f @@ -0,0 +1,33 @@ +! { dg-do run } +! +! PR fortran/49791 +! +! Contributed by Elliott Sales de Andrade +! + program namelist_test + + dimension xpos(5000), ypos(5000) + namelist /geometry/ xpos, ypos + + xpos = -huge(xpos) + ypos = -huge(ypos) + + open(unit=4,file='geometry.in') + write(4,'(a)') '$geometry' + write(4,'(a)') ' xpos(1)= 0.00, 0.10, 0.20, 0.30, 0.40,' + write(4,'(a)') ' ypos(1)= 0.50, 0.60, 0.70, 0.80, 0.90,' + write(4,'(a)') '$end' + + close(4) + + open (unit=4,file='geometry.in',status='old',form='formatted') + read (4,geometry) + close(4, status='delete') + + !print *, 'xpos', xpos(1:10), 'ypos', ypos(1:10) + + if (any (xpos(1:5) /= [0.00, 0.10, 0.20, 0.30, 0.40]))call abort() + if (any (ypos(1:5) /= [0.50, 0.60, 0.70, 0.80, 0.90]))call abort() + if (any (xpos(6:) /= -huge(xpos))) call abort () + if (any (ypos(6:) /= -huge(ypos))) call abort () + end diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/namelist_73.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/namelist_73.f90 new file mode 100644 index 0000000..8fc88aa --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/namelist_73.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! +! PR fortran/50109 +! +! Contributed by Jim Hanson +! + program namelist_test + + integer nfp + namelist /indata/ nfp + + nfp = 99 + open(unit=4, status='scratch') + write(4,'(a)') '$indata' + write(4,'(a)') 'NFP = 5,' + write(4,'(a)') "! " + write(4,'(a)') "! " + write(4,'(a)') "! " + write(4,'(a)') '/' + + rewind(4) + read (4,nml=indata) + close(4) + +! write(*,*) nfp + if (nfp /= 5) call abort() + + end diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_check_11.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_check_11.f90 new file mode 100644 index 0000000..b6aa79a --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_check_11.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! { dg-options "-fcheck=all" } +! +! { dg-shouldfail "Pointer check" } +! { dg-output "Fortran runtime error: Pointer actual argument 'y' is not associated" } +! +! +! PR fortran/50718 +! +! Was failing (ICE) with -fcheck=pointer if the dummy had the value attribute. + +type t + integer :: p +end type t + +type(t), pointer :: y => null() + +call sub(y) ! Invalid: Nonassociated pointer + +contains + subroutine sub (x) + type(t), value :: x + end subroutine +end diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_check_12.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_check_12.f90 new file mode 100644 index 0000000..cfef70e --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_check_12.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-options "-fcheck=all" } +! +! { dg-shouldfail "Pointer check" } +! { dg-output "Fortran runtime error: Pointer actual argument 'p' is not associated" } +! +! PR fortran/50718 +! +! Was failing with -fcheck=pointer: Segfault at run time + +integer, pointer :: p => null() + +call sub2(%val(p)) ! Invalid: Nonassociated pointer +end + +! Not quite correct dummy, but if one uses VALUE, gfortran +! complains about a missing interface - which we cannot use +! if we want to use %VAL(). + +subroutine sub2(p) + integer :: p +end subroutine sub2 diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90 new file mode 100644 index 0000000..44f360e --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_comp_init_1.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } +! +! PR fortran/50050 +! ICE whilst trying to access NULL shape. + +! Reduced from the FoX library http://www1.gly.bris.ac.uk/~walker/FoX/ +! Contributed by Andrew Benson <abenson@its.caltech.edu> + +module m_common_attrs + implicit none + + type dict_item + end type dict_item + + type dict_item_ptr + type(dict_item), pointer :: d => null() + end type dict_item_ptr + +contains + + subroutine add_item_to_dict() + type(dict_item_ptr), pointer :: tempList(:) + integer :: n + + allocate(tempList(0:n+1)) + end subroutine add_item_to_dict + +end module m_common_attrs + +! { dg-final { cleanup-modules "m_common_attrs" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_intent_5.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_intent_5.f90 new file mode 100644 index 0000000..c4e3c7a --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/pointer_intent_5.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! +! PR 50570: [4.6/4.7 Regression] Incorrect error for assignment to intent(in) pointer +! +! Contributed by Bill Long <longb@cray.com> + +program bots_sparselu_pointer_intent_in + + implicit none + integer, pointer :: array(:) + + allocate(array(4)) + array = 0 + call sub(array) + if (sum(array)/=1) call abort + +contains + + subroutine sub(dummy) + integer, pointer, intent(in) :: dummy(:) + dummy(1) = 1 + end subroutine sub + +end program diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/pr49675.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/pr49675.f90 new file mode 100644 index 0000000..06fd1b6 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/pr49675.f90 @@ -0,0 +1,6 @@ +! PR middle-end/49675 +! { dg-do compile } +! { dg-options "-finstrument-functions" } +end +! { dg-final { scan-assembler "__cyg_profile_func_enter" } } +! { dg-final { scan-assembler "__cyg_profile_func_exit" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/pr50875.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/pr50875.f90 new file mode 100644 index 0000000..6b4476c --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/pr50875.f90 @@ -0,0 +1,39 @@ +! { dg-do compile { target { i?86-*-* x86_64-*-* } } } +! { dg-options "-O3 -mavx" } +! +! PR fortran/50875.f90 + +module test + + implicit none + + integer, parameter :: dp=kind(1.d0) + + integer :: P = 2 + + real(kind=dp), allocatable :: real_array_A(:),real_array_B(:,:) + complex(kind=dp), allocatable :: cmplx_array_A(:) + +contains + + subroutine routine_A + + integer :: i + + allocate(cmplx_array_A(P),real_array_B(P,P),real_array_A(P)) + + real_array_A = 1 + real_array_B = 1 + + do i = 1, p + cmplx_array_A = cmplx(real_array_B(:,i),0.0_dp,dp) + cmplx_array_A = cmplx_array_A * exp(cmplx(0.0_dp,real_array_A+1)) + end do + + deallocate(cmplx_array_A,real_array_B,real_array_A) + + end subroutine routine_A + +end module test + +! { dg-final { cleanup-modules "test" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/proc_decl_27.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/proc_decl_27.f90 new file mode 100644 index 0000000..30ff4de --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/proc_decl_27.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! +! PR 50659: [4.5/4.6/4.7 Regression] [F03] ICE on invalid with procedure interface +! +! Contributed by Andrew Benson <abenson@caltech.edu> + +module m1 + integer :: arrSize +end module + +module m2 +contains + function Proc (arg) + use m1 + double precision, dimension(arrSize) :: proc + double precision :: arg + end function +end + + use m2 + implicit none + procedure(Proc) :: Proc_Get +end + +! { dg-final { cleanup-modules "m1 m2" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/realloc_on_assign_8.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/realloc_on_assign_8.f90 new file mode 100644 index 0000000..4f7d288 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/realloc_on_assign_8.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! +! PR fortran/51448 +! +! Contribued by François Willot +! + PROGRAM MAIN + IMPLICIT NONE + TYPE mytype + REAL b(2) + END TYPE mytype + TYPE(mytype) a + DOUBLE PRECISION, ALLOCATABLE :: x(:) + ALLOCATE(x(2)) + a%b=0.0E0 + x=a%b + END diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/result_in_spec_4.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/result_in_spec_4.f90 new file mode 100644 index 0000000..3f0e9a3 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/result_in_spec_4.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! +! PR fortran/49648 +! ICE for calls to a use-associated function returning an array whose spec +! depends on a function call. + +! Contributed by Tobias Burnus <burnus@net-b.de> + +module m2 + COMPLEX, SAVE, ALLOCATABLE :: P(:) +contains + FUNCTION getPhaseMatrix() RESULT(PM) + COMPLEX:: PM(SIZE(P),3) + PM=0.0 + END FUNCTION +end module m2 + +module m + use m2 +contains + SUBROUTINE gf_generateEmbPot() + COMPLEX :: sigma2(3,3) + sigma2 = MATMUL(getPhaseMatrix(), sigma2) + END SUBROUTINE +end module m + +! { dg-final { cleanup-modules "m m2" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/string_5.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/string_5.f90 new file mode 100644 index 0000000..87ec709 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/string_5.f90 @@ -0,0 +1,7 @@ +! { dg-do compile } +! PR fortran/48876 - this used to segfault. +! Test case contributed by mhp77 (a) gmx.at. +program test + character :: string = "string"( : -1 ) +end program test + diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/typebound_proc_24.f03 b/gcc-4.6/gcc/testsuite/gfortran.dg/typebound_proc_24.f03 new file mode 100644 index 0000000..f200e0e --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/typebound_proc_24.f03 @@ -0,0 +1,32 @@ +! { dg-do compile } +! +! PR 49112: [4.6/4.7 Regression] [OOP] Missing type-bound procedure, "duplicate save" warnings and internal compiler error +! +! Contributed by John <jwmwalrus@gmail.com> + +module datetime_mod + + implicit none + + type :: DateTime + integer :: year, month, day + contains + procedure :: getFormattedString + end type + + type(DateTime) :: ISO_REFERENCE_DATE = DateTime(1875, 5, 20) + +contains + + character function getFormattedString(dt) + class(DateTime) :: dt + end function + + subroutine test + type(DateTime) :: dt + print *,dt%getFormattedString() + end subroutine + +end module + +! { dg-final { cleanup-modules "datetime_mod" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/vect/pr50178.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/vect/pr50178.f90 new file mode 100644 index 0000000..e24ce5b --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/vect/pr50178.f90 @@ -0,0 +1,29 @@ +! { dg-do compile } + +module yemdyn + implicit none + integer, parameter :: jpim = selected_int_kind(9) + integer, parameter :: jprb = selected_real_kind(13,300) + real(kind=jprb) :: elx + real(kind=jprb), allocatable :: xkcoef(:) + integer(kind=jpim),allocatable :: ncpln(:), npne(:) +end module yemdyn + +subroutine suedyn + + use yemdyn + + implicit none + + integer(kind=jpim) :: jm, jn + real(kind=jprb) :: zjm, zjn, zxxx + + jn=0 + do jm=0,ncpln(jn) + zjm=real(jm,jprb) / elx + xkcoef(npne(jn)+jm) = - zxxx*(zjm**2)**0.5_jprb + end do + +end subroutine suedyn + +! { dg-final { cleanup-tree-dump "vect" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/vect/pr50412.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/vect/pr50412.f90 new file mode 100644 index 0000000..4f95741 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/vect/pr50412.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } + + DOUBLE PRECISION AK,AI,AAE + COMMON/com/AK(36),AI(4,4),AAE(8,4),ii,jj + DO 20 II=1,4 + DO 21 JJ=1,4 + AK(n)=AK(n)-AAE(I,II)*AI(II,JJ) + 21 CONTINUE + 20 CONTINUE + END + +! { dg-final { cleanup-tree-dump "vect" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/warn_function_without_result_2.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/warn_function_without_result_2.f90 new file mode 100644 index 0000000..25fd0b7 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/warn_function_without_result_2.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! { dg-options "-Wall" } +! +! PR fortran/50923 +! +module m +contains + integer pure function f() ! { dg-warning "Return value of function 'f' at .1. not set" } + end function f + integer pure function g() result(h) ! { dg-warning "Return value 'h' of function 'g' declared at .1. not set" } + end function g + integer pure function i() + i = 7 + end function i + integer pure function j() result(k) + k = 8 + end function j +end module m +! { dg-final { cleanup-modules "mod" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/where_3.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/where_3.f90 new file mode 100644 index 0000000..1507ad9 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/where_3.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! +! PR fortran/50129 +! ICE after reporting an error on a masked ELSEWHERE statement following an +! unmasked one. +! +! Contributed by Joost Van de Vondele <Joost.VandeVondele@pci.uzh.ch> + +INTEGER :: I(3) +WHERE (I>2) +ELSEWHERE +ELSEWHERE (I<1) ! { dg-error "follows previous unmasked ELSEWHERE" } +END WHERE +END + diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/whole_file_35.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/whole_file_35.f90 new file mode 100644 index 0000000..46a8865 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/whole_file_35.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! +! PR fortran/50408 +! +! Contributed by Vittorio Zecca +! + module m + type int + integer :: val + end type int + interface ichar + module procedure uch + end interface + contains + function uch (c) + character (len=1), intent (in) :: c + type (int) :: uch + intrinsic ichar + uch%val = 127 - ichar (c) + end function uch + end module m + + program p + use m + print *,ichar('~') ! must print "1" + end program p + +! { dg-final { cleanup-modules "m" } } diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/widechar_compare_1.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/widechar_compare_1.f90 new file mode 100644 index 0000000..4410110 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/widechar_compare_1.f90 @@ -0,0 +1,10 @@ +! { dg-do run } +! PR 50192 - on little-endian systems, this used to fail. +program main + character(kind=4,len=2) :: c1, c2 + c1 = 4_' ' + c2 = 4_' ' + c1(1:1) = transfer(257, mold=c1(1:1)) + c2(1:1) = transfer(64, mold=c2(1:1)) + if (c1 < c2) call abort +end program main diff --git a/gcc-4.6/gcc/testsuite/gfortran.dg/zero_stride_1.f90 b/gcc-4.6/gcc/testsuite/gfortran.dg/zero_stride_1.f90 new file mode 100644 index 0000000..c5f6cc7 --- /dev/null +++ b/gcc-4.6/gcc/testsuite/gfortran.dg/zero_stride_1.f90 @@ -0,0 +1,7 @@ +! { dg-do compile } +! PR 50130 - this caused an ICE. Test case supplied by Joost +! VandeVondele. +integer, parameter :: a(10)=0 +integer, parameter :: b(10)=a(1:10:0) ! { dg-error "Illegal stride of zero" } +END + |