diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
45 files changed, 409 insertions, 92 deletions
diff --git a/gcc/testsuite/gfortran.dg/altreturn_1.f90 b/gcc/testsuite/gfortran.dg/altreturn_1.f90 index c0ae15f9a6b..7ec77c178f5 100644 --- a/gcc/testsuite/gfortran.dg/altreturn_1.f90 +++ b/gcc/testsuite/gfortran.dg/altreturn_1.f90 @@ -1,4 +1,6 @@ ! { dg-do compile } +! { dg-options "-std=gnu" } + subroutine foo (a) real t, a, baz call bar (*10) diff --git a/gcc/testsuite/gfortran.dg/altreturn_2.f90 b/gcc/testsuite/gfortran.dg/altreturn_2.f90 index d0556d0370d..9abf3501fb1 100644 --- a/gcc/testsuite/gfortran.dg/altreturn_2.f90 +++ b/gcc/testsuite/gfortran.dg/altreturn_2.f90 @@ -1,4 +1,6 @@ ! { dg-do compile } +! { dg-options "-std=gnu" } + program altreturn_2 call foo() ! { dg-error "Missing alternate return" } contains diff --git a/gcc/testsuite/gfortran.dg/altreturn_3.f90 b/gcc/testsuite/gfortran.dg/altreturn_3.f90 index 28fc6a8aa8a..c445159872f 100644 --- a/gcc/testsuite/gfortran.dg/altreturn_3.f90 +++ b/gcc/testsuite/gfortran.dg/altreturn_3.f90 @@ -1,5 +1,5 @@ ! { dg-do run } -! { dg-options "-std=legacy" } +! { dg-options "-std=gnu" } ! ! Tests the fix for PR30236, which was due to alternate returns ! in generic interfaces causing a segfault. They now work diff --git a/gcc/testsuite/gfortran.dg/altreturn_4.f90 b/gcc/testsuite/gfortran.dg/altreturn_4.f90 index 409ea51be7e..7375544d203 100644 --- a/gcc/testsuite/gfortran.dg/altreturn_4.f90 +++ b/gcc/testsuite/gfortran.dg/altreturn_4.f90 @@ -1,4 +1,6 @@ ! { dg-do compile } +! { dg-options "-std=gnu" } +! ! Tests the fix for PR28172, in which an ICE would result from ! the contained call with an alternate retrun. diff --git a/gcc/testsuite/gfortran.dg/altreturn_5.f90 b/gcc/testsuite/gfortran.dg/altreturn_5.f90 index a8b6ff83cd1..a552d3904ac 100644 --- a/gcc/testsuite/gfortran.dg/altreturn_5.f90 +++ b/gcc/testsuite/gfortran.dg/altreturn_5.f90 @@ -1,33 +1,32 @@ -! { dg-do run } -! { dg-options "-std=legacy" } -! -! Tests the fix for PR31483, in which dummy argument procedures -! produced an ICE if they had an alternate return. -! -! Contributed by Mathias Fröhlich <M.Froehlich@science-computing.de> - - SUBROUTINE R (i, *, *) - INTEGER i - RETURN i - END - +! { dg-do run }
+! { dg-options "-std=gnu" }
+!
+! Tests the fix for PR31483, in which dummy argument procedures
+! produced an ICE if they had an alternate return.
+!
+! Contributed by Mathias Fröhlich <M.Froehlich@science-computing.de>
+
+ SUBROUTINE R (i, *, *)
+ INTEGER i
+ RETURN i
+ END
+
SUBROUTINE PHLOAD (READER, i, res)
IMPLICIT NONE
- EXTERNAL READER - integer i + EXTERNAL READER
+ integer i
character(3) res
CALL READER (i, *1, *2)
- 1 res = "one" + 1 res = "one"
return
- 2 res = "two" + 2 res = "two"
return
- END - - EXTERNAL R - character(3) res
- call PHLOAD (R, 1, res) - if (res .ne. "one") call abort () - CALL PHLOAD (R, 2, res) - if (res .ne. "two") call abort () END
+ EXTERNAL R
+ character(3) res
+ call PHLOAD (R, 1, res)
+ if (res .ne. "one") call abort ()
+ CALL PHLOAD (R, 2, res)
+ if (res .ne. "two") call abort ()
+ END
diff --git a/gcc/testsuite/gfortran.dg/altreturn_6.f90 b/gcc/testsuite/gfortran.dg/altreturn_6.f90 index 19c851e5092..82bb46df12c 100644 --- a/gcc/testsuite/gfortran.dg/altreturn_6.f90 +++ b/gcc/testsuite/gfortran.dg/altreturn_6.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-std=legacy" } +! { dg-options "-std=gnu" } ! ! PR 32938 subroutine r (*) diff --git a/gcc/testsuite/gfortran.dg/altreturn_7.f90 b/gcc/testsuite/gfortran.dg/altreturn_7.f90 index e667ff436c3..522d7677943 100644 --- a/gcc/testsuite/gfortran.dg/altreturn_7.f90 +++ b/gcc/testsuite/gfortran.dg/altreturn_7.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-std=legacy" } +! { dg-options "-std=gnu" } ! ! PR 40848: [4.5 Regression] ICE with alternate returns ! diff --git a/gcc/testsuite/gfortran.dg/altreturn_8.f90 b/gcc/testsuite/gfortran.dg/altreturn_8.f90 new file mode 100644 index 00000000000..ccd58a2b083 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_8.f90 @@ -0,0 +1,23 @@ +! { dg-do compile }
+! { dg-options "-std=gnu" }
+!
+! PR 56284: [OOP] ICE with alternate return in type-bound procedure
+!
+! Contributed by Arjen Markus <arjen.markus@deltares.nl>
+
+module try_this
+ implicit none
+
+ type :: table_t
+ contains
+ procedure, nopass :: getRecord
+ end type
+
+contains
+
+ subroutine getRecord ( * )
+ end subroutine
+
+end module
+
+! { dg-final { cleanup-modules "try_this" } }
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_44.f90 b/gcc/testsuite/gfortran.dg/array_constructor_44.f90 new file mode 100644 index 00000000000..e0cffd168be --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_44.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! { dg-options "-ffrontend-optimize" } +! PR 56872 - wrong front-end optimization with a single constructor. +! Original bug report by Rich Townsend. + integer :: k + real :: s + integer :: m + s = 2.0 + m = 4 + res = SUM([(s**(REAL(k-1)/REAL(m-1)),k=1,m)]) + if (abs(res - 5.84732246) > 1e-6) call abort + end diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_4.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_4.f90 index 3391fba882f..756ab2245c5 100644 --- a/gcc/testsuite/gfortran.dg/assumed_rank_4.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_rank_4.f90 @@ -20,8 +20,8 @@ end subroutine valid2 subroutine foo99(x) integer x(99) - call valid1(x) ! { dg-error "Procedure 'valid1' at .1. with assumed-rank dummy argument 'x' must have an explicit interface" } - call valid2(x(1)) ! { dg-error "Procedure 'valid2' at .1. with assumed-type dummy argument 'x' must have an explicit interface" } + call valid1(x) ! { dg-error "Explicit interface required" } + call valid2(x(1)) ! { dg-error "Explicit interface required" } end subroutine foo99 subroutine foo(x) diff --git a/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 index 6b4e26e6b45..72ee8450dc7 100644 --- a/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 +++ b/gcc/testsuite/gfortran.dg/auto_char_len_4.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-fwhole-file" } +! { dg-options "-pedantic -fwhole-file" } ! ! Tests the fix for PR25087, in which the following invalid code ! was not detected. @@ -14,8 +14,8 @@ FUNCTION a() END FUNCTION a SUBROUTINE s(n) - CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "must have an explicit interface" } - CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "must have an explicit interface" } + CHARACTER(LEN=n), EXTERNAL :: a ! { dg-error "Character length mismatch" } + CHARACTER(LEN=n), EXTERNAL :: d ! { dg-error "Character length mismatch" } interface function b (m) ! This is OK CHARACTER(LEN=m) :: b diff --git a/gcc/testsuite/gfortran.dg/block_11.f90 b/gcc/testsuite/gfortran.dg/block_11.f90 index 2c2ce9083f6..6fe244d91e8 100644 --- a/gcc/testsuite/gfortran.dg/block_11.f90 +++ b/gcc/testsuite/gfortran.dg/block_11.f90 @@ -50,7 +50,7 @@ module m3 implicit none contains subroutine my_test() - procedure(), pointer :: ptr + procedure(sub), pointer :: ptr ! Before the fix, one had the link error ! "undefined reference to `sub.1909'" block diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 index a667eaf52de..ea62715f33f 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 +++ b/gcc/testsuite/gfortran.dg/c_loc_test_19.f90 @@ -12,6 +12,6 @@ Contains Real( c_double ), Dimension( : ), Target :: aa Type( c_ptr ), Pointer :: b b = c_loc( aa( 1 ) ) ! was rejected before. - b = c_loc( aa ) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" } + b = c_loc( aa ) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" } End Subroutine test End Program gf diff --git a/gcc/testsuite/gfortran.dg/c_loc_test_21.f90 b/gcc/testsuite/gfortran.dg/c_loc_test_21.f90 new file mode 100644 index 00000000000..a31ca034fbb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_loc_test_21.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } + +subroutine foo(a,b,c,d) + use iso_c_binding, only: c_loc, c_ptr + implicit none + real, intent(in), target :: a(:) + real, intent(in), target :: b(5) + real, intent(in), target :: c(*) + real, intent(in), target, allocatable :: d(:) + type(c_ptr) :: ptr + ptr = C_LOC(b) + ptr = C_LOC(c) + ptr = C_LOC(d) + ptr = C_LOC(a) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" } +end subroutine foo diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 index 21cbe0be7ec..21b8526c2ab 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_10.f03 @@ -1,9 +1,9 @@ ! { dg-do compile } -! { dg-options "-std=f2008" } +! { dg-options "-std=f2003" } subroutine aaa(in) use iso_c_binding implicit none integer(KIND=C_int), DIMENSION(:), TARGET :: in type(c_ptr) :: cptr - cptr = c_loc(in) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC" } + cptr = c_loc(in) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" } end subroutine aaa diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 index b8e6d849e67..c00e5ed1640 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_11.f03 @@ -31,9 +31,9 @@ contains integer(c_int), intent(in) :: handle if (.true.) then ! The ultimate component is an allocatable target - get_double_vector_address = c_loc(dbv_pool(handle)%v) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" } + get_double_vector_address = c_loc(dbv_pool(handle)%v) ! OK: Interop type and allocatable else - get_double_vector_address = c_loc(vv) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" } + get_double_vector_address = c_loc(vv) ! OK: Interop type and allocatable endif end function get_double_vector_address diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 index 2c074e874f0..55e8d00fa9c 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_16.f90 @@ -19,7 +19,7 @@ type(C_PTR) :: p p = c_loc(tt%t%i(1)) - p = c_loc(n(1:2)) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only whole-arrays are interoperable" } - p = c_loc(ttt%t(5,1:2)%i(1)) ! { dg-error "TS 29113: Noninteroperable array at .1. as argument to C_LOC: Only whole-arrays are interoperable" } + p = c_loc(n(1:2)) ! OK: interop type + contiguous + p = c_loc(ttt%t(5,1:2)%i(1)) ! FIXME: Noncontiguous (invalid) - compile-time testable p = c_loc(x[1]) ! { dg-error "shall not be coindexed" } end diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 index 1f28d3e0c0e..d45a89156fc 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_4.f03 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-std=f2008" } +! { dg-options "-std=f2003" } ! module c_loc_tests_4 use, intrinsic :: iso_c_binding @@ -12,6 +12,6 @@ contains type(c_ptr) :: my_c_ptr my_array_ptr => my_array - my_c_ptr = c_loc(my_array_ptr) ! { dg-error "Noninteroperable array at .1. as argument to C_LOC: Only explicit-size and assumed-size arrays are interoperable" } + my_c_ptr = c_loc(my_array_ptr) ! { dg-error "Fortran 2008: Array of interoperable type at .1. to C_LOC which is nonallocatable and neither assumed size nor explicit size" } end subroutine sub0 end module c_loc_tests_4 diff --git a/gcc/testsuite/gfortran.dg/class_allocate_14.f90 b/gcc/testsuite/gfortran.dg/class_allocate_14.f90 new file mode 100644 index 00000000000..0c7aeb432d3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_allocate_14.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/56845 +! +module m +type t +integer ::a +end type t +contains +subroutine sub + type(t), save, allocatable :: x + class(t), save,allocatable :: y + if (.not. same_type_as(x,y)) call abort() +end subroutine sub +subroutine sub2 + type(t), save, allocatable :: a(:) + class(t), save,allocatable :: b(:) + if (.not. same_type_as(a,b)) call abort() +end subroutine sub2 +end module m + +use m +call sub() +call sub2() +end + +! { dg-final { scan-tree-dump-times "static struct __class_m_T_1_0a b = {._data={.data=0B}, ._vptr=&__vtab_m_T};" 1 "original" } } +! { dg-final { scan-tree-dump-times "static struct __class_m_T_a y = {._data=0B, ._vptr=&__vtab_m_T};" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } + diff --git a/gcc/testsuite/gfortran.dg/class_allocate_15.f90 b/gcc/testsuite/gfortran.dg/class_allocate_15.f90 new file mode 100644 index 00000000000..07c1cb49dbc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_allocate_15.f90 @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original -fdump-tree-original -fmax-stack-var-size=1" } +! +! PR fortran/56845 +! +type t +end type t +type, extends(t) :: t2 +end type t2 +type(t) :: y +call foo() +call bar() +contains + subroutine foo() + class(t), allocatable :: x + if(allocated(x)) call abort() + if(.not.same_type_as(x,y)) call abort() + allocate (t2 :: x) + end + subroutine bar() + class(t), allocatable :: x(:) + if(allocated(x)) call abort() + if(.not.same_type_as(x,y)) call abort() + allocate (t2 :: x(4)) + end +end +! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_2.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_2.f90 new file mode 100644 index 00000000000..13c823e7474 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_2.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! PR fortran/56929 +! +! Contributed by Damian Rouson +! +! Allocatable scalar corrays were mishandled (ICE) +! +module parent_coarray_component + type parent + real, allocatable :: dummy[:] + end type + type, extends(parent) :: child + end type +contains + subroutine do_something(this) + class(child) this + end +end diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 new file mode 100644 index 00000000000..bec7ee225fe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! Allocate/deallocate with libcaf. +! +! As coarray_lib_alloc_2.f90 but for a subroutine instead of the PROGRAM +! +subroutine test + type t + end type t + class(t), allocatable :: xx[:], yy(:)[:] + integer :: stat + character(len=200) :: errmsg + allocate(xx[*], stat=stat, errmsg=errmsg) + allocate(yy(2)[*], stat=stat, errmsg=errmsg) + deallocate(xx,yy,stat=stat, errmsg=errmsg) + end + +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/function_types_3.f90 b/gcc/testsuite/gfortran.dg/function_types_3.f90 index 49d5d5f561b..e8347251441 100644 --- a/gcc/testsuite/gfortran.dg/function_types_3.f90 +++ b/gcc/testsuite/gfortran.dg/function_types_3.f90 @@ -5,7 +5,7 @@ ! PR 50401: SIGSEGV in resolve_transfer interface - function f() ! { dg-error "must be a dummy argument" } + function f() ! { dg-error "must be a dummy argument|Interface mismatch in global procedure" } dimension f(*) end function end interface diff --git a/gcc/testsuite/gfortran.dg/global_references_1.f90 b/gcc/testsuite/gfortran.dg/global_references_1.f90 index 5e72dc9419b..cfff8b32c0b 100644 --- a/gcc/testsuite/gfortran.dg/global_references_1.f90 +++ b/gcc/testsuite/gfortran.dg/global_references_1.f90 @@ -23,7 +23,7 @@ function g(x) ! Global entity ! Function 'f' cannot be referenced as a subroutine. The previous ! definition is in 'line 12'. - call f(g) ! { dg-error "is already being used as a FUNCTION" } + call f(g) ! { dg-error "is already being used as a FUNCTION|Interface mismatch in global procedure" } end function g ! Error only appears once but testsuite associates with both lines. function h(x) ! { dg-error "is already being used as a FUNCTION" } @@ -59,7 +59,7 @@ END SUBROUTINE TT ! Function 'h' cannot be referenced as a subroutine. The previous ! definition is in 'line 29'. - call h (x) ! { dg-error "is already being used as a FUNCTION" } + call h (x) ! { dg-error "is already being used as a FUNCTION|Interface mismatch in global procedure" } ! PR23308=========================================================== ! Lahey - 2521-S: "SOURCE.F90", line 68: Intrinsic procedure name or diff --git a/gcc/testsuite/gfortran.dg/import2.f90 b/gcc/testsuite/gfortran.dg/import2.f90 index 9db21977daa..76c87d617dd 100644 --- a/gcc/testsuite/gfortran.dg/import2.f90 +++ b/gcc/testsuite/gfortran.dg/import2.f90 @@ -4,30 +4,6 @@ ! Test whether import does not work with -std=f95 ! PR fortran/29601 -subroutine test(x) - type myType3 - sequence - integer :: i - end type myType3 - type(myType3) :: x - if(x%i /= 7) call abort() - x%i = 1 -end subroutine test - - -subroutine bar(x,y) - type myType - sequence - integer :: i - end type myType - type(myType) :: x - integer(8) :: y - if(y /= 8) call abort() - if(x%i /= 2) call abort() - x%i = 5 - y = 42 -end subroutine bar - module testmod implicit none integer, parameter :: kind = 8 @@ -66,14 +42,4 @@ program foo end subroutine test end interface - type(myType) :: y - type(myType3) :: z - integer(dp) :: i8 - y%i = 2 - i8 = 8 - call bar(y,i8) ! { dg-error "Type mismatch in argument" } - if(y%i /= 5 .or. i8/= 42) call abort() - z%i = 7 - call test(z) ! { dg-error "Type mismatch in argument" } - if(z%i /= 1) call abort() end program foo diff --git a/gcc/testsuite/gfortran.dg/import6.f90 b/gcc/testsuite/gfortran.dg/import6.f90 index 1bf9669c5b6..d57a6368b74 100644 --- a/gcc/testsuite/gfortran.dg/import6.f90 +++ b/gcc/testsuite/gfortran.dg/import6.f90 @@ -7,6 +7,7 @@ !
subroutine func1(param)
type :: my_type
+ sequence
integer :: data
end type my_type
type(my_type) :: param
@@ -15,6 +16,7 @@ end subroutine func1 subroutine func2(param)
type :: my_type
+ sequence
integer :: data
end type my_type
type(my_type) :: param
@@ -22,6 +24,7 @@ subroutine func2(param) end subroutine func2
type :: my_type
+ sequence
integer :: data
end type my_type
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 index c2dd07cda5a..4c159bde179 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_actual_3.f90 @@ -1,4 +1,6 @@ ! { dg-do compile } +! { dg-options "-std=gnu" } +! ! Tests the fix for PR30237 in which alternate returns in intrinsic ! actual arglists were quietly ignored. ! diff --git a/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 index f3c6e1269b2..4fd747616a4 100644 --- a/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 +++ b/gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90 @@ -1,4 +1,6 @@ ! { dg-do compile } +! { dg-options "-std=gnu" } +! ! Tests the fix for PR25102, which did not diagnose the aberrant interface ! assignement below. ! diff --git a/gcc/testsuite/gfortran.dg/namelist_82.f90 b/gcc/testsuite/gfortran.dg/namelist_82.f90 new file mode 100644 index 00000000000..399d59fe66b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_82.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! PR56660 Fails to read NAMELIST with certain form array syntax +type ptracer + character(len = 2) :: sname + logical :: lini +end type ptracer + +type(ptracer) , dimension(3) :: tracer +namelist/naml1/ tracer + +tracer(:) = ptracer('XXX', .false.) + +open (99, file='nml.dat', status="replace") +write(99,*) "&naml1" +!write(99,*) " tracer(2) = 'bb' , .true." +write(99,*) " tracer(:) = 'aa' , .true." +write(99,*) " tracer(2) = 'bb' , .true." +write(99,*) "/" +rewind(99) + +read (99, nml=naml1) +close (99, status="delete") + +if (tracer(1)%sname.ne.'aa') call abort() +if (.not.tracer(1)%lini) call abort() +if (tracer(2)%sname.ne.'bb') call abort() +if (.not.tracer(2)%lini) call abort() +if (tracer(3)%sname.ne.'XX') call abort() +if (tracer(3)%lini) call abort() + +!write (*, nml=naml1) + +end diff --git a/gcc/testsuite/gfortran.dg/proc_decl_18.f90 b/gcc/testsuite/gfortran.dg/proc_decl_18.f90 index 15993626cc9..c4216135106 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_18.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_18.f90 @@ -23,7 +23,7 @@ implicit none abstract interface function abs_fun(x,sz) - integer :: x(:) + integer,intent(in) :: x(:) interface pure integer function sz(b) integer,intent(in) :: b(:) diff --git a/gcc/testsuite/gfortran.dg/proc_decl_2.f90 b/gcc/testsuite/gfortran.dg/proc_decl_2.f90 index a16b4db5f01..97e06148e27 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_2.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_2.f90 @@ -124,12 +124,12 @@ integer function p2(x) end function subroutine p3(x) - real,intent(inout):: x + real :: x x=x+1.0 end subroutine subroutine p4(x) - real,intent(inout):: x + real :: x x=x-1.5 end subroutine @@ -137,7 +137,7 @@ subroutine p5() end subroutine subroutine p6(x) - real,intent(inout):: x + real :: x x=x*2. end subroutine diff --git a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 b/gcc/testsuite/gfortran.dg/proc_decl_9.f90 index 08faee931e6..58ae321899e 100644 --- a/gcc/testsuite/gfortran.dg/proc_decl_9.f90 +++ b/gcc/testsuite/gfortran.dg/proc_decl_9.f90 @@ -2,7 +2,7 @@ ! PR33162 INTRINSIC functions as ACTUAL argument ! Test case adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org> real function t(x) - real ::x + real, intent(in) ::x t = x end function diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_40.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_40.f90 new file mode 100644 index 00000000000..dae91df1c3c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_40.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! +! PR 56261: [OOP] seg fault call procedure pointer on polymorphic array +! +! Contributed by Andrew Benson <abensonca@gmail.com> + + implicit none + type :: nc + end type + external :: qq + procedure( ), pointer :: f1 + procedure(ff), pointer :: f2 + + f1 => ff ! { dg-error "Explicit interface required" } + f2 => qq ! { dg-error "Explicit interface required" } + +contains + + subroutine ff (self) + class(nc) :: self + end subroutine + +end diff --git a/gcc/testsuite/gfortran.dg/read_repeat_2.f90 b/gcc/testsuite/gfortran.dg/read_repeat_2.f90 new file mode 100644 index 00000000000..4b8659e5f34 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/read_repeat_2.f90 @@ -0,0 +1,19 @@ +! { dg-do run } +! +! PR fortran/56810 +! +! Contributed by Jonathan Hogg +! +program test + implicit none + + integer :: i + complex :: a(4) + + open (99, status='scratch') + write (99, *) '4*(1.0,2.0)' + rewind (99) + read (99,*) a(:) + close (99) + if (any (a /= cmplx (1.0,2.0))) call abort() +end program test diff --git a/gcc/testsuite/gfortran.dg/reshape_5.f90 b/gcc/testsuite/gfortran.dg/reshape_5.f90 new file mode 100644 index 00000000000..a7d4a3f001f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape_5.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! +! PR fortran/56849 +! +integer :: x(2,2),y(4) +y = reshape([1,2,3,4],[4]) +x(:,1:1) = reshape(y(::2), [1,2], order=[1,2]) ! { dg-error "Different shape for array assignment at .1. on dimension 1 .2 and 1." } +print *, y +print *, x(:,1) +end diff --git a/gcc/testsuite/gfortran.dg/select_type_33.f03 b/gcc/testsuite/gfortran.dg/select_type_33.f03 new file mode 100644 index 00000000000..3ba27e0103c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_33.f03 @@ -0,0 +1,43 @@ +! { dg-do compile } +! +! PR fortran/56816 +! The unfinished SELECT TYPE statement below was leading to an ICE because +! at the time the statement was rejected, the compiler tried to free +! some symbols that had already been freed with the SELECT TYPE +! namespace. +! +! Original testcase from Dominique Pelletier <dominique.pelletier@polymtl.ca> +! +module any_list_module + implicit none + + private + public :: anylist, anyitem + + type anylist + end type + + type anyitem + class(*), allocatable :: value + end type +end module any_list_module + + +module my_item_list_module + + use any_list_module + implicit none + + type, extends (anyitem) :: myitem + end type myitem + +contains + + subroutine myprint (this) + class (myitem) :: this + + select type ( v => this % value ! { dg-error "parse error in SELECT TYPE" } + end select ! { dg-error "Expecting END SUBROUTINE" } + end subroutine myprint + +end module my_item_list_module diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_28.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_28.f03 new file mode 100644 index 00000000000..74199c343fa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_proc_28.f03 @@ -0,0 +1,30 @@ +! { dg-do compile } +! +! PR 56266: [OOP] ICE on invalid in gfc_match_varspec +! +! Contributed by Andrew Benson <abensonca@gmail.com> + +module t + + implicit none + + type nc + contains + procedure :: encM => em + end type nc + +contains + + double precision function em(self) + class(nc) :: self + em=0. + end function + + double precision function cem(c) + type(nc) :: c + cem=c(i)%encM() ! { dg-error "Unclassifiable statement" } + end function + +end module + +! { dg-final { cleanup-modules "t" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_29.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_29.f90 new file mode 100644 index 00000000000..2650d149368 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_proc_29.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! +! PR 55959: [OOP] ICE in in gfc_simplify_expr, at fortran/expr.c:1920 +! +! Contributed by Tilo Schwarz <tilo@tilo-schwarz.de> + +module pdfs + type :: pdf + contains + procedure, nopass :: getx + end type + +contains + + real function getx() + end function + +end module + +program abstract + use pdfs + type(pdf) pp + print pp%getx() ! { dg-error "must be of type default-kind CHARACTER or of INTEGER" } +end program + +! { dg-final { cleanup-modules "pdfs" } } diff --git a/gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f b/gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f index 8f196a69ad4..978b8713717 100644 --- a/gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f +++ b/gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f @@ -41,6 +41,6 @@ C ! we want to check that predictive commoning did something on the ! vectorized loop, which means we have to have exactly 13 vector ! additions. -! { dg-final { scan-tree-dump-times "vect_var\[^\\n\]*\\+ " 13 "optimized" } } +! { dg-final { scan-tree-dump-times "vect_\[^\\n\]*\\+ " 13 "optimized" } } ! { dg-final { cleanup-tree-dump "vect" } } ! { dg-final { cleanup-tree-dump "optimized" } } diff --git a/gcc/testsuite/gfortran.dg/vect/fast-math-pr37021.f90 b/gcc/testsuite/gfortran.dg/vect/fast-math-pr37021.f90 index d2eebd43574..b17ac9c3277 100644 --- a/gcc/testsuite/gfortran.dg/vect/fast-math-pr37021.f90 +++ b/gcc/testsuite/gfortran.dg/vect/fast-math-pr37021.f90 @@ -1,4 +1,5 @@ ! { dg-do compile } +! { dg-require-effective-target vect_double } subroutine to_product_of(self,a,b,a1,a2) complex(kind=8) :: self (:) diff --git a/gcc/testsuite/gfortran.dg/whole_file_16.f90 b/gcc/testsuite/gfortran.dg/whole_file_16.f90 index 048350f1d7e..6c910f47a2c 100644 --- a/gcc/testsuite/gfortran.dg/whole_file_16.f90 +++ b/gcc/testsuite/gfortran.dg/whole_file_16.f90 @@ -5,7 +5,7 @@ ! program main real, dimension(2) :: a - call foo(a) ! { dg-error "must have an explicit interface" } + call foo(a) ! { dg-error "Explicit interface required" } end program main subroutine foo(a) diff --git a/gcc/testsuite/gfortran.dg/whole_file_17.f90 b/gcc/testsuite/gfortran.dg/whole_file_17.f90 index 86272b848a8..a2a9d151511 100644 --- a/gcc/testsuite/gfortran.dg/whole_file_17.f90 +++ b/gcc/testsuite/gfortran.dg/whole_file_17.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-options "-fwhole-file" } +! { dg-options "-pedantic -fwhole-file" } ! ! PR fortran/30668 ! diff --git a/gcc/testsuite/gfortran.dg/whole_file_18.f90 b/gcc/testsuite/gfortran.dg/whole_file_18.f90 index f758408f81e..c483c7da100 100644 --- a/gcc/testsuite/gfortran.dg/whole_file_18.f90 +++ b/gcc/testsuite/gfortran.dg/whole_file_18.f90 @@ -5,7 +5,7 @@ ! PROGRAM MAIN REAL A - CALL SUB(A) ! { dg-error "requires an explicit interface" } + CALL SUB(A) ! { dg-error "Explicit interface required" } END PROGRAM SUBROUTINE SUB(A,I) diff --git a/gcc/testsuite/gfortran.dg/whole_file_20.f03 b/gcc/testsuite/gfortran.dg/whole_file_20.f03 index 766851776bf..b3f77e46105 100644 --- a/gcc/testsuite/gfortran.dg/whole_file_20.f03 +++ b/gcc/testsuite/gfortran.dg/whole_file_20.f03 @@ -17,8 +17,8 @@ PROGRAM main INTEGER :: coarr[*] - CALL coarray(coarr) ! { dg-error " must have an explicit interface" } - CALL polymorph(tt) ! { dg-error " must have an explicit interface" } + CALL coarray(coarr) ! { dg-error "Explicit interface required" } + CALL polymorph(tt) ! { dg-error "Explicit interface required" } END PROGRAM SUBROUTINE coarray(a) diff --git a/gcc/testsuite/gfortran.dg/whole_file_7.f90 b/gcc/testsuite/gfortran.dg/whole_file_7.f90 index 53fed228ae2..3225304397c 100644 --- a/gcc/testsuite/gfortran.dg/whole_file_7.f90 +++ b/gcc/testsuite/gfortran.dg/whole_file_7.f90 @@ -29,6 +29,6 @@ end function test program arr ! The error was not picked up causing an ICE real, dimension(2) :: res - res = test(2) ! { dg-error "needs an explicit INTERFACE" } + res = test(2) ! { dg-error "Explicit interface required" } print *, res end program |