home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / TESTS / SRC / SEMATEST.MOD < prev    next >
Text File  |  1996-09-27  |  7KB  |  192 lines
  1. MODULE SemaTest;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*      Test program to check that the semaphore        *)
  6.         (*      operations work.                                *)
  7.         (*                                                      *)
  8.         (*      Programmer:     P. Moylan                       *)
  9.         (*      Last edited:    27 September 1996               *)
  10.         (*                                                      *)
  11.         (*      Description:    Runs a pair of tasks in a       *)
  12.         (*              simple producer/consumer relationship.  *)
  13.         (*                                                      *)
  14.         (*      Status:         Working, but ...                *)
  15.         (*                                                      *)
  16.         (*      Problems:                                       *)
  17.         (*        1. Painfully slow.  I'm going to have to      *)
  18.         (*           put a substantial improvement into         *)
  19.         (*           module Windows.                            *)
  20.         (*        2. On final exit, have to type an extra key   *)
  21.         (*           to get the program to shut down.  This     *)
  22.         (*           comes from the way shutdown is handled     *)
  23.         (*           in Windows, and in the long term I'm       *)
  24.         (*           going to have to find a cleaner solution.  *)
  25.         (*        3. Bug in tracing: attempting to trace kernel *)
  26.         (*           causes infinite recursion.  For now        *)
  27.         (*           kernel tracing has been removed, but       *)
  28.         (*           given the intended use of this program we  *)
  29.         (*           should find a mechanism for kernel tracing.*)
  30.         (*                                                      *)
  31.         (********************************************************)
  32.  
  33.  
  34. FROM Windows IMPORT
  35.     (* type *)  Window, Colour, FrameType, DividerType,
  36.     (* proc *)  OpenWindow, CloseWindow, WriteString, WriteLn, Write,
  37.                 PressAnyKey, ReadChar;
  38.  
  39. FROM Trace IMPORT
  40.     (* proc *)  TraceOn;
  41.  
  42. FROM Semaphores IMPORT
  43.     (* type *)  Semaphore,
  44.     (* proc *)  CreateSemaphore, Wait, Signal;
  45.  
  46. FROM TaskControl IMPORT
  47.     (* proc *)  CreateTask, TaskExit;
  48.  
  49. FROM CircularBuffers IMPORT
  50.     (* type *)  CircularBuffer,
  51.     (* proc *)  CreateBuffer, PutBuffer, GetBuffer;
  52.  
  53. (************************************************************************)
  54.  
  55. CONST Esc = CHR(01BH);
  56.  
  57. VAR
  58.  
  59.     (* The consumer and producer tasks will communicate through a       *)
  60.     (* circular buffer called "pipe".                                   *)
  61.  
  62.     pipe: CircularBuffer;
  63.  
  64.     (* logwindow is a screen window used for status messages.           *)
  65.  
  66.     logwindow: Window;
  67.  
  68.     (* The "finished" semaphore is needed so the main task will know    *)
  69.     (* when the consumer and producer tasks have both exited.           *)
  70.  
  71.     finished: Semaphore;
  72.  
  73. (************************************************************************)
  74. (*                      THE PRODUCER AND CONSUMER TASKS                 *)
  75. (************************************************************************)
  76.  
  77. PROCEDURE Producer;
  78.  
  79.     (* The producer task.  Takes input from the keyboard, sends it to   *)
  80.     (* the intertask buffer where it will be picked up by the consumer  *)
  81.     (* task.  Exits when a second Esc key is received (the first is     *)
  82.     (* sent to the consumer task).                                      *)
  83.  
  84.     VAR datum: CHAR;  EscSent: BOOLEAN;
  85.         pwindow: Window;
  86.  
  87.     BEGIN
  88.         OpenWindow (pwindow, red, green, 4, 11, 0, 41, simpleframe, nodivider);
  89.         WriteString (pwindow, "Starting producer task.");
  90.         WriteLn (pwindow);
  91.         WriteString (pwindow, "Type Esc TWICE to exit from both tasks.");
  92.         WriteLn (pwindow);
  93.         EscSent := FALSE;
  94.  
  95.         LOOP
  96.             ReadChar (pwindow, datum);
  97.             IF datum = Esc THEN
  98.                 IF EscSent THEN EXIT(*LOOP*) END (*IF*);
  99.                 EscSent := TRUE;
  100.             END (*IF*);
  101.             PutBuffer (pipe, datum);
  102.         END (*LOOP*);
  103.  
  104.         WriteString (pwindow, "Producer task is now terminating.");
  105.         WriteLn (pwindow);
  106.         CloseWindow (pwindow);
  107.         Signal (finished);
  108.         TaskExit;
  109.     END Producer;
  110.  
  111. (************************************************************************)
  112.  
  113. PROCEDURE Consumer;
  114.  
  115.     (* The consumer task.  Takes input from the intertask buffer and    *)
  116.     (* prints it, changing lower case letters to upper case.            *)
  117.     (* Exits when an Esc character has been received.                   *)
  118.  
  119.     VAR datum: CHAR;
  120.         cwindow: Window;
  121.  
  122.     BEGIN
  123.         OpenWindow (cwindow, blue, cyan, 14,21, 30,69, simpleframe, nodivider);
  124.         WriteString (cwindow, "Starting consumer task.");
  125.         WriteLn (cwindow);
  126.         LOOP
  127.             datum := GetBuffer(pipe);
  128.             IF (datum >= 'a') AND (datum <= 'z') THEN
  129.                 datum := CHR (ORD(datum)-ORD('a')+ORD('A'))
  130.             END (*IF*);
  131.             IF datum = Esc THEN EXIT(*LOOP*) END(*IF*);
  132.             Write (cwindow, datum);
  133.         END (*LOOP*);
  134.         WriteLn (cwindow);
  135.         WriteString (cwindow, "Consumer task is now terminating.");
  136.         WriteLn (cwindow);
  137.         CloseWindow (cwindow);
  138.         Signal (finished);
  139.         TaskExit;
  140.     END Consumer;
  141.  
  142. (************************************************************************)
  143. (*                          THE TEST PROCEDURE                          *)
  144. (************************************************************************)
  145.  
  146. PROCEDURE RunTheTest;
  147.  
  148.     CONST ProducerPriority = 10; ConsumerPriority = 8;
  149.  
  150.     VAR taskcount: CARDINAL;
  151.  
  152.     BEGIN
  153.         CreateBuffer (pipe, 8);
  154.         CreateSemaphore (finished, 0);
  155.         taskcount := 0;
  156.  
  157.         CreateTask (Consumer, ConsumerPriority, "Consumer");
  158.         INC (taskcount);
  159.         WriteString (logwindow, "Have created consumer task.");
  160.         WriteLn (logwindow);
  161.  
  162.         CreateTask (Producer, ProducerPriority, "Producer");
  163.         INC (taskcount);
  164.         WriteString (logwindow, "Have created producer task.");
  165.         WriteLn (logwindow);
  166.  
  167.         WHILE taskcount > 0 DO
  168.             Wait (finished);  DEC(taskcount);
  169.         END (*WHILE*);
  170.  
  171.         WriteString (logwindow,
  172.                         "All tasks terminated - back in RunTheTest.");
  173.         WriteLn (logwindow);
  174.     END RunTheTest;
  175.  
  176. (************************************************************************)
  177. (*                              MAIN PROGRAM                            *)
  178. (************************************************************************)
  179.  
  180.     BEGIN
  181.         (*TraceOn (10, 24, 0, 79, 50);*)
  182.         OpenWindow (logwindow, white, black, 0, 3, 0, 49,
  183.                                         noframe, nodivider);
  184.         WriteString (logwindow, "Test of semaphore operations.");
  185.         WriteLn (logwindow);
  186.         RunTheTest;
  187.         WriteString (logwindow, "End of test.");
  188.         PressAnyKey (logwindow);
  189.         CloseWindow (logwindow);
  190.     END SemaTest.
  191.  
  192.