OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [list_read_3.f90] - Diff between revs 302 and 384

Only display areas with differences | Details | Blame | View Log

Rev 302 Rev 384
! { dg-do run }
! { dg-do run }
! Program to test reading in a list of integer values into REAL variables.
! Program to test reading in a list of integer values into REAL variables.
! The comma separator was not handled correctly.
! The comma separator was not handled correctly.
!
!
program fg
program fg
  character(len=80) buff
  character(len=80) buff
  logical debug
  logical debug
  debug = .FALSE.
  debug = .FALSE.
  a = 0
  a = 0
  b = 0
  b = 0
  c = 0
  c = 0
  d = 0
  d = 0
  write (buff,'(a)') '10,20,30,40'
  write (buff,'(a)') '10,20,30,40'
  read(buff,*) a, b, c, d
  read(buff,*) a, b, c, d
  if (debug) then
  if (debug) then
    print*,buff
    print*,buff
    print*,a, b, c, d
    print*,a, b, c, d
  end if
  end if
  if (abs(10. - a) > 1e-5) call abort
  if (abs(10. - a) > 1e-5) call abort
  if (abs(20. - b) > 1e-5) call abort
  if (abs(20. - b) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  a = 0
  a = 0
  b = 0
  b = 0
  c = 0
  c = 0
  d = 0
  d = 0
  write (buff,'(a)') '10.,20.,30.,40.'
  write (buff,'(a)') '10.,20.,30.,40.'
  read(buff,*) a, b, c, d
  read(buff,*) a, b, c, d
  if (abs(10. - a) > 1e-5) call abort
  if (abs(10. - a) > 1e-5) call abort
  if (abs(20. - b) > 1e-5) call abort
  if (abs(20. - b) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  if (debug) then
  if (debug) then
    print*,buff
    print*,buff
    print*,a, b, c, d
    print*,a, b, c, d
  end if
  end if
  a = 0
  a = 0
  b = 0
  b = 0
  c = 0
  c = 0
  d = 0
  d = 0
  write (buff,'(a)') '10.0,20.0,30.0,40.0'
  write (buff,'(a)') '10.0,20.0,30.0,40.0'
  read(buff,*) a, b, c, d
  read(buff,*) a, b, c, d
  if (abs(10. - a) > 1e-5) call abort
  if (abs(10. - a) > 1e-5) call abort
  if (abs(20. - b) > 1e-5) call abort
  if (abs(20. - b) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  if (debug) then
  if (debug) then
    print*,buff
    print*,buff
    print*,a, b, c, d
    print*,a, b, c, d
  end if
  end if
  a = 0
  a = 0
  b = -99
  b = -99
  c = 0
  c = 0
  d = 0
  d = 0
  write (buff,'(a)') '10.0,,30.0,40.0'
  write (buff,'(a)') '10.0,,30.0,40.0'
  read(buff,*) a, b, c, d
  read(buff,*) a, b, c, d
  if (abs(10. - a) > 1e-5) call abort
  if (abs(10. - a) > 1e-5) call abort
  if (abs(-99. - b) > 1e-5) call abort
  if (abs(-99. - b) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  if (abs(40. - d) > 1e-5) call abort
  if (debug) then
  if (debug) then
    print*,buff
    print*,buff
    print*,a, b, c, d
    print*,a, b, c, d
  end if
  end if
   call abc
   call abc
end program
end program
subroutine abc
subroutine abc
  character(len=80) buff
  character(len=80) buff
  a = 0
  a = 0
  b = 0
  b = 0
  c = 0
  c = 0
  d = 0
  d = 0
  write (buff,'(a)') '10,-20,30,-40'
  write (buff,'(a)') '10,-20,30,-40'
  read(buff,*) a, b, c, d
  read(buff,*) a, b, c, d
  if (abs(10. - a) > 1e-5) call abort
  if (abs(10. - a) > 1e-5) call abort
  if (abs(-20. - b) > 1e-5) call abort
  if (abs(-20. - b) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(30. - c) > 1e-5) call abort
  if (abs(-40. - d) > 1e-5) call abort
  if (abs(-40. - d) > 1e-5) call abort
end subroutine abc
end subroutine abc
 
 

powered by: WebSVN 2.1.0

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