xref: /original-bsd/usr.bin/f77/libF77/test/fpetst.f (revision 7bad34b3)
1C
2C Copyright (c) 1991 The Regents of the University of California.
3C All rights reserved.
4C
5C %sccs.include.proprietary.f%
6C
7C	@(#)fpetst.f	5.2 (Berkeley) 04/12/91
8C
9
10	program fpetst
11	character arg
12	logical flag
13	common /fpeflt/ flag
14
15	call trpfpe(1, 1.2345d0)
16	call traper(3)
17	i = 10
18	j = 0
19	x = 10.
20	y = 0.
21
22	write (*,*)
23	call getarg (1, arg)
24	if (arg .eq. '1') then
25		write(*,*) 'testing integer overflow, flag=', flag
26		k = inmax() + 10
27		write (*,*) 'k=', k, 'flag=', flag
28		stop('returned')
29	else if (arg .eq. '2') then
30		write(*,*) 'testing integer divide by 0, flag=', flag
31		k = i / j
32		write (*,*) 'k=', k, 'flag=', flag
33		stop('returned')
34	else if (arg .eq. '3') then
35		write(*,*) 'testing floating overflow, flag=', flag
36		z = flmax() * 10.
37		write(*,*) 'z=', z, 'flag=', flag
38		stop('returned')
39	else if (arg .eq. '4') then
40		write(*,*) 'testing floating divide by 0, flag=', flag
41		z = x / y
42		write(*,*) 'z=', z, 'flag=', flag
43		stop('returned')
44	else if (arg .eq. '5') then
45		write(*,*) 'testing floating underflow, flag=', flag
46		z = flmin() / 10.
47		write(*,*) 'z=', z, 'flag=', flag
48		stop('returned')
49	endif
50	write(*,*) 'what??'
51	end
52