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