Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-07 - decus/20-0170/split.for
There is 1 other file named split.for in the archive. Click here to see a list.
C     RENBR(SPLIT/SPLIT 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 SPLITS THE COMPOSITE TEST
C     FILES INTO INDIVIDUAL FILES EACH  CONTAINING  1  TEST
C     CASE,  AND  SPLITS  THE  COMPOSITE  RESULT FILES INTO
C     INDIVIDUAL FILES EACH CONTAINING THE REULTS  EXPECTED
C     FROM  PROCESSING  1 TEST CASE.  AN ADDITIONAL FILE IS
C     WRITTEN WHICH CONTAINS A LIST OF  THE  NAMES  OF  THE
C     TEST CASES.
C
      DIMENSION LTRBFR(132),LTRRES(6),LTRTRY(6),LTRGET(6),
     1LTRCMP(6),LTRMAX(6),LTRNOW(6),LWRRES(6),LWRTRY(6),
     2LWRGET(6)
      DOUBLE PRECISION FILINP,FILOUT,FILNAM,FILBAS
      DATA LTRRES/1H.,1HR,1HE,1HS,1HE,1HT/
      DATA LWRRES/1H.,1Hr,1He,1Hs,1He,1Ht/
      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(' SPLIT'/
     1' SPLITS FROFF COMPOSITE VERIFICATION FILES'/
     2' COMPOSITE TEST CASE FILE MUST HAVE .TRY EXTENSION'/
     3' COMPOSITE RESULT FILE MUST HAVE .GET EXTENSION')
      TYPE 2
    2 FORMAT(' SPLIT WHICH FILE (NO PERIOD): ',$)
      ACCEPT 3,FILBAS
    3 FORMAT(1A10)
C
C     SPLIT THE COMPOSITE TEST CASE FILE
      ENCODE(10,4,FILINP)FILBAS
    4 FORMAT(1A6,4H.TRY)
      OPEN(UNIT=IDSK,FILE=FILINP,ACCESS='SEQIN',ERR=42)
      IRESET=0
      IFOPEN=0
      MAXWID=0
    5 READ(IDSK,6,END=23)LTRBFR
    6 FORMAT(132A1)
      MAXBFR=132
    7 IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 8
      MAXBFR=MAXBFR-1
      IF(MAXBFR.GT.1)GO TO 7
    8 DO 9 I=1,6
      IF(LTRBFR(I).EQ.LTRTRY(I))GO TO 9
      IF(LTRBFR(I).EQ.LWRTRY(I))GO TO 9
      GO TO 16
    9 CONTINUE
      DO 10 I=1,6
      LTRNOW(I)=LTRBFR(I+7)
   10 CONTINUE
      IF(IFOPEN.NE.0)GO TO 12
      ENCODE(10,11,FILNAM)FILBAS
   11 FORMAT(1A6,4H.NAM)
      OPEN(UNIT=KDSK,FILE=FILNAM,ACCESS='SEQOUT')
      GO TO 13
   12 CLOSE(UNIT=JDSK)
   13 WRITE(KDSK,14)(LTRBFR(I),I=8,13)
   14 FORMAT(6A1)
      ENCODE(10,15,FILOUT)(LTRBFR(I),I=8,13)
   15 FORMAT(6A1,4H.RNO)
      OPEN(UNIT=JDSK,FILE=FILOUT,ACCESS='SEQOUT')
      IRESET=0
      IFOPEN=IFOPEN+1
      GO TO 18
   16 IF(MAXBFR.NE.6)GO TO 18
      DO 17 I=1,6
      IF(LTRBFR(I).EQ.LTRRES(I))GO TO 17
      IF(LTRBFR(I).EQ.LWRRES(I))GO TO 17
      GO TO 18
   17 CONTINUE
      IRESET=1
      GO TO 5
   18 IF(IFOPEN.EQ.0)GO TO 44
      IF(IRESET.EQ.0)GO TO 20
      WRITE(JDSK,19)
   19 FORMAT('.RESET')
      IRESET=0
   20 WRITE(JDSK,21)(LTRBFR(I),I=1,MAXBFR)
   21 FORMAT(132A1)
      IF(MAXWID.GE.MAXBFR)GO TO 5
      MAXWID=MAXBFR
      DO 22 I=1,6
      LTRMAX(I)=LTRNOW(I)
   22 CONTINUE
      GO TO 5
   23 CLOSE(UNIT=IDSK)
      IF(IFOPEN.EQ.0)GO TO 46
      CLOSE(UNIT=KDSK)
      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     SPLIT THE COMPOSITE RESULT FILE
      ENCODE(10,25,FILINP)FILBAS
   25 FORMAT(1A6,4H.GET)
      OPEN(UNIT=IDSK,FILE=FILINP,ACCESS='SEQIN',ERR=48)
      IFOPEN=0
      MAXWID=0
   26 READ(IDSK,27,END=40)LTRBFR
   27 FORMAT(132A1)
      MAXBFR=132
   28 IF(LTRBFR(MAXBFR).NE.LTRSPA)GO TO 29
      MAXBFR=MAXBFR-1
      IF(MAXBFR.GT.1)GO TO 28
   29 DO 30 I=1,6
      IF(LTRBFR(I).EQ.LTRGET(I))GO TO 30
      IF(LTRBFR(I).EQ.LWRGET(I))GO TO 30
      GO TO 37
   30 CONTINUE
      DO 31 I=1,6
      LTRNOW(I)=LTRBFR(I+7)
   31 CONTINUE
      IF(IFOPEN.NE.0)GO TO 32
      OPEN(UNIT=KDSK,FILE=FILNAM,ACCESS='SEQIN')
      GO TO 33
   32 CLOSE(UNIT=JDSK)
   33 READ(KDSK,34,END=54)LTRCMP
   34 FORMAT(6A1)
      DO 35 I=1,6
      IF(LTRBFR(I+7).NE.LTRCMP(I))GO TO 56
   35 CONTINUE
      ENCODE(10,36,FILOUT)(LTRBFR(I),I=8,13)
   36 FORMAT(6A1,4H.DOC)
      OPEN(UNIT=JDSK,FILE=FILOUT,ACCESS='SEQOUT')
      IFOPEN=IFOPEN+1
   37 IF(IFOPEN.EQ.0)GO TO 50
      WRITE(JDSK,38)(LTRBFR(I),I=1,MAXBFR)
   38 FORMAT(132A1)
      IF(MAXWID.GE.MAXBFR)GO TO 26
      MAXWID=MAXBFR
      DO 39 I=1,6
      LTRMAX(I)=LTRNOW(I)
   39 CONTINUE
      GO TO 26
   40 CLOSE(UNIT=IDSK)
      IF(IFOPEN.EQ.0)GO TO 52
      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 58
C
C     ERROR MESSAGES
   42 TYPE 43
   43 FORMAT(' COMPOSITE TEST CASE FILE MISSING')
      GO TO 58
   44 TYPE 45
   45 FORMAT(' COMPOSITE TEST CASE FILE MISSING INITIAL DEBUG LINE')
      GO TO 58
   46 TYPE 47
   47 FORMAT(' COMPOSITE TEST CASE FILE IS EMPTY')
      GO TO 58
   48 TYPE 49
   49 FORMAT(' COMPOSITE RESULT FILE MISSING')
      GO TO 58
   50 TYPE 51
   51 FORMAT(' COMPOSITE RESULT FILE MISSING INITIAL DEBUG LINE')
      GO TO 58
   52 TYPE 53
   53 FORMAT(' COMPOSITE RESULT FILE IS EMPTY')
      GO TO 58
   54 TYPE 55,(LTRBFR(I),I=8,13)
   55 FORMAT(' COMPOSITE RESULT FILE CONTAINS TOO MANY RESULTS')
      GO TO 58
   56 TYPE 57,LTRCMP,(LTRBFR(I),I=8,13)
   57 FORMAT(' MISMATCH BETWEEN CASES ',6A1,' AND ',6A1)
      GO TO 58
   58 STOP
      END