xref: /csrg-svn/usr.bin/f77/libF77/test/fpetst.f (revision 47950)
1*47950SbosticC
2*47950SbosticC Copyright (c) 1991 The Regents of the University of California.
3*47950SbosticC All rights reserved.
4*47950SbosticC
5*47950SbosticC %sccs.include.proprietary.f%
6*47950SbosticC
7*47950SbosticC	@(#)fpetst.f	5.2 (Berkeley) 04/12/91
8*47950SbosticC
9*47950Sbostic
1043981Sbostic	program fpetst
1143981Sbostic	character arg
1243981Sbostic	logical flag
1343981Sbostic	common /fpeflt/ flag
1443981Sbostic
1543981Sbostic	call trpfpe(1, 1.2345d0)
1643981Sbostic	call traper(3)
1743981Sbostic	i = 10
1843981Sbostic	j = 0
1943981Sbostic	x = 10.
2043981Sbostic	y = 0.
2143981Sbostic
2243981Sbostic	write (*,*)
2343981Sbostic	call getarg (1, arg)
2443981Sbostic	if (arg .eq. '1') then
2543981Sbostic		write(*,*) 'testing integer overflow, flag=', flag
2643981Sbostic		k = inmax() + 10
2743981Sbostic		write (*,*) 'k=', k, 'flag=', flag
2843981Sbostic		stop('returned')
2943981Sbostic	else if (arg .eq. '2') then
3043981Sbostic		write(*,*) 'testing integer divide by 0, flag=', flag
3143981Sbostic		k = i / j
3243981Sbostic		write (*,*) 'k=', k, 'flag=', flag
3343981Sbostic		stop('returned')
3443981Sbostic	else if (arg .eq. '3') then
3543981Sbostic		write(*,*) 'testing floating overflow, flag=', flag
3643981Sbostic		z = flmax() * 10.
3743981Sbostic		write(*,*) 'z=', z, 'flag=', flag
3843981Sbostic		stop('returned')
3943981Sbostic	else if (arg .eq. '4') then
4043981Sbostic		write(*,*) 'testing floating divide by 0, flag=', flag
4143981Sbostic		z = x / y
4243981Sbostic		write(*,*) 'z=', z, 'flag=', flag
4343981Sbostic		stop('returned')
4443981Sbostic	else if (arg .eq. '5') then
4543981Sbostic		write(*,*) 'testing floating underflow, flag=', flag
4643981Sbostic		z = flmin() / 10.
4743981Sbostic		write(*,*) 'z=', z, 'flag=', flag
4843981Sbostic		stop('returned')
4943981Sbostic	endif
5043981Sbostic	write(*,*) 'what??'
5143981Sbostic	end
52