1! { dg-do compile }
2! { dg-options "-Wconversion" }
3
4!
5! PR fortran/27866 -improve -Wconversion
6!
7SUBROUTINE pr27866
8  double precision :: d
9  real   :: r
10  d = 4d99
11  r = d                 ! { dg-warning "conversion" }
12END SUBROUTINE
13
14SUBROUTINE pr27866c4
15  real(kind=4)    :: a
16  real(kind=8)    :: b
17  integer(kind=1) :: i1
18  integer(kind=4) :: i4
19  i4 = 2.3              ! { dg-warning "conversion" }
20  i1 = 500              ! { dg-error "overflow" }
21  a = 2**26-1           ! assignment INTEGER(4) to REAL(4) - no warning
22  b = 1d999             ! { dg-error "overflow" }
23
24  a = i4                ! assignment INTEGER(4) to REAL(4) - no warning
25  b = i4                ! assignment INTEGER(4) to REAL(8) - no warning
26  i1 = i4               ! { dg-warning "conversion" }
27  a = b                 ! { dg-warning "conversion" }
28END SUBROUTINE
29
30
31!
32! PR fortran/35003 - spurious warning with -Wconversion
33! Contributed by Brian Barnes <bcbarnes AT gmail DOT com>
34!
35SUBROUTINE pr35003
36  IMPLICIT NONE
37  integer(8) :: i, n
38  n = 1_8
39
40  do i = 1_8,n
41  enddo
42END SUBROUTINE
43
44
45!
46! PR fortran/42809 - Too much noise with -Wconversion
47! Contributed by Harald Anlauf <anlauf AT gmx DOT de>
48!
49SUBROUTINE pr42809
50  implicit none
51  integer, parameter :: sp = kind (1.0)
52  integer, parameter :: dp = kind (1.d0)
53  real(sp)     :: s
54  real(dp)     :: d
55  complex(dp)  :: z
56
57  s = 0                 ! assignment INTEGER(4) to REAL(4) - no warning
58  d = s                 ! assignment REAL((8)) to REAL(4) - no warning
59  z = (0, 1)            ! conversion INTEGER(4) to REAL(4),
60                        ! assignment COMPLEX(4) to COMPLEX(8) - no warning
61END SUBROUTINE
62