Google
 

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