OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [large_real_kind_1.f90] - Blame information for rev 414

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! { dg-require-effective-target fortran_large_real }
3
 
4
module testmod
5
  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
6
contains
7
  subroutine testoutput (a,b,length,f)
8
    real(kind=k),intent(in) :: a
9
    real(kind=8),intent(in) ::  b
10
    integer,intent(in) :: length
11
    character(len=*),intent(in) :: f
12
 
13
    character(len=length) :: ca
14
    character(len=length) :: cb
15
 
16
    write (ca,f) a
17
    write (cb,f) b
18
    if (ca /= cb) call abort
19
  end subroutine testoutput
20
 
21
  subroutine outputstring (a,f,s)
22
    real(kind=k),intent(in) :: a
23
    character(len=*),intent(in) :: f
24
    character(len=*),intent(in) :: s
25
 
26
    character(len=len(s)) :: c
27
 
28
    write (c,f) a
29
    if (c /= s) call abort
30
  end subroutine outputstring
31
end module testmod
32
 
33
 
34
! Testing I/O of large real kinds (larger than kind=8)
35
program test
36
  use testmod
37
  implicit none
38
 
39
  real(kind=k) :: x
40
  character(len=20) :: c1, c2
41
 
42
  call testoutput (0.0_k,0.0_8,40,'(F40.35)')
43
 
44
  call testoutput (1.0_k,1.0_8,40,'(F40.35)')
45
  call testoutput (0.1_k,0.1_8,15,'(F15.10)')
46
  call testoutput (1e10_k,1e10_8,15,'(F15.10)')
47
  call testoutput (7.51e100_k,7.51e100_8,15,'(F15.10)')
48
  call testoutput (1e-10_k,1e-10_8,15,'(F15.10)')
49
  call testoutput (7.51e-100_k,7.51e-100_8,15,'(F15.10)')
50
 
51
  call testoutput (-1.0_k,-1.0_8,40,'(F40.35)')
52
  call testoutput (-0.1_k,-0.1_8,15,'(F15.10)')
53
  call testoutput (-1e10_k,-1e10_8,15,'(F15.10)')
54
  call testoutput (-7.51e100_k,-7.51e100_8,15,'(F15.10)')
55
  call testoutput (-1e-10_k,-1e-10_8,15,'(F15.10)')
56
  call testoutput (-7.51e-100_k,-7.51e-100_8,15,'(F15.10)')
57
 
58
  x = huge(x)
59
  call outputstring (2*x,'(F20.15)','           +Infinity')
60
  call outputstring (-2*x,'(F20.15)','           -Infinity')
61
 
62
  write (c1,'(G20.10E5)') x
63
  write (c2,'(G20.10E5)') -x
64
  if (c2(1:1) /= '-') call abort
65
  c2(1:1) = ' '
66
  if (c1 /= c2) call abort
67
 
68
  x = tiny(x)
69
  call outputstring (x,'(F20.15)','   0.000000000000000')
70
  call outputstring (-x,'(F20.15)','  -0.000000000000000')
71
 
72
  write (c1,'(G20.10E5)') x
73
  write (c2,'(G20.10E5)') -x
74
  if (c2(1:1) /= '-') call abort
75
  c2(1:1) = ' '
76
  if (c1 /= c2) call abort
77
end program test
78
 
79
! { dg-final { cleanup-modules "testmod" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.