A new project is
A code tests the ability of gfortran 14.2, ifort 2021.10.0, and ifx 2025.0.4 to detect 16 types of uninitialised variables. The Intel compilers catch a few more cases than gfortran. People who use other compilers, such as NAG, LFortran, and Flang could report results to the author and also suggest other tests. Here is the code
! Check how compilers can catch different cases of using uninitialised variables
! gfortran -ffpe-trap=zero,overflow,invalid -finit-real=snan -finit-derived
! Intel (ifort and ifx) -check all -init=snan -init=array
module work
implicit none
integer, parameter :: m = 4
real :: x
real, dimension(m) :: arr
real, dimension(:), allocatable :: arr_a
real, dimension(:), pointer :: arr_p
type test_type
real :: x
real, dimension(:), pointer :: arr_p
real, dimension(:), allocatable :: arr_a
end type test_type
type(test_type) :: var
contains
subroutine test_local_scalar()
real :: x, y
y = x * 2
print*, 'Local scalar in a subroutine'
print*, y
end subroutine test_local_scalar
subroutine test_module_scalar()
real :: y
y = x * 2
print*, 'Module scalar'
print*, y
end subroutine test_module_scalar
subroutine test_auto_array(n)
integer, intent(in) :: n
real, dimension(n) :: x
print*, 'Automatic array in a subroutine'
print*, sum(x)
end subroutine test_auto_array
subroutine test_array_mod_dim()
real, dimension(m) :: x
print*, 'Array in subroutine with dimension from module parameter'
print*, sum(x)
end subroutine test_array_mod_dim
subroutine test_array_mod_static()
print*, 'Static module array'
print*, sum(arr)
end subroutine test_array_mod_static
subroutine test_array_mod_alloc(n)
integer, intent(in) :: n
allocate (arr_a(n))
print*, 'Allocatable module array'
print*, sum(arr_a)
end subroutine test_array_mod_alloc
subroutine test_array_mod_ptr(n)
integer, intent(in) :: n
allocate (arr_p(n))
print*, 'Pointer module array'
print*, sum(arr_p)
end subroutine test_array_mod_ptr
subroutine test_type_scalar()
real :: y
y = var%x * 2
print*, 'Scalar component of a derived type'
print*, y
end subroutine test_type_scalar
subroutine test_type_ptr()
print*, 'Pointer array component of derived type'
print*, sum(var%arr_p)
end subroutine test_type_ptr
subroutine test_type_ptr_allocate(var, n)
! Array component (pointer) of derived type
integer, intent(in) :: n
type(test_type), intent(inout) :: var
allocate(var%arr_p(n))
print*, 'Pointer after alloc', var%arr_p
end subroutine test_type_ptr_allocate
subroutine test_type_alloc()
print*, 'Allocatable array component of derived type'
print*, sum(var%arr_a)
end subroutine test_type_alloc
subroutine test_type_alloc_allocate(var, n)
! Allocatable array component of derived type
integer, intent(in) :: n
type(test_type), intent(inout) :: var
allocate(var%arr_a(n))
print*, 'Allocatable after alloc', var%arr_a
end subroutine test_type_alloc_allocate
end module work
program uninit_test
use work
implicit none
integer, parameter :: n = 10
real :: z
real, dimension(10) :: y
real, dimension(:), allocatable :: a
real, dimension(:), pointer :: p
integer :: icase, ierr
print*, "Enter case (1-16)"
read(*,*,iostat=ierr) icase
print*, "Testing case", icase
select case (icase)
case (1)
print*, "Scalar in main"
z = z + 1
print*, z
case(2)
print*, "Static array in main"
z = sum(y)
print*, z
case (3)
print*, 'Allocatable array in main'
allocate(a(n))
print*, "A", sum(a)
case (4)
print*, 'Pointer array in main'
allocate(p(n))
print*, "A", sum(p)
case (5)
call test_local_scalar()
case (6)
call test_module_scalar()
case (7)
call test_auto_array(n)
case (8)
call test_array_mod_dim()
case (9)
call test_array_mod_static()
case (10)
call test_array_mod_alloc(n)
case (11)
call test_array_mod_ptr(n)
case (12)
call test_type_scalar()
case (13)
allocate(var%arr_p(n))
call test_type_ptr()
case (14)
print*, 'Pointer array component of derived type (alloc in subroutine)'
call test_type_ptr_allocate(var, n)
call test_type_ptr()
case (15)
allocate(var%arr_a(n))
call test_type_alloc()
case (16)
print*, 'Allocatable array component of derived type (alloc in subroutine)'
call test_type_alloc_allocate(var, n)
call test_type_alloc()
case default
print*, "Error: enter 1-16"
end select
end program uninit_test