Topspeed_JPI/TS-V3/MODBASE/CHKIND.MOD

IMPLEMENTATION MODULE ChkInd;
(*
 *  ModBase
 *  Release 3.0
 *  By Don Fletcher & John McMonagle
 *  (c) Copyright 1986 - 1991 PMI
 *  P.O. Box 8402
 *  Green Bay Wi 53308
 *  All Rights Reserved
 *
 *)

  FROM DBIndxes IMPORT
    FindPositionCh, OpenIndex, BuildIndex, DBIndex, NextRecord, PrevRecord,
    CurrentRec,CurrentKeyCh,GoTop;

  FROM StrConv IMPORT
    CardinalToStr;


  FROM StringIO IMPORT
    ReadStr, WriteStr, WriteEol;

  FROM M2Strings IMPORT
    Assign, CompareStr,Concat;

  FROM BigSets IMPORT InitSet,InSet,InclSet;

  FROM Storage IMPORT ALLOCATE, DEALLOCATE;

  CONST
    inp      = 0;
    outp     = 1;
    prn      = 4;
    stderror = 2;

PROCEDURE NDXChk(VAR ndx:DBIndex);
VAR
    LastKey,KeyStr  : ARRAY[ 0 .. 127 ] OF CHAR;
    str,string      :ARRAY[0..79] OF CHAR;
    cardrec, Keys     :CARDINAL;
    CurRec   : LONGINT;
    ok,
    error,
    dumbool  : BOOLEAN;
    set      : POINTER TO ARRAY[0..4095] OF BITSET;

BEGIN
  NEW( set);
  error:=FALSE;
  Keys:=1;
  InitSet(set^);
  GoTop( ndx );
  InclSet(set^,VAL(CARDINAL,CurrentRec(ndx)));
  CurrentKeyCh( ndx, LastKey );

  WHILE NextRecord( ndx, CurRec ) DO
    cardrec:=VAL(CARDINAL,CurRec);
    CurrentKeyCh(ndx,KeyStr);
    IF InSet(set^,cardrec)
    THEN
      error:=TRUE;
      Concat('duplicate entry for ',KeyStr,str);
      Concat(str,' record number ',str);
      CardinalToStr(cardrec,1,string);
      Concat(str,string,str);
      WriteEol(prn,str);
      HALT;
    ELSE
      InclSet(set^,cardrec);
    END;
    INC(Keys);
    IF CompareStr( LastKey, KeyStr ) > 0
    THEN
      WriteEol(prn,'sort error in index');
      error:=TRUE;
      HALT;
    END (* if *);
    Assign( KeyStr, LastKey );
  END (* while *);
  FOR cardrec:=1 TO Keys DO
    IF NOT InSet(set^,cardrec)
    THEN
      CardinalToStr(cardrec,1,string);
      Concat('record number not in index ',string,str);
      WriteEol(prn,str);
      HALT;
    END;
  END (* for *);


  IF error
  THEN
  CardinalToStr(Keys,8,LastKey);
  WriteStr( prn, LastKey );
  WriteEol( prn ,' keys found.');
    WriteEol( prn, 'SORTING ERRORS FOUND');
  END;
  DISPOSE(set);
END NDXChk;
END ChkInd.