Skip to content

R
riscv-gcc-1
Commit df8652dc by Steven G. Kargl Committed by Steven G. Kargl
Options

decl.c (gfc_match_old_kind_spec,match_type_spec): Use gfc_std_notify to report… 

decl.c (gfc_match_old_kind_spec,match_type_spec): Use gfc_std_notify to report nonstandard intrinsic type declarations.

2005-12-17  Steven G. Kargl  <kargls@comcast.net>

	* decl.c (gfc_match_old_kind_spec,match_type_spec): Use gfc_std_notify
	to report nonstandard intrinsic type declarations.

	* gfortran.dg/imag_1.f: Fix nonstandard type declarations.
	* gfortran.dg/nested_modules_1.f90: Ditto.
	* gfortran.dg/hollerith_f95.f90: Ditto.
	* gfortran.dg/select_5.f90: Ditto.
	* gfortran.dg/secnds.f: Ditto.
	* gfortran.dg/hollerith2.f90: Ditto.
	* gfortran.dg/imag_2.f: Ditto.
	* gfortran.dg/ftell_2.f90: Ditto.
	* gfortran.dg/malloc_free_1.f90: Ditto.
	* gfortran.dg/logint-1.f: Ditto.
	* gfortran.dg/recursive_statement_functions.f90: Ditto.
	* gfortran.dg/e_d_fmt.f90: Ditto.
	* gfortran.dg/hollerith_legacy.f90: Ditto.
	* gfortran.dg/logint-2.f: Ditto.
	* gfortran.dg/enum_5.f90: Ditto.
	* gfortran.dg/f2c_2.f90: Ditto.
	* gfortran.dg/pr17143.f90: Ditto.
	* gfortran.dg/namelist_14.f90: Ditto.
	* gfortran.dg/logint-3.f: Ditto.
	* gfortran.dg/spread_scalar_source.f90: Ditto.
	* gfortran.dg/fmt_read_bz_bn.f90: Ditto.
	* gfortran.dg/namelist_11.f: Ditto.
	* gfortran.dg/g77/intrinsic-unix-bessel.f: Ditto.
	* gfortran.dg/g77/20010519-1.f
	* gfortran.dg/g77/alpha1.f: Ditto.
	* gfortran.dg/g77/990115-1.f: Ditto.
	* gfortran.dg/g77/erfc.f: Ditto.
	* gfortran.dg/g77/19990313-3.f: Ditto.
	* gfortran.dg/g77/f90-intrinsic-numeric.f: Ditto.
	* gfortran.dg/g77/20010426.f: Ditto.
	* gfortran.dg/g77/19990313-0.f: Ditto.
	* gfortran.dg/g77/f90-intrinsic-mathematical.f: Ditto.
	* gfortran.dg/g77/20000629-1.f: Ditto.
	* gfortran.dg/g77/970125-0.f: Ditto.
	* gfortran.dg/g77/8485.f: Ditto.
	* gfortran.dg/g77/f90-intrinsic-bit.f: Ditto.
	* gfortran.dg/g77/19990313-1.f: Ditto.
	* gfortran.dg/g77/int8421.f: Ditto.
	* gfortran.dg/g77/19990305-0.f: Ditto.
	* gfortran.dg/g77/947.f: Ditto.
	* gfortran.dg/g77/19990905-2.f: Ditto.
	* gfortran.dg/g77/cabs.f: Ditto.
	* gfortran.dg/g77/19990313-2.f: Ditto.
	* gfortran.dg/g77/20020307-1.f: Ditto.
	* gfortran.dg/g77/dcomplex.f: Ditto.
	* gfortran.dg/g77/19990502-1.f: Ditto.
	* gfortran.dg/g77/19981216-0.f: Ditto.
	* gfortran.dg/common_4.f90: Ditto.
	* gfortran.dg/entry_4.f90: Ditto.
	* gfortran.dg/equiv_constraint_2.f90: Ditto.
	* gfortran.dg/g77_intrinsics_funcs.f: Ditto.
	* gfortran.dg/namelist_12.f: Ditto.
	* gfortran.dg/scale_1.f90: Ditto.
	* gfortran.dg/modulo_1.f90
	* gfortran.dg/hollerith.f90: Ditto.
	* gfortran.dg/direct_io_3.f90: Ditto.
	* gfortran.dg/ftell_1.f90: Ditto.: Ditto.
	* gfortran.dg/gnu_logical_1.F: Ditto.
	* gfortran.dg/unf_io_convert_1.f90: Ditto.
	* gfortran.dg/assign_1.f90: Ditto.
	* gfortran.dg/g77_intrinsics_sub.f: Ditto.
	* gfortran.dg/pr23095.f: Ditto.
	* gfortran.dg/read_float_1.f90: Ditto.

From-SVN: r108715
parent ad816b52
Showing with 324 additions and 247 deletions
gcc/fortran/ChangeLog
2005-12-17 Steven G. Kargl <kargls@comcast.net>
* decl.c (gfc_match_old_kind_spec,match_type_spec): Use gfc_std_notify
to report nonstandard intrinsic type declarations.
2005-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/24268
......
gcc/fortran/decl.c
......@@ -1311,6 +1311,10 @@ gfc_match_old_kind_spec (gfc_typespec * ts)
return MATCH_ERROR;
}
if (gfc_notify_std (GFC_STD_GNU, "Nonstandard type declaration %s*%d at %C",
gfc_basic_typename (ts->type), original_kind) == FAILURE)
return MATCH_ERROR;
return MATCH_YES;
}
......@@ -1616,6 +1620,10 @@ match_type_spec (gfc_typespec * ts, int implicit_flag)
if (gfc_match (" double complex") == MATCH_YES)
{
if (gfc_notify_std (GFC_STD_GNU, "DOUBLE COMPLEX at %C does not "
"conform to the Fortran 95 standard") == FAILURE)
return MATCH_ERROR;
ts->type = BT_COMPLEX;
ts->kind = gfc_default_double_kind;
return MATCH_YES;
......
gcc/testsuite/ChangeLog
2005-12-17 Steven G. Kargl <kargls@comcast.net>
* gfortran.dg/imag_1.f: Fix nonstandard type declarations.
* gfortran.dg/nested_modules_1.f90: Ditto.
* gfortran.dg/hollerith_f95.f90: Ditto.
* gfortran.dg/select_5.f90: Ditto.
* gfortran.dg/secnds.f: Ditto.
* gfortran.dg/hollerith2.f90: Ditto.
* gfortran.dg/imag_2.f: Ditto.
* gfortran.dg/ftell_2.f90: Ditto.
* gfortran.dg/malloc_free_1.f90: Ditto.
* gfortran.dg/logint-1.f: Ditto.
* gfortran.dg/recursive_statement_functions.f90: Ditto.
* gfortran.dg/e_d_fmt.f90: Ditto.
* gfortran.dg/hollerith_legacy.f90: Ditto.
* gfortran.dg/logint-2.f: Ditto.
* gfortran.dg/enum_5.f90: Ditto.
* gfortran.dg/f2c_2.f90: Ditto.
* gfortran.dg/pr17143.f90: Ditto.
* gfortran.dg/namelist_14.f90: Ditto.
* gfortran.dg/logint-3.f: Ditto.
* gfortran.dg/spread_scalar_source.f90: Ditto.
* gfortran.dg/fmt_read_bz_bn.f90: Ditto.
* gfortran.dg/namelist_11.f: Ditto.
* gfortran.dg/g77/intrinsic-unix-bessel.f: Ditto.
* gfortran.dg/g77/20010519-1.f
* gfortran.dg/g77/alpha1.f: Ditto.
* gfortran.dg/g77/990115-1.f: Ditto.
* gfortran.dg/g77/erfc.f: Ditto.
* gfortran.dg/g77/19990313-3.f: Ditto.
* gfortran.dg/g77/f90-intrinsic-numeric.f: Ditto.
* gfortran.dg/g77/20010426.f: Ditto.
* gfortran.dg/g77/19990313-0.f: Ditto.
* gfortran.dg/g77/f90-intrinsic-mathematical.f: Ditto.
* gfortran.dg/g77/20000629-1.f: Ditto.
* gfortran.dg/g77/970125-0.f: Ditto.
* gfortran.dg/g77/8485.f: Ditto.
* gfortran.dg/g77/f90-intrinsic-bit.f: Ditto.
* gfortran.dg/g77/19990313-1.f: Ditto.
* gfortran.dg/g77/int8421.f: Ditto.
* gfortran.dg/g77/19990305-0.f: Ditto.
* gfortran.dg/g77/947.f: Ditto.
* gfortran.dg/g77/19990905-2.f: Ditto.
* gfortran.dg/g77/cabs.f: Ditto.
* gfortran.dg/g77/19990313-2.f: Ditto.
* gfortran.dg/g77/20020307-1.f: Ditto.
* gfortran.dg/g77/dcomplex.f: Ditto.
* gfortran.dg/g77/19990502-1.f: Ditto.
* gfortran.dg/g77/19981216-0.f: Ditto.
* gfortran.dg/common_4.f90: Ditto.
* gfortran.dg/entry_4.f90: Ditto.
* gfortran.dg/equiv_constraint_2.f90: Ditto.
* gfortran.dg/g77_intrinsics_funcs.f: Ditto.
* gfortran.dg/namelist_12.f: Ditto.
* gfortran.dg/scale_1.f90: Ditto.
* gfortran.dg/modulo_1.f90
* gfortran.dg/hollerith.f90: Ditto.
* gfortran.dg/direct_io_3.f90: Ditto.
* gfortran.dg/ftell_1.f90: Ditto.: Ditto.
* gfortran.dg/gnu_logical_1.F: Ditto.
* gfortran.dg/unf_io_convert_1.f90: Ditto.
* gfortran.dg/assign_1.f90: Ditto.
* gfortran.dg/g77_intrinsics_sub.f: Ditto.
* gfortran.dg/pr23095.f: Ditto.
* gfortran.dg/read_float_1.f90: Ditto.
2005-12-17 Andreas Jaeger <aj@suse.de>
* gcc.dg/attr-weakref-1.c: Do not run on darwin.
gcc/testsuite/gfortran.dg/assign_1.f90
! { dg-do compile }
! Option passed to avoid excess errors from obsolete warning
! { dg-options "-w" }
integer*4 i(5)
integer i(5)
assign 1000 to i ! { dg-error "scalar default INTEGER" }
1000 continue
end
gcc/testsuite/gfortran.dg/common_4.f90
......@@ -4,8 +4,8 @@
! Check misaligned common blocks.
program prog
common /block/ a, b, c
integer*1 a
integer*4 b, c
integer(kind=1) a
integer b, c
a = 1
b = HUGE(b)
c = 2
......@@ -13,7 +13,7 @@ program prog
end program
subroutine foo
common /block/ a, b, c
integer*1 a
integer*4 b, c
integer(kind=1) a
integer b, c
if (a .ne. 1 .or. b .ne. HUGE(b) .or. c .ne. 2) call abort
end subroutine
gcc/testsuite/gfortran.dg/direct_io_3.f90
......@@ -2,7 +2,7 @@
! PR 18710 : We used to not read and write the imaginary part of
! complex numbers
COMPLEX C, D
DOUBLE COMPLEX E, F
COMPLEX(KIND=8) E, F
OPEN(UNIT=9,FILE='PR18710',ACCESS='DIRECT',RECL=132)
......
gcc/testsuite/gfortran.dg/e_d_fmt.f90
......@@ -2,7 +2,7 @@
! Verify that the D format uses 'D' as the exponent character.
! " " " E " " 'E' " " " "
CHARACTER*10 c1, c2
REAL*8 r
REAL(kind=8) r
r = 1.0
write(c1,"(e9.2)") r
write(c2,"(d9.2)") r
......
gcc/testsuite/gfortran.dg/entry_4.f90
......@@ -17,8 +17,8 @@ return
entry e2 ()
e2 (:, :, :) = 2
end function
integer*8 function f3 () ! { dg-error "can't be of type" }
complex*16 e3 ! { dg-error "can't be of type" }
integer(kind=8) function f3 () ! { dg-error "can't be of type" }
complex(kind=8) e3 ! { dg-error "can't be of type" }
f3 = 1
return
entry e3 ()
......
gcc/testsuite/gfortran.dg/enum_5.f90
......@@ -6,7 +6,7 @@ program main
integer :: i = 1
enum, bind (c) ! { dg-warning "New in Fortran 2003" }
enumerator :: red, black = i ! { dg-error "cannot appear" }
enumerator :: red, black = i ! { dg-error "is a variable" }
enumerator :: blue = 1
end enum junk ! { dg-error "Syntax error" }
......
gcc/testsuite/gfortran.dg/equiv_constraint_2.f90
......@@ -8,22 +8,22 @@
!
type :: numeric_type
sequence
integer :: i
real :: x
real*8 :: d
complex :: z
logical :: l
integer :: i
real :: x
real(kind=8) :: d
complex :: z
logical :: l
end type numeric_type
type (numeric_type) :: my_num, thy_num
type :: numeric_type2
sequence
integer :: i
real :: x
real*8 :: d
complex :: z
logical :: l
integer :: i
real :: x
real(kind=8) :: d
complex :: z
logical :: l
end type numeric_type2
type (numeric_type2) :: his_num
......@@ -38,16 +38,16 @@
type :: mixed_type
sequence
integer*4 :: i(4)
integer :: i(4)
character*4 :: cha (6)
end type mixed_type
type (mixed_type) :: my_mixed, thy_mixed
character(len=4) :: ch
integer :: num
integer*8 :: non_def
complex*16 :: my_z, thy_z
integer :: num
integer(kind=8) :: non_def
complex(kind=8) :: my_z, thy_z
! Permitted: character with character sequence
! numeric with numeric sequence
......
gcc/testsuite/gfortran.dg/f2c_2.f90
......@@ -2,7 +2,7 @@
! -ff2c
!
! Once the library has support for f2c calling conventions (i.e. passing
! a REAL*4 or COMPLEX-valued intrinsic as procedure argument works), we
! a REAL(kind=4) or COMPLEX-valued intrinsic as procedure argument works), we
! can simply add -ff2c to the list of options to cycle through, and get
! complete coverage. As of 2005-03-05 this doesn't work.
! { dg-do run }
......
gcc/testsuite/gfortran.dg/fmt_read_bz_bn.f90
......@@ -6,7 +6,7 @@ program test_bn
integer I1(2,2), I2(2,2,2)
real A1(5)
real*8 A2(0:3)
real(kind=8) A2(0:3)
character*80 :: IDATA1="111 2 2 3 3. 3E-1 44 5 5 6 . 67 . 78 8. 8E-1"
character*80 :: IDATA2="2345 1 34512 45123 51234 2345 1 34512 45123 5"
character*80 :: IDATA3="-8.0D0 1.0D-4 0.50D0 0.250D0"
......
gcc/testsuite/gfortran.dg/ftell_1.f90
! { dg-do run }
integer*8 o, o2
integer(kind=8) o, o2
open (10, status="scratch")
call ftell (10, o)
......
gcc/testsuite/gfortran.dg/ftell_2.f90
! { dg-do run }
integer*8 o
integer(kind=8) o
open (10, status="scratch")
if (ftell(10) /= 0) call abort
write (10,"(A)") "1234567"
......
gcc/testsuite/gfortran.dg/g77/19981216-0.f
......@@ -24,7 +24,7 @@ c { dg-do compile }
* -------------------------------------------
PROGRAM WAP
integer*2 ios
integer(kind=8) ios
character*80 name
name = 'blah'
......@@ -34,7 +34,7 @@ c { dg-do compile }
END
* -------------------------------------------
*
* The problem seems to be caused by the "integer*2 ios" declaration.
* The problem seems to be caused by the "integer(kind=2) ios" declaration.
* So far I solved it by simply using a plain integer instead.
*
* I'm running gcc on a Linux system compiled/installed
......
gcc/testsuite/gfortran.dg/g77/19990305-0.f
......@@ -34,7 +34,7 @@ C-----------------------------------------------------------------------
C Integral LOG(A-EPSI-BY(1-Y))/(Y-Y0)
C-----------------------------------------------------------------------
IMPLICIT NONE
DOUBLE COMPLEX HWUCI2,HWULI2,EPSI,Y1,Y2,Z1,Z2,Z3,Z4
complex(kind=8) HWUCI2,HWULI2,EPSI,Y1,Y2,Z1,Z2,Z3,Z4
DOUBLE PRECISION A,B,Y0,ZERO,ONE,FOUR,HALF
EXTERNAL HWULI2
COMMON/SMALL/EPSI
......
gcc/testsuite/gfortran.dg/g77/19990313-0.f
......@@ -8,11 +8,11 @@ c { dg-do run }
* User-Agent: Gnus/5.07007 (Pterodactyl Gnus v0.70) Emacs/20.3
* X-UIDL: d442bafe961c2a6ec6904f492e05d7b0
*
* ISTM that there is a real problem printing integer*8 (on x86):
* ISTM that there is a real problem printing integer(kind=8) (on x86):
*
* $ cat x.f
*[modified for test suite]
integer *8 foo, bar
integer(kind=8) foo, bar
data r/4e10/
foo = 4e10
bar = r
......
gcc/testsuite/gfortran.dg/g77/19990313-1.f
c { dg-do run }
integer *8 foo, bar
integer(kind=8) foo, bar
double precision r
data r/4d10/
foo = 4d10
......
gcc/testsuite/gfortran.dg/g77/19990313-2.f
c { dg-do run }
integer *8 foo, bar
integer(kind=8) foo, bar
complex c
data c/(4e10,0)/
foo = 4e10
......
gcc/testsuite/gfortran.dg/g77/19990313-3.f
c { dg-do run }
integer *8 foo, bar
double complex c
integer(kind=8) foo, bar
complex(kind=8) c
data c/(4d10,0)/
foo = 4d10
bar = c
......
gcc/testsuite/gfortran.dg/g77/19990502-1.f
c { dg-do compile }
SUBROUTINE G(IGAMS,IWRK,NADC,NCellsInY)
INTEGER*2 IGAMS(2,NADC)
INTEGER(kind=2) IGAMS(2,NADC)
in = 1
do while (in.le.nadc.and.IGAMS(2,in).le.in)
enddo
......
gcc/testsuite/gfortran.dg/g77/19990905-2.f
......@@ -4,7 +4,7 @@ c { dg-do compile }
* Too small to worry about copyright issues, IMO, since it
* doesn't do anything substantive.
SUBROUTINE OUTDNS(A,B,LCONV)
IMPLICIT REAL*8(A-H,O-Z),INTEGER*4(I-N)
IMPLICIT REAL(kind=8) (A-H,O-Z),INTEGER(I-N)
COMMON/ARRAYS/Z(64,8),AB(30,30),PAIRS(9,9),T(9,9),TEMP(9,9),C1(3),
> C2(3),AA(30),BB(30)
EQUIVALENCE (X1,C1(1)),(Y1,C1(2)),(Z1,C1(3))
......@@ -13,7 +13,7 @@ c { dg-do compile }
> SHIFT,CONV,SCION,DIVERG,
> IOPT,KCNDO,KINDO,KMINDO,I2EINT,KOHNO,KSLATE,
> N,NG,NUMAT,NSEK,NELECS,NIT,OCCA,OCCB,NOLDAT,NOLDFN
INTEGER*4 OCCA,OCCB
INTEGER OCCA,OCCB
DIMENSION W(N),A(N,N),B(N,N)
DIMENSION BUF(100)
occb=5
......
gcc/testsuite/gfortran.dg/g77/20000629-1.f
c { dg-do compile }
SUBROUTINE MIST(N, BETA)
IMPLICIT REAL*8 (A-H,O-Z)
IMPLICIT REAL(kind=8) (A-H,O-Z)
INTEGER IA, IQ, M1
DIMENSION BETA(N)
DO 80 IQ=1,M1
......
gcc/testsuite/gfortran.dg/g77/20010426.f
c { dg-do compile }
function f(c)
implicit none
real*8 c, f
real(kind=8) c, f
f = sqrt(c)
return
end
gcc/testsuite/gfortran.dg/g77/20010519-1.f
......@@ -237,7 +237,7 @@ C..##ENDIF
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C:::##INCLUDE '~/charmm_fcm/number.fcm'
REAL*8 ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX,
REAL(KIND=8) ZERO, ONE, TWO, THREE, FOUR, FIVE, SIX,
& SEVEN, EIGHT, NINE, TEN, ELEVEN, TWELVE, THIRTN,
& FIFTN, NINETN, TWENTY, THIRTY
C..##IF SINGLE
......@@ -249,7 +249,7 @@ C..##ELSE
& TWELVE = 12.D0, THIRTN = 13.D0, FIFTN = 15.D0,
& NINETN = 19.D0, TWENTY = 20.D0, THIRTY = 30.D0)
C..##ENDIF
REAL*8 FIFTY, SIXTY, SVNTY2, EIGHTY, NINETY, HUNDRD,
REAL(KIND=8) FIFTY, SIXTY, SVNTY2, EIGHTY, NINETY, HUNDRD,
& ONE2TY, ONE8TY, THRHUN, THR6TY, NINE99, FIFHUN, THOSND,
& FTHSND,MEGA
C..##IF SINGLE
......@@ -260,9 +260,9 @@ C..##ELSE
& THR6TY=360.D0, NINE99 = 999.D0, FIFHUN = 1500.D0,
& THOSND = 1000.D0,FTHSND = 5000.D0, MEGA = 1.0D6)
C..##ENDIF
REAL*8 MINONE, MINTWO, MINSIX
REAL(KIND=8) MINONE, MINTWO, MINSIX
PARAMETER (MINONE = -1.D0, MINTWO = -2.D0, MINSIX = -6.D0)
REAL*8 TENM20,TENM14,TENM8,TENM5,PT0001,PT0005,PT001,PT005,
REAL(KIND=8) TENM20,TENM14,TENM8,TENM5,PT0001,PT0005,PT001,PT005,
& PT01, PT02, PT05, PTONE, PT125, PT25, SIXTH, THIRD,
& PTFOUR, PTSIX, HALF, PT75, PT9999, ONEPT5, TWOPT4
C..##IF SINGLE
......@@ -276,14 +276,14 @@ C..##ELSE
& PTSIX = 0.6D0, PT75 = 0.75D0, PT9999 = 0.9999D0,
& ONEPT5 = 1.5D0, TWOPT4 = 2.4D0)
C..##ENDIF
REAL*8 ANUM,FMARK
REAL*8 RSMALL,RBIG
REAL(KIND=8) ANUM,FMARK
REAL(KIND=8) RSMALL,RBIG
C..##IF SINGLE
C..##ELSE
PARAMETER (ANUM=9999.0D0, FMARK=-999.0D0)
PARAMETER (RSMALL=1.0D-10,RBIG=1.0D20)
C..##ENDIF
REAL*8 RPRECI,RBIGST
REAL(KIND=8) RPRECI,RBIGST
C..##IF VAX DEC
C..##ELIF IBM
C..##ELIF CRAY
......@@ -297,41 +297,41 @@ C..##ENDIF
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C:::##INCLUDE '~/charmm_fcm/consta.fcm'
REAL*8 PI,RADDEG,DEGRAD,TWOPI
REAL(KIND=8) PI,RADDEG,DEGRAD,TWOPI
PARAMETER(PI=3.141592653589793D0,TWOPI=2.0D0*PI)
PARAMETER (RADDEG=180.0D0/PI)
PARAMETER (DEGRAD=PI/180.0D0)
REAL*8 COSMAX
REAL(KIND=8) COSMAX
PARAMETER (COSMAX=0.9999999999D0)
REAL*8 TIMFAC
REAL(KIND=8) TIMFAC
PARAMETER (TIMFAC=4.88882129D-02)
REAL*8 KBOLTZ
REAL(KIND=8) KBOLTZ
PARAMETER (KBOLTZ=1.987191D-03)
REAL*8 CCELEC
REAL(KIND=8) CCELEC
C..##IF AMBER
C..##ELIF DISCOVER
C..##ELSE
PARAMETER (CCELEC=332.0716D0)
C..##ENDIF
REAL*8 CNVFRQ
REAL(KIND=8) CNVFRQ
PARAMETER (CNVFRQ=2045.5D0/(2.99793D0*6.28319D0))
REAL*8 SPEEDL
REAL(KIND=8) SPEEDL
PARAMETER (SPEEDL=2.99793D-02)
REAL*8 ATMOSP
REAL(KIND=8) ATMOSP
PARAMETER (ATMOSP=1.4584007D-05)
REAL*8 PATMOS
REAL(KIND=8) PATMOS
PARAMETER (PATMOS = 1.D0 / ATMOSP )
REAL*8 BOHRR
REAL(KIND=8) BOHRR
PARAMETER (BOHRR = 0.529177249D0 )
REAL*8 TOKCAL
REAL(KIND=8) TOKCAL
PARAMETER (TOKCAL = 627.5095D0 )
C..##IF MMFF
real*8 MDAKCAL
REAL(KIND=8) MDAKCAL
parameter(MDAKCAL=143.9325D0)
C..##ENDIF
REAL*8 DEBYEC
REAL(KIND=8) DEBYEC
PARAMETER ( DEBYEC = 2.541766D0 / BOHRR )
REAL*8 ZEROC
REAL(KIND=8) ZEROC
PARAMETER ( ZEROC = 298.15D0 )
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
......@@ -357,7 +357,7 @@ C..##ENDIF
LOGICAL CHKPTR, EQST, EQSTA, EQSTWC, EQWDWC, DOTRIM, CHECQUE,
* HYDROG, INITIA, LONE, LTSTEQ, ORDER, ORDER5,
* ORDERR, USEDDT, QTOKDEL, QDIGIT, QALPHA
REAL*8 DECODF, DOTVEC, GTRMF, LENVEC, NEXTF, RANDOM, GTRR8,
REAL(KIND=8) DECODF, DOTVEC, GTRMF, LENVEC, NEXTF, RANDOM, GTRR8,
* RANUMB, R8VAL, RETVAL8, SUMVEC
C..##IF ADUMB
* ,UMFI
......@@ -403,7 +403,7 @@ C..##IF MMFF
external LEQUIV, LPATH
external nbndx, nbnd2, nbnd3, NTERMA
external find_loc
real*8 vangle, OOPNGL, TORNGL, ElementMass
REAL(KIND=8) vangle, OOPNGL, TORNGL, ElementMass
external vangle, OOPNGL, TORNGL, ElementMass
C..##ENDIF
C-----------------------------------------------------------------------
......@@ -468,7 +468,7 @@ C..##ENDIF
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C:::##INCLUDE '~/charmm_fcm/deriv.fcm'
REAL*8 DX,DY,DZ
REAL(KIND=8) DX,DY,DZ
COMMON /DERIVR/ DX(MAXAIM),DY(MAXAIM),DZ(MAXAIM)
C..##IF SAVEFCM
C..##ENDIF
......@@ -580,11 +580,11 @@ C..##ENDIF
COMMON /ANER/ CEPROP(LENENP), CETERM(LENENT), CEPRSS(LENENV)
LOGICAL QEPROP, QETERM, QEPRSS
COMMON /QENER/ QEPROP(LENENP), QETERM(LENENT), QEPRSS(LENENV)
REAL*8 EPROP, ETERM, EPRESS
REAL(KIND=8) EPROP, ETERM, EPRESS
COMMON /ENER/ EPROP(LENENP), ETERM(LENENT), EPRESS(LENENV)
C..##IF SAVEFCM
C..##ENDIF
REAL*8 EPRPA, EPRP2A, EPRPP, EPRP2P,
REAL(KIND=8) EPRPA, EPRP2A, EPRPP, EPRP2P,
& ETRMA, ETRM2A, ETRMP, ETRM2P,
& EPRSA, EPRS2A, EPRSP, EPRS2P
COMMON /ENACCM/ EPRPA(LENENP), ETRMA(LENENT), EPRSA(LENENV),
......@@ -595,7 +595,7 @@ C..##IF SAVEFCM
C..##ENDIF
INTEGER ECALLS, TOT1ST, TOT2ND
COMMON /EMISCI/ ECALLS, TOT1ST, TOT2ND
REAL*8 EOLD, FITA, DRIFTA, EAT0A, CORRA, FITP, DRIFTP,
REAL(KIND=8) EOLD, FITA, DRIFTA, EAT0A, CORRA, FITP, DRIFTP,
& EAT0P, CORRP
COMMON /EMISCR/ EOLD, FITA, DRIFTA, EAT0A, CORRA,
& FITP, DRIFTP, EAT0P, CORRP
......@@ -612,12 +612,12 @@ C..##ENDIF
C..##IF FLUCQ
C..##ENDIF
C..##IF TSM
REAL*8 TSMTRM(LENENT),TSMTMP(LENENT)
REAL(KIND=8) TSMTRM(LENENT),TSMTMP(LENENT)
COMMON /TSMENG/ TSMTRM,TSMTMP
C...##IF SAVEFCM
C...##ENDIF
C..##ENDIF
REAL*8 EHQBM
REAL(KIND=8) EHQBM
LOGICAL HQBM
COMMON /HQBMVAR/HQBM
C..##IF SAVEFCM
......@@ -666,12 +666,12 @@ C Passed variables
INTEGER INBCMP(*),JNBCMP(*),PARDIM
INTEGER ITMX,IUNMOD,IUNRMD,SAVF
INTEGER NBOND,IB(*),JB(*)
REAL*8 X(*),Y(*),Z(*),AMASS(*),DDSCR(*)
REAL*8 DDV(NAT3,*),PARDDV(PARDIM,*),DDM(*),DDS(*)
REAL*8 DDF(*),PARDDF(*),DDEV(*),PARDDE(*)
REAL*8 DD1BLK(*),DD1BLL(*),DD1CMP(*)
REAL*8 TOLDIM,DDVALM
REAL*8 PARFRQ,CUTF1
REAL(KIND=8) X(*),Y(*),Z(*),AMASS(*),DDSCR(*)
REAL(KIND=8) DDV(NAT3,*),PARDDV(PARDIM,*),DDM(*),DDS(*)
REAL(KIND=8) DDF(*),PARDDF(*),DDEV(*),PARDDE(*)
REAL(KIND=8) DD1BLK(*),DD1BLL(*),DD1CMP(*)
REAL(KIND=8) TOLDIM,DDVALM
REAL(KIND=8) PARFRQ,CUTF1
LOGICAL LNOMA,LRAISE,LSCI,LBIG
C Local variables
INTEGER NATOM,NATP,NDIM,I,J,II,OLDFAS,OLDPRN,IUPD
......@@ -687,7 +687,7 @@ C Local variables
INTEGER SCIFV1,SCIFV2,SCIFV3,SCIFV4,SCIFV6
INTEGER DRATQ,ERATQ,E2RATQ,BDRATQ,INRATQ
INTEGER I620,I640,I660,I700,I720,I760,I800,I840,I880,I920
REAL*8 CVGMX,TOLER
REAL(KIND=8) CVGMX,TOLER
LOGICAL LCARD,LAPPE,LPURG,LWDINI,QCALC,QMASWT,QMIX,QDIAG
C Begin
QCALC=.TRUE.
......
gcc/testsuite/gfortran.dg/g77/20020307-1.f
c { dg-do compile }
SUBROUTINE SWEEP
PARAMETER(MAXDIM=4,MAXVEC=4**3*8,MAXT=20)
REAL*8 B,W1,W2,BNORM,BINV,WT,W0,C1,C2,R1,R2
REAL(KIND=8) B,W1,W2,BNORM,BINV,WT,W0,C1,C2,R1,R2
DIMENSION B(MAXVEC,0:3),W1(MAXVEC,0:3),W2(MAXVEC,0:3)
DIMENSION BNORM(MAXVEC),BINV(MAXVEC),WT(MAXVEC),W0(MAXVEC)
DIMENSION C1(MAXVEC),C2(MAXVEC),R1(MAXVEC),R2(MAXVEC)
......
gcc/testsuite/gfortran.dg/g77/8485.f
c { dg-do compile }
C Extracted from PR fortran/8485
PARAMETER (PPMULT = 1.0E5)
INTEGER*8 NWRONG
INTEGER(kind=8) NWRONG
PARAMETER (NWRONG = 8)
PARAMETER (DDMULT = PPMULT * NWRONG)
PRINT 10, DDMULT
......
gcc/testsuite/gfortran.dg/g77/947.f
c { dg-do run }
DIMENSION A(-5:5)
INTEGER*1 IM5, IZ, IP5
INTEGER*2 IM1, IP1
INTEGER(kind=1) IM5, IZ, IP5
INTEGER(kind=2) IM1, IP1
PARAMETER (IM5=-5, IM1=-1, IZ=0, IP1=1, IP5=5)
DATA A(IM5) /-5./, A(IM1) /-1./
DATA A(IZ) /0./
......
gcc/testsuite/gfortran.dg/g77/970125-0.f
......@@ -26,9 +26,9 @@ C ../../egcs/gcc/expr.c:7291: Internal compiler error in function expand_expr
c Frontend bug fixed by JCB 1998-06-01 com.c &c changes.
integer*4 i4
integer*8 i8
integer*8 max4
integer i4
integer(kind=8) i8
integer(kind=8) max4
data max4/2147483647/
i4 = %loc(i4)
i8 = %loc(i8)
......@@ -39,7 +39,7 @@ c Frontend bug fixed by JCB 1998-06-01 com.c &c changes.
end
subroutine foo(i4, i4a, i8, i8a)
integer(kind=7) i4a, i8a
integer*8 i8
integer(kind=8) i8
print *, i4, i4a
print *, i8, i8a
end
gcc/testsuite/gfortran.dg/g77/990115-1.f
......@@ -2,7 +2,7 @@ c { dg-do compile }
C Derived from lapack
SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
$ WORK, RWORK, INFO )
COMPLEX*16 WORK( * )
COMPLEX(kind=8) WORK( * )
c Following declaration added on transfer to gfortran testsuite.
c It is present in original lapack source
integer rank
......
gcc/testsuite/gfortran.dg/g77/alpha1.f
c { dg-do compile }
REAL*8 A,B,C
REAL*4 RARRAY(19)
REAL(kind=8) A,B,C
REAL(kind=4) RARRAY(19)
DATA RARRAY /19*-1/
INTEGER BOTTOM,RIGHT
INTEGER IARRAY(19)
......
gcc/testsuite/gfortran.dg/g77/cabs.f
......@@ -2,8 +2,8 @@ c { dg-do run { xfail mips-sgi-irix6* } } PR 16292
program cabs_1
complex z0
real r0
complex*16 z1
real*8 r1
complex(kind=8) z1
real(kind=8) r1
z0 = cmplx(3.,4.)
r0 = cabs(z0)
......
gcc/testsuite/gfortran.dg/g77/dcomplex.f
c { dg-do run }
program foo
complex*16 z0, z1, z2
complex(kind=8) z0, z1, z2
z0 = dcmplx(0.,.5)
z1 = 1./z0
......
gcc/testsuite/gfortran.dg/g77/erfc.f
c { dg-do run }
c============================================== test.f
real x, y
real*8 x1, y1
real(kind=8) x1, y1
x=0.
y = erfc(x)
if (y .ne. 1.) call abort
......
gcc/testsuite/gfortran.dg/g77/f90-intrinsic-mathematical.f
......@@ -35,7 +35,7 @@ c COS - Section 13.13.22
call c_d(COS(1.d0),0.54030231d0,'COS(double)')
call c_c(COS((1.,0.)),(0.54030231,0.),'COS(complex)')
call c_z(COS((1.d0,0.d0)),(0.54030231d0,0.d0),
$ 'COS(double complex)')
$ 'COS(complex(kind=8))')
c COSH - Section 13.13.23
call c_r(COSH(1.0),1.5430806,'COSH(real)')
......@@ -46,14 +46,14 @@ c EXP - Section 13.13.34
call c_d(EXP(1.d0),2.7182818d0,'EXP(double)')
call c_c(EXP((1.,0.)),(2.7182818,0.),'EXP(complex)')
call c_z(EXP((1.d0,0.d0)),(2.7182818d0,0.d0),
$ 'EXP(double complex)')
$ 'EXP(complex(kind=8))')
c LOG - Section 13.13.59
call c_r(LOG(10.0),2.3025851,'LOG(real)')
call c_d(LOG(10.d0),2.3025851d0,'LOG(double)')
call c_c(LOG((10.,0.)),(2.3025851,0.),'LOG(complex)')
call c_z(LOG((10.d0,0.)),(2.3025851d0,0.d0),
$ 'LOG(double complex)')
$ 'LOG(complex(kind=8))')
c LOG10 - Section 13.13.60
call c_r(LOG10(10.0),1.0,'LOG10(real)')
......@@ -64,7 +64,7 @@ c SIN - Section 13.13.97
call c_d(SIN(1.d0),0.84147098d0,'SIN(double)')
call c_c(SIN((1.,0.)),(0.84147098,0.),'SIN(complex)')
call c_z(SIN((1.d0,0.d0)),(0.84147098d0,0.d0),
$ 'SIN(double complex)')
$ 'SIN(complex(kind=8))')
c SINH - Section 13.13.98
call c_r(SINH(1.0),1.175201,'SINH(real)')
......@@ -75,7 +75,7 @@ c SQRT - Section 13.13.102
call c_d(SQRT(4.d0),2.d0,'SQRT(double)')
call c_c(SQRT((4.,0.)),(2.,0.),'SQRT(complex)')
call c_z(SQRT((4.d0,0.)),(2.d0,0.),
$ 'SQRT(double complex)')
$ 'SQRT(complex(kind=8))')
c TAN - Section 13.13.105
call c_r(TAN(1.0),1.5574077,'TAN(real)')
......@@ -129,7 +129,7 @@ c Check if COMPLEX a equals b, and fail otherwise
subroutine c_z(a,b,label)
c Check if COMPLEX a equals b, and fail otherwise
double complex a, b
complex(kind=8) a, b
character*(*) label
if ( abs(a-b) .gt. 1.0d-5 ) then
call failure(label)
......
gcc/testsuite/gfortran.dg/g77/f90-intrinsic-numeric.f
......@@ -10,8 +10,8 @@ c * Section 13.12: Specific names for intrinsic functions tested in
c intrinsic77.f
logical fail
integer*2 j, j2, ja
integer*1 k, k2, ka
integer(kind=2) j, j2, ja
integer(kind=1) k, k2, ka
common /flags/ fail
fail = .false.
......@@ -22,17 +22,17 @@ c ABS - Section 13.13.1
k = j
ka = ja
call c_i(ABS(-7),7,'ABS(integer)')
call c_i2(ABS(j),ja,'ABS(integer*2)')
call c_i1(ABS(k),ka,'ABS(integer*1)')
call c_i2(ABS(j),ja,'ABS(integer(2))')
call c_i1(ABS(k),ka,'ABS(integer(1))')
call c_r(ABS(-7.),7.,'ABS(real)')
call c_d(ABS(-7.d0),7.d0,'ABS(double)')
call c_r(ABS((3.,-4.)),5.0,'ABS(complex)')
call c_d(ABS((3.d0,-4.d0)),5.0d0,'ABS(double complex)')
call c_d(ABS((3.d0,-4.d0)),5.0d0,'ABS(complex(kind=8))')
c AIMAG - Section 13.13.6
call c_r(AIMAG((2.,-7.)),-7.,'AIMAG(complex)')
c g77: AIMAG(double complex) does not comply with F90
c call c_d(AIMAG((2.d0,-7.d0)),-7.d0,'AIMAG(double complex)')
c g77: AIMAG(complex(kind=8)) does not comply with F90
c call c_d(AIMAG((2.d0,-7.d0)),-7.d0,'AIMAG(complex(kind=8))')
c AINT - Section 13.13.7
call c_r(AINT(2.783),2.0,'AINT(real) 1')
......@@ -58,31 +58,31 @@ c CMPLX - Section 13.13.20
ka = 2
call c_c(CMPLX(1),(1.,0.),'CMPLX(integer)')
call c_c(CMPLX(1,2),(1.,2.),'CMPLX(integer, integer)')
call c_c(CMPLX(j),(1.,0.),'CMPLX(integer*2)')
call c_c(CMPLX(j,ja),(1.,2.),'CMPLX(integer*2, integer*2)')
call c_c(CMPLX(k),(1.,0.),'CMPLX(integer*1)')
call c_c(CMPLX(k,ka),(1.,2.),'CMPLX(integer*1, integer*1)')
call c_c(CMPLX(j),(1.,0.),'CMPLX(integer(2))')
call c_c(CMPLX(j,ja),(1.,2.),'CMPLX(integer(2), integer(2))')
call c_c(CMPLX(k),(1.,0.),'CMPLX(integer(1)')
call c_c(CMPLX(k,ka),(1.,2.),'CMPLX(integer(1), integer(1))')
call c_c(CMPLX(1.),(1.,0.),'CMPLX(real)')
call c_c(CMPLX(1.d0),(1.,0.),'CMPLX(double)')
call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(double,double)')
call c_c(CMPLX(1.,2.),(1.,2.),'CMPLX(complex)')
call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(double complex)')
call c_c(CMPLX(1.d0,2.d0),(1.,2.),'CMPLX(complex(kind=8))')
c NOTE: g77 does not support optional argument KIND
c CONJG - Section 13.13.21
call c_c(CONJG((2.,-7.)),(2.,7.),'CONJG(complex)')
call c_z(CONJG((2.d0,-7.d0)),(2.d0,7.d0),'CONJG(double complex)')
call c_z(CONJG((2.d0,-7.d0)),(2.d0,7.d0),'CONJG(complex(kind=8))')
c DBLE - Section 13.13.27
j = 5
k = 5
call c_d(DBLE(5),5.0d0,'DBLE(integer)')
call c_d(DBLE(j),5.0d0,'DBLE(integer*2)')
call c_d(DBLE(k),5.0d0,'DBLE(integer*1)')
call c_d(DBLE(j),5.0d0,'DBLE(integer(2))')
call c_d(DBLE(k),5.0d0,'DBLE(integer(1))')
call c_d(DBLE(5.),5.0d0,'DBLE(real)')
call c_d(DBLE(5.0d0),5.0d0,'DBLE(double)')
call c_d(DBLE((5.0,0.5)),5.0d0,'DBLE(complex)')
call c_d(DBLE((5.0d0,0.5d0)),5.0d0,'DBLE(double complex)')
call c_d(DBLE((5.0d0,0.5d0)),5.0d0,'DBLE(complex(kind=8))')
c DIM - Section 13.13.29
j = -8
......@@ -92,8 +92,8 @@ c DIM - Section 13.13.29
k2 = -3
ka = 0
call c_i(DIM(-8,-3),0,'DIM(integer)')
call c_i2(DIM(j,j2),ja,'DIM(integer*2)')
call c_i1(DIM(k,k2),ka,'DIM(integer*1)')
call c_i2(DIM(j,j2),ja,'DIM(integer(2))')
call c_i1(DIM(k,k2),ka,'DIM(integer(1)')
call c_r(DIM(-8.,-3.),0.,'DIM(real,real)')
call c_d(DIM(-8.d0,-3.d0),0.d0,'DIM(double,double)')
......@@ -107,8 +107,8 @@ c INT - Section 13.13.47
j = 5
k = 5
call c_i(INT(5),5,'INT(integer)')
call c_i(INT(j),5,'INT(integer*2)')
call c_i(INT(k),5,'INT(integer*1)')
call c_i(INT(j),5,'INT(integer(2))')
call c_i(INT(k),5,'INT(integer(1))')
call c_i(INT(5.01),5,'INT(real)')
call c_i(INT(5.01d0),5,'INT(double)')
c Note: Does not accept optional second argument KIND
......@@ -121,8 +121,8 @@ c MAX - Section 13.13.63
k2 = 2
ka = 2
call c_i(MAX(1,2,3),3,'MAX(integer,integer,integer)')
call c_i2(MAX(j,j2),ja,'MAX(integer*2,integer*2)')
call c_i1(MAX(k,k2),ka,'MAX(integer*1,integer*1)')
call c_i2(MAX(j,j2),ja,'MAX(integer(2),integer(2))')
call c_i1(MAX(k,k2),ka,'MAX(integer(1),integer(1))')
call c_r(MAX(1.,2.,3.),3.,'MAX(real,real,real)')
call c_d(MAX(1.d0,2.d0,3.d0),3.d0,'MAX(double,double,double)')
......@@ -134,8 +134,8 @@ c MIN - Section 13.13.68
k2 = 2
ka = 1
call c_i(MIN(1,2,3),1,'MIN(integer,integer,integer)')
call c_i2(MIN(j,j2),ja,'MIN(integer*2,integer*2)')
call c_i1(MIN(k,k2),ka,'MIN(integer*1,integer*1)')
call c_i2(MIN(j,j2),ja,'MIN(integer(2),integer(2))')
call c_i1(MIN(k,k2),ka,'MIN(integer(1),integer(1))')
call c_r(MIN(1.,2.,3.),1.,'MIN(real,real,real)')
call c_d(MIN(1.d0,2.d0,3.d0),1.d0,'MIN(double,double,double)')
......@@ -147,17 +147,17 @@ c MOD - Section 13.13.72
j = 8
j2 = 5
ja = 3
call c_i2(MOD(j,j2),ja,'MOD(integer*2,integer*2) 1')
call c_i2(MOD(-j,j2),-ja,'MOD(integer*2,integer*2) 2')
call c_i2(MOD(j,-j2),ja,'MOD(integer*2,integer*2) 3')
call c_i2(MOD(-j,-j2),-ja,'MOD(integer*2,integer*2) 4')
call c_i2(MOD(j,j2),ja,'MOD(integer(2),integer(2)) 1')
call c_i2(MOD(-j,j2),-ja,'MOD(integer(2),integer(2)) 2')
call c_i2(MOD(j,-j2),ja,'MOD(integer(2),integer(2)) 3')
call c_i2(MOD(-j,-j2),-ja,'MOD(integer(2),integer(2)) 4')
k = 8
k2 = 5
ka = 3
call c_i1(MOD(k,k2),ka,'MOD(integer*1,integer*1) 1')
call c_i1(MOD(-k,k2),-ka,'MOD(integer*1,integer*1) 2')
call c_i1(MOD(k,-k2),ka,'MOD(integer*1,integer*1) 3')
call c_i1(MOD(-k,-k2),-ka,'MOD(integer*1,integer*1) 4')
call c_i1(MOD(k,k2),ka,'MOD(integer(1),integer(1)) 1')
call c_i1(MOD(-k,k2),-ka,'MOD(integer(1),integer(1)) 2')
call c_i1(MOD(k,-k2),ka,'MOD(integer(1),integer(1)) 3')
call c_i1(MOD(-k,-k2),-ka,'MOD(integer(1),integer(1)) 4')
call c_r(MOD(8.,5.),3.,'MOD(real,real) 1')
call c_r(MOD(-8.,5.),-3.,'MOD(real,real) 2')
call c_r(MOD(8.,-5.),3.,'MOD(real,real) 3')
......@@ -179,13 +179,13 @@ c REAL - Section 13.13.86
j = -2
k = -2
call c_r(REAL(-2),-2.0,'REAL(integer)')
call c_r(REAL(j),-2.0,'REAL(integer*2)')
call c_r(REAL(k),-2.0,'REAL(integer*1)')
call c_r(REAL(j),-2.0,'REAL(integer(2))')
call c_r(REAL(k),-2.0,'REAL(integer(1))')
call c_r(REAL(-2.0),-2.0,'REAL(real)')
call c_r(REAL(-2.0d0),-2.0,'REAL(double)')
call c_r(REAL((-2.,9.)),-2.0,'REAL(complex)')
c REAL(double complex) not implemented
c call c_r(REAL((-2.d0,9.d0)),-2.0,'REAL(double complex)')
c REAL(complex(kind=8)) not implemented
c call c_r(REAL((-2.d0,9.d0)),-2.0,'REAL(complex(kind=8))')
c SIGN - Section 13.13.96
j = -3
......@@ -195,8 +195,8 @@ c SIGN - Section 13.13.96
k2 = 2
ka = 3
call c_i(SIGN(-3,2),3,'SIGN(integer)')
call c_i2(SIGN(j,j2),ja,'SIGN(integer*2)')
call c_i1(SIGN(k,k2),ka,'SIGN(integer*1)')
call c_i2(SIGN(j,j2),ja,'SIGN(integer(2))')
call c_i1(SIGN(k,k2),ka,'SIGN(integer(1))')
call c_r(SIGN(-3.0,2.),3.,'SIGN(real,real)')
call c_d(SIGN(-3.d0,2.d0),3.d0,'SIGN(double,double)')
......@@ -223,8 +223,8 @@ c Check if INTEGER i equals j, and fail otherwise
end
subroutine c_i2(i,j,label)
c Check if INTEGER*2 i equals j, and fail otherwise
integer*2 i,j
c Check if INTEGER(kind=2) i equals j, and fail otherwise
integer(kind=2) i,j
character*(*) label
if ( i .ne. j ) then
call failure(label)
......@@ -233,8 +233,8 @@ c Check if INTEGER*2 i equals j, and fail otherwise
end
subroutine c_i1(i,j,label)
c Check if INTEGER*1 i equals j, and fail otherwise
integer*1 i,j
c Check if INTEGER(kind=1) i equals j, and fail otherwise
integer(kind=1) i,j
character*(*) label
if ( i .ne. j ) then
call failure(label)
......@@ -274,7 +274,7 @@ c Check if COMPLEX a equals b, and fail otherwise
subroutine c_z(a,b,label)
c Check if COMPLEX a equals b, and fail otherwise
double complex a, b
complex(kind=8) a, b
character*(*) label
if ( abs(a-b) .gt. 1.0d-5 ) then
call failure(label)
......
gcc/testsuite/gfortran.dg/g77/int8421.f
c { dg-do run }
integer*1 i1, i11
integer*2 i2, i22
integer i, ii
integer*4 i4, i44
integer*8 i8, i88
integer(kind=1) i1, i11
integer(kind=2) i2, i22
integer i, ii
integer(kind=4) i4, i44
integer(kind=8) i8, i88
real r, rr
real*4 r4, r44
real(kind=4) r4, r44
double precision d, dd
real*8 r8, r88
real(kind=8) r8, r88
parameter (i1 = 1, i2 = 2, i4 = 4, i = 5, i8 = i + i4*i2 + i2*i1)
parameter (r = 3.0, r4 = 4.0, r8 = 8.d0, d = i8*r + r4*i2 + r8*i1)
if (i8 .ne. 15 ) call abort
......
gcc/testsuite/gfortran.dg/g77/intrinsic-unix-bessel.f
......@@ -9,9 +9,9 @@ c
real x, a
double precision dx, da
integer i
integer*2 j
integer*1 k
integer*8 m
integer(kind=2) j
integer(kind=1) k
integer(kind=8) m
logical fail
common /flags/ fail
fail = .false.
......@@ -40,14 +40,14 @@ c BESJN - Bessel function of first kind of order N
a = 0.3528340
da = a
call c_r(BESJN(i,x),a,'BESJN(integer,real)')
call c_r(BESJN(j,x),a,'BESJN(integer*2,real)')
call c_r(BESJN(k,x),a,'BESJN(integer*1,real)')
call c_r(BESJN(j,x),a,'BESJN(integer(2),real)')
call c_r(BESJN(k,x),a,'BESJN(integer(1),real)')
call c_d(BESJN(i,dx),da,'BESJN(integer,double)')
call c_d(BESJN(j,dx),da,'BESJN(integer*2,double)')
call c_d(BESJN(k,dx),da,'BESJN(integer*1,double)')
call c_d(BESJN(j,dx),da,'BESJN(integer(2),double)')
call c_d(BESJN(k,dx),da,'BESJN(integer(1),double)')
call c_d(DBESJN(i,dx),da,'DBESJN(integer,double)')
call c_d(DBESJN(j,dx),da,'DBESJN(integer*2,double)')
call c_d(DBESJN(k,dx),da,'DBESJN(integer*1,double)')
call c_d(DBESJN(j,dx),da,'DBESJN(integer(2),double)')
call c_d(DBESJN(k,dx),da,'DBESJN(integer(1),double)')
c BESY0 - Bessel function of second kind of order zero
a = 0.51037567
......@@ -67,14 +67,14 @@ c BESYN - Bessel function of second kind of order N
a = -0.6174081
da = a
call c_r(BESYN(i,x),a,'BESYN(integer,real)')
call c_r(BESYN(j,x),a,'BESYN(integer*2,real)')
call c_r(BESYN(k,x),a,'BESYN(integer*1,real)')
call c_r(BESYN(j,x),a,'BESYN(integer(2),real)')
call c_r(BESYN(k,x),a,'BESYN(integer(1),real)')
call c_d(BESYN(i,dx),da,'BESYN(integer,double)')
call c_d(BESYN(j,dx),da,'BESYN(integer*2,double)')
call c_d(BESYN(k,dx),da,'BESYN(integer*1,double)')
call c_d(BESYN(j,dx),da,'BESYN(integer(2),double)')
call c_d(BESYN(k,dx),da,'BESYN(integer(1),double)')
call c_d(DBESYN(i,dx),da,'DBESYN(integer,double)')
call c_d(DBESYN(j,dx),da,'DBESYN(integer*2,double)')
call c_d(DBESYN(k,dx),da,'DBESYN(integer*1,double)')
call c_d(DBESYN(j,dx),da,'DBESYN(integer(2),double)')
call c_d(DBESYN(k,dx),da,'DBESYN(integer(1),double)')
if ( fail ) call abort()
end
......
gcc/testsuite/gfortran.dg/g77_intrinsics_funcs.f
! { dg-do compile }
! Testing g77 intrinsics as subroutines
integer*8 i8
integer*4 i4
integer(kind=8) i8
integer i4
integer i
character*80 c
......
gcc/testsuite/gfortran.dg/g77_intrinsics_sub.f
! { dg-do compile }
! Testing g77 intrinsics as subroutines
integer*8 i8, j8
integer*4 i4, j4
integer(kind=8) i8, j8
integer i4, j4
integer i, j
character*80 c
......
gcc/testsuite/gfortran.dg/gnu_logical_1.F
! Testcases for the AND, OR and XOR functions (GNU intrinsics).
! { dg-do run }
! { dg-options "-ffixed-line-length-none" }
integer*1 i1, j1
integer*2 i2, j2
integer*4 i4, j4
integer*8 i8, j8
logical*1 l1, k1
logical*2 l2, k2
logical*4 l4, k4
logical*8 l8, k8
integer(kind=1) i1, j1
integer(kind=2) i2, j2
integer i4, j4
integer(kind=8) i8, j8
logical(kind=1) l1, k1
logical(kind=2) l2, k2
logical l4, k4
logical(kind=8) l8, k8
#define TEST_INTEGER(u,ukind,v,vkind) \
ukind = u;\
......
gcc/testsuite/gfortran.dg/hollerith.f90
! { dg-do run }
! PR15966, PR18781 & PR16531
implicit none
complex*16 x(2)
complex*8 a(2,2)
complex(kind=8) x(2)
complex a(2,2)
character*4 z
character z1(4)
character*4 z2(2,2)
character*80 line
integer*4 i
logical*4 l
real*4 r
integer i
logical l
real r
character*8 c
data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
......@@ -52,7 +52,7 @@ call test (8h hello)
end
subroutine test (h)
integer*8 h
integer(kind=8) h
character*80 line
write (line, '(8a)') h
......
gcc/testsuite/gfortran.dg/hollerith2.f90
......@@ -2,7 +2,7 @@
! Program to test Hollerith constant.
Program test
implicit none
integer* 4 i,j
integer i,j
real r, x, y
parameter (i = 4h1234)
parameter (r = 4hdead)
......
gcc/testsuite/gfortran.dg/hollerith_f95.f90
......@@ -2,15 +2,15 @@
! { dg-options "-std=f95" }
! PR15966, PR18781 & PR16531
implicit none
complex*16 x(2)
complex*8 a(2,2)
complex(kind=8) x(2)
complex a(2,2)
character*4 z
character z1(4)
character*4 z2(2,2)
character*80 line
integer*4 i
logical*4 l
real*4 r
integer i
logical l
real r
character*8 c
data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
......@@ -53,7 +53,7 @@ call test (8h hello)
end
subroutine test (h)
integer*8 h
integer(kind=8) h
character*80 line
write (line, '(8a)') h
......
gcc/testsuite/gfortran.dg/hollerith_legacy.f90
......@@ -2,15 +2,15 @@
! { dg-options "-std=legacy" }
! PR15966, PR18781 & PR16531
implicit none
complex*16 x(2)
complex*8 a(2,2)
complex(kind=8) x(2)
complex a(2,2)
character*4 z
character z1(4)
character*4 z2(2,2)
character*80 line
integer*4 i
logical*4 l
real*4 r
integer i
logical l
real r
character*8 c
data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
......@@ -53,7 +53,7 @@ call test (8h hello)
end
subroutine test (h)
integer*8 h
integer(kind=8) h
character*80 line
write (line, '(8a)') h
......
gcc/testsuite/gfortran.dg/imag_1.f
! { dg-do compile }
program bug
implicit none
double complex z
complex(kind=8) z
double precision x,y
z = cmplx(1.e0_8,2.e0_8)
y = imag(z)
......
gcc/testsuite/gfortran.dg/imag_2.f
......@@ -2,7 +2,7 @@
! { dg-options "-std=f95" }
program bug
implicit none
double complex z
complex(kind=8) z
double precision x
z = cmplx(1.e0_8, 2.e0_8)
x = imag(z) ! { dg-error "has no IMPLICIT type" "" }
......
gcc/testsuite/gfortran.dg/logint-1.f
c { dg-do compile }
c { dg-options "-O2 -std=legacy" }
LOGICAL*1 l1
LOGICAL*2 l2
LOGICAL*4 l4
INTEGER*1 i1
INTEGER*2 i2
INTEGER*4 i4
LOGICAL(kind=1) l1
LOGICAL(kind=2) l2
LOGICAL l4
INTEGER(kind=1) i1
INTEGER(kind=2) i2
INTEGER i4
i1 = .TRUE.
i2 = .TRUE.
......
gcc/testsuite/gfortran.dg/logint-2.f
c { dg-do compile }
c { dg-options "-O2 -std=f95" }
LOGICAL*1 l1
LOGICAL*2 l2
LOGICAL*4 l4
INTEGER*1 i1
INTEGER*2 i2
INTEGER*4 i4
LOGICAL(kind=1) l1
LOGICAL(kind=2) l2
LOGICAL l4
INTEGER(kind=1) i1
INTEGER(kind=2) i2
INTEGER i4
i1 = .TRUE. ! { dg-error "convert" }
i2 = .TRUE. ! { dg-error "convert" }
......
gcc/testsuite/gfortran.dg/logint-3.f
c { dg-do compile }
c { dg-options "-O2" }
LOGICAL*1 l1
LOGICAL*2 l2
LOGICAL*4 l4
INTEGER*1 i1
INTEGER*2 i2
INTEGER*4 i4
LOGICAL(kind=1) l1
LOGICAL(kind=2) l2
LOGICAL l4
INTEGER(kind=1) i1
INTEGER(kind=2) i2
INTEGER i4
i1 = .TRUE. ! { dg-warning "Extension: Conversion" }
i2 = .TRUE. ! { dg-warning "Extension: Conversion" }
......
gcc/testsuite/gfortran.dg/malloc_free_1.f90
......@@ -2,7 +2,7 @@
! If something is wrong with them, this test might segfault
! { dg-do run }
integer j
integer*8 i8
integer(kind=8) i8
do j = 1, 10000
i8 = malloc (10 * j)
......
gcc/testsuite/gfortran.dg/modulo_1.f90
! { dg-do compile }
! PR fortran/23912
integer*4 i4
integer*8 i8
integer i4
integer(kind=8) i8
i4 = modulo(i4,i8) ! { dg-warning "Extension" }
i4 = modulo(i8,i4) ! { dg-warning "Extension" }
......
gcc/testsuite/gfortran.dg/namelist_11.f
......@@ -7,8 +7,8 @@ c provided by Paul Thomas - pault@gcc.gnu.org
program namelist_1
REAL*4 x(10)
REAL*8 xx
REAL x(10)
REAL(kind=8) xx
integer ier
namelist /mynml/ x, xx
......
gcc/testsuite/gfortran.dg/namelist_12.f
......@@ -8,8 +8,8 @@ c Provided by Paul Thomas - pault@gcc.gnu.org
program namelist_12
integer*4 x(10)
integer*8 xx
integer x(10)
integer(kind=8) xx
integer ier
character*10 ch , check
namelist /mynml/ x, xx, ch
......
gcc/testsuite/gfortran.dg/namelist_14.f90
......@@ -16,7 +16,7 @@ program namelist_14
integer :: i(2) = (/101,201/)
type(mt) :: dt(2)
type(mt) :: cdt
real*8 :: pi = 3.14159_8
real(kind=8) :: pi = 3.14159_8
character*10 :: chs="singleton"
character*10 :: cha(2)=(/"first ","second "/)
......@@ -37,7 +37,7 @@ contains
subroutine foo (i, dt, pi, chs, cha)
use global
common /myc/ cdt
real *8 :: pi !local real scalar
real(kind=8) :: pi !local real scalar
integer :: i(2) !dummy arg. array
integer :: j(2) = (/21, 21/) !equivalenced array
integer :: jj ! -||- scalar
......
gcc/testsuite/gfortran.dg/nested_modules_1.f90
......@@ -4,7 +4,7 @@
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
module mod0
double complex FOO, KANGA
complex(kind=8) FOO, KANGA
common /bar/ FOO, KANGA
contains
subroutine eyeore ()
......@@ -20,12 +20,12 @@
module mod2
use mod0
use mod1
real*8 re1, im1, re2, im2, re, im
real(kind=8) re1, im1, re2, im2, re, im
common /bar/ re1, im1, re2, im2
equivalence (re1, re), (im1, im)
contains
subroutine tigger (w)
double complex w
complex(kind=8) w
if (FOO.ne.(1.0d0, 1.0d0)) call abort ()
if (KANGA.ne.(-1.0d0, -1.0d0)) call abort ()
if (ROBIN.ne.(99.0d0, 99.0d0)) CALL abort ()
......
gcc/testsuite/gfortran.dg/pr17143.f90
......@@ -2,7 +2,7 @@
! pr17143
! does not print 2*63 correctly
character*25 l
integer*8 i
integer(kind=8) i
data i /1/
do j = 1,63
i = i * 2
......
gcc/testsuite/gfortran.dg/pr23095.f
......@@ -4,9 +4,9 @@
! GCSE after reload made a stack register live across an abnormal
! edges for one of the computed jumps. This bombed in reg-stack.
function foo(n)
real*8 foo
real(kind=8) foo
integer ix, n, next
real*8 xmax, absx
real(kind=8) xmax, absx
foo = 0.0d0
assign 20 to next
do ix = 1,n
......
gcc/testsuite/gfortran.dg/read_float_1.f90
......@@ -4,7 +4,7 @@
! resulting in introducing large cumulative floating point errors.
program foo
character*20 s
real*8 d
real(kind=8) d
s = "-.18774312893273 "
read(unit=s, fmt='(g20.14)') d
if (d + 0.18774312893273d0 .gt. 1d-13) call abort
......
gcc/testsuite/gfortran.dg/recursive_statement_functions.f90
......@@ -29,4 +29,3 @@
!
write(6,*) st1 (1), fi (2), dshpfunc (1.0_8)
END
gcc/testsuite/gfortran.dg/scale_1.f90
......@@ -5,10 +5,10 @@ DOUBLE PRECISION Y
INTEGER, PARAMETER :: DP = KIND(Y)
INTEGER*1 I1
INTEGER*2 I2
INTEGER*4 I4
INTEGER*8 I8
INTEGER(kind=1) I1
INTEGER(kind=2) I2
INTEGER(kind=4) I4
INTEGER(kind=8) I8
X = 1.
Y = 1._DP
......
gcc/testsuite/gfortran.dg/secnds.f
......@@ -7,10 +7,10 @@ C
C Contributed by Paul Thomas <pault@gcc.gnu.org>
C
character*20 dum1, dum2, dum3
real*4 t1, t2
real*4 dat1, dat2
real*4 dt
integer*4 i, j, values(8)
real t1, t2
real dat1, dat2
real dt
integer i, j, values(8)
dt = 40e-3
t1 = secnds (0.0)
call date_and_time (dum1, dum2, dum3, values)
......
gcc/testsuite/gfortran.dg/select_5.f90
! { dg-do run }
! Test mismatched type kinds in a select statement.
program select_5
integer*1 i ! kind = 1, -128 <= i < 127
integer(kind=1) i ! kind = 1, -128 <= i < 127
do i = 1, 3
select case (i)
case (1_4) ! kind = 4, reachable
......
gcc/testsuite/gfortran.dg/spread_scalar_source.f90
......@@ -3,10 +3,10 @@
character*1 :: i, j(10)
character*8 :: buffer
integer*1 :: ii, jj(10)
integer(kind=1) :: ii, jj(10)
type :: mytype
real*8 :: x
integer*1 :: i
real(kind=8) :: x
integer(kind=1) :: i
character*15 :: ch
end type mytype
type(mytype) :: iii, jjj(10)
......@@ -49,4 +49,4 @@
write (buffer, '(4i2)') spread (31, 1 , 4)
if (trim(buffer) /= "31313131") call abort ()
end
\ No newline at end of file
end
gcc/testsuite/gfortran.dg/unf_io_convert_1.f90
......@@ -14,7 +14,7 @@ program main
! set debug to true for help in debugging failures.
integer m(2)
integer n
real*4 r(size)
real r(size)
integer i
character*4 str
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment