Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0170/compar.for
There are 3 other files named compar.for in the archive. Click here to see a list.
C RENBR(COMPAR/COMPARE 2 FROFF COMPOSITE RESULT FILES)
C
C DONALD E. BARTH, YALE SCHOOL OF MANAGEMENT
C
C This program reports the names of the test cases for
C which different results are produced when a composite
C test case file is processed with 2 different versions
C of FROFF.
C
DOUBLE PRECISION FILONE,FILTWO,FILNUL
DIMENSION LTR1IN(132),LTR2IN(132),LTR1DB(6),LTR2DB(6),
1LTRDBG(7),LWRDBG(7)
DATA IDISK,JDISK,ITTY,JTTY/1,20,5,5/
DATA LTRDBG/1H ,1HD,1HE,1HB,1HU,1HG,1H /
DATA LWRDBG/1H ,1Hd,1He,1Hb,1Hu,1Hg,1H /
DATA FILNUL/' '/
C
C INITIALIZE GLOBAL COUNTS
KNTBAD=0
KNTALL=0
KNTFIL=0
C
C INFORM USER WHAT PROGRAM THIS IS
WRITE(ITTY,1)
1 FORMAT(' COMPAR'/
1' Reports the names of the test cases for which'/
2' different results are produced when a composite'/
3' test case file is processed with 2 different'/
4' versions of FROFF.')
C
C ASK FOR FILE NAMES AND OPEN THEM
2 WRITE(ITTY,3)
3 FORMAT(' OLD COMPOSITE RESULT FILE: ',$)
READ(JTTY,4)FILONE
4 FORMAT(1A10)
IF(FILONE.EQ.FILNUL)GO TO 54
OPEN(UNIT=IDISK,FILE=FILONE,ACCESS='SEQIN',ERR=5)
GO TO 7
5 WRITE(ITTY,6)
6 FORMAT(' OLD FILE CANNOT BE OPENED')
GO TO 2
7 WRITE(ITTY,8)
8 FORMAT(' NEW COMPOSITE RESULT FILE: ',$)
READ(JTTY,4)FILTWO
OPEN(UNIT=JDISK,FILE=FILTWO,ACCESS='SEQIN',ERR=9)
GO TO 11
9 WRITE(ITTY,10)
10 FORMAT(' NEW FILE CANNOT BE OPENED')
GO TO 7
11 CONTINUE
C
C READ THE FILES
C ISTATE = 0, READ IN ANOTHER LINE IN OLD FILE
C = 1, DO NOT READ IN ANOTHER LINE YET
C = -1, END OF FILE READ
C JSTATE = 0, READ IN ANOTHER LINE IN NEW FILE
C = 1, DO NOT READ IN ANOTHER LINE YET
C = -1, END OF FILE READ
C IFERR = 0, NO ERROR YET IN THIS TEST CASE
C = 1, THIS CASE HAS BEEN REPORTED AS IN ERROR
KNTFIL=KNTFIL+1
ISTATE=0
JSTATE=0
IFERR=0
KNTERR=0
KNTDBG=0
KNTOLD=0
KNTNEW=0
12 IF(ISTATE.EQ.0)READ(IDISK,13,END=14)LTR1IN
13 FORMAT(132A1)
IF(ISTATE.EQ.0)KNTOLD=KNTOLD+1
IF(JSTATE.GE.0)GO TO 15
GO TO 37
14 ISTATE=-1
IF(JSTATE.LT.0)GO TO 41
IF(JSTATE.GT.0)GO TO 52
15 IF(JSTATE.EQ.0)READ(JDISK,13,END=16)LTR2IN
IF(JSTATE.EQ.0)KNTNEW=KNTNEW+1
IF(ISTATE.GE.0)GO TO 17
GO TO 37
16 JSTATE=-1
IF(ISTATE.LT.0)GO TO 41
IF(ISTATE.GT.0)GO TO 50
GO TO 37
17 CONTINUE
C
C GET INITIAL DEBUG LINES
DO 19 I=1,7
IF(LTR1IN(I).EQ.LTRDBG(I))GO TO 18
IF(LTR1IN(I).EQ.LWRDBG(I))GO TO 18
GO TO 22
18 IF(LTR2IN(I).EQ.LTRDBG(I))GO TO 19
IF(LTR2IN(I).EQ.LWRDBG(I))GO TO 19
GO TO 22
19 CONTINUE
J=7
DO 20 I=1,6
J=J+1
LTR1DB(I)=LTR1IN(J)
LTR2DB(I)=LTR2IN(J)
20 CONTINUE
DO 21 I=1,6
IF(LTR1DB(I).NE.LTR2DB(I))GO TO 48
21 CONTINUE
KNTDBG=KNTDBG+1
IFERR=0
ISTATE=0
JSTATE=0
GO TO 12
22 IF(KNTDBG.LE.0)GO TO 46
C
C IF AN EARLY DEBUG LINE IN ONE FILE, LOOK FOR ANOTHER
IF(ISTATE.LE.0)GO TO 26
DO 23 I=1,7
IF(LTR2IN(I).EQ.LTRDBG(I))GO TO 23
IF(LTR2IN(I).EQ.LWRDBG(I))GO TO 23
GO TO 12
23 CONTINUE
J=7
DO 24 I=1,6
J=J+1
LTR2DB(I)=LTR2IN(J)
24 CONTINUE
DO 25 I=1,6
IF(LTR1DB(I).NE.LTR2DB(I))GO TO 48
25 CONTINUE
KNTDBG=KNTDBG+1
IFERR=0
ISTATE=0
JSTATE=0
GO TO 12
26 IF(JSTATE.LE.0)GO TO 30
DO 27 I=1,7
IF(LTR1IN(I).EQ.LTRDBG(I))GO TO 27
IF(LTR1IN(I).EQ.LWRDBG(I))GO TO 27
GO TO 12
27 CONTINUE
J=7
DO 28 I=1,6
J=J+1
LTR1DB(I)=LTR1IN(J)
28 CONTINUE
DO 29 I=1,6
IF(LTR1DB(I).NE.LTR2DB(I))GO TO 48
29 CONTINUE
KNTDBG=KNTDBG+1
IFERR=0
JSTATE=0
ISTATE=0
GO TO 12
30 CONTINUE
C
C TEST FOR AN EARLY DEBUG LINE IN EITHER FILE
DO 31 I=1,7
IF(LTR1IN(I).EQ.LTRDBG(I))GO TO 31
IF(LTR1IN(I).EQ.LWRDBG(I))GO TO 31
GO TO 33
31 CONTINUE
J=7
DO 32 I=1,6
J=J+1
LTR1DB(I)=LTR1IN(J)
32 CONTINUE
ISTATE=1
IF(IFERR.NE.0)GO TO 12
WRITE(ITTY,40)LTR2DB
KNTERR=KNTERR+1
IFERR=1
GO TO 12
33 DO 34 I=1,7
IF(LTR2IN(I).EQ.LTRDBG(I))GO TO 34
IF(LTR2IN(I).EQ.LWRDBG(I))GO TO 34
GO TO 36
34 CONTINUE
J=7
DO 35 I=1,6
J=J+1
LTR2DB(I)=LTR2IN(J)
35 CONTINUE
JSTATE=1
IF(IFERR.NE.0)GO TO 12
WRITE(ITTY,40)LTR1DB
KNTERR=KNTERR+1
IFERR=1
GO TO 12
36 CONTINUE
C
C TEST IF LINES ARE SAME
37 IF(IFERR.NE.0)GO TO 12
DO 38 I=1,132
IF(LTR1IN(I).NE.LTR2IN(I))GO TO 39
38 CONTINUE
GO TO 12
39 WRITE(ITTY,40)LTR1DB
40 FORMAT(' ERROR IN ',6A1)
KNTERR=KNTERR+1
IFERR=1
GO TO 12
C
C FINAL SUMMARY
41 KNTBAD=KNTBAD+KNTERR
KNTALL=KNTALL+KNTDBG
IF(KNTERR.GT.0)GO TO 43
WRITE(ITTY,42)KNTDBG
42 FORMAT(
11X/' NO ERRORS IN',1I5,' CASES '/1X)
GO TO 45
43 WRITE(ITTY,44)KNTERR,KNTDBG
44 FORMAT(
11X/' ',1I4,' OF',1I5,' CASES CONTAINED ERRORS'/1X)
45 GO TO 2
C
C ERROR MESSAGES
46 WRITE(ITTY,47)
47 FORMAT(' FILES DO NOT START WITH DEBUG LINES')
GO TO 54
48 WRITE(ITTY,49)LTR1DB,LTR2DB
49 FORMAT(' OLD FILE CONTAINS ',6A1,', BUT NEW FILE CONTAINS ',6A1)
GO TO 54
50 WRITE(ITTY,51)LTR1DB
51 FORMAT(' END OF NEW FILE WHILE SEARCHING FOR ',6A1)
KNTERR=KNTERR+1
GO TO 54
52 WRITE(ITTY,53)LTR2DB
53 FORMAT(' END OF OLD FILE WHILE SEARCHING FOR ',6A1)
KNTERR=KNTERR+1
GO TO 54
C
C ALL FINISHED
54 IF(KNTBAD.GT.0)GO TO 56
WRITE(ITTY,55)KNTALL,KNTFIL
55 FORMAT(1X/' NO ERRORS IN',1I5,' CASES IN',1I4,' FILES'/1X)
GO TO 58
56 WRITE(ITTY,57)KNTBAD,KNTALL,KNTFIL
57 FORMAT(1X/' ',1I4,' OF',1I5,' CASES IN',1I4,
1' FILES CONTAINED ERRORS'/1X)
58 STOP
END