Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/MISC.ZIP/COMPARE.PAS

Pascal/Delphi Source File | 1986-02-02 | 16.5 KB | 497 lines

{.F-}
{
compare two similar text files for mismatches

call as COMPARE FileA FileB [Output Redirection]

modified Kim Kokkonen, TurboPower Software, 1986
     minimize code for Turbo Pascal version 3.0.
modified Willett Kempton, mich state u, 1984
     add options for ANSI output and CPM support.
written and copyright by James F. Miner, University of Minnesota, 1977
     for CDC mainframe.
}
{.F+}

{$P128}

PROGRAM compare;

CONST
  linelength = 128;           {maximum significant input line length}
  minlinesformatch = 4;       {number of consecutive equivalent
                              lines to end a mis-match}
  markunequalcolumns = 5;     {unequal lines are paired, and columns
                              marked, if mismatch < this length}
  minread = 40;               {try for multiple reads (=1 saves heap)}
  prespace = 7;               {spaces before text on reportfile lines}
  tab = 9;                    {ascii tab for aligning ^ indicator}
  barchar = '|';              {separator between line number and text}

TYPE
  textfile = Text[512];
  argstrtype = STRING[64];
  linepointer = ^line;
  lineimagetype = ARRAY[1..linelength] OF Char;

  line =                      {single line buffer}
  RECORD
    nextline : linepointer;
    Length : 0..linelength;
    image : lineimagetype
  END;

  stream =                    {bookkeeping for each input file}
  RECORD
    name : Char;
    cursor, head, tail : linepointer;
    cursorlineno, headlineno, taillineno : Integer;
    endfile : Boolean
  END;

VAR
  filea, fileb : textfile;
  a, b : stream;
  endfile : Boolean;          {true if end of stream a or b}
  freelines : linepointer;    {free list of line buffers}
  same : Boolean;             {true if no mis-matches occur}
  linestoolong : Boolean;     {true if some lines not completely checked}

  PROCEDURE comparefiles;
  VAR
    match : Boolean;

    FUNCTION endstream(VAR x : stream) : Boolean;
    BEGIN                     {endstream}
      endstream := (x.cursor = NIL) AND x.endfile
    END;                      {endstream}

    PROCEDURE Mark(VAR x : stream);
      {causes beginning of stream to be positioned before}
      {current stream cursor.  buffers get reclaimed, line}
      {counters reset, etc.}
    VAR
      p : linepointer;
    BEGIN                     {mark}
      WITH x DO IF head <> NIL THEN BEGIN
        WHILE head <> cursor DO BEGIN
          {reclaim buffers}
          WITH head^ DO BEGIN
            p := nextline;
            nextline := freelines;
            freelines := head
          END;
          head := p
        END;
        headlineno := cursorlineno;
        IF cursor = NIL THEN BEGIN
          tail := NIL;
          taillineno := cursorlineno
        END
      END
    END;                      {mark}

    PROCEDURE movecursor(VAR x : stream; VAR filex : textfile);
      {filex is the input file associated with stream x.  the}
      {cursor for x is moved forward one line, reading from x}
      {if necessary, and incrementing the line count.  endfile}
      {is set if eof is encountered on either stream.}

      PROCEDURE readline;
        {read from filex}
      CONST
        ordcr = 13;
        mask = 127;           {ascii values; to equate cr and ri}
      VAR
        newline : linepointer;
        c, c2 : 0..linelength;
        ch : Char;
        morereads : Integer;
      BEGIN                   {readline}
        morereads := minread;
        WHILE (NOT x.endfile) AND (morereads > 0) DO BEGIN
          {allocate space for the line}
          newline := freelines;
          IF newline <> NIL THEN
            freelines := freelines^.nextline
          ELSE BEGIN
            {need more from heap}
            {should check for heap exhaustion here}
            New(newline);
            newline^.Length := linelength; {new: must blank fill}
          END;
          c := 0;
          WITH newline^ DO BEGIN
            IF NOT EoF(filex) THEN
              {first char of line}
              Read(filex, ch);
            WHILE ((Ord(ch) AND mask) <> ordcr)
            AND (c < linelength)
            AND (NOT EoF(filex)) DO BEGIN
              c := Succ(c);
              image[c] := ch;
              Read(filex, ch);
            END;
            WHILE ((Ord(ch) AND mask) <> ordcr) AND (NOT EoF(filex)) DO BEGIN
              Read(filex, ch);
              linestoolong := True;
            END;
            IF NOT EoF(filex) THEN Read(filex, ch); {should be the lf}
          END;

          WHILE (newline^.image[c] = ' ') AND (c > 1) DO c := Pred(c);
          WITH newline^ DO
            IF c < Length THEN
              FOR c2 := Succ(c) TO Length DO image[c2] := ' ';
          newline^.Length := c;
          newline^.nextline := NIL;
          IF x.tail = NIL THEN BEGIN
            x.head := newline;
            x.taillineno := 1;
            x.headlineno := 1
          END
          ELSE BEGIN
            x.tail^.nextline := newline;
            x.taillineno := Succ(x.taillineno)
          END;
          x.tail := newline;
          x.endfile := EoF(filex);
          morereads := Pred(morereads);
        END
      END;                    {readline}

    BEGIN                     {movecursor}
      IF x.cursor <> NIL THEN BEGIN
        IF x.cursor = x.tail THEN readline;
        x.cursor := x.cursor^.nextline;
        IF x.cursor = NIL THEN endfile := True;
        x.cursorlineno := Succ(x.cursorlineno)
      END ELSE IF NOT x.endfile THEN BEGIN
        {beginning of stream}
        readline;
        x.cursor := x.head;
        x.cursorlineno := x.headlineno
      END ELSE
        {end of stream }
        endfile := True;
    END;                      {movecursor}

    PROCEDURE backtrack(VAR x : stream; VAR xlines : Integer);
      {causes the current position of stream x to become that}
      {of the last mark operation.  i.e., the current line  }
      {when the stream was marked last becomes the new cursor. }
      {xlines is set to the number of lines from the new cursor }
      {to the old cursor, inclusive.}
    BEGIN                     {backtrack}
      xlines := Succ(x.cursorlineno)-x.headlineno;
      x.cursor := x.head; x.cursorlineno := x.headlineno;
      endfile := endstream(a) OR endstream(b)
    END;                      {backtrack}

    PROCEDURE comparelines(VAR match : Boolean);
      {compare the current lines of streams a and b, returning}
      {match to signal their (non-) equivalence.  eof on both streams}
      {is considered a match, but eof on only one stream is a mismatch}
    BEGIN                     {comparelines}
      IF (a.cursor = NIL) OR (b.cursor = NIL) THEN
        match := endstream(a) AND endstream(b)
      ELSE BEGIN
        match := (a.cursor^.Length = b.cursor^.Length);
        IF match THEN
          match := (a.cursor^.image = b.cursor^.image)
      END
    END;                      {comparelines}

    PROCEDURE findmismatch;
    BEGIN                     {findmismatch}
      {not endfile and match}
      REPEAT                  {comparenextlines}
        movecursor(a, filea);
        movecursor(b, fileb);
        Mark(a);
        Mark(b);
        comparelines(match)
      UNTIL endfile OR NOT match;
    END;                      {findmismatch}

    PROCEDURE findmatch;
    VAR
      advanceb : Boolean;     {toggle one-line lookahead between streams}

      PROCEDURE search(VAR x : stream; {stream to search}
                       VAR filex : textfile;
                       VAR y : stream; {stream to lookahead}
                       VAR filey : textfile);
        {look ahead one line on stream y, and search for that line}
        {backtracking on stream x.}
      VAR
        count : Integer;      {number of lines backtracked on x}

        PROCEDURE checkfullmatch;
          {from the current positions in x and y, which match,}
          {make sure that the next minlinesformatch-1 lines also}
          {match, or else set match := false. }
        VAR
          n : Integer;
          savexcur, saveycur : linepointer;
          savexline, saveyline : Integer;
        BEGIN                 {checkfullmatch}
          savexcur := x.cursor;
          saveycur := y.cursor;
          savexline := x.cursorlineno;
          saveyline := y.cursorlineno;
          comparelines(match);
          n := Pred(minlinesformatch);
          WHILE match AND (n <> 0) DO BEGIN
            movecursor(x, filex);
            movecursor(y, filey);
            comparelines(match);
            n := Pred(n)
          END;
          x.cursor := savexcur;
          x.cursorlineno := savexline;
          y.cursor := saveycur;
          y.cursorlineno := saveyline;
        END;                  {checkfullmatch}

      BEGIN                   {search}
        movecursor(y, filey);
        backtrack(x, count);
        checkfullmatch;
        count := Pred(count);
        WHILE (count <> 0) AND NOT match DO BEGIN
          movecursor(x, filex);
          count := Pred(count);
          checkfullmatch;
        END
      END;                    {search}

      PROCEDURE printmismatch;
      VAR
        emptya, emptyb : Boolean;

        PROCEDURE writeoneline(name : Char; l : Integer; p : linepointer);
        VAR i : Integer;
        BEGIN                 {writeoneline}
          Write(name, l:5, barchar);
          IF p^.Length <> 0 THEN
            FOR i := 1 TO p^.Length DO Write(p^.image[i]);
          WriteLn;
        END;                  {writeoneline }

        PROCEDURE writetext(VAR x : stream);
          {write from x.head to one line before x.cursor}
        VAR
          p, q : linepointer; lineno : Integer;
        BEGIN                 {writetext}
          p := x.head; q := x.cursor; lineno := x.headlineno;
          WHILE (p <> NIL) AND (p <> q) DO BEGIN
            writeoneline(x.name, lineno, p);
            p := p^.nextline;
            lineno := Succ(lineno);
          END;
          IF p = NIL THEN WriteLn(' *** eof ***');
          {writeln}
        END;                  {writetext}

        PROCEDURE writepairs(pa, pb : linepointer; la, lb : Integer);
          {this writes from the head to the cursor, like procedure writetext.}
          {unlike procedure writetext, this writes from both files at once,  }
          {compares columns within lines, and marks unequal columns    }
        VAR
          tempa, tempb : lineimagetype;
          col, maxcol : Integer;
        BEGIN                 {writepairs}
          REPEAT
            writeoneline('a', la, pa);
            writeoneline('b', lb, pb);
            tempa := pa^.image;
            tempb := pb^.image;
            IF pa^.Length > pb^.Length THEN
              maxcol := pa^.Length
            ELSE
              maxcol := pb^.Length;
            Write(' ':prespace);
            FOR col := 1 TO maxcol DO
              IF tempa[col] <> tempb[col] THEN
                Write('^')
              ELSE BEGIN
                IF tempa[col] = Chr(tab) THEN
                  Write(Chr(tab))
                ELSE
                  Write(' ');
              END;
            WriteLn;
            pa := pa^.nextline;
            la := Succ(la);
            pb := pb^.nextline;
            lb := Succ(lb);
          UNTIL (pa = a.cursor) OR (pa = NIL);
        END;                  {writepairs}

        PROCEDURE writelineno(VAR x : stream);
        VAR
          f, l : Integer;
        BEGIN                 {writelineno}
          Write(' file', x.name, ', ');
          f := x.headlineno;
          l := Pred(x.cursorlineno);
          Write('line');
          IF f = l THEN
            Write(' ', f)
          ELSE
            Write('s ', f, ' - ', l);
          IF x.cursor = NIL THEN Write(' (before eof)');
        END;                  {writelineno}

        PROCEDURE printextratext(VAR x, y : stream);
        BEGIN                 {printextratext}
          Write('extra text:  on file', x.name, ', ');
          IF y.head = NIL THEN
            WriteLn(' before eof on file', y.name)
          ELSE
            WriteLn(' between lines ', Pred(y.headlineno), ' and ',
            y.headlineno, ' of file', y.name);
          WriteLn;
          writetext(x);
        END;                  {printextratext}

      BEGIN                   {printmismatch}
        WriteLn;
        WriteLn(' ':prespace,
        '*************************************************************');
        emptya := (a.head = a.cursor);
        emptyb := (b.head = b.cursor);
        IF emptya OR emptyb THEN
          IF emptya THEN
            printextratext(b, a)
          ELSE
            printextratext(a, b)
        ELSE BEGIN
          Write('mismatch:   ');
          writelineno(a);
          Write('  not equal to ');
          writelineno(b);
          WriteLn(':');
          WriteLn;
          IF (markunequalcolumns > Pred(a.cursorlineno-a.headlineno)) AND
          ((a.cursorlineno-a.headlineno) = (b.cursorlineno-b.headlineno))
          THEN
            writepairs(a.head, b.head, a.headlineno, b.headlineno)
          ELSE BEGIN
            writetext(a);
            WriteLn(' ':prespace, '----------------');
            writetext(b)
          END;
        END
      END;                    {printmismatch}

    BEGIN                     {findmatch}
      {not match}
      advanceb := True;
      REPEAT
        IF NOT endfile THEN
          advanceb := NOT advanceb
        ELSE
          advanceb := endstream(a);
        IF advanceb THEN
          search(a, filea, b, fileb)
        ELSE
          search(b, fileb, a, filea)
      UNTIL match;
      printmismatch;
    END;                      {findmatch}

  BEGIN                       {comparefiles}
    match := True;            {i.e., beginnings-of-files match}
    REPEAT
      IF match THEN
        findmismatch
      ELSE BEGIN
        same := False;
        findmatch
      END
    UNTIL endfile AND match;
  END;                        {comparefiles}

  PROCEDURE initialize;
    {setup files, using names from command line}
  VAR
    argfilea, argfileb, argfilec : argstrtype;
    nfiles : Integer;
    argumentsok : Boolean;

    FUNCTION resetok(VAR filex : textfile; fname : argstrtype) : Boolean;
    BEGIN                     {resetok}
      {$I-}
      Assign(filex, fname);
      Reset(filex);
      resetok := (IOResult = 0);
      {$I+}
    END;                      {resetok}

    PROCEDURE initstream(namechar : Char; VAR x : stream;
                         VAR filex : textfile; arg : argstrtype);
    BEGIN                     {initstream}
      IF resetok(filex, arg) THEN
        x.endfile := EoF(filex)
      ELSE BEGIN
        Write(' error   cannot find');
        argumentsok := False;
      END;
      WITH x DO BEGIN
        name := namechar;
        cursor := NIL;
        head := NIL;
        tail := NIL;
        cursorlineno := 0;
        headlineno := 0;
        taillineno := 0;
        WriteLn(' file', name, ': ', arg);
      END;
    END;                      {initstream}

  BEGIN                       {initialize}
    nfiles := ParamCount;
    IF (nfiles <> 2) THEN BEGIN
      WriteLn('Usage:  COMPARE  FileA  FileB  [Output Redirection]');
      argumentsok := False;
    END ELSE BEGIN
      argfilea := ParamStr(1);
      argfileb := ParamStr(2);
      argumentsok := resetok(filea, argfilea) AND resetok(fileb, argfileb);
      Write('compare  (options:');
      WriteLn(' rematch on ', minlinesformatch, ' lines.)');
      initstream('a', a, filea, argfilea);
      initstream('b', b, fileb, argfileb);
      endfile := a.endfile OR b.endfile;
      linestoolong := False;
      same := True;
      freelines := NIL;
    END;
    IF NOT argumentsok THEN endfile := True;
  END;                        {initialize}

  PROCEDURE summarize;
  BEGIN
    WriteLn;
    IF same THEN
      WriteLn(' ', Pred(a.cursorlineno), ' lines read; no differences.')
    ELSE
      WriteLn(' files are different.');
    IF linestoolong THEN BEGIN
      WriteLn;
      WriteLn(' warning:  some lines were longer than ', linelength, ' characters.');
      WriteLn(' ':11, 'they were not compared past that point.');
    END;
  END;                        {summarize}

BEGIN                         {compare}
  WriteLn;
  initialize;
  IF NOT endfile THEN BEGIN
    comparefiles;
    summarize;
  END;
END.                          {compare}