Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-07 - decus/20-0170/merge.for
There are 3 other files named merge.for in the archive. Click here to see a list.
C     RENBR(MERGE/MERGE FROFF COMPOSITE TEST FILES)
C
C     DONALD E. BARTH, YALE SCHOOL OF MANAGEMENT
C
C     THE  VERIFICATION  FILES  SUPPLIED  WITH  FROFF  EACH
C     CONTAIN  MANY  TEST  CASES  OR  THE RESULTS WHICH ARE
C     EXPECTED WHEN THESE TEST CASES ARE  PROCESSED.   EACH
C     TEST  CASE  BEGINS WITH A LINE CONTAINING THE COMMAND
C     .DEBUG FOLLOWED  BY  A  UNIQUE  NAME  OF  6  OR  LESS
C     CHARACTERS.    EACH   RESULT   BEGINS   WITH  A  LINE
C     CONTAINING THE WORD DEBUG FOLLOWED BY THE NAME OF THE
C     TEST  CASE.   THIS PROGRAM MERGES THE INDIVIDUAL TEST
C     CASES INTO A COMPOSITE  TEST  FILE,  AND  MERGES  THE
C     INDIVIDUAL  RESULT FILES EXPECTED FROM PROCESSING THE
C     INDIVIDUAL TEST CASES INTO A COMPOSITE  RESULT  FILE.
C     AN  ADDITIONAL  FILE IS READ WHICH CONTAINS THE NAMES
C     OF THE TEST CASES.
C
      DIMENSION LTRBFR(132),LTRTRY(6),LTRGET(6),LTRCMP(6),
     1LTRMAX(6),LTRALL(10),LWRTRY(6),LWRGET(6),LWRALL(10)
      DOUBLE PRECISION FILINP,FILOUT,FILNAM,FILBAS
      DATA LTRALL/1H.,1HR,1HE,1HS,1HE,1HT,1H ,1HA,1HL,1HL/
      DATA LWRALL/1H.,1Hr,1He,1Hs,1He,1Ht,1H ,1Ha,1Hl,1Hl/
      DATA LTRTRY/1H.,1HD,1HE,1HB,1HU,1HG/
      DATA LWRTRY/1H.,1Hd,1He,1Hb,1Hu,1Hg/
      DATA LTRGET/1H ,1HD,1HE,1HB,1HU,1HG/
      DATA LWRGET/1H ,1Hd,1He,1Hb,1Hu,1Hg/
      DATA LTRSPA/1H /
      DATA IDSK,JDSK,KDSK/1,20,21/
      TYPE 1
    1 FORMAT(' MERGE'/
     1' MERGES FROFF TEST CASES INTO COMPOSITE FILES'/
     2' LIST OF NAMES MUST BE IN FILE HAVING .NAM EXTENSION'/
     3' INDIVIDUAL TEST FILES MUST HAVE .RNO EXTENSION'/
     4' INDIVIDUAL RESULT FILES MUST HAVE .DOC EXTENSION')
      TYPE 2
    2 FORMAT(' MERGE WHICH FILE (NO PERIOD): ',$)
      ACCEPT 3,FILBAS
    3 FORMAT(1A10)
      ENCODE(10,4,FILNAM)FILBAS
    4 FORMAT(1A6,4H.NAM)
C
C     MERGE THE INDIVIDUAL TEST CASES
      OPEN(UNIT=KDSK,FILE=FILNAM,ACCESS='SEQIN',ERR=42)
      IFOPEN=0
      MAXWID=0
    5 READ(KDSK,6,END=23)LTRCMP
    6 FORMAT(6A1)
      IF(IFOPEN.NE.0)GO TO 8
      ENCODE(10,7,FILOUT)FILBAS
    7 FORMAT(1A6,4H.TRY)
      OPEN(UNIT=JDSK,FILE=FILOUT,ACCESS='SEQOUT')
    8 IFOPEN=IFOPEN+1
      ENCODE(10,9,FILINP)LTRCMP
    9 FORMAT(6A1,4H.RNO)
      OPEN(UNIT=IDSK,FILE=FILINP,ACCESS='SEQIN',ERR=46)
      KNTLIN=0
      IRESET=0
   10 READ(IDSK,11,END=21)LTRBFR
   11 FORMAT(132A1)
      MAXBFR=132
   12 IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 13
      MAXBFR=MAXBFR-1
      IF(MAXBFR.GT.1)GO TO 12
   13 IF(KNTLIN.NE.0)GO TO 15
      DO 14 I=1,6
      IF(LTRBFR(I).EQ.LTRTRY(I))GO TO 14
      IF(LTRBFR(I).EQ.LWRTRY(I))GO TO 14
      GO TO 48
   14 CONTINUE
   15 IRESET=0
      IF(MAXBFR.NE.10)GO TO 17
      DO 16 I=1,10
      IF(LTRBFR(I).EQ.LTRALL(I))GO TO 16
      IF(LTRBFR(I).NE.LWRALL(I))GO TO 17
   16 CONTINUE
      IRESET=1
   17 KNTLIN=KNTLIN+1
      IF(MAXWID.GE.MAXBFR)GO TO 19
      MAXWID=MAXBFR
      DO 18 I=1,6
      LTRMAX(I)=LTRCMP(I)
   18 CONTINUE
   19 WRITE(JDSK,20)(LTRBFR(I),I=1,MAXBFR)
   20 FORMAT(132A1)
      GO TO 10
   21 IF(IRESET.EQ.0)WRITE(JDSK,22)
   22 FORMAT('.RESET')
      CLOSE(UNIT=IDSK)
      GO TO 5
   23 CLOSE(UNIT=KDSK)
      IF(IFOPEN.EQ.0)GO TO 44
      CLOSE(UNIT=JDSK)
      TYPE 24,IFOPEN,MAXWID,LTRMAX
   24 FORMAT('         NUMBER OF TEST CASES',1I4/
     1'       LENGTH OF LONGEST LINE',1I4/
     2' LONGEST LINE IS IN TEST CASE ',6A1)
C
C     MERGE THE INDIVIDUAL RESULTS
      OPEN(UNIT=KDSK,FILE=FILNAM,ACCESS='SEQIN')
      IFOPEN=0
      MAXWID=0
   25 READ(KDSK,26,END=40)LTRCMP
   26 FORMAT(6A1)
      IF(IFOPEN.NE.0)GO TO 28
      ENCODE(10,27,FILOUT)FILBAS
   27 FORMAT(1A6,4H.GET)
      OPEN(UNIT=JDSK,FILE=FILOUT,ACCESS='SEQOUT')
   28 IFOPEN=IFOPEN+1
      ENCODE(10,29,FILINP)LTRCMP
   29 FORMAT(6A1,4H.DOC)
      OPEN(UNIT=IDSK,FILE=FILINP,ACCESS='SEQIN',ERR=50)
      KNTLIN=0
   30 READ(IDSK,31,END=39)LTRBFR
   31 FORMAT(132A1)
      MAXBFR=132
   32 IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 33
      MAXBFR=MAXBFR-1
      IF(MAXBFR.GT.1)GO TO 32
   33 IF(KNTLIN.NE.0)GO TO 35
      DO 34 I=1,6
      IF(LTRBFR(I).EQ.LTRGET(I))GO TO 34
      IF(LTRBFR(I).EQ.LWRGET(I))GO TO 34
      GO TO 52
   34 CONTINUE
   35 KNTLIN=KNTLIN+1
      IF(MAXWID.GE.MAXBFR)GO TO 37
      MAXWID=MAXBFR
      DO 36 I=1,6
      LTRMAX(I)=LTRCMP(I)
   36 CONTINUE
   37 WRITE(JDSK,38)(LTRBFR(I),I=1,MAXBFR)
   38 FORMAT(132A1)
      GO TO 30
   39 CLOSE(UNIT=IDSK)
      GO TO 25
   40 CLOSE(UNIT=KDSK)
      CLOSE(UNIT=JDSK)
      TYPE 41,MAXWID,LTRMAX
   41 FORMAT('       LENGTH OF LONGEST LINE',1I4/
     1'    LONGEST LINE IS IN RESULT ',6A1)
      GO TO 54
C
C     ERROR MESSAGES
   42 TYPE 43
   43 FORMAT(' NAME FILE MISSING')
      GO TO 54
   44 TYPE 45
   45 FORMAT(' NAME FILE IS EMPTY')
      GO TO 54
   46 TYPE 47,LTRCMP
   47 FORMAT(' INDIVIDUAL TEST CASE ',6A1,' MISSING')
      GO TO 54
   48 TYPE 49,LTRCMP
   49 FORMAT(' INDIVIDUAL TEST CASE ',6A1,' MISSING DEBUG LINE')
      GO TO 54
   50 TYPE 51,LTRCMP
   51 FORMAT(' INDIVIDUAL RESULT ',6A1,' MISSING')
      GO TO 54
   52 TYPE 53,LTRCMP
   53 FORMAT(' INDIVIDUAL RESULT ',6A1,' MISSING DEBUG LINE')
      GO TO 54
   54 STOP
      END