+2012-05-15 Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
+
+ * gfortran.dg/*.f90: Remove now redundant manual
+ cleanup-modules directive.
+
2012-05-14 Uros Bizjak <ubizjak@gmail.com>
* gcc.target/i386/avx256-unaligned-load-[1234].c: Update scan strings.
END TYPE t ! { dg-error "END MODULE" }
END MODULE m
-! { dg-final { cleanup-modules "m" } }
END TYPE error_t ! { dg-error "END MODULE" }
END MODULE m
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE impl
END MODULE m
-! { dg-final { cleanup-modules "m" } }
! See if constructing the extending type works.
conc = concrete_t (1, 2)
END PROGRAM main
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE test
END MODULE m
-! { dg-final { cleanup-modules "m" } }
! other stuff
END SUBROUTINE bottom_c
end module
-! { dg-final { cleanup-modules "m" } }
end type c_type
end module ice_module
-! { dg-final { cleanup-modules "ice_module" } }
end subroutine generic_desc
end interface
end module factory_pattern
-
-! { dg-final { cleanup-modules "factory_pattern" } }
integer, private :: z ! Fortran 2003
end type
end module
-! { dg-final { cleanup-modules "mod" } }
public :: i ! { dg-error "only allowed in the specification part of a module" }
integer,public :: j ! { dg-error "not allowed outside of the specification part of a module" }
end program x
-! { dg-final { cleanup-modules "test mod" } }
bint = 8
write(*,*) aint
end program
-! { dg-final { cleanup-modules "base a b c" } }
end subroutine option_stopwatch_a
end program main
-! { dg-final { cleanup-modules "global my_module" } }
-
n = 5
if(any (foo3(n) /= [ 0,1,2,3,0 ])) call abort()
end program
-! { dg-final { cleanup-modules "one" } }
call bb(w((/3,2,1/))) ! { dg-error "vector subscript" }
write(*,*)w
end
-
-! { dg-final { cleanup-modules "mod" } }
proc_ext = arg
chr = "proc_ext"
end function
-! { dg-final { cleanup-modules "m" } }
\ No newline at end of file
get_d = d
end function get_d
end program test
-! { dg-final { cleanup-modules "foo" } }
CALL foobar (x)
end subroutine bar
END subroutine test
-
-! { dg-final { cleanup-modules "m m2" } }
end function
end module foo
-
-! { dg-final { cleanup-modules "foo" } }
deallocate (u%design, u%model)
deallocate (s%u)
end program
-
-! { dg-final { cleanup-modules "test_struct" } }
call o%make(u)
if (any (int (o%disp()) .ne. [1,2])) call abort
end program main2
-! { dg-final { cleanup-modules "foo" } }
-
call abort ()
end if
end program VST28
-
-! { dg-final { cleanup-modules "iso_varying_string" } }
if (this%look_at_path%r(i)%y2(1) .ne. x(i)) call abort
end do
end
-
-! { dg-final { cleanup-modules "prettypix_module" } }
if (t1%a .ne. -0.5d0) call abort
if (any(t1%b .ne. [-1d0, -2d0])) call abort
end
-
-! { dg-final { cleanup-modules "typemodule" } }
call read_grid_header
end
! { dg-final { cleanup-tree-dump "grid_io" } }
-! { dg-final { cleanup-modules "grid_io" } }
end program alloc
! { dg-final { scan-tree-dump-times "builtin_free" 18 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "alloc_m" } }
USE types_m
TYPE(grib_t) g_dest ! output field
END MODULE
-! { dg-final { cleanup-modules "types_m globals_m" } }
-
if (info .ne. 10) call abort ()
end program tsave
-
-! { dg-final { cleanup-modules "bar_mod" } }
type(d_sparse_mat), intent(out) :: a
end subroutine bug14
end
-! { dg-final { cleanup-modules "d_mat_mod " } }
return
end subroutine cell_output
end module cell
-! { dg-final { cleanup-modules "cell" } }
end subroutine p_bld
end program foo
-! { dg-final { cleanup-modules "p_type_mod" } }
x = a_fun(0)
if (any (x(1)%mons%coeff .ne. 99)) call abort
end program test
-! { dg-final { cleanup-modules "mod_a" } }
end program alloc_fun
! { dg-final { scan-tree-dump-times "free" 10 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "m" } }
bar = carg(1:12)
end function
end
-
-! { dg-final { cleanup-modules "m" } }
use fred1
use fred2
end program fred
-! { dg-final { cleanup-modules "fred1 fred2" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 32 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-
-! { dg-final { cleanup-modules "m" } }
call foo(q)
end program hum
-
-! { dg-final { cleanup-modules "moo" } }
if(associated(p)) deallocate(p)
end subroutine sub
end module test
-! { dg-final { cleanup-modules "test" } }
if (name .ne. 'xxxxxxxxxx') call abort
if (len (name) .ne. 10 ) call abort
end program note7_35
-! { dg-final { cleanup-modules "foo" } }
20 continue
if (i /= -1) call abort ()
end
-! { dg-final { cleanup-modules "arswitch" } }
CALL ABORT()
2 CONTINUE
END
-
-! { dg-final { cleanup-modules "tt" } }
-
function x(z)
x = z
end function x
-! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } }
end subroutine myRoutine ! this is not ambiguous !
end module
-
-! { dg-final { cleanup-modules "a1 a2 b" } }
-
CALL FOO(10.)
call bar (foo) ! { dg-error "is ambiguous" }
END PROGRAM P
-! { dg-final { cleanup-modules "m1 m2" } }
SUBROUTINE bar (arg)
EXTERNAL arg
END SUBROUTINE bar
-! { dg-final { cleanup-modules "m1 m2" } }
call sub2(a%mdr(GRH_SIZE+1),a%size-GRH_SIZE)
end subroutine sub1
end module teststr
-
-! { dg-final { cleanup-modules "teststr" } }
if (astr(i:i) /= achar(0)) call abort
end do
end program test
-! { dg-final { cleanup-modules "cyclic" } }
if (present (j1)) stop
end subroutine
END MODULE s_TESTS
-
-! { dg-final { cleanup-modules "m s_tests" } }
UDS0L = SEQ(RESHAPE ( (/ ((CA_T(J1,J2), J1 = 1, 1), J2 = 1, 2)/),(/2/)))
END SUBROUTINE
END
-! { dg-final { cleanup-modules "o_type_defs tests" } }
write(*,*) my_string(x)
end program len_test
-! { dg-final { cleanup-modules "test" } }
! { dg-error "specification expression" "" { target *-*-* } 13 }
END TYPE TWindowData
END MODULE WinData
-
-! { dg-final { cleanup-modules "windata" } }
return
end subroutine write_out_particles
-
-! { dg-final { cleanup-modules "communication_tools" } }
lenf = x(1)
end function lenf
END MODULE B1
-
-! { dg-final { cleanup-modules "b1" } }
! { dg-final { scan-tree-dump-times "= {}" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "foo" } }
call xmain
if (c(1) .ne. "ab") call abort
end
-! { dg-final { cleanup-modules "bar" } }
-
REAL,INTENT(IN) :: b(:,:)
END SUBROUTINE
end module m3
-
-! { dg-final { cleanup-modules "m1 m2 m3" } }
ZTEMP = PVAZG * SCALP_DV
END SUBROUTINE CAININAD_SCALE_DISTVEC
END MODULE YOMCAIN
-
-! { dg-final { cleanup-modules "yomcain" } }
IF (arr(1) /= 1 .OR. arr(4) /= 4) CALL abort ()
END ASSOCIATE
END PROGRAM main
-! { dg-final { cleanup-modules "m" } }
! { dg-final { scan-tree-dump-times "func" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
END PROGRAM main
! { dg-excess-errors "Syntex error in IF" }
-! { dg-final { cleanup-modules "m" } }
if (.not. associated (a, b)) call abort()
end subroutine cmpPtr
end
-
-! { dg-final { cleanup-modules "m" } }
\r
END\r
\r
-! { dg-final { cleanup-modules "m1" } }\r
integer, intent(in) :: x
end function assumed_len
end program main
-
-! { dg-final { cleanup-modules "funcs mod2" } }
x (2) = 21.0
END SUBROUTINE roo
end program test
-
-! { dg-final { cleanup-modules "global" } }
write(6,*) I
END SUBROUTINE TST
END
-
-! { dg-final { cleanup-modules "addon" } }
call foo (bar, i)
if (i .ne. 2) call abort ()
end
-
-! { dg-final { cleanup-modules "mod1" } }
END MODULE TEST
end
-
-! { dg-final { cleanup-modules "test" } }
call MPI_Send2(x, 1, 1,1,1,j,i)
end
end
-
-! { dg-final { cleanup-modules "mpi_interface" } }
end
-! { dg-final { cleanup-modules "mod" } }
-
! { dg-final { scan-tree-dump-times "sub_scalar .0B," 2 "original" } }
! { dg-final { scan-tree-dump-times "sub_scalar .scalar_real_alloc," 2 "original" } }
! { dg-final { scan-tree-dump-times "sub_scalar .scalar_char_ptr," 2 "original" } }
end subroutine a
end program oh_no_not_pr15908_again
-
-! { dg-final { cleanup-modules "global" } }
if (txt .ne. "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz") &
call abort ()
end program TestStringTools
-
-! { dg-final { cleanup-modules "chtest" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } }
-
-! { dg-final { cleanup-modules "automatic_deallocation" } }
! { dg-final { cleanup-tree-dump "original" } }
USE M1
CALL S1(2)
END
-! { dg-final { cleanup-modules "m1" } }
init = x
end function init
end module sd
-
-! { dg-final { cleanup-modules "sd" } }
integer, dimension (i) :: k ! { dg-error "must have constant shape" }
character (len = i) :: c2 ! { dg-error "must have constant character length" }
end program foobar
-
-! { dg-final { cleanup-modules "foo bar" } }
integer(c_int) :: m, n
bind(c, name="") /com3/
end module bind_c_coms_2
-
-! { dg-final { cleanup-modules "bind_c_coms bind_c_coms_2" } }
myDerived%s = myDerived%s + 1.0;
end subroutine types_test
end module bind_c_dts
-
-! { dg-final { cleanup-modules "bind_c_dts" } }
end if
end subroutine sub0
end module bind_c_dts_2
-
-! { dg-final { cleanup-modules "bind_c_dts_2" } }
end if
end subroutine sub0
end module bind_c_dts_3
-
-! { dg-final { cleanup-modules "bind_c_dts_3" } }
end type
type(foo), bind(c) :: cp
end module test
-
-! { dg-final { cleanup-modules "test" } }
write (*,*) liter_cb(link_info)
END PROGRAM main
-
-! { dg-final { cleanup-modules "liter_cb_mod" } }
i = 0
end subroutine sub0
end module bind_c_implicit_vars
-
-! { dg-final { cleanup-modules "bind_c_implicit_vars" } }
implicit none
bind(c) :: a ! { dg-error "applied to" }
end module d
-! { dg-final { cleanup-modules "a" } }
end function my_f03_func
end module bind_c_procs
-
-! { dg-final { cleanup-modules "bind_c_procs" } }
func4ent = -88.0
end function func4
end module mod
-
-! { dg-final { cleanup-modules "mod" } }
call gen(x)
if(x /= 17) call abort()
end program main
-
-! { dg-final { cleanup-modules "mod" } }
if(iachar(d(i)(2:2)) /=32 .or. iachar(d(i)(3:3)) /= 32) call abort()
end do
end subroutine
-
-! { dg-final { cleanup-modules "mod" } }
WRITE(str4,'(i0)') ICHAR(cdir())
if(str4 /= '47' .or. ichar(str4(3:3)) /= 32) call abort()
END PROGRAM
-
-! { dg-final { cleanup-modules "mod" } }
liter_cb = 0
END FUNCTION liter_cb
end module m
-
-! { dg-final { cleanup-modules "m" } }
call c_proc (.true._c_bool, val)
if (val /= 7) call abort ()
end program test
-
-! { dg-final { cleanup-modules "m" } }
real(myI), bind(c) :: myCFloat2 ! { dg-warning "is for type INTEGER" }
real(4), bind(c) :: myFloat
end module c_kind_tests_2
-
-! { dg-final { cleanup-modules "c_kind_tests_2" } }
-! { dg-final { cleanup-modules "bind_c_implicit_vars" } }
-! { dg-final { cleanup-modules "test" } }
-! { dg-final { cleanup-modules "iso_c_utilities" } }
type(foo), bind(c) :: cp ! { dg-error "is not C interoperable" }
real(c_double), pointer,bind(c) :: p ! { dg-error "cannot have both the POINTER and BIND.C." }
end module test
-! { dg-final { cleanup-modules "test" } }
my_string_func = 'my_string' // C_NULL_CHAR
end function my_string_func
end module x
-
-! { dg-final { cleanup-modules "x" } }
CALL C_F_POINTER(FPTR=FPTR, CPTR=CPTR, SHAPE=[strlen(CPTR)])
END FUNCTION
END MODULE ISO_C_UTILITIES
-! { dg-final { cleanup-modules "iso_c_utilities" } }
-
end subroutine changeF90Globals
end module bind_c_vars
-
-! { dg-final { cleanup-modules "bind_c_vars" } }
subroutine sub4() BIND(c, name = " ")
end subroutine sub4
end module binding_label_tests
-
-! { dg-final { cleanup-modules "binding_label_tests" } }
use binding_label_tests_10 ! { dg-error "collides" }
use binding_label_tests_10_main
end program main
-! { dg-final { cleanup-modules "binding_label_tests_10" } }
use one, only: foo_one => foo
use two, only: foo_two => foo
end
-
-! { dg-final { cleanup-modules "one two" } }
print *, a, b
if (a /= 5 .or. b /= -5) call abort()
end program prog
-! { dg-final { cleanup-modules "m n" } }
subroutine sub8() bind(c, name) ! { dg-error "Syntax error" }
end subroutine sub8 ! { dg-error "Expecting END MODULE" }
end module binding_label_tests_2
-
-! { dg-final { cleanup-modules "binding_label_tests_2" } }
call my_c_print()
end program main
-
-! { dg-final { cleanup-modules "a" } }
subroutine my_public_sub() bind(c, name="my_sub")
end subroutine my_public_sub
end module x
-
-! { dg-final { cleanup-modules "x" } }
end module m3
end
-
-! { dg-final { cleanup-modules "testmod testmod2 m3" } }
INTEGER, PARAMETER, DIMENSION(2) :: IP_ARRAY1_32_S = &
& (/ LBOUND(IP_ARRAY2_4_S(5:10,2:3))/)
END module foo
-! { dg-final { cleanup-modules "foo" } }
call sub()
call sub((/4,5/))
end program main
-! { dg-final { cleanup-modules "sub_mod" } }
call sub((/4/))
end program main
! { dg-output "Fortran runtime error: Array bound mismatch" }
-! { dg-final { cleanup-modules "sub_mod" } }
END PROGRAM main
! { dg-output "shorter than the declared one for dummy argument 'str' \\(3/5\\)" }
-! { dg-final { cleanup-modules "m" } }
END PROGRAM main
! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
-! { dg-final { cleanup-modules "m" } }
END PROGRAM main
! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
-! { dg-final { cleanup-modules "m" } }
END PROGRAM main
! { dg-output "does not match the declared one for dummy argument 'str' \\(7/5\\)" }
-! { dg-final { cleanup-modules "m" } }
CALL test ('abcde') ! String length matches.
CALL test ('abcdef') ! String too long, is ok.
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
END PROGRAM main
! { dg-output "shorter than the declared one for dummy argument 'opt' \\(0/5\\)" }
-! { dg-final { cleanup-modules "m" } }
USE M3
CALL S1
END
-
-! { dg-final { cleanup-modules "m1 m2 m3" } }
end subroutine verify_assoc
end module c_assoc
-
-! { dg-final { cleanup-modules "c_assoc" } }
call Grid2BMP(10)
! call test()
end program main
-
-! { dg-final { cleanup-modules "x" } }
if(my_char_ref /= c_char_'y') call abort()
end subroutine sub1
end module c_char_tests
-
-! { dg-final { cleanup-modules "c_char_tests" } }
end do
end subroutine test_complex_arrays
end module c_f_pointer_complex
-! { dg-final { cleanup-modules "c_f_pointer_complex" } }
-
end do
end subroutine test_array
end module c_f_pointer_logical
-! { dg-final { cleanup-modules "c_f_pointer_logical" } }
end do
end subroutine test_mixed
end module c_f_pointer_shape_tests_2
-! { dg-final { cleanup-modules "c_f_pointer_shape_tests_2" } }
-
end do
end subroutine test_mixed
end module c_f_pointer_shape_tests_4
-! { dg-final { cleanup-modules "c_f_pointer_shape_tests_4" } }
-
endif
end subroutine testDerivedPtrs
end module c_f_pointer_tests
-
-! { dg-final { cleanup-modules "c_f_pointer_tests" } }
call sub0()
end program driver
-
-! { dg-final { cleanup-modules "c_funloc_tests" } }
p = c_funloc(ffunc)
call callFunc(p, 21,-17*21)
end program main
-! { dg-final { cleanup-modules "c_funloc_tests_3" } }
func0 = desired_retval
end function func0
end module c_funloc_tests_4
-! { dg-final { cleanup-modules "c_funloc_tests_4" } }
-
end subroutine param_test
end module c_kind_params
-! { dg-final { cleanup-modules "c_kind_params" } }
real(myI), bind(c) :: myCFloat2 ! { dg-warning "is for type INTEGER" }
real(4), bind(c) :: myFloat ! { dg-warning "may not be a C interoperable" }
end module c_kind_tests_2
-! { dg-final { cleanup-modules "c_kind_tests_2" } }
call test_address(my_c_ptr, 100)
end subroutine test0
end module c_loc_test
-! { dg-final { cleanup-modules "c_loc_test" } }
call sub1(c_loc(argv))
end program test2
!
-! { dg-final { cleanup-modules "test1" } }
call test1()
call test2()
end program driver
-! { dg-final { cleanup-modules "c_loc_tests_2" } }
end subroutine sub0
end module c_loc_tests_5
-! { dg-final { cleanup-modules "c_loc_tests_5" } }
argv(1)=C_LOC(empty_string)
END SUBROUTINE
end module x
-! { dg-final { cleanup-modules "x" } }
argv(1)=C_LOC(empty_string)
END SUBROUTINE
end module c_loc_tests_7
-! { dg-final { cleanup-modules "c_loc_tests_7" } }
call c_f_pointer(self%myServices, localServices)
end subroutine sub0
end module c_ptr_tests
-
-! { dg-final { cleanup-modules "c_ptr_tests" } }
use c_ptr_tests_10
call sub0()
end program main
-
-! { dg-final { cleanup-modules "c_ptr_tests_10" } }
type(t), intent(out) :: a
end subroutine func
end module m
-! { dg-final { cleanup-modules "fgsl m" } }
-
status = fgsl_vector_align(p_x, f_x)
end subroutine expb_df
end module tmod
-
-! { dg-final { cleanup-modules "fgsl tmod" } }
-
! { dg-final { scan-tree-dump-times "bbb =" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "m" } }
! { dg-final { scan-tree-dump-times "bbb =" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "m" } }
end interface
kill_C_FUNPTR = C_FUNLOC(fun)
end function kill_C_FUNPTR
-
-! { dg-final { cleanup-modules "m3 m1" } }
write(*,*) 'ASSOCIATED =', associated(img)
deallocate(r)
end program cfpointerstress
-
-! { dg-final { cleanup-modules "nag_j_types" } }
func0 = c_null_ptr
end function func0
end module c_ptr_tests_7
-! { dg-final { cleanup-modules "c_ptr_tests_7" } }
call sub0()
end program main
-
-! { dg-final { cleanup-modules "c_ptr_tests_9" } }
end if
end subroutine sub0
end module c_size_t_test
-
-! { dg-final { cleanup-modules "c_size_t_test" } }
if (b(1) /= 'abcd ') call abort
if (b(2) /= 'efghij') call abort
end program y
-
-! { dg-final { cleanup-modules "z" } }
use foomod
print *, aa, bb
end
-! { dg-final { cleanup-modules "foomod" } }
ENDDO
end subroutine alloc
END program char_array_structure_constructor
-
-! { dg-final { cleanup-modules "global" } }
use bar
call xmain()
end program main
-
-! { dg-final { cleanup-modules "bar" } }
if (len (join (words2(2:4:2), sep2)) .ne. 10) call abort ()
end program xjoin
-! { dg-final { cleanup-modules "util_mod" } }
! This was another bug, uncovered when the PR was fixed.
if (any(ccopy(z//mz(:)(i:j)) .ne. (/"zzgh ","zzjk "/))) call abort ()
end program xx
-! { dg-final { cleanup-modules "str_mod" } }
val%c_val(i)(1:MIN (80, l_out-(i-1)*default_string_length))
END SUBROUTINE val_get
END MODULE input_val_types
-
-! { dg-final { cleanup-modules "input_val_types" } }
print *, str
end program test
-
-! { dg-final { cleanup-modules "cutils" } }
use abc
call xmain(3, 2)
end
-! { dg-final { cleanup-modules "abc" } }
-
s = s_to_c(c)
end program huj
-
-! { dg-final { cleanup-modules "foo" } }
TDA1L(NF1:NF2:NF1)%C = TDA1L(NF0+2:NF3:NF2/2)%C
END SUBROUTINE
END MODULE TESTS
-! { dg-final { cleanup-modules "tests" } }
class(gradient_class), pointer :: g_initial, ip_save
ip_save => g_initial%inner_product() ! ICE
end
-
-! { dg-final { cleanup-modules "abstract_gradient" } }
operand = operand%product(scale)
end subroutine
end module
-
-! { dg-final { cleanup-modules "abstract_algebra" } }
end function
end module concrete_inner_product
-! { dg-final { cleanup-modules "concrete_vector concrete_gradient concrete_inner_product" } }
use concrete_gradient
implicit none
end module concrete_inner_product
-! { dg-final { cleanup-modules "abstract_vector concrete_vector" } }
-! { dg-final { cleanup-modules "concrete_gradient concrete_inner_product" } }
use mod_A
use mod_C
end module
-
-! { dg-final { cleanup-modules "mod_a mod_b mod_c mod_d" } }
end function
end module
-
-! { dg-final { cleanup-modules "m_rotation_matrix" } }
end type b_type
end module b_module
-
-! { dg-final { cleanup-modules "error_stack_module b_module" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 11 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-
-! { dg-final { cleanup-modules "foo_mod" } }
type(t),save :: default_t
end module
-
-! { dg-final { cleanup-modules "m" } }
end subroutine ice_proc
end module ice_module
-
-! { dg-final { cleanup-modules "ice_module" } }
end module
end
-
-! { dg-final { cleanup-modules "m" } }
end
-! { dg-final { cleanup-modules "s_mat_mod s_tester" } }
endif
end function Type1_initProc
end module type1_type
-
-! { dg-final { cleanup-modules "type2_type extended2a_type type1_type" } }
allocate(x(1))
end program p
-
-! { dg-final { cleanup-modules "m m2" } }
print *, x%a
print *, y%b
end
-
-! { dg-final { cleanup-modules "m1 m2" } }
PROGRAM p
USE m
END
-
-! { dg-final { cleanup-modules "m" } }
end type
class(molecularAbundancesStructure), pointer :: molecules
end module
-
-! { dg-final { cleanup-modules "molecular_abundances_structure" } }
end module
end
-
-! { dg-final { cleanup-modules "m0 m1 m2" } }
if (same_type_as(a1,a2)) call abort()
end
-
-! { dg-final { cleanup-modules "one one_two" } }
return
end subroutine psb_cdall
-
-! { dg-final { cleanup-modules "psb_penv_mod psb_indx_map_mod psb_gen_block_map_mod psb_descriptor_type psb_cd_if_tools_mod psb_cd_tools_mod psb_base_tools_mod" } }
type(treeNode) :: node
call walk (node)
end program
-
-! { dg-final { cleanup-modules "tree_nodes merger_trees merger_tree_build" } }
print *,a_string(this)
end subroutine b_sub
end module a_module
-
-! { dg-final { cleanup-modules "a_module" } }
class(Overload_AnException_impl_t) :: self
end subroutine
end module
-
-! { dg-final { cleanup-modules "overload_anexception_impl" } }
class(t0), allocatable :: c
allocate(t1 :: c)
end program Test
-
-! { dg-final { cleanup-modules "G_Nodes" } }
implicit none
if (allocated(x)) call abort()
end
-
-! { dg-final { cleanup-modules "m" } }
call test(sparseMatrix)
END PROGRAM
-
-! { dg-final { cleanup-modules "m_sparsematrix m_subroutine" } }
allocate(x)
call s (x)
end
-! { dg-final { cleanup-modules "m" } }
type is (integrand); if (any (kernel1%variable .ne. [3,4,5])) call abort
end select
end program
-! { dg-final { cleanup-modules "show_producer_class" } }
-
end if
end select
end program prog
-! { dg-final { cleanup-modules "generic_deferred" } }
-
attractor = constructor( [1., 1., 1.] , timed_lorenz_integrator)
call integrate(attractor)
end program main
-
-! { dg-final { cleanup-modules "surrogate_module strategy_module integrand_module runge_kutta_2nd_module" } }
allocate(kernel,source=executive_producer%create_show ())
if (kernel%variable .ne. 99) call abort
end program
-! { dg-final { cleanup-modules "show_producer_class" } }
-
type is (integrand); if (any (kernel%variable .ne. -1)) call abort
end select
end program
-! { dg-final { cleanup-modules "show_producer_class" } }
-
if (kernel1%variable .ne. -1) call abort
if (kernel2%variable .ne. -1) call abort
end program
-! { dg-final { cleanup-modules "show_producer_class" } }
-
end function BGet
end module test
-
-! { dg-final { cleanup-modules "test" } }
! print *, "After qsort: ", A%disp()
if (any (A%disp() .ne. [2,3,4,5,7])) call abort
end program main
-
-! { dg-final { cleanup-modules "m_qsort test" } }
call x(:)%foo(n)
if (any(n .ne. [99,199,299])) call abort
end
-! { dg-final { cleanup-modules "m" } }
end subroutine do_something_else
end module ice6
-! { dg-final { cleanup-modules "ice6" } }
!TYPE(ParentVector), INTENT(INOUT) :: pvec
END SUBROUTINE item_operation
END MODULE procedure_intent_nonsense
-! { dg-final { cleanup-modules "procedure_intent_nonsense" } }
call reallocate (a)
if (trim (print_type ("a", a)) .ne. "a is base_type") call abort
end program main
-
-! { dg-final { cleanup-modules "realloc" } }
if (x(4)%disp () .ne. 4) call abort
end
-
-! { dg-final { cleanup-modules "m" } }
this = this*scale
end subroutine
end program
-
-! { dg-final { cleanup-modules "bar_module foo_module" } }
end module fails_test
end
-
-! { dg-final { cleanup-modules "fails_mod fails_test" } }
end do
end program random_walk
-
-! { dg-final { cleanup-modules "points2d" } }
call subpr2_array (g ())
end program
-
-! { dg-final { cleanup-modules "mod_subpr" } }
if (not_refed /= 784) call abort()
end subroutine uncalled
end subroutine test
-
-! { dg-final { cleanup-modules "m" } }
allocate (t :: a) ! { dg-error "Coarray specification required in ALLOCATE statement" }
allocate (t :: a[*]) ! OK
end program myTest
-
-! { dg-final { cleanup-modules "m" } }
! as->cotype was not AS_DEFERERED.
use m
end
-
-! { dg-final { cleanup-modules "m" } }
type(pct) :: picture[*]
allocate(picture%data(size, size))
end program test
-
-
-! { dg-final { cleanup-modules "mod_reduction" } }
program main
integer :: A[*] ! Valid, implicit SAVE attribute
end program main
-
-! { dg-final { cleanup-modules "m" } }
integer, allocatable :: z(:)[:]
z(:)[1] = z
end subroutine assign42
-
-! { dg-final { cleanup-modules "mod2 m mmm3 mmm4" } }
write(*, *) 'OK'
end if
end program
-
-! { dg-final { cleanup-modules "mod_rank_mismatch_02" } }
! { dg-final { scan-tree-dump-times "sub_opt \\(.integer.kind=4. .. caf.data, caf.token, 0\\)" 1 "original" } }
!
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "matrix_data" } }
type(lock_type), intent(in) :: x[*]
end subroutine test
end subroutine argument_check
-
-! { dg-final { cleanup-modules "m m2 m3" } }
integer, allocatable :: d[:] ! { dg-error "Noncoarray component c at .1. of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must have a codimension or be a subcomponent of a coarray. .Variables of type t5 may not have a codimension as d at .2. has a codimension or a coarray subcomponent." }
end type t5
end subroutine test2
-
-! { dg-final { cleanup-modules "m3" } }
call testTypes()
end program comBlockDriver
-
-! { dg-final { cleanup-modules "mycommodule comblocktests" } }
call bar(z0)
end subroutine foo
end module
-
-! { dg-final { cleanup-modules "pr39594" } }
call two()
end
-
-! { dg-final { cleanup-modules "m" } }
integer:: a, b
common a
end module foo
-! { dg-final { cleanup-modules "foo" } }
call check(atanh(z4), cmplx(-0.38187020129010862908881230531688930_4, -1.07198475450905931839240655913126728_4, kind=4))
call check(atanh(z8), cmplx(-0.38187020129010862908881230531688930_8, -1.07198475450905931839240655913126728_8, kind=8))
END PROGRAM ArcTrigHyp
-
-! { dg-final { cleanup-modules "test" } }
c = mycomplex(x=0.0, y=1.0) ! A function reference
c = mycomplex(0.0, 1.0) ! A function reference
end program myuse
-
-! { dg-final { cleanup-modules "mycomplex_module" } }
!print *, x%j
!print *, k
end
-
-! { dg-final { cleanup-modules "m m2" } }
type(t2) :: f2
end function
end module
-
-! { dg-final { cleanup-modules "m m2" } }
if (my_test_cnt /= 6) call abort()
end program Struct_over
-
-! { dg-final { cleanup-modules "test_cnt rational temp_node" } }
call a
if (i .ne. 1) call abort
end program
-
-! { dg-final { cleanup-modules "contained_1_mod" } }
INTEGER FUNCTION setbd()
setbd=42
END FUNCTION setbd
-
-! { dg-final { cleanup-modules "ksbin1_aux_mod" } }
implicit none
if(.not. is_gfortran()) call abort()
end program fire
-! { dg-final { cleanup-modules "chk_gfortran" } }
-
integer, parameter :: answer = 42
contains
end module truc
-
-! { dg-final { cleanup-modules "truc" } }
USE MODULE_B
a = 0
END
-
-! { dg-final { cleanup-modules "module_a module_b" } }
ipt = loc (arr)
if (any (var .ne. (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/))) call abort
end
-
-! { dg-final { cleanup-modules "cray_pointers_5" } }
p = transfer(fp,p)
write(*,'(a)') fun([1,2,3])
end program fptr
-! { dg-final { cleanup-modules "funcs other_fun" } }
data foobar /0/ ! { dg-error "conflicts with FUNCTION" }
end function foobar
end
-
-! { dg-final { cleanup-modules "global" } }
if (i /= 0 .or. j /= 1) call abort
close(10)
end program
-! { dg-final { cleanup-modules "globals" } }
if (test (-huge(0.0_8), 1) /= 0) call abort
end program main
!
-! { dg-final { cleanup-modules "test_default_format" } }
if (test (-huge(0.0_kl), 1) /= 0) call abort
end program main
!
-! { dg-final { cleanup-modules "test_default_format" } }
end program main
!
-! { dg-final { cleanup-modules "test_default_format" } }
if (test (-tiny(0.0_kl), 1) /= 0) call abort
end program main
!
-! { dg-final { cleanup-modules "test_default_format" } }
end type default_initialization
type (default_initialization) t ! { dg-error "default initialization" }
end module bad
-
-! { dg-final { cleanup-modules "bad" } }
POINTER MATRIX
ALLOCATE(MATRIX)
END
-
-! { dg-final { cleanup-modules "mat" } }
call other
call dominique
end
-! { dg-final { cleanup-modules "demo m1" } }
t%x = 0
if (t%x /= 0) call abort()
end
-! { dg-final { cleanup-modules "good" } }
! { 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" } }
foo_3 = a + 3 * b - c
end function foo_3
end module mymod
-! { dg-final { cleanup-modules "mymod" } }
end subroutine construct
end module gfcbug49
-! { dg-final { cleanup-modules "gfcbug49" } }
use rg0045_stuff
call rg0045(1, 2, 3)
end
-! { dg-final { cleanup-modules "rg0045_stuff" } }
-
-
if (any (a%j .ne. 99)) call abort
end subroutine
end
-! { dg-final { cleanup-modules "m" } }
if (any (abs(Table%RealData(:,4) - 1) > epsilon(1.0))) call abort ()
if (any (abs(Table%RealData(:,[1,2,3,5]) - 42) > epsilon(1.0))) call abort ()
end program TestProgram
-
-! { dg-final { cleanup-modules "unitvalue_module" } }
cell%h = reshape ([(real(i), i = 1, 9)], [3, 3])
call s1 (cell)
end
-! { dg-final { cleanup-modules "m1 m2" } }
! { dg-final { scan-tree-dump-times "&a" 1 "original" } }
! { dg-final { scan-tree-dump-times "pack" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
a(c%k:c%m) = a(c%i:c%j) + b(c%k:c%m) ! { dg-warning "Creating array temporary" }
end subroutine foo
end module foobar
-! { dg-final { cleanup-modules "foobar" } }
a(bar(i,i+2):2) = a(bar(i,i+2):2)
a(int(i,kind=2):5) = a(int(i,kind=2)+1:6)
end program main
-! { dg-final { cleanup-modules "foo" } }
a = bar(3,4)*5 + b
e = sum(b,1) + 3
end program main
-! { dg-final { cleanup-modules "foo" } }
x = matmul(a,b) ! { dg-warning "Creating array temporary" }
END SUBROUTINE GeneticOptimize
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
Table%RealData = 1
Table%RealData(:,1) = Table%RealData(:,1) * CENTIMETER
end program TestProgram
-! { dg-final { cleanup-modules "unitvalue_module" } }
deallocate(t%data)
deallocate(t)
end program main
-! { dg-final { cleanup-modules "m1" } }
type(T), intent(in) :: X
end subroutine
end module another_core
-
-! { dg-final { cleanup-modules "core another_core" } }
write (*, *) z ! { dg-error "PRIVATE components" }
write (*, *) zb
end program prog
-
-! { dg-final { cleanup-modules "gfortran2" } }
use m2
call test
end
-
-! { dg-final { cleanup-modules "m1 m2" } }
type(x_t), pointer :: x
end module test
-
-! { dg-final { cleanup-modules "test" } }
program size_test
use ints
end program size_test
-
-! { dg-final { cleanup-modules "ints" } }
end type foo
type (foo), save :: bar
end module crash
-
-! { dg-final { cleanup-modules "crash" } }
end
! { dg-final { scan-tree-dump-times "j = 50" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "m" } }
call activate_gd_calcs (used_, outputs_)
if (any (outputs_(ndim:1:-1)%used .neqv. used_)) call abort ()
end
-
-! { dg-final { cleanup-modules "gd_calc" } }
call cdf_beta (1, 99)
call cdf_beta (2, 999)
end
-! { dg-final { cleanup-modules "cdf_aux_mod cdf_beta_mod" } }
use cdf_nc_chisq_mod
call local_cum_nc_chisq
end
-! { dg-final { cleanup-modules "cdf_nc_chisq_mod" } }
call chk (2)
call chk (1)
end
-! { dg-final { cleanup-modules "foo gfcbug70" } }
CALL set_bound(the_beta%parameters(1:which)) ! { dg-error "Rank mismatch" }
END SUBROUTINE cdf_beta
END MODULE cdf_beta_mod
-
-! { dg-final { cleanup-modules "cdf_aux_mod" } }
end function foo
end program prog
-! { dg-final { cleanup-modules "foo_mod" } }
t = bug4()
write(*,*) t
end program bug4_structure
-! { dg-final { cleanup-modules "bug4_mod" } }
end function fun ! { dg-error "Expecting END PROGRAM" }
end
-! { dg-final { cleanup-modules "kinds" } }
call foo(aa)\r
end program main\r
\r
-! { dg-final { cleanup-modules "dt subs" } }
end module llo
! copyright 1996 Loren P. Meissner -- May be distributed if this line is included.
! Linked List operations with Pointer to Pointer
-
-! { dg-final { cleanup-modules "llo" } }
if (ap%initialized .neqv. .false.) call abort()
END
-
-! { dg-final { cleanup-modules "atom_types" } }
-
! use snafu
! foo%v = 1
! end
-
-! { dg-final { cleanup-modules "snafu" } }
end subroutine
end module
-! { dg-final { cleanup-modules "modone modtwo" } }
use innerfun
call foo(3,f)
end program test
-
-! { dg-final { cleanup-modules "innerfun outerfun" } }
w = 1
end function w
end
-
-! { dg-final { cleanup-modules "m1" } }
print *,integrate (g,0d0,3d0)
end subroutine foo2
end
-! { dg-final { cleanup-modules "integrator" } }
end do
end function
end
-! { dg-final { cleanup-modules "m" } }
-
end subroutine
end
-
-! { dg-final { cleanup-modules "m" } }
end subroutine
end program
-
-! { dg-final { cleanup-modules "m" } }
call sol(cost)
if (icheck /= 1) call abort ()
end program test
-
-! { dg-final { cleanup-modules "t tt check" } }
if (a%prod() .ne. 42) call abort
if (a%extract (4) .ne. 168) call abort
end
-! { dg-final { cleanup-modules "m" } }
end do
end
-
-! { dg-final { cleanup-modules "basestrategy laxwendroffstrategy kestrategy" } }
allocate(a)
if (a%get()/=1) call abort()
end
-
-
-! { dg-final { cleanup-modules "mod1 mod2" } }
call a%extract (4, i)
if (i .ne. 168) call abort
end
-! { dg-final { cleanup-modules "m" } }
if (a%prod() .ne. 42) call abort
if (a%extract (4) .ne. 168) call abort
end
-! { dg-final { cleanup-modules "m1, m2" } }
call a%doit
if (a%getit () .ne. 3) call abort
end
-! { dg-final { cleanup-modules "foo_mod s_bar_mod a_bar_mod" } }
-
call a%scal (1.0_spk_, info)
if (info .ne. 700) call abort
end
-! { dg-final { cleanup-modules "const_mod base_mat_mod s_base_mat_mod s_mat_mod" } }
-
allocate (periodic_5th_factory :: field_creator)
u => field_creator%create()
end program
-
-! { dg-final { cleanup-modules "field_module periodic_5th_order_module field_factory_module periodic_5th_factory_module" } }
z%a => y
if ((z%sizeof() .ne. 2) .or. (z%a%sizeof() .ne. 2)) call abort
end
-
-! { dg-final { cleanup-modules "m1 m2 m3" } }
if (a%getit() .ne. 3) call abort
end program testd10
-
-! { dg-final { cleanup-modules "foo_mod foo2_mod bar_mod" } }
-
if (o2%gen(3) .ne. 9) call abort
end
-
-! { dg-final { cleanup-modules "m" } }
-
END INTERFACE
END SUBROUTINE S1
END MODULE M1
-! { dg-final { cleanup-modules "m1" } }
call add (c , b )
end subroutine foo
end module gfcbug82
-
-! { dg-final { cleanup-modules "gfcbug82" } }
end function len_
end module iso_varying_string
-
-! { dg-final { cleanup-modules "iso_varying_string" } }
INTEGER :: XX
SUB=XX()
END
-
-! { dg-final { cleanup-modules "tt" } }
POINTER :: LL ! { dg-error " POINTER attribute conflicts with ELEMENTAL attribute" }
END FUNCTION LL
END MODULE Test
-
-! { dg-final { cleanup-modules "test" } }
INTEGER, pointer :: MM ! { dg-error "conflicts with ELEMENTAL" }
END FUNCTION MM
END MODULE Test
-! { dg-final { cleanup-modules "test" } }
if (any (b .ne. real_one)) call abort
end subroutine test_real
end program main
-! { dg-final { cleanup-modules "polar_mod" } }
b = -a
end subroutine foobar
end
-
-! { dg-final { cleanup-modules "pr22146" } }
if (any(reshape (i, (/4/)).ne.(/1,8,27,64/))) call abort ()
end program test_assign
-
-! { dg-final { cleanup-modules "type assign" } }
y = reshape (z, (/6/))
if (any(y%x .ne. (/ 64000, 128000, 19200, 64, 128000, 256000/))) call abort ()
end program test
-
-! { dg-final { cleanup-modules "elem_assign" } }
-
INTEGER, INTENT(IN) :: I,J
END SUBROUTINE S
END
-
-! { dg-final { cleanup-modules "elem_assign" } }
out(1, 1:42) = in(1, 1:42)
END SUBROUTINE
END MODULE foo
-! { dg-final { cleanup-modules "foo" } }
! Empty!
end type junk
end module stuff
-
-! { dg-final { cleanup-modules "stuff" } }
call test1 ()
call test2 ()
end program
-
-! { dg-final { cleanup-modules "m" } }
if (e (1.0) .ne. 3.0) call abort ()
if (f (1 ) .ne. 4.0) call abort ()
end
-! { dg-final { cleanup-modules "a" } }
if (any ((/foo (), bar (99), foobar (), foobar (99), j (), k (99)/) .ne. &
(/1, 2, 1, 2, 1, 2/))) Call abort ()
end
-! { dg-final { cleanup-modules "ksbin1_aux_mod" } }
z1 = y1==x1
if (abs(z1%x - 19.0_4/7.0_4) > epsilon(x1%x)) call abort ()
end program test
-! { dg-final { cleanup-modules "type_mod" } }
-
if(abs(ent(27) + 216.0) > tiny(1.0)) call abort()
end subroutine test4
end program main
-
-! { dg-final { cleanup-modules "m1 m2 m3 m4" } }
if (.not.((a + b) .eq. (b + a))) call abort ()
if (.not.((a + b) .eq. cx (4, 2))) call abort ()
end
-! { dg-final { cleanup-modules "complex" } }
y = x
end subroutine
end module
-! { dg-final { cleanup-modules "gsub" } }
call bar(a)
if (any (a .ne. (/3, 4/))) call abort
end program
-
-! { dg-final { cleanup-modules "entry_4" } }
if (z1((3,4)) .ne. (-5, 10)) call abort ()
if (z2((5,6)) .ne. (-9, 38)) call abort ()
end
-
-! { dg-final { cleanup-modules "foo" } }
bar = "abcd"
end function
END MODULE TT
-
-
-! { dg-final { cleanup-modules "tt" } }
if (F2(4) /= -4) call abort()
if (F1(1) /= -1) call abort()
end program main
-
-! { dg-final { cleanup-modules "m1" } }
END FUNCTION F1
END MODULE M1
END
-
-! { dg-final { cleanup-modules "m1" } }
call f4 (two4, 2)
call f4 (max4, huge(1_4)+0)
end
-
-! { dg-final { cleanup-modules "enum_10" } }
INTEGER :: L
EQUIVALENCE(K,L) ! { dg-error "conflicts with USE ASSOCIATED attribute" }
END
-
-! { dg-final { cleanup-modules "test" } }
EQUIVALENCE(I,J)
END MODULE DATA
END
-! { dg-final { cleanup-modules "data" } }
END MODULE M1
USE M1, ONLY: I,&! { dg-error "Missing" }
-! { dg-final { cleanup-modules "m1" } }
-
new_person%supervisor => supervisor
end function
end
-
-! { dg-final { cleanup-modules "persons person_education" } }
print *,a%t1%i
print *,b%u1%j ! { dg-error "is a PRIVATE component of" }
end program
-
-! { dg-final { cleanup-modules "mo" } }
implicit none
call create_ext()
end program
-
-! { dg-final { cleanup-modules "mod_diff_01" } }
use type_definitions
use elliptical_elements
end
-
-! { dg-final { cleanup-modules "type_definitions elliptical_elements" } }
supervisor)
end function
end
-
-! { dg-final { cleanup-modules "persons person_education" } }
SUPERVISOR = supervisor)
end function
end
-
-! { dg-final { cleanup-modules "persons person_education" } }
q = d (b = set_b (), id = 99)
call check_b (q%b)
end
-
-! { dg-final { cleanup-modules "mymod" } }
type, extends(dt) :: dt_type ! { dg-error "because it is BIND" }
end type ! { dg-error "Expecting END PROGRAM" }
end
-
-! { dg-final { cleanup-modules "m" } }
foo_dt%dt%day = 1 ! { dg-error "not a member" }
end subroutine
end
-
-! { dg-final { cleanup-modules "m" } }
END TYPE subt
END MODULE m2
-
-! { dg-final { cleanup-modules "m1 m2" } }
use m, only: A
end
-! { dg-final { cleanup-modules "m" } }
END
-! { dg-final { cleanup-modules "run_example_fortran03" } }
call foo (x0)
print *, x0
end program gfcbug53
-! { dg-final { cleanup-modules "mod1 mod2" } }
IMPLICIT NONE
! Do nothing here
END PROGRAM finalizer
-
-! { dg-final { cleanup-modules "final_type" } }
IMPLICIT NONE
! Do nothing here
END PROGRAM finalizer
-
-! { dg-final { cleanup-modules "final_type" } }
IMPLICIT NONE
! Do nothing here
END PROGRAM finalizer
-
-! { dg-final { cleanup-modules "final_type" } }
! TODO: Remove this once finalization is implemented.
! { dg-excess-errors "not yet implemented" }
-
-! { dg-final { cleanup-modules "final_type" } }
! TODO: Remove this once finalization is implemented.
! { dg-excess-errors "not yet implemented" }
-
-! { dg-final { cleanup-modules "final_type" } }
! TODO: Remove this once finalization is implemented.
! { dg-excess-errors "not yet implemented" }
-
-! { dg-final { cleanup-modules "final_type" } }
! TODO: Remove this once finalization is implemented.
! { dg-excess-errors "not yet implemented" }
-
-! { dg-final { cleanup-modules "final_type" } }
IMPLICIT NONE
! Do nothing here
END PROGRAM finalizer
-
-! { dg-final { cleanup-modules "final_type" } }
w = 5 - i
end function w
end
-! { dg-final { cleanup-modules "foo" } }
w = 5 - i
end function w
end
-! { dg-final { cleanup-modules "foo" } }
end module mod
end
-
-! { dg-final { cleanup-modules "mod" } }
testCatch = testObj%test(2,2) ! This would cause an ICE
if (any (testCatch .ne. dble (reshape ([(i, i = 1, 4)],[2,2])))) call abort
end program bugTest
-! { dg-final { cleanup-modules "bugtestmod" } }
end function f
end
-
-! { dg-final { cleanup-modules "m" } }
y => get2 (x)
if (y%i.ne.112) call abort ()
end program func_derived_2
-
-! { dg-final { cleanup-modules "mpoint" } }
if (trim (line).ne."simple = 1") call abort ()
close (10)
end program
-
-! { dg-final { cleanup-modules "func_derived_3 func_derived_3a" } }
call create_field(quality,msh)
mshp => msh_(quality)
end program test_pnt
-
-! { dg-final { cleanup-modules "class_mesh class_field class_scalar_field" } }
use m
foo = t()
end function foo
-
-! { dg-final { cleanup-modules "m" } }
foo = [33, 77]
end function foo
end subroutine test
-
-! { dg-final { cleanup-modules "m" } }
end interface
print *, test()
end
-! { dg-final { cleanup-modules "m" } }
if (len (g) == 2) g= "2"
end function g
end program test
-! { dg-final { cleanup-modules "m" } }
z = func()
if (z%i .ne. 5) call abort ()
end
-! { dg-final { cleanup-modules "kinds mymodule" } }
end function
end interface
end module
-! { dg-final { cleanup-modules "types x" } }
-
use m
test4 = 'A'
end function test4
-
-! { dg-final { cleanup-modules "m" } }
two = 1
end function two
end program main
-! { dg-final { cleanup-modules "m1 m2" } }
! { dg-final { scan-tree-dump-times "myfunc" 2 "original" } }
! { dg-final { scan-tree-dump-times "mychar" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "x" } }
type(non_exist) function func2() ! { dg-error "not accessible" }
end function func2
end module bar
-! { dg-final { cleanup-modules "bar" } }
d1%m = 55
end function d1
end program main
-! { dg-final { cleanup-modules "m1 m2 m3" } }
subroutine BAZ(X)
use FOO
end subroutine
-
-! { dg-final { cleanup-modules "foo" } }
call random_number (z)
print *, z
end
-! { dg-final { cleanup-modules "gfcbug46" } }
call foo ! { dg-error "is an ambiguous reference" }
end
-! { dg-final { cleanup-modules "m_foo m_bar" } }
-
-
IMPLICIT NONE
CALL hello(10)
END PROGRAM main
-! { dg-final { cleanup-modules "interfaces global_module" } }
CALL SUB(xx,I)
IF (I.NE.7) CALL ABORT()
END PROGRAM
-! { dg-final { cleanup-modules "test too" } }
end module h
end
-
-! { dg-final { cleanup-modules "a inclmod" } }
CALL odfname(base,i,cnames)
if (trim (cnames(1)) .ne. "odfamilycnames") call abort
END PROGRAM
-! { dg-final { cleanup-modules "test" } }
REAL(kind=dp) :: rawData(2), data, work(3)
data = median(rawData, work) ! { dg-error "no specific function" }
END PROGRAM main
-! { dg-final { cleanup-modules "auxiliary" } }
subroutine s_foobar2(x) \r
use foo_mod\r
end subroutine s_foobar2\r
-! { dg-final { cleanup-modules "s_foo_mod d_foo_mod foo_mod" } }
! { dg-final { scan-tree-dump-times "specproc" 3 "original" } }
! { dg-final { scan-tree-dump-times "elemproc" 3 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "someoptions" } }
call sub(1, "integer ")
call sub(1.0, "real ")
end program prog
-! { dg-final { cleanup-modules "mod1 mod2" } }
integer,intent(in) :: nspden
end subroutine nonlinear
-
-! { dg-final { cleanup-modules "bidon" } }
res = matmul (one(2.0), (/ 2.0/))
if (abs (res(1)-4.0) > epsilon (res)) call abort ()
end
-
-! { dg-final { cleanup-modules "m" } }
end do
end function sqrt_vector
end module gfcbug102
-
-! { dg-final { cleanup-modules "gfcbug102" } }
end module base_mod
-! { dg-final { cleanup-modules "base_mod" } }
if (af2%get() .ne. 3) call abort
end program testd15
-
-! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
use sparse_matrices_fields
use global_numbering
end program test
-
-! { dg-final { cleanup-modules "sparse_tools sparse_matrices_fields global_numbering" } }
call gauss( x(i), a, yan, dyda, ma )
end do
end subroutine mrqcof
-
-! { dg-final { cleanup-modules "fit_functions" } }
call baz(y,z)
if (any (y /= z)) call abort ()
end
-
-! { dg-final { cleanup-modules "foo" } }
CALL ice(23.0) ! { dg-error "no specific subroutine" }
END SUBROUTINE
END MODULE
-! { dg-final { cleanup-modules "ice_gfortran provoke_ice" } }
use c
call useCreate
end
-! { dg-final { cleanup-modules "a b c" } }
WRITE(*,*) x, y
END SUBROUTINE
END MODULE
-
-! { dg-final { cleanup-modules "global" } }
CALL A(MAXVAL(X),Y)
END SUBROUTINE T
END MODULE M
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE
END MODULE
-! { dg-final { cleanup-modules "class_foo_type class_foo" } }
SUBROUTINE F()
END SUBROUTINE
-! { dg-final { cleanup-modules "test test2" } }
end function gt_cmp
end interface
end module m_sort
-
-! { dg-final { cleanup-modules "m_sort" } }
entry link2 (nameg) ! { dg-error "is already being used as a SUBROUTINE" }
return
end
-
-! { dg-final { cleanup-modules "m" } }
endif
end subroutine test_globals
end module global_vars_c_init
-
-! { dg-final { cleanup-modules "global_vars_c_init" } }
endif
end subroutine test_globals
end module global_vars_f90_init
-
-! { dg-final { cleanup-modules "global_vars_f90_init" } }
!$omp end parallel do
END SUBROUTINE
END MODULE
-
-! { dg-final { cleanup-modules "test_allocatable_components" } }
!$OMP THREADPRIVATE(/T/) ! { dg-error "COMMON block" }
!non-conforming because /T/ not declared in A22_4_WRONG
END SUBROUTINE A22_4_WRONG
-! { dg-final { cleanup-modules "A22_MODULE" } }
!$OMP END PARALLEL DO
END SUBROUTINE F
END MODULE A26_2
-! { dg-final { cleanup-modules "A26_2" } }
ALLOCATE(WORK(SIZE))
WORK = TOL
END SUBROUTINE BUILD
-! { dg-final { cleanup-modules "M" } }
!$omp end parallel ! { dg-error "" }
end subroutine bad3
end subroutine bad2
-! { dg-final { cleanup-modules "omp_threadprivate1" } }
end subroutine fn14
end function fn12
end module
-
-! { dg-final { cleanup-modules "pr35768" } }
i = iand (i, 18)
!$omp end parallel
end subroutine f6
-! { dg-final { cleanup-modules "mreduction3" } }
END SELECT
END FUNCTION dlegendre
END MODULE spherical_harmonics
-! { dg-final { cleanup-modules "spherical_harmonics" } }
subroutine fourir(A,ntot,kconjg, E,useold)
end subroutine fourir
end module solv_cap
-! { dg-final { cleanup-modules "solv_cap" } }
END DO
ENDDO
END
-
-! { dg-final { cleanup-modules "les3d_data" } }
END IF
END SUBROUTINE QSORT
END SUBROUTINE READIN
-! { dg-final { cleanup-modules "vimage vcimage" } }
mat0 = 0.0d0
end function spher_cartesians
end module INT_MODULE
-! { dg-final { cleanup-modules "int_module" } }
ENDIF
999 CONTINUE
END
-! { dg-final { cleanup-modules "main1" } }
end subroutine mutual_ind_quad_cir_coil
end module mqc_m
-! { dg-final { cleanup-modules "mqc_m" } }
-
IF ( WETSCIM ) HRVALD(ITYP) = 0.0
ENDDO
END SUBROUTINE VOLCALC
-! { dg-final { cleanup-modules "main1" } }
CALL test()
END SUBROUTINE sic_explicit_orbitals
END MODULE qs_ks_methods
-! { dg-final { cleanup-modules "qs_ks_methods" } }
l12 = coefficient * l12
end subroutine mutual_ind_cir_cir_coils
end module mcc_m
-! { dg-final { cleanup-modules "mcc_m" } }
END IF
END SUBROUTINE newuob
END MODULE powell
-! { dg-final { cleanup-modules "powell" } }
END DO mainloop
END SUBROUTINE trsapp
END MODULE powell
-! { dg-final { cleanup-modules "powell" } }
END IF
END SUBROUTINE CALERF
END MODULE erf_fn
-! { dg-final { cleanup-modules "erf_fn" } }
fn_val = sum
END FUNCTION basym
END MODULE beta_gamma_psi
-! { dg-final { cleanup-modules "beta_gamma_psi" } }
fn_val = e0*t*u*sum
END FUNCTION basym
END MODULE beta_gamma_psi
-! { dg-final { cleanup-modules "beta_gamma_psi" } }
ENDDO
END SUBROUTINE create_destination_list
END MODULE
-! { dg-final { cleanup-modules "util" } }
BLOCK DATA
use globals
END BLOCK DATA
-! { dg-final { cleanup-modules "globals" } }
use globals
common /co/ pdm_bps ! { dg-error "already in a COMMON block" }
end program main
-! { dg-final { cleanup-modules "globals" } }
END SUBROUTINE sub2
END SUBROUTINE sub1
END MODULE ksbin2_aux_mod
-! { dg-final { cleanup-modules "ksbin2_aux_mod" } }
call InitialDiatomicX () ! { dg-error "which is not consistent with the CALL" }
end subroutine FindDiatomicPeriod
end module Diatoms
-! { dg-final { cleanup-modules "diatoms" } }
CALL S3
call S4
END
-! { dg-final { cleanup-modules "m1 m2" } }
call GetBasicElementData (TargetElement, ProcedureName, ErrorNumber, ErrorLevel, ErrorMessage, CallingStat)
end subroutine WH_ERR
end module ErrorMod
-! { dg-final { cleanup-modules "errelmnt errormod" } }
subroutine other_sub ()
end subroutine other_sub
end module foo
-! { dg-final { cleanup-modules "foo" } }
USE m
CALL g()
END
-! { dg-final { cleanup-modules "m" } }
use m
call s()
end
-! { dg-final { cleanup-modules "m" } }
end subroutine foo
end module gfcbug64_mod2
-! { dg-final { cleanup-modules "gfcbug64_mod1 gfcbug64_mod2" } }
use m
call s
end
-! { dg-final { cleanup-modules "m" } }
USE M2
CALL S2
END
-! { dg-final { cleanup-modules "m1 m2" } }
mons(1) = p1%mons(1)*p2%mons(2)
end function
end module
-! { dg-final { cleanup-modules "mod_symmon mod_sympoly" } }
mu = a_fun(x)
end function fun
end module mod_b
-
-! { dg-final { cleanup-modules "mod_a mod_b" } }
call SA0054 (RDA)
IF (ANY (INT (RDA) .ne. [(6 * I, I = 1, 10)])) print *, rda
END
-
-! { dg-final { cleanup-modules "sa0054_stuff" } }
use m
call s
end
-! { dg-final { cleanup-modules "m" } }
-
ENDDO vertex
END SUBROUTINE
END MODULE test
-! { dg-final { cleanup-modules "test" } }
call overloaded_sub(dval)\r
end subroutine\r
end program\r
-! { dg-final { cleanup-modules "stype dtype" } }\r
print *, "in the main:", k
call write(33)
end program testit
-! { dg-final { cleanup-modules "gfcbug68 gfcbug68a m n" } }
end subroutine SetTimeSteps
end module ThermoData
-
-! { dg-final { cleanup-modules "modelparams thermodata" } }
implicit none
common/rommel/aaa ! { dg-error "no IMPLICIT type" "no IMPLICIT type" }
end
-
-! { dg-final { cleanup-modules "ahfinder_dat" } }
call sub(di(i),i)
if (i.NE.4) call abort()
end
-! { dg-final { cleanup-modules "mod1" } }
ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "is not a variable" }
END SUBROUTINE
END MODULE tests2
-
-! { dg-final { cleanup-modules "tests" } }
if('#'//Q2//'#' /='#abcdefghijkl#') call abort()
call sub('ABCDEFGHIJKLM') ! len=13
end program startest
-
-! { dg-final { cleanup-modules "mod" } }
v%i = 42
end subroutine
end module
-
-! { dg-final { cleanup-modules "implicit_2" } }
end subroutine foo
end program snafu
-
-! { dg-final { cleanup-modules "global" } }
print *, x(1)%i
end subroutine s
end module m
-
-! { dg-final { cleanup-modules "m" } }
end program gfcbug114a
! { dg-final { scan-module "b" "IMPLICIT_PURE" } }
-! { dg-final { cleanup-modules "b" } }
end module m
! { dg-final { scan-module-absence "m" "IMPLICIT_PURE" } }
-! { dg-final { cleanup-modules "m" } }
call test(z)
if(z%i /= 1) call abort()
end program foo
-! { dg-final { cleanup-modules "testmod" } }
call test(z) ! { dg-error "Type mismatch in argument" }
if(z%i /= 1) call abort()
end program foo
-! { dg-final { cleanup-modules "testmod" } }
if(r /= -123.0 .or. t%c /= -44) call abort()
end subroutine test3
end program all
-! { dg-final { cleanup-modules "modtest general" } }
end subroutine sub1
end module test_import
-! { dg-final { cleanup-modules "test_import" } }
END TYPE
TYPE(T1) X
END
-
-! { dg-final { cleanup-modules "mod" } }
-
END FUNCTION accumulate
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE purified
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
USE M1
write(6,*) J(L) ! { dg-error "Mismatch in PURE attribute" }
END
-
-! { dg-final { cleanup-modules "m1" } }
-
I=J ! { dg-error "is not PURE" }
END SUBROUTINE S2
END
-! { dg-final { cleanup-modules "m1" } }
-
RES = B
END FUNCTION
END MODULE pr20882
-! { dg-final { cleanup-modules "pr20863 pr20882" } }
-
z = t3(x) ! { dg-error "Invalid expression in the structure constructor" }
end subroutine foo
end module m
-
-! { dg-final { cleanup-modules "m" } }
integer :: u(n(1)) ! { dg-error "must be PURE" }
end subroutine
end module test
-! { dg-final { cleanup-modules "test" } }
-
end subroutine foo
end module const
-
-! { dg-final { cleanup-modules "const" } }
END SUBROUTINE Parser
END MODULE Readdata_mod
-
-! { dg-final { cleanup-modules "readdata_mod" } }
use EGOPS_Utilities
use AtmoIono
end module AtmoIonoSphere
-
-! { dg-final { cleanup-modules "egops_utilities atmoiono atmoionosphere" } }
call g
end program t
-
-! ! { dg-final { cleanup-modules "c s" } }
CHARACTER, PARAMETER :: the_alpha = one_parameter('c') ! { dg-error "Can't convert TYPE" }
CHARACTER, PARAMETER :: the_beta = (/one_parameter('c')/) ! { dg-error "Incompatible ranks" }
END MODULE cdf_aux_mod
-
-! { dg-final { cleanup-modules "cdf_aux_mod" } }
-
INQUIRE (UNIT=1, EXIST=qexist)
END SUBROUTINE i
END MODULE print_it
-! { dg-final { cleanup-modules "print_it" } }
if (i4 /= 17_ik4 .or. i8 /= 17_ik8) call abort
end program test_int
-
-! { dg-final { cleanup-modules "mykinds" } }
! PR fortran/32823
! { dg-do compile }
-! { dg-final { cleanup-modules "token_module" } }
module token_module
ATEST((1.0,0.),-9,c4)
end program test
-
-! { dg-final { cleanup-modules "mod_check" } }
TEST(nearest(1.0,-1.0),-huge(0),r4)
end program test
-
-! { dg-final { cleanup-modules "mod_check" } }
implicit none
call setup ()
end program test
-! { dg-final { cleanup-modules "gfcbug72" } }
-
USE M1
CALL S1(D1%I(3)) ! { dg-error "variable definition context" }
END
-! { dg-final { cleanup-modules "m1" } }
call sub1(x)
if(x(1) /= 5) call abort()
end program
-
-! { dg-final { cleanup-modules "test_module" } }
END SUBROUTINE foo
END INTERFACE
END MODULE global
-
-! { dg-final { cleanup-modules "global" } }
end function
end module z
-
-! { dg-final { cleanup-modules "y z" } }
nsz=size(x)
end subroutine solve_s_foo
end module class_s_foo
-! { dg-final { cleanup-modules "class_s_fld class_fld class_s_foo" } }
END MODULE
END
-! { dg-final { cleanup-modules "m1" } }
f = 2*x+1
end function f
-! { dg-final { cleanup-modules "test1" } }
data_r8(1)=0
end subroutine my_sio_file_read_common
end module files_module
-
-! { dg-final { cleanup-modules "files_module" } }
call new (a)
call new (b)
end
-
-! { dg-final { cleanup-modules "p_class s_class t_class d_class poly_class" } }
F1 = D%I
END FUNCTION
END MODULE
-
-! { dg-final { cleanup-modules "m1" } }
Call foo_pwrk(pr,p,f,cd,info,work=aux) ! This worked if bar_pwrk was called!
return
End Subroutine foo_sub
-
-! { dg-final { cleanup-modules "foo_base_mod foo_pr_mod bar_pr_mod bar_prt" } }
-
MODULE graphcon
USE util, ONLY: sort
END MODULE graphcon
-! { dg-final { cleanup-modules "kinds util graphcon" } }
type(mytype_type), intent(in out) :: mytype
end subroutine mytype_test
end module mytype_application
-
-! { dg-final { cleanup-modules "mytype_application" } }
call sub()
call sub(dcos)
end
-
-! { dg-final { cleanup-modules "m" } }
-
END FUNCTION Compare_Float_Single
END MODULE Compare_Float_Numbers
-
-! { dg-final { cleanup-modules "compare_float_numbers" } }
intrinsic cos
call sub(cos) ! { dg-error "wrong number of arguments" }
end
-
-! { dg-final { cleanup-modules "m" } }
-
EXTERNAL foo ! implicit interface is undefined
call sub(foo) ! { dg-error "is not a function" }
end
-
-! { dg-final { cleanup-modules "m" } }
-
module procedure sreal, schar, sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
end interface swap
end module gswap
-
-! { dg-final { cleanup-modules "foo g gswap" } }
-
end interface
call bar() ! { dg-error "Missing actual argument" }
end program
-
-! { dg-final { cleanup-modules "a b" } }
end function
end interface
end module
-
-! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } }
end if
END FUNCTION recSum
END PROGRAM test
-
-! { dg-final { cleanup-modules "funcs" } }
end if
END FUNCTION recSum
END PROGRAM test
-
-! { dg-final { cleanup-modules "funcs" } }
end subroutine
end module
-
-! { dg-final { cleanup-modules "m" } }
-
call test(subActual) ! { dg-error "INTENT mismatch in argument" }
call test(subActual2) ! { dg-error "OPTIONAL mismatch in argument" }
end program
-
-! { dg-final { cleanup-modules "sub testsub" } }
-
complex, intent(out) :: y(:)
end subroutine
end module test
-
-! { dg-final { cleanup-modules "m test" } }
-
use test_mod2
print *, my_fun (a) ! { dg-error "ambiguous reference" }
end subroutine his_fun
-
-! { dg-final { cleanup-modules "test_mod test_mod2" } }
r%j = lhs%j + rhs%j
END FUNCTION add_b
END MODULE mod2
-! { dg-final { cleanup-modules "mod1 mod2" } }
ip_save => g_initial%inquire_inner_product()
end subroutine cg
end module m4
-! { dg-final { cleanup-modules "m1 m2 m3 m4" } }
SUBROUTINE subr_name()
END SUBROUTINE
END MODULE
-
-! { dg-final { cleanup-modules "m1 m2" } }
end function
end
-
-! { dg-final { cleanup-modules "module_m module_m2 s_hard sidl_string_array" } }
call bl_copy(1.0, chr)
if (chr /= "recopy") call abort ()
end program main
-! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
call bl_copy(1.0, chr)
if (chr /= "recopy") call abort ()
end program main
-! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
END SUBROUTINE S9C ! { dg-error "Ambiguous interfaces" }
END INTERFACE BAD9
end module xx
-
-! { dg-final { cleanup-modules "xx" } }
use mod1, only: generic ! { dg-warning "has ambiguous interfaces" }
use mod2
end program main
-
-! { dg-final { cleanup-modules "mod1 mod2" } }
if (inverse(1_4) /= 3_4) call abort ()
end subroutine sub
end program gfcbug48
-
-! { dg-final { cleanup-modules "module1 module2" } }
-
IF (D%I.NE.4) call abort ()
IF (4.NE.E%I) call abort ()
END
-! { dg-final { cleanup-modules "tt" } }
if (any (str_ara(1)%chars(1:5) .ne. char_elm(1:5))) call abort
if (any (str_ara(2)%chars(1:5) .ne. char_elm(6:10))) call abort
END PROGRAM VST_2
-! { dg-final { cleanup-modules "iso_varying_string" } }
y% m = x% m ! ICE
end subroutine assign_atm_to_atm
end module gfcbug74
-! { dg-final { cleanup-modules "mo_memory gfcbug74" } }
-
end subroutine assign_to_atm
end module mod2
-! { dg-final { cleanup-modules "mod1 mod2" } }
end interface
type(fcnparms) :: params ! -ditto-
end subroutine sim_3
-
-! { dg-final { cleanup-modules "test type_decl" } }
END INTERFACE
end subroutine
end module
-
-! { dg-final { cleanup-modules "n" } }
END SUBROUTINE incA
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
CALL test (1)
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
two = -123*y
end function two
end program main
-! { dg-final { cleanup-modules "test_mod" } }
type(t_set) :: c (1)
call get_rule (c)
end program test
-! { dg-final { cleanup-modules "mo_obs_rules" } }
end subroutine bar
! { dg-final { scan-tree-dump-times "unpack" 4 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "m" } }
-
! { dg-final { scan-tree-dump-times "a != 0B \\? \\\(.*\\\) _gfortran_internal_pack" 1 "original" } }
! { dg-final { scan-tree-dump-times "if \\(a != 0B &&" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "m1" } }
call s2
end
-! { dg-final { cleanup-modules "m1" } }
! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
s2=0
END FUNCTION S2
END MODULE M1
-! { dg-final { cleanup-modules "m1" } }
! { dg-final { scan-tree-dump-times "pack" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
USE M1
CALL S1
END
-! { dg-final { cleanup-modules "m1" } }
bar = 1.0
end function bar
end program test
-! { dg-final { cleanup-modules "m" } }
real a
end subroutine sub
end module aap
-
-! { dg-final { cleanup-modules "aap" } }
END FUNCTION next_state
end module vector_calculus
-
-! { dg-final { cleanup-modules "vector_calculus" } }
-
end function erfc
end module p
-
-! { dg-final { cleanup-modules "p" } }
-
END FUNCTION random_seed
! We do only compile, so no main program needed.
-
-! { dg-final { cleanup-modules "testmod" } }
END FUNCTION acosh
! We do only compile, so no main program needed.
-
-! { dg-final { cleanup-modules "testmod" } }
END FUNCTION acos
! We do only compile, so no main program needed.
-
-! { dg-final { cleanup-modules "testmod" } }
100 continue
200 format (2i6)
END
-
-! { dg-final { cleanup-modules "fails global" } }
100 continue
200 format (2i6)
END
-
-! { dg-final { cleanup-modules "global" } }
read (*, nml=definable)
write (*, nml=definable)
end program main
-
-! { dg-final { cleanup-modules "m" } }
open (newunit=a, file="foo") ! { dg-error "variable definition context" }
close (unit=a)
end program main
-
-! { dg-final { cleanup-modules "m" } }
subroutine test
use test_mod
end subroutine test
-
-! { dg-final { cleanup-modules "test_mod" } }
public :: c_null_ptr
end module mymod
-
-! { dg-final { cleanup-modules "mymod" } }
! a mangled name to prevent collisions.
integer :: c_ptr
end module iso_c_binding_only
-! { dg-final { cleanup-modules "iso_c_binding_only" } }
-
end if
end subroutine sub4
end module iso_c_binding_rename_1
-
-! { dg-final { cleanup-modules "iso_c_binding_rename_0 iso_c_binding_rename_1" } }
end subroutine sub4
end module mod2
-
-! { dg-final { cleanup-modules "mod0 mod1 mod2" } }
call bar
call bar2
end
-! { dg-final { cleanup-modules "iso_fortran_env" } }
use ,non_intrinsic :: iso_fortran_env
print *, x
end
-
-! { dg-final { cleanup-modules "iso_fortran_env" } }
use, non_intrinsic :: iso_fortran_env
use, intrinsic :: iso_fortran_env ! { dg-error "conflicts with non-intrinsic module" }
end subroutine truc
-! { dg-final { cleanup-modules "iso_fortran_env" } }
integer, parameter :: myFKind = c_float
real(myFKind), bind(c) :: myF
end module kind_tests_2
-
-! { dg-final { cleanup-modules "kind_tests_2" } }
use my_kinds
real(myFKind), bind(c) :: myF
end module my_module
-
-! { dg-final { cleanup-modules "my_kinds my_module" } }
x = -huge(0_8)
call testoutput (x,-huge(0_8),50,'(I50)')
end program test
-
-! { dg-final { cleanup-modules "testmod" } }
c2(1:1) = ' '
if (c1 /= c2) call abort
end program test
-
-! { dg-final { cleanup-modules "testmod" } }
END SUBROUTINE NFT_Init
END MODULE NFT_mod
-
-! { dg-final { cleanup-modules "nft_mod" } }
p = c_funloc(ffunc)
call callFunc(p, 21,-17*21)
end program main
-! { dg-final { cleanup-modules "c_funloc_tests_3" } }
end if
end subroutine sub0
end module bind_c_dts_2
-
-! { dg-final { cleanup-modules "bind_c_dts_2" } }
USE M2
CALL S1()
END
-
-! { dg-final { cleanup-modules "m1 m2" } }
CALL S1(x)
write(6,*) x%r
END
-
-! { dg-final { cleanup-modules "m1 m2" } }
integer :: xstop
CONTAINS
END MODULE globalvar_mod
-
-! { dg-final { cleanup-modules "globalvar_mod pec_mod" } }
c_size = 5
if (tricky ('Help me', butt_ugly) .ne. transfer (butt_ugly (1), chr)) call abort ()
end program spec_test
-! { dg-final { cleanup-modules "mykinds spec_xpr xtra_fun" } }
if (my_string(x) .ne. "01234567890") call abort ()
end program len_test
-! { dg-final { cleanup-modules "test" } }
call foo(res)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
-! { dg-final { cleanup-modules "tst" } }
-
call foo(res)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
-! { dg-final { cleanup-modules "tst" } }
call foo(res)
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" }
-! { dg-final { cleanup-modules "tst" } }
type(nonexist),pointer :: l ! { dg-error "has not been declared" }
end type epot_t
end module test
-! { dg-final { cleanup-modules "test" } }
if (.not.present(substr)) isscan = myscan ("foo", "over")
end function isscan
end
-! { dg-final { cleanup-modules "myint" } }
-
! { dg-final { scan-tree-dump " tm_doit \\(0B, 0\\);" "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "krmod" } }
-
! { dg-final { scan-tree-dump " tm_doit \\(&parm\.., 0B, 0\\);" "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "krmod" } }
-
b = -999.0_4
if (z.ne.cmplx (a,b)) call abort ()
end program blank_common
-
-! { dg-final { cleanup-modules "global" } }
b = 99.0
call foo ()
end program collision
-
-! { dg-final { cleanup-modules "m1 m2" } }
program bug
use h5global
end
-
-! { dg-final { cleanup-modules "h5global" } }
call BAR (T2)
CALL FOOBAR (T2)
END PROGRAM TEST1
-! { dg-final { cleanup-modules "test2 test3 test4" } }
if (kind(x).ne.kind(y)) call abort ()
if (v.ne.u) call abort ()
end program d
-
-! { dg-final { cleanup-modules "a" } }
c = (/99.0_4, 999.0_4, 999.0_4, 99.0_4/)
call foo ()
end program module_equiv
-
-! { dg-final { cleanup-modules "test_equiv" } }
reM = 0.57d1
if (M .ne. 0.57d1) call abort ()
end
-! { dg-final { cleanup-modules "a b" } }
if (any(d(3:5) .ne. b)) call abort ()
end subroutine
end
-
-! { dg-final { cleanup-modules "aap" } }
real :: a_(2) = (/1.,2./)
call nudata (nlibe_, a_, l_)
end
-
-! { dg-final { cleanup-modules "data_c" } }
nf2 = 2
call cf0004
end
-
-! { dg-final { cleanup-modules "stuff" } }
-
INTEGER :: ii
ii = H5P_DEFAULT_F
END PROGRAM fortranlibtest
-! { dg-final { cleanup-modules "h5global hdf5" } }
type(A_type):: A_var
A_var = initA()
end program C
-
-! { dg-final { cleanup-modules "a b" } }
-
! double complex :: s = (1.0D0, 0D0)
double complex :: s = (1.0, 0D0)
end module module_implicit_conversion
-
-! { dg-final { cleanup-modules "module_implicit_conversion" } }
return
end subroutine Selection_Sort
end program module_interface
-
-! { dg-final { cleanup-modules "max_loc_mod" } }
print *, two (2.3)
print *, dbl (2.3)
end program xfoo
-! { dg-final { cleanup-modules "foo_mod" } }
print *, pi
end program test
! { dg-final { scan-module "foo" "MD5:510304affe70481794fecdb22fc9ca0c" } }
-! { dg-final { cleanup-modules "foo" } }
! mangled to __m2_mod_m2_MOD_m3
end subroutine m3
end module m2_MOD_m2
-! { dg-final { cleanup-modules "m1 m1__m2 m2 m2_mod_m2" } }
write(str,*) nan
if (adjustl(str) /= "NaN") call abort()
end program a
-
-! { dg-final { cleanup-modules "nonordinal" } }
integer :: arr(max(len,1))
end
-
-! { dg-final { cleanup-modules "foo" } }
i = 1
if (para(i) /= 1) call i_am_optimized_away()
end
-
-! { dg-final { cleanup-modules "m" } }
j = 1
print *, i, j
end program main
-
-! { dg-final { cleanup-modules "bar foo" } }
use bar
call sub ()
end
-
-! { dg-final { cleanup-modules "foo bar" } }
call sub_module (sub)
call sub_module (str)
end
-! { dg-final { cleanup-modules "test_module" } }
if (mysum(1) /= 3 .and. mysum(2) /= 4) call abort
end subroutine test_sub
-! { dg-final { cleanup-modules "myoperator" } }
real x
end subroutine
end module
-! { dg-final { cleanup-modules "m1" } }
real x
end subroutine
end module
-! { dg-final { cleanup-modules "m1" } }
if(len(push(0)) /= 0) call abort()
if(len(push(1)) /= 1) call abort()
end program
-! { dg-final { cleanup-modules "foo" } }
if (len (string_to_char (str)) /= 5) call abort ()
if (string_to_char (str) /= "Hello") call abort ()
end
-
-! { dg-final { cleanup-modules "m_string" } }
if (ichar(a(2:2)) /= 0) call abort
write (s,"(A)") a
end
-
-! { dg-final { cleanup-modules "m" } }
implicit none
print *, vs_str("ABC")
end
-! { dg-final { cleanup-modules "fox_m_fsys_array_str fox_m_fsys_format m_dom_dom fox_dom" } }
call abort ()
end select
end program main
-
-! { dg-final { cleanup-modules "myalloc" } }
call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." }
END SUBROUTINE
end subroutine test4
-
-! { dg-final { cleanup-modules "bug" } }
if (allocated(sm2)) call abort()
if (.not. allocated(sm)) call abort()
end program
-
-! { dg-final { cleanup-modules "m2 m3" } }
call yg0009(tda2l,4,3,1,-1,-4,-3)
end
-! { dg-final { cleanup-modules "yg0009_stuff" } }
end subroutine really_snafu
end interface foo
end module snafu
-
-! { dg-final { cleanup-modules "snafu" } }
integer,private :: x
namelist /n/ x ! { dg-error "cannot be member of PUBLIC namelist" "" }
end module
-
-! { dg-final { cleanup-modules "namelist_1" } }
end subroutine foo
end program namelist_14
-
-! { dg-final { cleanup-modules "global" } }
(x(2)%m(2)%ch(2) == "kz"))) call abort ()
end program namelist_15
-
-! { dg-final { cleanup-modules "global" } }
namelist /nml2/ t5 ! { dg-error "has use-associated PRIVATE components" }
end subroutine
end program
-
-! { dg-final { cleanup-modules "types nml" } }
namelist /a/ t1 ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
namelist /b/ t3 ! { dg-error "has ALLOCATABLE or POINTER components and thus requires a defined input/output" }
END MODULE
-
-! { dg-final { cleanup-modules "types nml" } }
namelist /nml3/ t2 ! ok, private components
end subroutine
END MODULE
-
-! { dg-final { cleanup-modules "nml" } }
END FUNCTION\r
END
\r
-! { dg-final { cleanup-modules "m1" } }
! { dg-output "Missing colon in substring qualifier for namelist variable x%m%ch(\n|\r\n|\r)" }
! { dg-output "Substring out of range for namelist variable x%m%ch(\n|\r\n|\r)" }
! { dg-output "Bad character in substring qualifier for namelist variable x%m%ch(\n|\r\n|\r)" }
-! { dg-final { cleanup-modules "global" } }
! { dg-output "Missing colon in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" }
! { dg-output "Substring out of range for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" }
! { dg-output "Bad character in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\n|\r\n|\r)" }
-! { dg-final { cleanup-modules "nml_47" } }
if (adjoint%solver_type /= 'direct') call abort
if (adjoint%screen_io_fs_ntime%begin /= 42) call abort
end program gfortran_error_2
-
-! { dg-final { cleanup-modules "mod1" } }
NAMELIST /ga/ nichflg
READ (23, nml=ga)
END PROGRAM gafortran
-
-! { dg-final { cleanup-modules "ga_commons" } }
close (10)
end program namelist_use
-
-! { dg-final { cleanup-modules "global" } }
if ((i.ne.0).or.(rrrr.ne.3.5).or.foo()) call abort ()
close (10)
end program namelist_use_only
-
-! { dg-final { cleanup-modules "global" } }
if (isinf(max(-large, -inf, nan))) call abort
end program test
-
-! { dg-final { cleanup-modules "aux2" } }
if (isinf(max(-large, -inf, nan))) call abort
end program test
-! { dg-final { cleanup-modules "aux2" } }
END FORALL
END SUBROUTINE
END MODULE TESTS
-! { dg-final { cleanup-modules "tests" } }
call eyeore ()
call tigger (w)
end
-
-! { dg-final { cleanup-modules "mod0 mod1 mod2" } }
call sub2 (l)
if (any (l.ne.(/84,42,0/))) call abort ()
end program testfoobar
-
-! { dg-final { cleanup-modules "foo bar foobar" } }
CALL sub3 (z, j)
IF (ALL (j.ne.(/3,2,1/))) CALL abort ()
END PROGRAM use_foobar
-
-! { dg-final { cleanup-modules "foo bar foobar" } }
character*15 :: buffer
buffer = lc ("Have a Nice DAY")
end
-
-! { dg-final { cleanup-modules "string serial" } }
character*15 :: buffer
buffer = lc ("Have a Nice DAY")
end
-
-! { dg-final { cleanup-modules "anything serial" } }
print *, s_last
print *, diag (x)
end
-! { dg-final { cleanup-modules "tao_random_numbers linalg vamp_rest" } }
if (any((ac*bc) /= matmul(ac,bc))) call abort()
end
-! { dg-final { cleanup-modules "m1" } }
end function f3
end
-! { dg-final { cleanup-modules "foo" } }
A = (A > C) ! { dg-error "comparison operator '>'" }
A = (A.GT.C) ! { dg-error "comparison operator '.gt.'" }
END PROGRAM
-
-! { dg-final { cleanup-modules "mod_t" } }
t_bar = .FALSE.
END FUNCTION
END MODULE
-
-! { dg-final { cleanup-modules "mod_t" } }
program test
use foo, only : operator(.none.) ! { dg-error "not found in module" }
end program test
-! { dg-final { cleanup-modules "foo" } }
type(foo) :: a, b
print *, a == b
end subroutine
-
-! { dg-final { cleanup-modules "foo_type" } }
end function f1
end module op
-
-! { dg-final { cleanup-modules "op" } }
END SUBROUTINE sub2
END MODULE foo
-! { dg-final { cleanup-modules "foo" } }
call sub(bound=.false., dimmy=1_8)
call sub()
end program main
-! { dg-final { cleanup-modules "tst_foo" } }
& abort
end subroutine checku
end program main
-! { dg-final { cleanup-modules "m" } }
integer(1), parameter :: MSKa1(len(HEX1)) = [(1,i=1,len(HEX1))]
integer(1), parameter :: ARR1(len(HEX1)) = [( MSKa1(i), i=1,len(HEX1) )]
end module abuse_mod
-! { dg-final { cleanup-modules "abuse_mod" } }
use bug3
call sr
end program TEST
-! { dg-final { cleanup-modules "bug3" } }
use gfcbug45
call foo
end
-! { dg-final { cleanup-modules "gfcbug45" } }
c = bobo(5)
if (c .ne. "12345") call abort
end program test
-
-! { dg-final { cleanup-modules "para" } }
end program test
-
-! { dg-final { cleanup-modules "m" } }
use m\r
if (f ().ne.2) call abort ()\r
end\r
-
-! { dg-final { cleanup-modules "m" } }
integer :: b
end subroutine
end
-
-
-! { dg-final { cleanup-modules "m" } }
end subroutine
end module
-
-! { dg-final { cleanup-modules "base_mat_mod" } }
end subroutine add_item_to_dict
end module m_common_attrs
-
-! { dg-final { cleanup-modules "m_common_attrs" } }
if (u%i/=4) call abort()
end
-
-! { dg-final { cleanup-modules "m" } }
if (u%ppc()/=43) call abort()
end
-
-! { dg-final { cleanup-modules "m" } }
if (u%ppc()/=43) call abort()
end
-
-! { dg-final { cleanup-modules "m" } }
end subroutine
end module m2
-
-! { dg-final { cleanup-modules "m1 m2" } }
return
end subroutine split
end module specfiles
-
-! { dg-final { cleanup-modules "specfiles" } }
program test
call quus
end program test
-
-! { dg-final { cleanup-modules "foo bar" } }
real(8) :: c(3)
c = cross_product()
END PROGRAM TEST
-
-! { dg-final { cleanup-modules "module_vec3d" } }
integer :: i
i = map(42)
end subroutine string_comp
-
-! { dg-final { cleanup-modules "b" } }
if (tt(null(c4)) /= 3) call abort()
if (tt(null(c8)) /= 4) call abort()
end program test
-
-! { dg-final { cleanup-modules "mymod" } }
end function baz ! { dg-warning "res.yr' may be" }
end module foo
-
-! { dg-final { cleanup-modules "foo" } }
! { dg-final { scan-tree-dump-times "static int" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "pr26246_1" } }
!PR fortran/32222
! { dg-do compile }
-! { dg-final { cleanup-modules "splinemod" } }
module splinemod
implicit none
!PR fortran/32238
! { dg-do compile }
-! { dg-final { cleanup-modules "bug_test" } }
module bug_test
!PR fortran/32242
! { dg-do compile }
! { dg-options "-Wreturn-type" }
-! { dg-final { cleanup-modules "kahan_sum" } }
MODULE kahan_sum
INTEGER, PARAMETER :: dp=KIND(0.0D0)
end subroutine subsub
end subroutine sub
end module mo
-
-! { dg-final { cleanup-modules "mo" } }
print *, c_loc(get_ptr()) ! { dg-error "has PRIVATE components" }
end
-! { dg-final { cleanup-modules "pr32601" } }
implicit none
print *, tree_size(1)
end program example
-
-! { dg-final { cleanup-modules "cluster_definition cluster_tree" } }
END
! { dg-final { scan-tree-dump-times "stride" 4 "lim1" } }
! { dg-final { cleanup-tree-dump "lim1" } }
-! { dg-final { cleanup-modules "les3d_data" } }
call create_(self)
end subroutine
end
-
-! { dg-final { cleanup-modules "bar_module foo_module" } }
call self_ind_cir_coil (r, l, turns, mu, self_l)
end program test
-
-! { dg-final { cleanup-modules "scc_m" } }
end function gn_monte_rand
end module general_rand
-
-! { dg-final { cleanup-modules "general_rand" } }
end subroutine set_null
end module pr37287_1
end
-! { dg-final { cleanup-modules "pr37287_1" } }
-! { dg-final { cleanup-modules "pr37287_2" } }
#endif
implicit none
end module pr37287_2
-! { dg-final { cleanup-modules "pr37287_2" } }
end subroutine prininfo
end module hsl_ma41_m
-! { dg-final { cleanup-modules "hsl_ma41_m" } }
END DO
END SUBROUTINE diff_momop
END MODULE ai_moments
-! { dg-final { cleanup-modules "kinds ai_moments" } }
end module
end
-
-! { dg-final { cleanup-modules "grid_module field_module" } }
call Check(C_FUNLOC(Callback))
end program Main
-! { dg-final { cleanup-modules "test" } }
END DO
END SUBROUTINE newuob
END MODULE powell
-
-! { dg-final { cleanup-modules "powell" } }
end subroutine
END PROGRAM TEST
-! { dg-final { cleanup-modules "main1" } }
-
-
end if
end subroutine sparse_alltoall
end module fft_tools
-! { dg-final { cleanup-modules "fft_tools" } }
Q%B=0
CALL FOO (Q,N,N,.FALSE.)
END
-
-! { dg-final { cleanup-modules "pr43866" } }
! { dg-final { scan-tree-dump-times "= iyz.data" 3 "pre" } }
! { dg-final { cleanup-tree-dump "pre" } }
-! { dg-final { cleanup-modules "test" } }
end subroutine routine_A
end module test
-
-! { dg-final { cleanup-modules "test" } }
END SUBROUTINE S1
END MODULE
END
-! { dg-final { cleanup-modules "m1" } }
real :: local_array(4)
end subroutine dummysub
end module modboom
-
-! { dg-final { cleanup-modules "modboom" } }
type(myint), save :: foo2 ! { dg-error "of PRIVATE derived type" }
public :: foo2
end module demo2
-
-! { dg-final { cleanup-modules "demo" } }
TYPE(T1) FUNCTION F2()
END FUNCTION F2
END MODULE M1
-! { dg-final { cleanup-modules "m1" } }
TYPE(T1) FUNCTION F2() ! { dg-error "Fortran 2003: PUBLIC variable 'f2'" }
END FUNCTION F2
END MODULE M1
-! { dg-final { cleanup-modules "m1" } }
end subroutine
end module
-! { dg-final { cleanup-modules "m" } }
end do
write(*, *) 'OK'
end program
-
-! { dg-final { cleanup-modules "type_ext" } }
public all_type, any_type
END MODULE
END
-
-! { dg-final { cleanup-modules "test" } }
arg_t%c = 42
end subroutine d
end module c
-
-! { dg-final { cleanup-modules "a c" } }
end function
end module
-
-! { dg-final { cleanup-modules "m1" } }
end subroutine init
end subroutine sub
end module test
-! { dg-final { cleanup-modules "test" } }
foo2 = bartype(1,2) ! { dg-error "is a PRIVATE component" }
foo2%dummy2 = 5 ! { dg-error "is a PRIVATE component" }
end program foo_test
-! { dg-final { cleanup-modules "foomod" } }
k = foo(i)
print *, "in the main:", k
end program testit
-! { dg-final { cleanup-modules "gfcbug68" } }
real :: local_array(4)
end subroutine dummysub
end module modboom
-
-! { dg-final { cleanup-modules "modboom" } }
end module m4
end
-! { dg-final { cleanup-modules "m1 m2 m3 m4" } }
y = 2 ! OK - function result\r
end function y\r
end\r
-! { dg-final { cleanup-modules "simple simpler" } }\r
END FUNCTION
END FUNCTION
END MODULE
-! { dg-final { cleanup-modules "foo" } }
procedure(dprod) :: my3 ! { dg-error "Cannot change attributes" }
end program test
-
-! { dg-final { cleanup-modules "m" } }
call f([1,2,3])
end subroutine foo
end program test
-
-! { dg-final { cleanup-modules "m" } }
end interface
call f([1,2,3]) ! Works
end subroutine foo2
-
-! { dg-final { cleanup-modules "m" } }
end program test
call check(foo,i)
end program
-
-! { dg-final { cleanup-modules "m" } }
p(l) = y(l)*2
end do
end function
-
-! { dg-final { cleanup-modules "m" } }
integer :: x, p7
p7 = x*(-2)
end function
-
-! { dg-final { cleanup-modules "m" } }
use other_fun
procedure(abstract_fun) :: fun
end program fptr
-
-! { dg-final { cleanup-modules "other_fun" } }
print *, char1 (["j","k","l"])
end
! { dg-final { cleanup-tree-dump "m_string" } }
-! { dg-final { cleanup-modules "m_string" } }
implicit none
procedure(Proc) :: Proc_Get
end
-
-! { dg-final { cleanup-modules "m1 m2" } }
implicit none
if(x() /= -5) call abort()
end program test
-
-! { dg-final { cleanup-modules "modproc" } }
intrinsic cos
call sub(cos) ! { dg-error "wrong number of arguments" }
end
-! { dg-final { cleanup-modules "m" } }
procedure(cos) :: foo ! { dg-error "Duplicate EXTERNAL attribute specified" }
call sub(foo) ! { dg-error "is not a function" }
end
-! { dg-final { cleanup-modules "m" } }
if (ptr6()/=6.3) call abort()
end program
-
-! { dg-final { cleanup-modules "m" } }
call proc4( p )
end program myProg
-! { dg-final { cleanup-modules "mymod" } }
use myfortran_binding
error_handler => error_stop
end
-
-! { dg-final { cleanup-modules "myfortran_binding" } }
PRINT*, 'sub'
END SUBROUTINE s
END PROGRAM prog
-
-! { dg-final { cleanup-modules "m" } }
-
pp2 => returnMat
if (sum(pp2(3,2))/=6) call abort()
end program bugTest
-
-! { dg-final { cleanup-modules "bugtestmod" } }
-
if (associated(p_fun) .or. associated(p_fun2)) &
call abort ()
end program main
-
-! { dg-final { cleanup-modules "mod_a" } }
end interface
procedure(i_f), pointer, protected :: p_f => null()
end module m
-
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE use_sub
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
y = p(x)
end function i_g
end module m2
-
-! { dg-final { cleanup-modules "m1 m2" } }
f => my_dcos ! { dg-error "Mismatch in PURE attribute" }
write(*,*) f(x)
end program start
-
-! { dg-final { cleanup-modules "funcs" } }
\ No newline at end of file
stop
end program test_proc_ptr
-
-! { dg-final { cleanup-modules "examplefuncs" } }
subroutine sub2
end subroutine sub2
-
-! { dg-final { cleanup-modules "m0" } }
end subroutine
END
-
-! { dg-final { cleanup-modules "x" } }
obj%ppc => pp
pp => obj%ppc
end
-
-! { dg-final { cleanup-modules "m" } }
-
print *,testObj%test(3,3)
if (sum(testObj%test(3,3))/=9) call abort()
end program bugTest
-
-! { dg-final { cleanup-modules "bugtestmod" } }
-
str = x%ptr()
if (str/='abcde') call abort()
end
-
-! { dg-final { cleanup-modules "m" } }
-
str = x%ptr(3)
if (str/='abc') call abort()
end
-
-! { dg-final { cleanup-modules "m" } }
-
str = 'fghij'
if (strptr/='fghij') call abort()
end
-
-! { dg-final { cleanup-modules "m" } }
-
arr%myproc => myproc ! { dg-error "must not have the POINTER attribute" }
END PROGRAM main
-! { dg-final { cleanup-modules "m" } }
print *, funcp%p(nr=3,x=(/0.1,0.1/))
end program t
-! { dg-final { cleanup-modules "poisson_functions_m element_defs_m" } }
type(rectangle) :: rect
write(*,*) rect ! { dg-error "cannot have procedure pointer components" }
end program
-
-! { dg-final { cleanup-modules "proc_pointers" } }
type(rectangle) :: rect
rect%get_special_area => get_my_area ! { dg-error "Interface mismatch in procedure pointer assignment" }
end
-
-! { dg-final { cleanup-modules "m" } }
end function get2
end
-
-
-! { dg-final { cleanup-modules "m" } }
end function var_list_get_var_ptr
end
-
-! { dg-final { cleanup-modules "expressions process_libraries hard_interactions" } }
-
if (calls/=2) call abort
end program main
-
-! { dg-final { cleanup-modules "proc_component_example" } }
-
integer :: j
j = x%ppc()
end
-
-! { dg-final { cleanup-modules "m" } }
-
if (m%i/=6) call abort()
end program Test_03
-
-! { dg-final { cleanup-modules "mymod" } }
-
call x%proc (output_unit)
end program main
-
-! { dg-final { cleanup-modules "passed_object_example" } }
-
end function
end module m
-
-! { dg-final { cleanup-modules "m" } }
-
call t2%foo()
call t2%foo(t1)
end
-
-! { dg-final { cleanup-modules "m" } }
-
CALL arr(i)%Proc(ierr)
END DO
END PROGRAM ProgA
-
-! { dg-final { cleanup-modules "moda" } }
call obj%base_t%write_procptr ! { dg-error "is of ABSTRACT type" }
end program main
-
-! { dg-final { cleanup-modules "types" } }
end function
end
-
-! { dg-final { cleanup-modules "mo" } }
-
end function
end
-
-! { dg-final { cleanup-modules "proc_ptr_15" } }
-
j = j*3
call set_sub(my_sub)
end subroutine my_sub
-
-! { dg-final { cleanup-modules "store_subroutine" } }
-
getPtr2 => func
end function
end program test
-
-! { dg-final { cleanup-modules "m" } }
-
b = 1. ! { dg-error "is not a variable" }
y = a(1.)
end subroutine r
-
-! { dg-final { cleanup-modules "t" } }
if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
end subroutine
end program main
-
-! { dg-final { cleanup-modules "protmod" } }
if(a /= 44 .or. ap /= 79 .or. at /= 4) call abort()
end subroutine
end program main
-
-! { dg-final { cleanup-modules "protmod" } }
real :: a
protected :: test ! { dg-error "MODULE attribute conflicts with PROTECTED" }
end module test
-
-! { dg-final { cleanup-modules "protmod test" } }
nullify(t%p) ! { dg-error "pointer association context" }
allocate(t%array(15))! { dg-error "variable definition context" }
end program main
-
-! { dg-final { cleanup-modules "good1 good2 bad1 bad2" } }
real, protected :: b ! { dg-error "only allowed in specification part of a module" }
end subroutine bar
end module prot2
-
-! { dg-final { cleanup-modules "protmod" } }
unprotected_pointer => protected_target ! { dg-error "target has PROTECTED attribute" }
unprotected_pointer => protected_pointer ! OK
end program p
-
-! { dg-final { cleanup-modules "m" } }
b%j = 5 ! OK 5
END PROGRAM test
-
-! { dg-final { cleanup-modules "amod" } }
implicit none
private a ! { dg-error "attribute applied to" }
end module d
-! { dg-final { cleanup-modules "a" } }
a = hoj()
if (.not. all(a == (/1, 2, 3/))) call abort()
end program pure_byref_3
-
-! { dg-final { cleanup-modules "huj_mod" } }
deallocate(pT1)
end program Test
-! { dg-final { cleanup-modules "testpure" } }
integer :: test
test = p
end function test
-! { dg-final { cleanup-modules "mod_xyz mod_xyz2 mod_xyz3" } }
reduced = pack (array, mask)
end function reduced
end module cascades
-! { dg-final { cleanup-modules "cascades" } }
-
bar = carg(1:12)
end function
end
-
-! { dg-final { cleanup-modules "m" } }
-
end do
end subroutine print_after_transfer
-! { dg-final { cleanup-modules "m gf33" } }
-! { dg-final { cleanup-modules "custom_type custom_interfaces" } }
-! { dg-final { cleanup-modules "store_data_test" } }
july4 = new_show(boom=fireworks)
end program
-
-! { dg-final { cleanup-modules "soop_stars_class" } }
call f(.false.)
call f(.false.)
end program test
-! { dg-final { cleanup-modules "m" } }
call f(.false.)
call f(.true.)
end program test
-! { dg-final { cleanup-modules "m" } }
real, intent(in) :: b ! { dg-error "Unexpected data declaration statement" }
end subroutine a3 ! { dg-error "Expecting END MODULE" }
end module m3
-! { dg-final { cleanup-modules "m1 m2 m3" } }
END FUNCTION func
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
END FUNCTION func
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE main
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
IF (ANY(TEST(3).NE.(/5,5,5,5,5/))) CALL ABORT()
IF (ANY(TEST(6).NE.(/0,0,0,0,0/))) CALL ABORT()
END
-! { dg-final { cleanup-modules "m1" } }
-
I=-J
END SUBROUTINE T1
END MODULE M1
-! { dg-final { cleanup-modules "m1" } }
lhs(:) = rhs(:)
end subroutine invalid3
end module test4
-
-! { dg-final { cleanup-modules "test1" } }
if (nxttab(linem, 1) .ne. 6) call abort
if (nxttab(linem, nplam) .ne. 132) call abort
end program test
-! { dg-final { cleanup-modules "splitprms" } }
\ No newline at end of file
USE M1
CALL S2(0)
END
-! { dg-final { cleanup-modules "m1" } }
integer f
f = 2*x+1
end function f
-! { dg-final { cleanup-modules "test1" } }
if(len (test2()) /= 3) call abort ()
if(test2() /= '123') call abort ()
end program test
-! { dg-final { cleanup-modules "test1" } }
sigma2 = MATMUL(getPhaseMatrix(), sigma2)
END SUBROUTINE
end module m
-
-! { dg-final { cleanup-modules "m m2" } }
subroutine u
end subroutine u
end module m
-
-! { dg-final { cleanup-modules "n m" } }
write(*,*) 'BB'
end subroutine aa
end module
-! { dg-final { cleanup-modules "aha" } }
answer=i
end function tell_i
end module g95bug
-
-! { dg-final { cleanup-modules "g95bug" } }
CHARACTER(len=1), PARAMETER :: backslash = '\\'
PUBLIC :: backslash
END MODULE
-
-! { dg-final { cleanup-modules "test" } }
end function
end module
-
-! { dg-final { cleanup-modules "bar_module" } }
end select
end program bug20
-
-
-! { dg-final { cleanup-modules "base_mat_mod d_base_mat_mod" } }
end subroutine bug21
end module d_base_mat_mod
-
-
-! { dg-final { cleanup-modules "d_base_mat_mod" } }
return
end subroutine trans2
-
-! { dg-final { cleanup-modules "base_mod s_base_mod" } }
call destroy_list(list)
stop
end program main
-! { dg-final { cleanup-modules "poly_list" } }
Integer(kindInt), dimension(:), pointer :: subset
end type GroupDefLL
end module data_types
-! { dg-final { cleanup-modules "data_types" } }
call bar(self, z)
end subroutine
end
-
-! { dg-final { cleanup-modules "foo" } }
call bar_(self, z)
end subroutine
end
-
-! { dg-final { cleanup-modules "foo" } }
end subroutine bar
end subroutine foo
end module
-
-! { dg-final { cleanup-modules "ice" } }
if (any (ISHFTC(X, 3, 5) /= D)) call abort ()
if (any (ISHFTC(X, Y, 5) /= E)) call abort ()
end
-! { dg-final { cleanup-modules "mods" } }
e%numbering => ent
print *, element_local_coords (e)
end
-! { dg-final { cleanup-modules "elements global_numbering" } }
p1_type = 42
end function p1_type
end module m2
-
-! { dg-final { cleanup-modules "m m2" } }
print *, elements_uncommon_with (z)
print *, n_elements_uncommon_with_ (z)
end
-! { dg-final { cleanup-modules "test" } }
end function bar
end module gfcbug50
-
-! { dg-final { cleanup-modules "gfcbug50" } }
MODULE stmt
f(x) = x**2 ! { dg-error "Unexpected STATEMENT FUNCTION" }
END MODULE
-
-! { dg-final { cleanup-modules "stmt" } }
-
end if
end do
end
-
-! { dg-final { cleanup-modules "xparams" } }
IMPLICIT NONE
CALL check_complements(the_beta%name)
END SUBROUTINE cdf_beta
-
-! { dg-final { cleanup-modules "cdf_aux_mod" } }
-
WRITE (*,*) ispriv_t (5) ! { dg-error "has no IMPLICIT type" }
END PROGRAM test
-! { dg-final { cleanup-modules "privmod" } }
character(4) :: b
b = a
end
-
-! { dg-final { cleanup-modules "m" } }
character :: at, dev
equivalence ( encodings(1:1),at ), ( encodings(2:2),dev)
end module FLAGS
-
-! { dg-final { cleanup-modules "flags" } }
call abort()
endif
end program testComBlock
-
-! { dg-final { cleanup-modules "nonf03comblock" } }
integer(c_int) :: i
bind(c, name="mycom2") /com2/
end module z
-
-! { dg-final { cleanup-modules "x y" } }
endif
end subroutine testOnly
end module testOnlyClause
-
-! { dg-final { cleanup-modules "testonlyclause" } }
call BytesToString( StringToBytes('Hi'), str )
if (trim(str) .ne. "Hi") call abort ()
end program
-! { dg-final { cleanup-modules "transferbug" } }
-
end do
deallocate(qname)
end
-! { dg-final { cleanup-modules "m" } }
\ No newline at end of file
! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 4 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "foo" } }
! { dg-final { scan-tree-dump-times "parm" 66 "original" } }
! { dg-final { scan-tree-dump-times "atmp" 12 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "mod" } }
! { dg-final { scan-tree-dump-times "memmove" 4 "original" } }
! { dg-final { scan-tree-dump-times "string_trim" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
-! { dg-final { cleanup-modules "faz" } }
if (line /= "aX ") call abort
if (f() .ne. 2) call abort
end program main
-
-! { dg-final { cleanup-modules "foo" } }
use m
f = 42
end
-
-! { dg-final { cleanup-modules "m" } }
this%st = st
end subroutine init_comps
end module hydro_flow
-
-! { dg-final { cleanup-modules "hydro_state hydro_flow" } }
this%gr = gr
end subroutine init_comps
end module hydro_flow
-
-! { dg-final { cleanup-modules "hydro_grid hydro_flow" } }
type (bar) :: foobar(2)
foobar = bar() ! There was a not-implemented error here
end
-
-! { dg-final { cleanup-modules "foo" } }
USE m, ONLY: test
CALL test ()
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
call t2%foo()
call t1%foo(t2)
end
-
-! { dg-final { cleanup-modules "m" } }
-
end function new_field3
end module
-
-! { dg-final { cleanup-modules "grid_module field_module" } }
END DO
END PROGRAM ProgA
-! { dg-final { cleanup-modules "moda" } }
if (res /= 2) call abort()
end program
-
-! { dg-final { cleanup-modules "module_myobj" } }
print *,ice_array(2)%next%ice_fun()
end subroutine
end module ice_module
-
-! { dg-final { cleanup-modules "ice_module" } }
end subroutine
end module ice5
-! { dg-final { cleanup-modules "ice5" } }
m = a%get_nrows()
end
-
-! { dg-final { cleanup-modules "base_mat_mod" } }
call p1%add_poly()
end program test_poly
-
-! { dg-final { cleanup-modules "polynomial" } }
call g%assign (g_initial)
print *, "cg: after g%assign"
end program main
-
-! { dg-final { cleanup-modules "abstract_vector concrete_vector concrete_gradient" } }
this%x = this%find_x()
if (this%x%i /= 4) call abort()
end
-
-! { dg-final { cleanup-modules "class_t" } }
USE m, ONLY: test
CALL test ()
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
y = this%find_y()
if (y/=3) call abort()
end
-
-! { dg-final { cleanup-modules "class_t" } }
end
! { dg-final { scan-tree-dump-times "_vptr->" 0 "original" } }
-
-! { dg-final { cleanup-modules "m" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-final { scan-tree-dump-times "base \\(\\);" 1 "optimized" } }
! { dg-final { cleanup-tree-dump "optimized" } }
-
-! { dg-final { cleanup-modules "m" } }
CALL abort ()
END IF
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE test
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
CALL obj%priv () ! { dg-error "PRIVATE" }
CALL obj%publ ()
END SUBROUTINE test2
-
-! { dg-final { cleanup-modules "m" } }
CALL super%proc
CALL sub%proc
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
END SUBROUTINE fill_gap
END MODULE touching
-
-! { dg-final { cleanup-modules "touching" } }
END SUBROUTINE fill_gap
END MODULE touching
-
-! { dg-final { cleanup-modules "touching" } }
End Subroutine foo_free
end module foo_mod
-
-! { dg-final { cleanup-modules "foo_mod" } }
END SUBROUTINE subr
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
end subroutine b_subroutine
end module generic
-
-! { dg-final { cleanup-modules "generic" } }
res = ( t%i == i )
end function i_equal_t2
end module m_test2
-
-! { dg-final { cleanup-modules "m_test m_test2" } }
WRITE (*,*) myobj%sub (1) ! { dg-error "FUNCTION" }
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
END PROGRAM main
! { dg-output "Plain Integer(\n|\r\n|\r).*Plain Real(\n|\r\n|\r).*Passed Integer(\n|\r\n|\r).*Passed Real" }
-! { dg-final { cleanup-modules "m" } }
end program foobar
! { dg-output "Vector.*Matrix" }
-! { dg-final { cleanup-modules "bar_mod" } }
CALL abort ()
END IF
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
if (afab%get() .ne. 3) call abort
end program testd15
-
-! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
call x%do()
end subroutine
end
-
-! { dg-final { cleanup-modules "foo_mod" } }
end subroutine do_something
end module ice6
-
-! { dg-final { cleanup-modules "ice6" } }
if (af2%get() .ne. 3) call abort
end program testd15
-
-! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
END SUBROUTINE assign_proc
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
class(field) ,pointer :: u
u = (u)*2. ! { dg-error "check that there is a matching specific" }
end program
-! { dg-final { cleanup-modules "field_module" } }
x = x%t()*dt
end subroutine
end module
-
-! { dg-final { cleanup-modules "foo_module" } }
if (any (fireworks%position .ne. [6, 12, 18])) call abort
if (any (fireworks%velocity .ne. [24, 30, 36])) call abort
end program
-! { dg-final { cleanup-modules "soop_stars_class" } }
-
if (any (fireworks%position .ne. [6, 12, 18])) call abort
if (any (fireworks%velocity .ne. [24, 30, 36])) call abort
end program
-! { dg-final { cleanup-modules "soop_stars_class" } }
-
END SUBROUTINE sub2
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
IF (.GET. num1 /= 3.0) CALL abort ()
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
x = x + 42 ! { dg-error "Operands of" }
x = x .PLUS. 5 ! { dg-error "Unknown operator" }
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
CLASS (NODE),POINTER :: A, B
PRINT *, A%PT .LT. B%PT
END
-
-! { dg-final { cleanup-modules "def1" } }
if (.NOT. NDA .LT. NDB) call abort()
END
-
-! { dg-final { cleanup-modules "dat_mod node_mod" } }
type is (i_field); if (u%i .ne. 152064) call abort
end select
end program
-! { dg-final { cleanup-modules "field_module i_field_module" } }
-
if (u%i .ne. 152064) call abort
end program
-! { dg-final { cleanup-modules "field_module i_field_module" } }
end select
end subroutine
end program test_pde_solver
-! { dg-final { cleanup-modules "pde_specific define_pde_objects cartesian_2d_objects base_pde_objects" } }
end function
end module w2
-
-! { dg-final { cleanup-modules "m w1 w2" } }
integer, intent(inout) :: j
end subroutine ext_bar
end module extfoo_mod
-
-! { dg-final { cleanup-modules "foo_mod extfoo_mod" } }
END FUNCTION proc3
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
END TYPE sub_type2
END MODULE m2
-
-! { dg-final { cleanup-modules "m1" } }
END SUBROUTINE realproc
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
END SUBROUTINE test
END MODULE m
-
-! { dg-final { cleanup-modules "m" } }
end subroutine
end
-
-! { dg-final { cleanup-modules "m" } }
end subroutine
end
-
-! { dg-final { cleanup-modules "m" } }
r%d = a%d*b%d
END FUNCTION
END
-
-! { dg-final { cleanup-modules "rational_numbers" } }
end function get_coeff
end module array
-
-
-! { dg-final { cleanup-modules "array" } }
end function Tree_Node_Get
end module Merger_Trees
-
-! { dg-final { cleanup-modules "merger_trees" } }
call test()
end
-
-! { dg-final { cleanup-modules "mytypes" } }
END FUNCTION proc2
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
! { dg-excess-errors "no IMPLICIT type" }
type(t) :: x
call x%calc()
end
-
-! { dg-final { cleanup-modules "class_t" } }
find_x => null()
end function find_x
end module class_t
-
-! { dg-final { cleanup-modules "class_t" } }
bar = foo%getx() ! OK
bar = fooPriv%getxPriv() ! { dg-error " is PRIVATE " }
end program quicktest
-
-! { dg-final { cleanup-modules "qtest qtestpriv" } }
call ice_sub(t)
if (it/=1) call abort()
end
-
-! { dg-final { cleanup-modules "ice" } }
end subroutine
end module
-
-! { dg-final { cleanup-modules "datetime_mod" } }
CALL factory%finalize() ! Destroy the object
END PROGRAM main
-
-! { dg-final { cleanup-modules "factory_pattern" } }
END TYPE t ! { dg-error "Fortran 2008" }
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
CONTAINS
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
END SUBROUTINE proc_no_module
END PROGRAM main
-
-! { dg-final { cleanup-modules "othermod testmod" } }
END SUBROUTINE proc_tmereal
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
END SUBROUTINE proc_noarg
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
END SUBROUTINE proc
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
END TYPE abstract_type
END MODULE testmod
-
-! { dg-final { cleanup-modules "testmod" } }
call DoSomethingWithBytes( UserTypeToBytes(user) )
end program
-! { dg-final { cleanup-modules "internalcompilererror" } }
end function
end module foo
-! { dg-final { cleanup-modules "foo" } }
subroutine bar1
usefoo
end
- ! { dg-final { cleanup-modules "foo" } }
implicit none
if (.my.2 /= -2 .or. .op.3 /= -3 .or. .ops.7 /= -7) call abort()
end
-
-! { dg-final { cleanup-modules "a" } }
local2 = 3
if (local1 .ne. local2) call abort ()
end
-! { dg-final { cleanup-modules "m" } }
integer :: nfirst(3)
nfirst(1:numclusters) = get_nfirst( )
end program kmeans_driver
-! { dg-final { cleanup-modules "m1 m2" } }
use m2
call test()
end
-! { dg-final { cleanup-modules "m m2" } }
end subroutine
END
-
-! { dg-final { cleanup-modules "test_mod" } }
end subroutine
END
-
-! { dg-final { cleanup-modules "test_mod test_mod2" } }
implicit none
integer :: bar ! { dg-error "Symbol 'bar' at \\(1\\) conflicts with symbol from module 'a'" }
end
-
-! { dg-final { cleanup-modules "a" } }
integer :: c_double
integer, parameter :: p1 = c_int, p2 = c_double_orig
end subroutine test1
-
-! { dg-final { cleanup-modules "mod1 mod2" } }
print *, i*j
print *, k > l
end
-
-! { dg-final { cleanup-modules "foo bar" } }
use m, only: operator(/) ! { dg-error "Intrinsic operator '/' referenced at .1. not found in module 'm'" }
end
-
-! { dg-final { cleanup-modules "m" } }
use foo, only: foo_t ! <------ change order to prevent ICE
use bar, only: bar_t ! <------ change order to prevent ICE
end module merry_ICE
-
-! { dg-final { cleanup-modules "foo bar merry_ice" } }
implicit none
call dom%init
end program ala
-
-! { dg-final { cleanup-modules "domain" } }
use, nonintrinsic :: iso_fortran_env ! { dg-error "shall be either INTRINSIC or NON_INTRINSIC" }
use, intrinsic :: iso_fortran_env
end
-! { dg-final { cleanup-modules "foo" } }
use foo, only: i => foo! { dg-error "been used as an external module name" }
use foo, only: foo => i! { dg-error "been used as an external module name" }
end program
-! { dg-final { cleanup-modules "foo bar test test2 test3" } }
if ((.my. i) /= 2+15) call abort ()
if ((.addfive. i) /= 2+5) call abort ()
end
-
-! { dg-final { cleanup-modules "x y z" } }
use y, operator(.my.) => operator(.addfive.) ! { dg-error "Fortran 2003: Renaming operators in USE statements" }
use z
end
-
-! { dg-final { cleanup-modules "x y z" } }
use y, operator(.my.) => sub ! { dg-error "Syntax error in USE statement" }
use y, operator(+) => operator(.addfive.) ! { dg-error "Syntax error in USE statement" }
end
-
-! { dg-final { cleanup-modules "x y z" } }
use test, only: operator(.func.) ! { dg-error "not found in module 'test'" }
end
-! { dg-final { cleanup-modules "test" } }
use foo
if (.not.allocated(bar)) call abort
end subroutine init
-
-! { dg-final { cleanup-modules "foo" } }
! --Rickett, 09.13.06
use iso_c_binding, only: c_int, c_int
end module use_stmt_7
-
-! { dg-final { cleanup-modules "use_stmt_2 use_stmt_3 use_stmt_4 use_stmt_5 use_stmt_6 use_stmt_7" } }
if (yfoobar (77) /= 77_4) call abort ()
end subroutine
END PROGRAM test2uses
-! { dg-final { cleanup-modules "xmod ymod" } }
module MyMod4\r
USE MyMod3, only: write_MyInt\r
end module MYMOD4\r
-! { dg-final { cleanup-modules "mymod1 mymod2 mymod3 mymod4" } }
& dq2, gmes
end subroutine dforceb
-! { dg-final { cleanup-modules "cell_base cvan gvecs kinds" } }
-! { dg-final { cleanup-modules "constants electrons_base gvecw parameters" } }
-! { dg-final { cleanup-modules "control_flags electrons_nose ions_base" } }
-
use m2
call two
end
-! { dg-final { cleanup-modules "m1 m2" } }
use m_common_attrs, only: dictionary_t
use m_common_attrs, only: get_prefix_by_index
end module m_common_namespaces
-
-! { dg-final { cleanup-modules "m_common_attrs m_common_namespaces" } }
integer :: nmoltype_phase
namelist /confNmoltypePhase/ nmoltype_phase
end subroutine read_initial_config_nml2
-! { dg-final { cleanup-modules "common_init_conf" } }
if (b .ne. 5) call abort ()
end subroutine test2
end
-
-! { dg-final { cleanup-modules "reduction5" } }
print *, 'Is flag'
endif
end program
-! { dg-final { cleanup-modules "funcinterfacemod secondmod" } }
CALL abort ()
END IF
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
i = 4 ! { dg-error "no IMPLICIT type" }
j = 5
END PROGRAM main
-
-! { dg-final { cleanup-modules "m" } }
! Test an empty function works, too.
INTEGER FUNCTION test5 ()
END FUNCTION test5
-
-! { dg-final { cleanup-modules "testmod" } }
call test (res)
if (res%a.ne.42) call abort
end
-
-! { dg-final { cleanup-modules "mtyp atest" } }
v = x%f2(:)
end subroutine foo
end module mod2
-
-! { dg-final { cleanup-modules "mod1 mod2" } }
TYPE(data_type) :: x
CALL TEST(x) ! { dg-error "Type mismatch in argument" }
END
-
-! { dg-final { cleanup-modules "t1 t2" } }
y = seq_type3 (99)
end subroutine foo
END
-
-! { dg-final { cleanup-modules "global" } }
print *, x, y, z, dt2, st2, ns2, ns1
end subroutine foo
END
-
-! { dg-final { cleanup-modules "global" } }
USE ATOMS
USE CONSTRAINT, ONLY : ENERGY_CONSTRAINT
END MODULE P_POTENTIAL_ENERGY
-
-! { dg-final { cleanup-modules "atoms constraint potential_energy p_constraint p_potential_energy" } }
END SUBROUTINE
END INTERFACE
END MODULE
-! { dg-final { cleanup-modules "atom types list" } }
D1=T1(3)
write(6,*) E1(D1)
END
-! { dg-final { cleanup-modules "m1" } }
REAL :: solveCConvert(1:anzKomponenten)
solveCConvert = (/(real(i), i = 1, anzKomponenten)/)
END FUNCTION solveCConvert
-
-! { dg-final { cleanup-modules "module_conc module_thermocalc" } }
mtpcar%coo='a' !ICE was here
END SUBROUTINE str_clan
END MODULE
-
-! { dg-final { cleanup-modules "testcase tp_trace" } }
end subroutine foo_bar
-! { dg-final { cleanup-modules "derived_type_mod tools" } }
x => foo ()
print *, associated (x)
end
-! { dg-final { cleanup-modules "a b" } }
TYPE(T1) :: BAZ
BAZ = BAR
END
-! { dg-final { cleanup-modules "m" } }
-
call point ( gp)
end subroutine plane
end module gfcbug44
-! { dg-final { cleanup-modules "geo gfcbug44" } }
-
end subroutine foo_ext
end module foo_mod
-! { dg-final { cleanup-modules "foo_type_mod foo_mod" } }
atom = dam%atoms%table(1)
END SUBROUTINE
END MODULE
-! { dg-final { cleanup-modules "class_dummy_atom_types test_class_intensity_private" } }
\r
this%table(1:this%nused) = other%table(1:other%nused)\r
END SUBROUTINE\r
-! { dg-final { cleanup-modules "class_dummy_atom_types class_dummy_atom_list" } }
end subroutine boxarray_sort
end module boxarray_module
-
-! { dg-final { cleanup-modules "box_module sort_box_module boxarray_module" } }
use A
type(A_type):: A_var
end program C
-! { dg-final { cleanup-modules "a b" } }
foobar = .FALSE.
c = bar (x)
END FUNCTION foobar
-! { dg-final { cleanup-modules "types foo" } }
-
TYPE(outer), INTENT(IN) :: a
END SUBROUTINE test3
END MODULE test
-! { dg-final { cleanup-modules "types mymod test" } }
type(vector) :: new_pos ! the new vertex position, after smoothing\r
\r
end subroutine smooth_mesh\r
-! { dg-final { cleanup-modules "class_vector class_dimensions tools_math" } }
-! { dg-final { cleanup-modules "class_motion class_bc_math class_bc tools_mesh_basics" } }
type(vector ) :: new_pos ! { dg-error "used before it is defined" }\r
end module smooth_mesh\r
\r
-! { dg-final { cleanup-modules "class_vector tools_math smooth_mesh" } }
implicit none
end module test_mod
-
-! { dg-final { cleanup-modules "m1 m2 test_mod" } }
type t ! { dg-error "Derived type definition of 't' at .1. has already been defined" }
end type t ! { dg-error "Expecting END PROGRAM statement" }
end
-
-! { dg-final { cleanup-modules "m" } }
-
use m2
type(t) :: x ! { dg-error "Type name 't' at .1. is ambiguous" }
end
-
-! { dg-final { cleanup-modules "m m2" } }
a%ofTypA(i,j) = ofTypB(k,j)
end subroutine buggy
end module modC
-! { dg-final { cleanup-modules "moda modb modc" } }
call InitRECFAST(CP%omegab,CP%h0,CP%tcmb,CP%yhe)\r
end subroutine inithermo\r
end module ThermoData\r
-! { dg-final { cleanup-modules "precision modelparams timesteps thermodata" } }
if (any (x .ne. (/42.0, 42.0, -42.0, -42.0/))) call abort ()
if (cam%i .ne. 99) call abort ()
end
-! { dg-final { cleanup-modules "types global" } }
RETURN
END SUBROUTINE bar
END MODULE seg_mod
-! { dg-final { cleanup-modules "type_mod seg_mod" } }
clock%CurrTime = clock%CurrTime + clock%CurrTime
end subroutine ESMF_ClockAdvance
end module foo
-! { dg-final { cleanup-modules "foo bar" } }
clock%CurrTime = clock%CurrTime + clock%CurrTime
end subroutine ESMF_ClockAdvance
end module foo
-! { dg-final { cleanup-modules "foo bar" } }
end interface\r
end subroutine integrate\r
end module foo\r
-! { dg-final { cleanup-modules "foo bar" } }\r
a = dot_product (t(:,1), t(:,2) .cross. t(:,3))
end program opshape
-
-! { dg-final { cleanup-modules "geometry" } }
print*, a .myop. b
end subroutine test_fn
end module test_mod
-
-! { dg-final { cleanup-modules "test_mod" } }
end subroutine complex_foo
end program test_value
-! { dg-final { cleanup-modules "global" } }
v = c_to_c (u, w)
if (delta ((4.0 * u), v)) call abort ()
end program value_4
-! { dg-final { cleanup-modules "global" } }
implicit none
call test('a')
end program main
-! { dg-final { cleanup-modules "pr32732" } }
END SUBROUTINE ACCONV
! { dg-final { cleanup-tree-dump "vect" } }
-! { dg-final { cleanup-modules "yomphy0" } }
! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { target vect_intfloat_cvt } } }
! { dg-final { cleanup-tree-dump "vect" } }
-! { dg-final { cleanup-modules "solv_cap" } }
end program test
! { dg-final { cleanup-tree-dump "vect" } }
-! { dg-final { cleanup-modules "foo" } }
! { dg-final { scan-tree-dump-times "vectorized 19 loops" 1 "vect" } }
! { dg-final { cleanup-tree-dump "vect" } }
-! { dg-final { cleanup-modules "lfk_prec" } }
! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } }
! { dg-final { cleanup-tree-dump "vect" } }
-! { dg-final { cleanup-modules "upml_mod" } }
PRINT *, pw%cr(UBOUND(pw%cr))
END SUBROUTINE pw_write
END MODULE
-
-! { dg-final { cleanup-modules "pw_types" } }
! TODO: dg-final { scan-tree-dump-not "main_test2_3" "optimized" }
! { dg-final { scan-tree-dump "main_test2_4" "optimized" } }
! { dg-final { cleanup-tree-dump "optimized" } }
-! { dg-final { cleanup-modules "impl one two" } }
! { dg-final { scan-tree-dump-not "cPresent" "optimized" } }
! { dg-final { scan-tree-dump-not "cStillPresent" "optimized" } }
! { dg-final { cleanup-tree-dump "optimized" } }
-! { dg-final { cleanup-modules "volmod" } }
implicit none
volatile :: v13
end subroutine s14
-
-! { dg-final { cleanup-modules "mod13 mod13a mod13b" } }
k = 8
end function j
end module m
-! { dg-final { cleanup-modules "mod" } }
! Can't check undefined function, because it needs to be declared a type
! in any case (and the implicit type is enough to not trigger this warning).
END PROGRAM
-
-! { dg-final { cleanup-modules "m" } }
type(t2), intent(out) :: x
END SUBROUTINE
END MODULE
-
-! { dg-final { cleanup-modules "m" } }
j = 1
print*,"j=",j
end program main
-
-! { dg-final { cleanup-modules "util_mod" } }
use util_mod, only: i ! { dg-warning "Unused parameter .i. which has been explicitly imported" }
integer, parameter :: j = 4 ! { dg-warning "Unused parameter .j. declared at" }
end program main
-
-! { dg-final { cleanup-modules "util_mod" } }
END FUNCTION iaef
END PROGRAM test_prog
-
-! { dg-final { cleanup-modules "kind_mod pointer_mod" } }
endwhere
end subroutine test_where_4
end program test
-! { dg-final { cleanup-modules "global" } }
-
endwhere
end subroutine test_where_char2
end program test
-! { dg-final { cleanup-modules "global" } }
-
WHERE (I(:)%I>0) J=I ! { dg-error "Non-ELEMENTAL user-defined assignment in WHERE" }
END
-! { dg-final { cleanup-modules "m1" } }
USE module_foo, ONLY: foo
INTEGER :: foo_count
END FUNCTION
-
-! { dg-final { cleanup-modules "module_foo" } }
j%this => base !to one another
end subroutine check !take j out of scope
end program test_equi
-! { dg-final { cleanup-modules "global" } }
SUBROUTINE ep_force_release()
END SUBROUTINE ep_force_release
END MODULE ep_types
-! { dg-final { cleanup-modules "replica_types ep_types" } }
USE M
CALL b()
END
-! { dg-final { cleanup-modules "m" } }
USE classtype
CLASS(t) :: b
END SUBROUTINE
-
-! { dg-final { cleanup-modules "classtype" } }
END SUBROUTINE four
END MODULE mod
END
-
-! { dg-final { cleanup-modules "mod" } }
USE M
CALL b()
END
-
-! { dg-final { cleanup-modules "m" } }
character (len=5) :: words(2) = (/"two ","three"/)
write (*,"(1x,'words = ',a)") "'"//join (words, "&")//"'"
end program xjoin
-
-! { dg-final { cleanup-modules "util_mod" } }
end subroutine syntax_init_from_ifile
end module syntax_rules
end
-
-! { dg-final { cleanup-modules "iso_red ifiles syntax_rules" } }
USE INTS
CALL NOZZLE ()
END program CORTESA
-
-! { dg-final { cleanup-modules "ints" } }
end subroutine VALUE
end
-
-! { dg-final { cleanup-modules "ints" } }
stop
end program d_coo_err
-
-! { dg-final { cleanup-modules "base_mat_mod const_mod d_base_mat_mod" } }
x=x_o
END SUBROUTINE GEINV8
END MODULE DENSEOP
-
-! { dg-final { cleanup-modules "la_precision lapack90 denseop" } }
use m
print *,ichar('~') ! must print "1"
end program p
-
-! { dg-final { cleanup-modules "m" } }
if (any (len_trim (outer4) /= [len(outer4), 3])) call abort
end program test_modules
-
-! { dg-final { cleanup-modules "kinds inner middle outer" } }
if (len (cut(4_"12345")) /= 2 .or. cut(4_"45") /= 4_"") call abort
end program test
-
-! { dg-final { cleanup-modules "mod" } }
projects / gcc.git / commitdiff