4.4BSD/usr/src/usr.bin/f77/tests/tests/fm045.f
c comment section
c
c fm045
c
c this routine tests arithmetic assignments using integer
c variables connected by a series of arithmetic operators.
c different combinations of parenthetical notation are exercized.
c
c
c references
c american national standard programming language fortran,
c x3.9-1978
c
c section 4.3, integer type
c section 4.3.1, integer constant
c section 6.1, arithmetic expressions
c section 6.6, evaluation of expressions
c section 10.1, arithmetic assignment statement
c
c
c
c **********************************************************
c
c a compiler validation system for the fortran language
c based on specifications as defined in american national standard
c programming language fortran x3.9-1978, has been developed by the
c federal cobol compiler testing service. the fortran compiler
c validation system (fcvs) consists of audit routines, their related
c data, and an executive system. each audit routine is a fortran
c program, subprogram or function which includes tests of specific
c language elements and supporting procedures indicating the result
c of executing these tests.
c
c this particular program/subprogram/function contains features
c found only in the subset as defined in x3.9-1978.
c
c suggestions and comments should be forwarded to -
c
c department of the navy
c federal cobol compiler testing service
c washington, d.c. 20376
c
c **********************************************************
c
c
c
c initialization section
c
c initialize constants
c **************
c i01 contains the logical unit number for the card reader.
i01 = 5
c i02 contains the logical unit number for the printer.
i02 = 6
c system environment section
c
cx010 this card is replaced by contents of fexec x-010 control card.
c the cx010 card is for overriding the program default i01 = 5
c (unit number for card reader).
cx011 this card is replaced by contents of fexec x-011 control card.
c the cx011 card is for systems which require additional
c fortran statements for files associated with cx010 above.
c
cx020 this card is replaced by contents of fexec x-020 control card.
c the cx020 card is for overriding the program default i02 = 6
c (unit number for printer).
cx021 this card is replaced by contents of fexec x-021 control card.
c the cx021 card is for systems which require additional
c fortran statements for files associated with cx020 above.
c
ivpass=0
ivfail=0
ivdele=0
iczero=0
c
c write page headers
write (i02,90000)
write (i02,90001)
write (i02,90002)
write (i02, 90002)
write (i02,90003)
write (i02,90002)
write (i02,90004)
write (i02,90002)
write (i02,90011)
write (i02,90002)
write (i02,90002)
write (i02,90005)
write (i02,90006)
write (i02,90002)
c
c
c test section
c
c arithmetic assignment statement
c
c
c tests 747 through 755 use the same string of variables and
c operators, but use different combinations of parenthetical
c notation to alter priorities in order of evaluation.
c
c tests 756 through 759 check the capability to enclose the entire
c right hand side of an assignment statement in parentheses or sets
c of nested parentheses.
c
c
c
c
c
c
c
ivtnum = 747
c
c **** test 747 ****
c
if (iczero) 37470, 7470, 37470
7470 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 18
ivon05 = 6
ivon06 = 2
ivcomp = ivon01 + ivon02 - ivon03 * ivon04 / ivon05 ** ivon06
go to 47470
37470 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47470, 7481, 47470
47470 if (ivcomp - 22) 27470,17470,27470
17470 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7481
27470 ivfail = ivfail + 1
ivcorr = 22
write (i02,80004) ivtnum, ivcomp, ivcorr
7481 continue
ivtnum = 748
c
c **** test 748 ****
c
if (iczero) 37480, 7480, 37480
7480 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 18
ivon05 = 6
ivon06 = 2
ivcomp = ((((ivon01 + ivon02) - ivon03) * ivon04) / ivon05)
* ** ivon06
go to 47480
37480 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47480, 7491, 47480
47480 if (ivcomp - 3600) 27480,17480,27480
17480 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7491
27480 ivfail = ivfail + 1
ivcorr = 3600
write (i02,80004) ivtnum, ivcomp, ivcorr
7491 continue
ivtnum = 749
c
c **** test 749 ****
c
if (iczero) 37490, 7490, 37490
7490 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 36
ivon05 = 6
ivon06 = 2
ivcomp = (ivon01 + ivon02 - ivon03) * (ivon04 / ivon05 ** ivon06)
go to 47490
37490 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47490, 7501, 47490
47490 if (ivcomp - 20) 27490,17490,27490
17490 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7501
27490 ivfail = ivfail + 1
ivcorr = 20
write (i02,80004) ivtnum, ivcomp, ivcorr
7501 continue
ivtnum = 750
c
c **** test 750 ****
c
if (iczero) 37500, 7500, 37500
7500 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 36
ivon05 = 6
ivon06 = 2
ivcomp = (ivon01 + ivon02) - (ivon03 * ivon04) / (ivon05 **
* ivon06)
go to 47500
37500 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47500, 7511, 47500
47500 if (ivcomp - 20) 27500,17500,27500
17500 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7511
27500 ivfail = ivfail + 1
ivcorr = 20
write (i02,80004) ivtnum, ivcomp, ivcorr
7511 continue
ivtnum = 751
c
c **** test 751 ****
c
if (iczero) 37510, 7510, 37510
7510 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 36
ivon05 = 6
ivon06 = 2
ivcomp = ((ivon01 + ivon02) - (ivon03 * ivon04)) / (ivon05 **
* ivon06)
go to 47510
37510 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47510, 7521, 47510
47510 if (ivcomp + 3) 27510,17510,27510
17510 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7521
27510 ivfail = ivfail + 1
ivcorr = -3
c actual answer is -3.333333... truncation is necessary
write (i02,80004) ivtnum, ivcomp, ivcorr
7521 continue
ivtnum = 752
c
c **** test 752 ****
c
if (iczero) 37520, 7520, 37520
7520 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 36
ivon05 = 6
ivon06 = 2
ivcomp = (ivon01 + ivon02) - (ivon03 * ivon04 / ivon05) ** ivon06
go to 47520
37520 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47520, 7531, 47520
47520 if (ivcomp + 552) 27520,17520,27520
17520 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7531
27520 ivfail = ivfail + 1
ivcorr = -552
write (i02,80004) ivtnum, ivcomp, ivcorr
7531 continue
ivtnum = 753
c
c **** test 753 ****
c
if (iczero) 37530, 7530, 37530
7530 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 36
ivon05 = 6
ivon06 = 2
ivcomp = ivon01 + (ivon02 - ivon03 * ivon04) / ivon05 ** ivon06
go to 47530
37530 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47530, 7541, 47530
47530 if (ivcomp - 12) 27530,17530,27530
17530 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7541
27530 ivfail = ivfail + 1
ivcorr = 12
c actual answer is 11.25 truncation is necessary
c during an intermediate step
write (i02,80004) ivtnum, ivcomp, ivcorr
7541 continue
ivtnum = 754
c
c **** test 754 ****
c
if (iczero) 37540, 7540, 37540
7540 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 36
ivon05 = 6
ivon06 = 2
ivcomp = ivon01 + (ivon02 - ivon03) * (ivon04 / ivon05) ** ivon06
go to 47540
37540 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47540, 7551, 47540
47540 if (ivcomp - 195) 27540,17540,27540
17540 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7551
27540 ivfail = ivfail + 1
ivcorr = 195
write (i02,80004) ivtnum, ivcomp, ivcorr
7551 continue
ivtnum = 755
c
c **** test 755 ****
c
if (iczero) 37550, 7550, 37550
7550 continue
ivon01 = 15
ivon02 = 9
ivon03 = 4
ivon04 = 36
ivon05 = 6
ivon06 = 2
ivcomp = ((ivon01 + (ivon02 - ivon03) * ivon04) / ivon05) **
* ivon06
go to 47550
37550 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47550, 7561, 47550
47550 if (ivcomp - 1024) 27550,17550,27550
17550 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7561
27550 ivfail = ivfail + 1
ivcorr = 1024
c actual answer is 1056.25 truncation is necessary
c during an intermediate step
write (i02,80004) ivtnum, ivcomp, ivcorr
7561 continue
ivtnum = 756
c
c **** test 756 ****
c single parentheses
c
if (iczero) 37560, 7560, 37560
7560 continue
ivon01 = 13
ivon02 = 37
ivcomp = (ivon01 + ivon02)
go to 47560
37560 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47560, 7571, 47560
47560 if (ivcomp - 50) 27560,17560,27560
17560 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7571
27560 ivfail = ivfail + 1
ivcorr = 50
write (i02,80004) ivtnum, ivcomp, ivcorr
7571 continue
ivtnum = 757
c
c **** test 757 ****
c nested parentheses (two sets)
c
if (iczero) 37570, 7570, 37570
7570 continue
ivon01 = 13
ivon02 = 37
ivcomp = ((ivon01 - ivon02))
go to 47570
37570 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47570, 7581, 47570
47570 if (ivcomp + 24) 27570,17570,27570
17570 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7581
27570 ivfail = ivfail + 1
ivcorr = -24
write (i02,80004) ivtnum, ivcomp, ivcorr
7581 continue
ivtnum = 758
c
c **** test 758 ****
c nested parentheses (21 sets - same line)
c
if (iczero) 37580, 7580, 37580
7580 continue
ivon01 = 13
ivon02 = 37
ivcomp = (((((((((((((((((((((ivon01 * ivon02)))))))))))))))))))))
go to 47580
37580 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47580, 7591, 47580
47580 if (ivcomp - 481) 27580,17580,27580
17580 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7591
27580 ivfail = ivfail + 1
ivcorr = 481
write (i02,80004) ivtnum, ivcomp, ivcorr
7591 continue
ivtnum = 759
c
c **** test 759 ****
c nested parentheses (57 sets - multiple lines)
c
if (iczero) 37590, 7590, 37590
7590 continue
ivon01 = 13
ivon02 = 37
ivcomp = (((((((((((((((((((((((((((((((((((((((((((((((((((((((((
* ivon01 / ivon02
* )))))))))))))))))))))))))))))))))))))))))))))))))))))))))
go to 47590
37590 ivdele = ivdele + 1
write (i02,80003) ivtnum
if (iczero) 47590, 7601, 47590
47590 if (ivcomp) 27590,17590,27590
17590 ivpass = ivpass + 1
write (i02,80001) ivtnum
go to 7601
27590 ivfail = ivfail + 1
ivcorr = 0
write (i02,80004) ivtnum, ivcomp, ivcorr
7601 continue
c
c write page footings and run summaries
99999 continue
write (i02,90002)
write (i02,90006)
write (i02,90002)
write (i02,90002)
write (i02,90007)
write (i02,90002)
write (i02,90008) ivfail
write (i02,90009) ivpass
write (i02,90010) ivdele
c
c
c terminate routine execution
stop
c
c format statements for page headers
90000 format (1h1)
90002 format (1h )
90001 format (1h ,10x,34hfortran compiler validation system)
90003 format (1h ,21x,11hversion 1.0)
90004 format (1h ,10x,38hfor official use only - copyright 1978)
90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
90006 format (1h ,5x,46h----------------------------------------------)
90011 format (1h ,18x,17hsubset level test)
c
c format statements for run summaries
90008 format (1h ,15x,i5,19h errors encountered)
90009 format (1h ,15x,i5,13h tests passed)
90010 format (1h ,15x,i5,14h tests deleted)
c
c format statements for test results
80001 format (1h ,4x,i5,7x,4hpass)
80002 format (1h ,4x,i5,7x,4hfail)
80003 format (1h ,4x,i5,7x,7hdeleted)
80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
c
90007 format (1h ,20x,20hend of program fm045)
end