home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / TESTS / SRC / SORTFILE.MOD < prev    next >
Text File  |  1996-10-02  |  5KB  |  134 lines
  1. MODULE Sort3;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*                  File sort program                   *)
  6.         (*                                                      *)
  7.         (*      This is a test of the FileSort module.          *)
  8.         (*                                                      *)
  9.         (*  Programmer:         P. Moylan                       *)
  10.         (*  Last edited:        2 October 1996                  *)
  11.         (*  Status:             Not working.  I probably need   *)
  12.         (*      to check out FileSys more carefully before      *)
  13.         (*      proceeding with this.                           *)
  14.         (*                                                      *)
  15.         (*    Almost OK, it's just putting a couple of          *)
  16.         (*    records in the wrong place.                       *)
  17.         (*                                                      *)
  18.         (********************************************************)
  19.  
  20. FROM SYSTEM IMPORT
  21.     (* type *)  ADDRESS;
  22.  
  23. FROM FileSort IMPORT
  24.     (* proc *)  InplaceSort;
  25.  
  26. FROM Files IMPORT
  27.     (* type *)  File,
  28.     (* proc *)  OpenFile, CloseFile, FileSize;
  29.  
  30. FROM Windows IMPORT
  31.     (* type *)  Window, Colour, FrameType, DividerType,
  32.     (* proc *)  OpenWindow, CloseWindow, Write, WriteString, WriteLn,
  33.                 EditString, EditAborted, PressAnyKey;
  34.  
  35. FROM NumericIO IMPORT
  36.     (* proc *)  EditCardinal;
  37.  
  38. FROM IOErrorCodes IMPORT
  39.     (* type *)  ErrorCode,
  40.     (* proc *)  TranslateErrorCode;
  41.  
  42. (************************************************************************)
  43.  
  44. CONST testing = FALSE;
  45.  
  46. CONST MaxRecordSize = 65536;
  47.  
  48. TYPE
  49.     StringSubscript = [0..MaxRecordSize-1];
  50.     BufferPointer = POINTER TO ARRAY StringSubscript OF CHAR;
  51.  
  52. VAR debug: Window;
  53.     RecordSize: CARDINAL;
  54.  
  55. (************************************************************************)
  56.  
  57. PROCEDURE GEproc (first, second: ADDRESS): BOOLEAN;
  58.  
  59.     (* Tests for first^ >= second^.     *)
  60.  
  61.     VAR p1, p2: BufferPointer;
  62.         j: CARDINAL;
  63.  
  64.     BEGIN
  65.         p1 := first;  p2 := second;
  66.         j := 0;
  67.         LOOP
  68.             IF p1^[j] > p2^[j] THEN RETURN TRUE END(*IF*);
  69.             IF p1^[j] < p2^[j] THEN RETURN FALSE END(*IF*);
  70.             INC (j);
  71.             IF j >= RecordSize THEN RETURN TRUE END(*IF*);
  72.         END (*LOOP*);
  73.     END GEproc;
  74.  
  75. (************************************************************************)
  76.  
  77. PROCEDURE DoTheSort;
  78.  
  79.     (* Opens the data file, and uses the FileSort module to sort it.    *)
  80.  
  81.     VAR datafile: File;  log: Window;
  82.         name: ARRAY [0..40] OF CHAR;
  83.         status: ErrorCode;
  84.  
  85.     BEGIN
  86.         RecordSize := 20;
  87.         OpenWindow (log, white, black, 17, 23, 0, 79,
  88.                                         simpleframe, nodivider);
  89.         WriteString (log, "Test of in-place file sort algorithm");
  90.         WriteLn (log);
  91.         WriteString (log, "File name: ");
  92.         name := "test.dat";
  93.         EditString (log, name, SIZE(name));
  94.         IF EditAborted() THEN status := OperationAborted
  95.         ELSE status := OpenFile (datafile, name, FALSE);
  96.         END (*IF*);
  97.         IF status = OK THEN
  98.             WriteLn (log);  WriteString (log, "Record size: ");
  99.             EditCardinal (log, RecordSize, 4);
  100.             WriteLn (log);  WriteString (log, "About to start sorting.");
  101.             InplaceSort (datafile, 0,
  102.                         FileSize(datafile) DIV RecordSize - 1,
  103.                         RecordSize, 0, GEproc);
  104.             WriteLn (log);  WriteString (log, "Sorting completed.");
  105.         ELSE
  106.             WriteLn (log);  WriteString (log, "Could not open data file");
  107.             WriteLn (log);  WriteString (log, "Error code ");
  108.             TranslateErrorCode (status, name);
  109.             WriteString (log, name);
  110.         END (*IF successfully opened file*);
  111.  
  112.         IF testing THEN
  113.             WriteLn (debug);  WriteString (debug, "Calling CloseFile");
  114.         END (*IF*);
  115.         CloseFile (datafile);
  116.         WriteLn (log);  WriteString (log, "End of Sort");
  117.         PressAnyKey (log);
  118.         CloseWindow (log);
  119.  
  120.     END DoTheSort;
  121.  
  122. (************************************************************************)
  123. (*                              MAIN PROGRAM                            *)
  124. (************************************************************************)
  125.  
  126. BEGIN
  127.     IF testing THEN
  128.         OpenWindow (debug, white, black, 12, 16, 0, 79,
  129.                                         simpleframe, nodivider);
  130.     END (*IF*);
  131.     DoTheSort;
  132. END Sort3.
  133.  
  134.