Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!mips!samsung!uunet!zephyr.ens.tek.com!tektronix!percy!m2xenix!puddle!p25.f506.n106.z1.fidonet.org!Jon.Guthrie
From: Jon.Guthrie@p25.f506.n106.z1.fidonet.org (Jon Guthrie)
Newsgroups: comp.lang.modula2
Subject: (2 of 2) Sorting Linked Lists
Message-ID: <2861.2864C8EE@puddle.fidonet.org>
Date: 21 Jun 91 06:32:49 GMT
Sender: ufgate@puddle.fidonet.org (newsout1.26)
Organization: FidoNet node 1:106/506.25 - Fulcrum's Edge, Spring TX
Lines: 94

(* Start of file 3:  SORTTEST.MOD *)

MODULE  SortTest;

FROM SYSTEM IMPORT    ADDRESS;
FROM Sort IMPORT      SortL;
FROM InOut IMPORT     WriteInt, WriteLn;
FROM Storage IMPORT   ALLOCATE, DEALLOCATE;

TYPE
  ListPtr = POINTER TO List;
  List = RECORD
    Value     : INTEGER;
    Next      : ListPtr;
  END;


  PROCEDURE GetNext(This : ADDRESS) : ADDRESS;
  VAR
    Temp : ListPtr;
    
  BEGIN
    Temp := This;
    RETURN Temp^.Next
  END GetNext;


  PROCEDURE SetNext(First, Next : ADDRESS);
  VAR
    Temp : ListPtr;
    
  BEGIN
    Temp := First;
    Temp^.Next := Next;
  END SetNext;


  PROCEDURE Compare(First, Next : ADDRESS) : INTEGER;
  VAR
    Temp1, Temp2  : ListPtr;
    
  BEGIN
    Temp1 := First;
    Temp2 := Next;
    RETURN (Temp1^.Value - Temp2^.Value)
  END Compare;


  PROCEDURE Random(VAR Seed : INTEGER) : INTEGER;
  BEGIN
    Seed := SHORT((LONG(Seed) * 1255 + 6173) MOD 29282);
    RETURN Seed
  END Random;


  PROCEDURE DoTest(Size : INTEGER);
  VAR
    Base, This                : ListPtr;
    I, J                      : INTEGER;

  BEGIN
    J := 5;
    Base := NIL;
    FOR I:=1 TO Size DO
      This := Base;
      ALLOCATE(Base, SIZE(List));
      Base^.Next := This;
      Base^.Value := Random(J)
    END;

    SortL(Base, GetNext, SetNext, Compare); 

    WHILE Base # NIL DO
      WriteInt(Base^.Value, 8);
      WriteLn;
      This := Base^.Next;
      DEALLOCATE(Base, SIZE(List));
      Base := This
    END
  END DoTest;

BEGIN
  DoTest(100);
  WriteLn;
  DoTest(1000);
  WriteLn;
  DoTest(10000)
END SortTest.



--  
uucp: uunet!m2xenix!puddle!106!506.25!Jon.Guthrie
Internet: Jon.Guthrie@p25.f506.n106.z1.fidonet.org