Commit df8652dc by Steven G. Kargl Committed by Steven G. Kargl

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