Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0170/number.for
There is 1 other file named number.for in the archive. Click here to see a list.
C RENBR(NUMBER/RESEQUENCE NAMES OF TEST CASES)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS PROGRAM SEARCHES FOR THE DEBUG STATEMENTS IN
C A FROFF COMPOSITE TEST FILE AND REPLACES THE NAME
C APPEARING TO THE RIGHT OF THE WORD DEBUG WITH A NAME
C CONSTRUCTED OF A FIXED WORD PREFIX AND THE SERIAL
C NUMBER OF THE LOCATION OF THE TEST CASE IN THE
C COMPOSITE TEST FILE. THE NAMES ARE REPLACED IN BOTH
C THE .TRY AND THE .GET FILES.
C
DOUBLE PRECISION FILINP,FILOUT
DIMENSION LTRBFR(132),LTRDBG(6),LWRDBG(6),LTRNAM(6),
1LTRINP(6),LTROUT(6),LTRLNG(6),LTRCAS(6)
DATA LMTBFR/132/
DATA LTRDBG/1H.,1HD,1HE,1HB,1HU,1HG/
DATA LWRDBG/1H.,1Hd,1He,1Hb,1Hu,1Hg/
DATA LTRSPA,LTRZRO/1H ,1H0/
DATA ITTY,JTTY,IDISK,JDISK/5,5,1,20/
C
C TELL USER WHAT THIS PROGRAM DOES
WRITE(ITTY,1)
1 FORMAT(' NUMBER'/
1' ASSIGNS NEW NAMES CONSTRUCTED OF WORD AND SEQUENCE'/
2' NUMBER TO TESTS IN FROFF COMPOSITE VERIFICATION FILES.'/
3' COMPOSITE TEST CASE FILE MUST HAVE .TRY EXTENSION'/
4' COMPOSITE RESULT FILE MUST HAVE .GET EXTENSION')
C
C GET BASE FILE NAMES
2 WRITE(ITTY,3)
3 FORMAT(' UNSEQUENCED FILE (NO PERIOD): ',$)
READ(JTTY,4)LTRINP
4 FORMAT(6A1)
WRITE(ITTY,5)
5 FORMAT(' RESEQUENCED FILE (NO PERIOD): ',$)
READ(JTTY,4)LTROUT
DO 6 I=1,6
IF(LTRINP(I).NE.LTROUT(I))GO TO 8
6 CONTINUE
WRITE(ITTY,7)
7 FORMAT(' NAMES OF UNSEQUENCED AND RESEQUENCED FILES MUST DIFFER')
GO TO 2
C
C GET BASE TEST CASE NAME
8 WRITE(ITTY,9)
9 FORMAT(' FIXED PORTION OF NAMES OF TEST CASES: ',$)
READ(JTTY,10)LTRNAM
10 FORMAT(6A1)
DO 11 I=1,6
IF(LTRNAM(I).EQ.LTRSPA)LTRNAM(I)=LTRZRO
11 CONTINUE
WRITE(ITTY,12)
12 FORMAT(' NUMERIC PORTION OF NAME OF FIRST CASE: ',$)
READ(JTTY,13)INITAL
13 FORMAT(I)
IF(INITAL.LE.0)INITAL=1
C
C COPY .TRY FILE FIRST, THEN .GET FILE
DO 36 KNDFIL=1,2
C
C OPEN INPUT AND OUTPUT FILES
IF(KNDFIL.EQ.1)ENCODE(10,14,FILINP)LTRINP
IF(KNDFIL.EQ.2)ENCODE(10,15,FILINP)LTRINP
14 FORMAT(6A1,4H.TRY)
15 FORMAT(6A1,4H.GET)
OPEN(UNIT=IDISK,FILE=FILINP,ACCESS='SEQIN')
IF(KNDFIL.EQ.1)ENCODE(10,14,FILOUT)LTROUT
IF(KNDFIL.EQ.2)ENCODE(10,15,FILOUT)LTROUT
OPEN(UNIT=JDISK,FILE=FILOUT,ACCESS='SEQOUT')
C
C READ LINES FROM INPUT FILE
KASE=INITAL-1
KNTLIN=0
MAXWID=0
16 READ(IDISK,17,END=32)LTRBFR
17 FORMAT(132A1)
KNTLIN=KNTLIN+1
MAXBFR=LMTBFR+1
18 MAXBFR=MAXBFR-1
IF(MAXBFR.LE.1)GO TO 19
IF(LTRBFR(MAXBFR).EQ.1H )GO TO 18
19 IF(MAXWID.GE.MAXBFR)GO TO 21
MAXWID=MAXBFR
KASWID=KASE
DO 20 I=1,6
LTRLNG(I)=LTRCAS(I)
20 CONTINUE
C
C CHECK FOR START OF NEW TEST CASE
21 DO 22 I=2,6
IF(LTRBFR(I).EQ.LTRDBG(I))GO TO 22
IF(LTRBFR(I).NE.LWRDBG(I))GO TO 31
22 CONTINUE
J=7
DO 23 I=1,6
J=J+1
LTRCAS(I)=LTRBFR(J)
23 CONTINUE
C
C GENERATE LINE WHICH IS START OF NEW TEST CASE
KASE=KASE+1
IF(KASE.GE.1000)GO TO 29
IF(KASE.GE.100)GO TO 27
IF(KASE.GE.10)GO TO 25
WRITE(JDISK,24)LTRBFR(1),(LTRNAM(I),I=1,5),KASE
24 FORMAT(1A1,6HDEBUG ,5A1,1I1)
GO TO 16
25 WRITE(JDISK,26)LTRBFR(1),(LTRNAM(I),I=1,4),KASE
26 FORMAT(1A1,6HDEBUG ,4A1,1I2)
GO TO 16
27 WRITE(JDISK,28)LTRBFR(1),(LTRNAM(I),I=1,3),KASE
28 FORMAT(1A1,6HDEBUG ,3A1,1I3)
GO TO 16
29 WRITE(JDISK,30)LTRBFR(1),(LTRNAM(I),I=1,2),KASE
30 FORMAT(1A1,6HDEBUG ,2A1,1I4)
GO TO 16
C
C COPY LINE WHICH IS NOT START OF NEW TEST CASE
31 WRITE(JDISK,17)(LTRBFR(I),I=1,MAXBFR)
GO TO 16
C
C FILE COMPLETELY COPIED
32 CLOSE(UNIT=IDISK)
CLOSE(UNIT=JDISK)
IF(KNDFIL.EQ.1)WRITE(JTTY,33)
IF(KNDFIL.EQ.2)WRITE(JTTY,34)
33 FORMAT(' .TRY FILE')
34 FORMAT(' .GET FILE')
KASE=KASE-INITAL+1
WRITE(JTTY,35)KASE,KNTLIN,MAXWID,KASWID,LTRLNG
35 FORMAT(
1' NUMBER OF CASES=',1I5,', LENGTH=',1I5,', WIDTH=',1I5/
2' WIDEST LINE IS IN CASE',1I5,' (ORIGINAL NAME ',6A1,')')
36 CONTINUE
END