Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50542/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