home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rxipc.zip / TESTIPC.CMD < prev   
OS/2 REXX Batch file  |  1996-01-14  |  72KB  |  2,419 lines
  1. /*:VRX         TestIPC
  2. */
  3.  
  4. /* $Id: testipc.vrx 1.3 1996/01/14 11:57:49 SFB Rel $ */
  5.  
  6. /* $Title: Test file for RexxIPC. $ */
  7.  
  8. /* $Copyright: Serge Brisson. */
  9.  
  10. /* This file is supplied with RexxIPC starting with version 1.21-000.
  11. ** It is meant as a basic test of the library.
  12. **
  13. ** It accepts a parameter which must be an abbreviation of:
  14. **
  15. **      Minimal     -- for a test of minimal operations
  16. **      Semaphore   -- for a test of semaphore operations
  17. **      Pipe        -- for a test of pipe operations
  18. **      Queue       -- for a test of queue operations
  19. **      Benchmark   -- to perform a simple communication benchmark
  20. **
  21. ** Without a parameter, it will perform all the tests but not
  22. ** the benchmark.
  23. **
  24. ** This file needs an other file (TestIPC.CFG) on the same
  25. ** directory as itself. */
  26.  
  27.     /* Initialize global variables. */
  28.     !. = ''
  29.  
  30.     /* Specify signal processing. */
  31.     signal on halt
  32.     signal on failure
  33.     signal on error
  34.     signal on syntax
  35.     signal on novalue
  36.     signal on notready
  37.  
  38.     /* Identify commands source. */
  39.     parse source . . !._source
  40.     parse value Reverse(!._source) with . '.' !._source._pathName
  41.     !._source._pathName = Reverse(!._source._pathName)
  42.     !._source._name = FileSpec('Name', !._source._pathName)
  43.  
  44.     /* Get configuration. */
  45.     call LoadConfig !._source._pathName'.CFG', '_CFG'
  46.  
  47.     /* Start the whole procedure or complete a callback. */
  48.     if Translate(Word(Arg(1), 1)) \= 'CALL' then do
  49.         call Main Arg(1)
  50.     end
  51.     else do
  52.         parse value IPCVersion() with . 'V' !._major '.' !._minor '-' !._revision
  53.         interpret Arg(1)
  54.     end
  55.  
  56.     call Cleanup
  57.  
  58.     return
  59.  
  60.  
  61. /*
  62. ** $Log: testipc.vrx $
  63. ** Revision 1.3  1996/01/14 11:57:49  SFB
  64. ** Queue support is completed.
  65. **
  66. ** Revision 1.2  1995/09/18 20:05:10  SFB
  67. ** Adjustement for release with V1.21.
  68. **
  69. ** Revision 1.1  1995/09/17 17:57:49  SFB
  70. ** Initial revision
  71. */
  72.  
  73.  
  74.  
  75. /*:VRX         BenchmarkDestination
  76. */
  77.  
  78. /* BenchmarkDestination -- Destination side of the benchmark. */
  79.  
  80. BenchmarkDestination:
  81.     procedure expose !. record.
  82.  
  83.     eventOrig = Arg(1)
  84.     eventDest = Arg(2)
  85.     parse upper value Arg(3) with . test .
  86.     if test = '*' then test = ''
  87.  
  88.     /* Resources used. */
  89.     !._pipe.0 = 1
  90.     !._queue.0 = 1
  91.  
  92.     /* Check for internal functions handicap. */
  93.     handicap = !._CFG._Benchmark._Handicap
  94.     if handicap = '' then handicap = 0
  95.     else if handicap \= 0 & handicap \= 1 then signal Config
  96.  
  97.     /* Get the data from file transfer. */
  98.     file = !._CFG._Benchmark._FileName
  99.     if file \= '' & Abbrev('FILE', test, 0) then do
  100.         /* Wait for the file to be written. */
  101.         call SemEventWait eventOrig
  102.         if result \= 0 then signal CallFailed
  103.         call SemEventReset eventOrig
  104.         if result \= 0 then signal CallFailed
  105.  
  106.         /* Read and compare. */
  107.         if Stream(file, 'C', 'Open Read') \= 'READY:' then signal CheckFailed
  108.         do i = 1 to record.0
  109.             if LineIn(file) \= record.i then signal CheckFailed
  110.             if handicap then call IPCVersion
  111.         end
  112.         call Stream file, 'C', 'Close'
  113.  
  114.         /* Indicate reception completed. */
  115.         call SemEventPost eventDest
  116.         if result \= 0 then signal CallFailed
  117.     end
  118.  
  119.     /* Get the data from Rexx queue transfer. */
  120.     rexxQueue = !._CFG._Benchmark._RexxQueue
  121.     if rexxQueue \= '' & Abbrev('REXX', test, 0) then do
  122.         /* Wait for the queue to be created. */
  123.         call SemEventWait eventOrig
  124.         if result \= 0 then signal CallFailed
  125.         call SemEventReset eventOrig
  126.         if result \= 0 then signal CallFailed
  127.  
  128.         /* Dequeue and compare. */
  129.         previousQueue = RxQueue('Set', rexxQueue)
  130.         do i = 1 to record.0
  131.             if LineIn('QUEUE:') \= record.i then signal CheckFailed
  132.             if handicap then call IPCVersion
  133.         end
  134.         call RxQueue 'Set', previousQueue
  135.  
  136.         /* Indicate reception completed. */
  137.         call SemEventPost eventDest
  138.         if result \= 0 then signal CallFailed
  139.     end
  140.  
  141.     /* Get the data from named pipe transfer. */
  142.     pipeName = !._CFG._Benchmark._PipeName
  143.     if pipeName \= '' & Abbrev('PIPE', test, 0) then do
  144.         /* Wait for the pipe to be created. */
  145.         call SemEventWait eventOrig
  146.         if result \= 0 then signal CallFailed
  147.         call SemEventReset eventOrig
  148.         if result \= 0 then signal CallFailed
  149.  
  150.         /* Wait until the server is ready. */
  151.         call PipeWait pipeName, -1
  152.         if result \= 0 then signal CallFailed
  153.  
  154.         /* Establish the connection. */
  155.         call PipeOpen '!._pipe.1', pipeName
  156.         if result \= 0 then signal CallFailed
  157.  
  158.         /* Receive and compare. */
  159.         do i = 1 to record.0
  160.             call PipeRead !._pipe.1, 'record'
  161.             if result \= 0 then signal CallFailed
  162.             if record \= record.i then signal CheckFailed
  163.         end
  164.  
  165.         /* Close the connection. */
  166.         call PipeClose !._pipe.1
  167.         if result \= 0 then signal CallFailed
  168.         !._pipe.1 = ''
  169.  
  170.         /* Indicate reception completed. */
  171.         call SemEventPost eventDest
  172.         if result \= 0 then signal CallFailed
  173.     end
  174.  
  175.     /* Get the data from OS/2 queue transfer. */
  176.     queueName = !._CFG._Benchmark._QueueName
  177.     if !._major = 1 then
  178.         if !._minor <= 20 then queueName = ''
  179.         else if !._minor = 21 then
  180.             if !._revision < 100 then queueName = ''
  181.     if queueName \= '' & Abbrev('QUEUE', test, 0) then do
  182.         /* Wait for the origin to be ready. */
  183.         call SemEventWait eventOrig
  184.         if result \= 0 then signal CallFailed
  185.         call SemEventReset eventOrig
  186.         if result \= 0 then signal CallFailed
  187.  
  188.         /* Create the queue. */
  189.         call QueueCreate '!._queue.1', queueName
  190.         if result \= 0 then signal CallFailed
  191.  
  192.         /* Indicate queue created. */
  193.         call SemEventPost eventDest
  194.         if result \= 0 then signal CallFailed
  195.  
  196.         /* Wait for the origin to start. */
  197.         call SemEventWait eventOrig
  198.         if result \= 0 then signal CallFailed
  199.         call SemEventReset eventOrig
  200.         if result \= 0 then signal CallFailed
  201.  
  202.         /* Dequeue and compare. */
  203.         do i = 1 to record.0
  204.             call QueueRead !._queue.1, 'record'
  205.             if result \= 0 then signal CallFailed
  206.             if record \= record.i then signal CheckFailed
  207.         end
  208.  
  209.         /* Close the queue. */
  210.         call QueueClose !._queue.1
  211.         if result \= 0 then signal CallFailed
  212.         !._queue.1 = ''
  213.  
  214.         /* Indicate reception completed. */
  215.         call SemEventPost eventDest
  216.         if result \= 0 then signal CallFailed
  217.  
  218.     end
  219.  
  220.     /* Resources released. */
  221.     !._pipe.0 = ''
  222.     !._queue.0 = ''
  223.  
  224.     return
  225.  
  226.  
  227.  
  228. /*:VRX         BenchmarkOrigin
  229. */
  230.  
  231. /* BenchmarkOrigin -- Origin side of the benchmark. */
  232.  
  233. BenchmarkOrigin:
  234.     procedure expose !. record.
  235.  
  236.     eventOrig = Arg(1)
  237.     eventDest = Arg(2)
  238.     parse upper value Arg(3) with . test .
  239.     if test = '*' then test = ''
  240.  
  241.     /* Resources used. */
  242.     !._rexxQueue.0 = 1
  243.     !._pipe.0 = 1
  244.     !._queue.0 = 1
  245.  
  246.     /* Check for internal functions handicap. */
  247.     handicap = !._CFG._Benchmark._Handicap
  248.     if handicap = '' then handicap = 0
  249.     else if handicap \= 0 & handicap \= 1 then signal Config
  250.     if handicap then handicapNotice = ' (handicapped)'
  251.     else handicapNotice = ''
  252.  
  253.     /* File transfer. */
  254.     file = !._CFG._Benchmark._FileName
  255.     if file \= '' & Abbrev('FILE', test, 0) then do
  256.         say 'Doing a file transfer...'
  257.         call Time 'Reset'
  258.  
  259.         /* Write the file. */
  260.         if Stream(file, 'C', 'Open Write') \= 'READY:' then
  261.             signal CheckFailed
  262.         !._file = file
  263.         call LineOut !._file, , 1
  264.         do i = 1 to record.0
  265.             call LineOut !._file, record.i
  266.             if result \= 0 then signal CallFailed
  267.             if handicap then call IPCVersion
  268.         end
  269.         call Stream !._file, 'C', 'Close'
  270.  
  271.         /* The destination may now read the file. */
  272.         call SemEventPost eventOrig
  273.         if result \= 0 then signal CallFailed
  274.  
  275.         /* Wait for the destination. */
  276.         call SemEventWait eventDest
  277.         if result \= 0 then signal CallFailed
  278.  
  279.         /* Display summary. */
  280.         call Time 'Reset'
  281.         say 'File transfer'handicapNotice':' Trunc(result, 2) 'seconds.'
  282.         say
  283.         call LineOut !._logFile,,
  284.             '  File'handicapNotice':' Trunc(result, 2) 'seconds.'
  285.  
  286.         /* Reset destination event. */
  287.         call SemEventReset eventDest
  288.         if result \= 0 then signal CallFailed
  289.     end
  290.  
  291.     /* Rexx queue transfer. */
  292.     rexxQueue = !._CFG._Benchmark._RexxQueue
  293.     if rexxQueue \= '' & Abbrev('REXX', test, 0) then do
  294.         say 'Doing a Rexx queue transfer...'
  295.         call Time 'Reset'
  296.  
  297.         /* Create the queue and set current. */
  298.         rexxQueue = Translate(rexxQueue)
  299.         !._rexxQueue.1 = RxQueue('Create', rexxQueue)
  300.         if !._rexxQueue.1 \= rexxQueue then signal CheckFailed
  301.         previousQueue = RxQueue('Set', !._rexxQueue.1)
  302.  
  303.         /* The destination may now open the queue. */
  304.         call SemEventPost eventOrig
  305.         if result \= 0 then signal CallFailed
  306.  
  307.         /* Put all the records on the queue. */
  308.         do i = 1 to record.0
  309.             queue record.i
  310.             if handicap then call IPCVersion
  311.         end
  312.  
  313.         /* Wait for the destination. */
  314.         call SemEventWait eventDest
  315.         if result \= 0 then signal CallFailed
  316.  
  317.         /* Display summary. */
  318.         call Time 'Reset'
  319.         say 'Rexx queue transfer'handicapNotice':' Trunc(result, 2) 'seconds.'
  320.         say
  321.         call LineOut !._logFile,,
  322.             '  Rexx queue'handicapNotice':' Trunc(result, 2) 'seconds.'
  323.  
  324.         /* Reset destination event. */
  325.         call SemEventReset eventDest
  326.         if result \= 0 then signal CallFailed
  327.  
  328.         /* Cleanup the queue environment. */
  329.         call RxQueue 'Set', previousQueue
  330.         call RxQueue 'Delete', !._rexxQueue.1
  331.         !._rexxQueue.1 = ''
  332.         if result \= 0 then signal CallFailed
  333.     end
  334.  
  335.     /* Named pipe transfer. */
  336.     pipeName = !._CFG._Benchmark._PipeName
  337.     if pipeName \= '' & Abbrev('PIPE', test, 0) then do
  338.         say 'Doing a named pipe transfer...'
  339.  
  340.         /* Create the server's named pipe. */
  341.         call PipeCreate '!._pipe.1', pipeName
  342.         if result \= 0 then signal CallFailed
  343.  
  344.         /* The client may now try to open the pipe. */
  345.         call SemEventPost eventOrig
  346.         if result \= 0 then signal CallFailed
  347.  
  348.         call Time 'Reset'
  349.  
  350.         /* Wait for the connection. */
  351.         call PipeConnect !._pipe.1
  352.         if result \= 0 then signal CallFailed
  353.  
  354.         /* Send the records on the pipe. */
  355.         do i = 1 to record.0
  356.             call PipeWrite !._pipe.1, record.i
  357.             if result \= 0 then signal CallFailed
  358.         end
  359.  
  360.         /* Wait for the destination. */
  361.         call SemEventWait eventDest
  362.         if result \= 0 then signal CallFailed
  363.  
  364.         /* Disconnect. */
  365.         call PipeDisconnect !._pipe.1
  366.         if result \= 0 then signal CallFailed
  367.  
  368.         /* Display summary. */
  369.         call Time 'Reset'
  370.         say 'Named pipe transfer:' Trunc(result, 2) 'seconds.'
  371.         say
  372.         call LineOut !._logFile,,
  373.             '  Named pipe:' Trunc(result, 2) 'seconds.'
  374.  
  375.         /* Reset destination event. */
  376.         call SemEventReset eventDest
  377.         if result \= 0 then signal CallFailed
  378.  
  379.         /* Close the server's pipe. */
  380.         call PipeClose !._pipe.1
  381.         if result \= 0 then signal CallFailed
  382.         !._pipe.1 = ''
  383.     end
  384.  
  385.     /* OS/2 queue transfer. */
  386.     queueName = !._CFG._Benchmark._QueueName
  387.     if !._major = 1 then
  388.         if !._minor <= 20 then queueName = ''
  389.         else if !._minor = 21 then
  390.             if !._revision < 100 then queueName = ''
  391.     if queueName \= '' & Abbrev('QUEUE', test, 0) then do
  392.         say 'Doing a OS/2 queue transfer...'
  393.  
  394.         /* The client should now create the queue. */
  395.         call SemEventPost eventOrig
  396.         if result \= 0 then signal CallFailed
  397.  
  398.         /* Wait for the confirmation. */
  399.         call SemEventWait eventDest
  400.         if result \= 0 then signal CallFailed
  401.         call SemEventReset eventDest
  402.         if result \= 0 then signal CallFailed
  403.  
  404.         call Time 'Reset'
  405.  
  406.         /* Let the client serve. */
  407.         call SemEventPost eventOrig
  408.         if result \= 0 then signal CallFailed
  409.  
  410.         /* Queue the records. */
  411.         call QueueOpen '!._queue.1', queueName, 'server'
  412.         if result \= 0 then signal CallFailed
  413.         do i = 1 to record.0
  414.             call QueueWrite !._queue.1, record.i
  415.             if result \= 0 then signal CallFailed
  416.         end
  417.  
  418.         /* Close the queue if inter-process. */
  419.         call ProcGetThreadInfo , , , 'process'
  420.         if process \= server then do
  421.             call QueueClose !._queue.1
  422.             if result \= 0 then signal CallFailed
  423.         end
  424.         !._queue.1 = ''
  425.  
  426.         /* Wait for the destination. */
  427.         call SemEventWait eventDest
  428.         if result \= 0 then signal CallFailed
  429.  
  430.         /* Display summary. */
  431.         call Time 'Reset'
  432.         say 'OS/2 queue transfer:' Trunc(result, 2) 'seconds.'
  433.         say
  434.         call LineOut !._logFile,,
  435.             '  OS/2 queue:' Trunc(result, 2) 'seconds.'
  436.  
  437.         /* Reset destination event. */
  438.         call SemEventReset eventDest
  439.         if result \= 0 then signal CallFailed
  440.     end
  441.  
  442.     /* Resources released. */
  443.     !._rexxQueue.0 = ''
  444.     !._pipe.0 = ''
  445.     !._queue.0 = ''
  446.  
  447.     return
  448.  
  449.  
  450.  
  451. /*:VRX         BenchmarkProcess
  452. */
  453.  
  454. /* BenchmarkProcess -- Created for PerformSimpleBenchmark. */
  455.  
  456. BenchmarkProcess:
  457.     procedure expose !.
  458.  
  459.     eventOrig = Arg(1)
  460.     eventDest = Arg(2)
  461.     parse value Arg(3) with . . encore .
  462.  
  463.     /* Resources used. */
  464.     !._event.0 = 2
  465.  
  466.     /* Open supplied shared events. */
  467.     call SemEventOpen eventOrig
  468.     if result \= 0 then signal CallFailed
  469.     !._event.1 = eventOrig
  470.     call SemEventOpen eventDest
  471.     if result \= 0 then signal CallFailed
  472.     !._event.2 = eventDest
  473.  
  474.     /* Get benchmark data generated by the main process. */
  475.     file = !._CFG._Benchmark._FileName
  476.     if file = '' then file = !._source._pathName'.TMP'
  477.     if Stream(file, 'C', 'Open Read') \= 'READY:' then signal CheckFailed
  478.     record.0 = !._CFG._Benchmark._RecordCount
  479.     do i = 1 to record.0
  480.         record.i = LineIn(file)
  481.     end
  482.     call Stream file, 'C', 'Close'
  483.  
  484.     /* Indicate that the destination process is ready. */
  485.     call SemEventPost eventDest
  486.     if result \= 0 then signal CallFailed
  487.  
  488.     /* Do the destination part of the benchmark. */
  489.     call BenchmarkDestination eventOrig, eventDest, Arg(3)
  490.  
  491.     /* Encore if specified. */
  492.     if encore = '' then encore = !._CFG._Benchmark._Encore
  493.     if encore = '' then encore = 0
  494.     do encore
  495.         call BenchmarkDestination eventOrig, eventDest, Arg(3)
  496.     end
  497.  
  498.     /* Close the shared events. */
  499.     call SemEventClose !._event.1
  500.     if result \= 0 then signal CallFailed
  501.     !._event.1 = ''
  502.     call SemEventClose !._event.2
  503.     if result \= 0 then signal CallFailed
  504.     !._event.2 = ''
  505.  
  506.     /* Resources released. */
  507.     !._event.0 = ''
  508.  
  509.     call Cleanup
  510.  
  511.     '@EXIT'
  512.  
  513.     return
  514.  
  515.  
  516.  
  517. /*:VRX         BenchmarkThread
  518. */
  519.  
  520. /* BenchmarkThread -- Created for PerformSimpleBenchmark. */
  521.  
  522. BenchmarkThread:
  523.     procedure expose !.
  524.  
  525.     eventOrig = Arg(1)
  526.     eventDest = Arg(2)
  527.     parse value Arg(3) with . . encore .
  528.  
  529.     /* Get benchmark data generated by the main thread. */
  530.     record.0 = !._CFG._Benchmark._RecordCount
  531.     do i = 1 to record.0
  532.         record.i = LineIn('QUEUE:')
  533.     end
  534.  
  535.     /* Indicate that the destination thread is ready. */
  536.     call SemEventPost eventDest
  537.     if result \= 0 then signal CallFailed
  538.  
  539.     /* Do the destination part of the benchmark. */
  540.     call BenchmarkDestination eventOrig, eventDest, Arg(3)
  541.  
  542.     /* Encore if specified. */
  543.     if encore = '' then encore = !._CFG._Benchmark._Encore
  544.     if encore = '' then encore = 0
  545.     do encore
  546.         call BenchmarkDestination eventOrig, eventDest, Arg(3)
  547.     end
  548.  
  549.     return
  550.  
  551.  
  552.  
  553. /*:VRX         Cleanup
  554. */
  555.  
  556. /* Cleanup -- Cleanup before exit. */
  557.  
  558. Cleanup:
  559.     procedure expose !.
  560.  
  561.     signal off notready
  562.  
  563.     /* Close any open context. */
  564.     if !._context.0 \= '' then
  565.         do context = 1 to !._context.0
  566.             if !._context.context \= '' then do
  567.                 call IPCContextClose !._context.context
  568.                 !._context.context = ''
  569.             end
  570.         end
  571.  
  572.     /* Close any open event semaphore. */
  573.     if !._event.0 \= '' then
  574.         do event = 1 to !._event.0
  575.             if !._event.event \= '' then do
  576.                 call SemEventClose !._event.event
  577.                 !._event.event = ''
  578.             end
  579.         end
  580.  
  581.     /* Close any open mutex semaphore. */
  582.     if !._mutex.0 \= '' then
  583.         do mutex = 1 to !._mutex.0
  584.             if !._mutex.mutex \= '' then do
  585.                 call SemMutexRelease !._mutex.mutex
  586.                 call SemMutexClose !._mutex.mutex
  587.                 !._mutex.mutex = ''
  588.             end
  589.         end
  590.  
  591.     /* Close any open muxwait semaphore. */
  592.     if !._muxwait.0 \= '' then
  593.         do muxwait = 1 to !._muxwait.0
  594.             if !._muxwait.muxwait \= '' then do
  595.                 call SemMuxwaitClose !._muxwait.muxwait
  596.                 !._muxwait.muxwait = ''
  597.             end
  598.         end
  599.  
  600.     /* Stop any active timer. */
  601.     if !._timer.0 \= '' then
  602.         do timer = 1 to !._timer.0
  603.             if !._timer.timer \= '' then do
  604.                 call SemStopTimer !._timer.timer
  605.                 !._timer.timer = ''
  606.             end
  607.         end
  608.  
  609.     /* Close any open named pipe. */
  610.     if !._pipe.0 \= '' then
  611.         do pipe = 1 to !._pipe.0
  612.             if !._pipe.pipe \= '' then do
  613.                 call PipeClose !._pipe.pipe
  614.                 !._pipe.pipe = ''
  615.             end
  616.         end
  617.  
  618.     /* Close any open OS/2 queue. */
  619.     if !._queue.0 \= '' then
  620.         do queue = 1 to !._queue.0
  621.             if !._queue.queue \= '' then do
  622.                 call QueueClose !._queue.queue
  623.                 !._queue.queue = ''
  624.             end
  625.         end
  626.  
  627.     /* Delete any created Rexx queue. */
  628.     if !._rexxQueue.0 \= '' then
  629.         do rexxQueue = 1 to !._rexxQueue.0
  630.             if !._rexxQueue.rexxQueue \= '' then do
  631.                 call RxQueue 'Delete', !._rexxQueue.rexxQueue
  632.                 !._rexxQueue.rexxQueue = ''
  633.             end
  634.         end
  635.  
  636.     /* Close and delete a temporary file. */
  637.     if !._file \= '' then do
  638.         call Stream !._file, 'C', 'Close'
  639.         call SysFileDelete !._file
  640.         !._file = ''
  641.     end
  642.  
  643.     /* Close a log file. */
  644.     if !._logFile \= '' then do
  645.         call Stream !._logFile, 'C', 'Close'
  646.         !._logFile = ''
  647.     end
  648.  
  649.     return
  650.  
  651.  
  652.  
  653. /*:VRX         LoadConfig
  654. */
  655.  
  656. /* LoadConfig -- Load configuration parameters from file. */
  657.  
  658. LoadConfig:
  659.     procedure expose !.
  660.  
  661.     parse arg file, subStem
  662.  
  663.     /* Open the configuration file. */
  664.     if Stream(file, 'C', 'Open Read') \= 'READY:' then
  665.         signal ConfigFileMissing
  666.  
  667.     lineNumber = 0
  668.     section = ''
  669.  
  670.     /* Read the configuration file. */
  671.     do while Lines(file)
  672.         /* Get a line. */
  673.         line = Strip(LineIn(file))
  674.         lineNumber = lineNumber + 1
  675.  
  676.         /* If line is empty or comment, ignore. */
  677.         if line = '' | Left(line, 1) = ';' then iterate
  678.  
  679.         /* Line is either section header or entry definition. */
  680.         if Left(line, 1) = '[' then do
  681.             /* Get upper case section name prefixed with '_'. */
  682.             parse var line '[' section ']' .
  683.             section = '_'Translate(Strip(section))
  684.  
  685.             /* On first occurrence of section, zero count of entries. */
  686.             if !.subStem.section.0 = '' then !.subStem.section.0 = 0
  687.         end
  688.         else do
  689.             /* Get upper case entry name prefixed with '_', value. */
  690.             parse var line entry '=' value
  691.             entry = '_'Translate(Strip(entry))
  692.  
  693.             /* Save value stripped of prefix / suffix spaces. */
  694.             !.subStem.section.entry = Strip(value)
  695.  
  696.             /* Save the entry stem in the section list. */
  697.             entryIndex = !.subStem.section.0 + 1
  698.             !.subStem.section.entryIndex = entry
  699.             !.subStem.section.0 = entryIndex
  700.         end
  701.  
  702.     end /* do while */
  703.  
  704.     /* Close the configuration file. */
  705.     call Stream file, 'C', 'Close'
  706.  
  707.     return
  708.  
  709.  
  710. ConfigFileMissing:
  711.  
  712.     say 'Failed to open configuration file "'file'"!'
  713.     signal Abort
  714.  
  715.  
  716.  
  717. /*:VRX         Main
  718. */
  719.  
  720. Main:
  721.     procedure expose !.
  722.  
  723.     arg test .
  724.  
  725.     /* Load OS/2 supplied utilities. */
  726.     call RxFuncAdd 'SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs'
  727.     signal on syntax name SysLoadFailed
  728.     call SysLoadFuncs
  729.     signal on syntax
  730.  
  731.     /* Drop previous definition of library. */
  732.     if \RxFuncQuery('IPCDropFuncs') then call IPCDropFuncs
  733.     call RxFuncDrop 'IPCLoadFuncs'
  734.  
  735.     /* Load new definition or fail. */
  736.     call RxFuncAdd 'IPCLoadFuncs', 'REXXIPC', 'IPCLoadFuncs'
  737.     signal on syntax name IPCLoadFailed
  738.     call IPCLoadFuncs
  739.     signal on syntax
  740.  
  741.     /* External identification. */
  742.     say
  743.     say 'TestIPC V1.10-000.'
  744.     say
  745.     say !._CFG._Configuration._Identification !._CFG._Configuration._Version'.'
  746.     say
  747.     parse value IPCVersion() with producer ipcVersion
  748.     say 'Using' producer ipcVersion'.'
  749.     say
  750.  
  751.     /* Test for minimum RexxIPC version. */
  752.     if producer \= 'SFB' then signal Producer
  753.     parse value Word(ipcVersion, 2) with 'V' !._major '.' !._minor '-' !._revision
  754.     if !._major = 1 then
  755.         if !._minor < 20 then signal Version
  756.         else if !._minor = 20 then
  757.             if !._revision < 103 then signal Version
  758.  
  759.     !._profiler = !._CFG._Configuration._Profiler
  760.     if !._profiler = '' then !._profiler = 0
  761.     else if !._profiler \= 0 & !._profiler \= 1 then signal Config
  762.  
  763.     if Abbrev('MINIMAL', test, 0) then call TestMinimalOperations Arg(1)
  764.     if Abbrev('SEMAPHORE', test, 0) then call TestSemaphoreOperations Arg(1)
  765.     if Abbrev('PIPE', test, 0) then call TestPipeOperations Arg(1)
  766.     if Abbrev('QUEUE', test, 0) then call TestQueueOperations Arg(1)
  767.     if Abbrev('BENCHMARK', test, 1) then call PerformSimpleBenchmark Arg(1)
  768.  
  769.     say 'TestIPC completed.'
  770.  
  771.     return
  772.  
  773.  
  774. SysLoadFailed:
  775.  
  776.     say 'TestIPC needs REXXUTIL functions!'
  777.     signal Abort
  778.  
  779.  
  780. IPCLoadFailed:
  781.  
  782.     say 'Failed to load RexxIPC functions!'
  783.     signal Abort
  784.  
  785.  
  786. Producer:
  787.  
  788.     say 'TestIPC expects SFB as producer!'
  789.     signal Abort
  790.  
  791.  
  792. Version:
  793.  
  794.     say 'TestIPC needs RexxIPC V1.20-103 or later!'
  795.     signal Abort
  796.  
  797.  
  798.  
  799. /*:VRX         MinimalProcess
  800. */
  801.  
  802. /* MinimalProcess -- Created for TestMinimalOperations. */
  803.  
  804. MinimalProcess:
  805.     procedure expose !.
  806.  
  807.     event1 = Arg(1)
  808.     event2 = Arg(2)
  809.  
  810.     /* Resources used. */
  811.     !._event.0 = 1
  812.     !._pipe.0 = 1
  813.  
  814.     /* Try to open what should be a local event. */
  815.     call SemEventOpen event2
  816.     if result \= 006 then signal CallFailed
  817.  
  818.     /* Open and post the supplied event. */
  819.     call SemEventOpen event1
  820.     if result \= 0 then signal CallFailed
  821.     !._event.1 = event1
  822.     call SemEventPost !._event.1
  823.     if result \= 0 then signal CallFailed
  824.  
  825.     /* The server must be waiting on connect. */
  826.     name = !._CFG._Minimal._PipeName
  827.     if name = '' then signal Config
  828.     call PipeOpen '!._pipe.1', name
  829.     if result \= 0 then signal CallFailed
  830.  
  831.     /* Send our PID. */
  832.     call ProcGetThreadInfo , , , 'PID'
  833.     call PipeWrite !._pipe.1, PID
  834.     if result \= 0 then signal CallFailed
  835.  
  836.     /* Get the negated PID as response. */
  837.     call PipeRead !._pipe.1, 'response'
  838.     if result \= 0 then signal CallFailed
  839.     if response \= -PID then signal CheckFailed
  840.  
  841.     /* Disconnect. */
  842.     call PipeClose !._pipe.1
  843.     if result \= 0 then signal CallFailed
  844.     !._pipe.1 = ''
  845.  
  846.     /* Close event. */
  847.     call SemEventClose !._event.1
  848.     if result \= 0 then signal CallFailed
  849.     !._event.1 = ''
  850.  
  851.     /* Resources released. */
  852.     !._event.0 = ''
  853.     !._pipe.0 = ''
  854.  
  855.     call Cleanup
  856.  
  857.     '@EXIT'
  858.  
  859.     return
  860.  
  861.  
  862.  
  863. /*:VRX         MinimalThread
  864. */
  865.  
  866. /* MinimalThread -- Created for TestMinimalOperations. */
  867.  
  868. MinimalThread:
  869.     procedure expose !.
  870.  
  871.     event = Arg(1)
  872.  
  873.     /* Boost priority and test for the C Set++ optimizer
  874.     ** bug triggered when 1st parameter absent. */
  875.     call ProcSetThreadPriority , , +31
  876.     if result \= 0 then signal CallFailed
  877.  
  878.     /* Wait for the calling thread. */
  879.     timeout = !._CFG._Minimal._ThreadTimeout
  880.     if timeout = '' then signal Config
  881.     call SemEventWait event, timeout * 1000
  882.     if result \= 0 then signal CallFailed
  883.  
  884.     return
  885.  
  886.  
  887.  
  888. /*:VRX         PerformSimpleBenchmark
  889. */
  890.  
  891. /* PerformSimpleBenchmark -- Perform a simple benchmark. */
  892.  
  893. PerformSimpleBenchmark:
  894.     procedure expose !.
  895.  
  896.     arg . . encore .
  897.  
  898.     say 'Performing a simple benchmark...'
  899.  
  900.     /* Resources used. */
  901.     !._event.0 = 4
  902.     !._context.0 = 1
  903.  
  904.     /* Open benchmark log file. */
  905.     !._logFile = !._CFG._Benchmark._LogFile
  906.     if !._logFile = '' then signal Config
  907.     if Stream(!._logFile, 'C', 'Open Write') \= 'READY:' then
  908.         signal CheckFailed
  909.     say 'Logging results in "'!._logFile'"...'
  910.     call LineOut !._logFile,,
  911.         'Started' Translate(Date('Ordered'), '-', '/') Time()'.'
  912.  
  913.     /* Get specifications. */
  914.     record.0 = !._CFG._Benchmark._RecordCount
  915.     if record.0 = '' | \DataType(record.0, 'W') then signal Config
  916.     length = !._CFG._Benchmark._RecordLength
  917.     if length = '' | \DataType(length, 'W') then signal Config
  918.     say 'Using' record.0 'records of' length 'bytes...'
  919.     call LineOut !._logFile,,
  920.         'With' record.0 'records of' length 'bytes.'
  921.  
  922.     /* Event 1 will be used as origin thread ready indicator. */
  923.     call SemEventCreate '!._event.1'
  924.     if result \= 0 then signal CallFailed
  925.  
  926.     /* Event 2 will be used as destination thread ready indicator. */
  927.     call SemEventCreate '!._event.2'
  928.     if result \= 0 then signal CallFailed
  929.  
  930.     /* Context 1 will be used for thread monitoring. */
  931.     call IPCContextCreate '!._context.1'
  932.     if result \= 0 then signal CallFailed
  933.  
  934.     /* Clear the session queue. */
  935.     do while Queued() > 0
  936.         pull anything
  937.     end
  938.  
  939.     /* Start the destination thread. */
  940.     call ProcCreateThread !._context.1, !._source,,
  941.         'call BenchmarkThread' !._event.1',' !._event.2', "'Arg(1)'"'
  942.     if result \= 0 then signal CallFailed
  943.  
  944.     /* Create the data records. */
  945.     say 'Generating test data...'
  946.     call Time 'Reset'
  947.     do i = 1 to record.0
  948.         record = ''
  949.         do while Length(record) < length
  950.             record = record || X2B(D2X(Random(0, 65535), 4))
  951.         end
  952.         record.i = Left(record, length)
  953.         queue record.i
  954.     end
  955.     call Time 'Reset'
  956.     call LineOut !._logFile,,
  957.             'Test data generation:' Trunc(result, 2) 'seconds.'
  958.     say 'Test data generated.'
  959.     say
  960.  
  961.     /* Thread benchmark. */
  962.     say 'Thread to thread transfers.'
  963.     say
  964.     call LineOut !._logFile, 'Thread to thread.'
  965.  
  966.     /* Wait for the destination thread to be ready. */
  967.     call SemEventWait !._event.2
  968.     if result \= 0 then signal CallFailed
  969.     call SemEventReset !._event.2
  970.     if result \= 0 then signal CallFailed
  971.  
  972.     /* Do the origin part of the benchmark. */
  973.     call BenchMarkOrigin !._event.1, !._event.2, Arg(1)
  974.  
  975.     /* The process benchmark is skipped when profiling. */
  976.     if \!._profiler then do
  977.         /* Event 3 will be used as origin process ready indicator. */
  978.         call SemEventCreate '!._event.3', 'Shared'
  979.         if result \= 0 then signal CallFailed
  980.  
  981.         /* Event 4 will be used as destination process ready indicator. */
  982.         call SemEventCreate '!._event.4', 'Shared'
  983.         if result \= 0 then signal CallFailed
  984.  
  985.         /* Save benchmark data for process. */
  986.         if !._file = '' then do
  987.             !._file = !._source._pathName'.TMP'
  988.             if Stream(!._file, 'C', 'Open Write') \= 'READY:' then
  989.                 signal CheckFailed
  990.             call LineOut !._file, , 1
  991.             do i = 1 to record.0
  992.                 call LineOut !._file, record.i
  993.                 if result \= 0 then signal CallFailed
  994.             end
  995.             call Stream !._file, 'C', 'Close'
  996.         end
  997.  
  998.         /* Process benchmark. */
  999.         say 'Process to process transfers.'
  1000.         say
  1001.         call LineOut !._logFile, 'Process to process.'
  1002.  
  1003.         /* Start the destination process. */
  1004.         '@START "TestIPC Benchmark" /B /WIN /MIN' !._source,
  1005.             'call BenchmarkProcess' !._event.3',' !._event.4',"'Arg(1)'"'
  1006.  
  1007.         /* Wait for destination process to be ready. */
  1008.         call SemEventWait !._event.4
  1009.         if result \= 0 then signal CallFailed
  1010.         call SemEventReset !._event.4
  1011.         if result \= 0 then signal CallFailed
  1012.  
  1013.         /* Delete the temporary data file. */
  1014.         call SysFileDelete !._file
  1015.         if result \= 0 then signal CallFailed
  1016.         !._file = ''
  1017.  
  1018.         /* Do the origin part of the benchmark. */
  1019.         call BenchMarkOrigin !._event.3, !._event.4, Arg(1)
  1020.     end
  1021.  
  1022.     /* Encore if specified. */
  1023.     if encore = '' then encore = !._CFG._Benchmark._Encore
  1024.     if encore = '' then encore = 0
  1025.     else if \DataType(encore, 'W') then signal Config
  1026.     do encore
  1027.         /* Thread benchmark. */
  1028.         say 'Thread to thread transfers.'
  1029.         say
  1030.         call LineOut !._logFile, 'Thread to thread.'
  1031.  
  1032.         /* Delete the temporary data file. */
  1033.         if !._file \= '' then do
  1034.             call SysFileDelete !._file
  1035.             if result \= 0 then signal CallFailed
  1036.             !._file = ''
  1037.         end
  1038.  
  1039.         /* Do the origin part of the benchmark. */
  1040.         call BenchMarkOrigin !._event.1, !._event.2, Arg(1)
  1041.  
  1042.         /* The process benchmark is skipped when profiling. */
  1043.         if \!._profiler then do
  1044.             /* Process benchmark. */
  1045.             say 'Process to process transfers.'
  1046.             say
  1047.             call LineOut !._logFile, 'Process to process.'
  1048.  
  1049.             /* Delete the temporary data file. */
  1050.             if !._file \= '' then do
  1051.                 call SysFileDelete !._file
  1052.                 if result \= 0 then signal CallFailed
  1053.                 !._file = ''
  1054.             end
  1055.  
  1056.             /* Do the origin part of the benchmark. */
  1057.             call BenchMarkOrigin !._event.3, !._event.4, Arg(1)
  1058.         end
  1059.     end
  1060.  
  1061.     /* Wait for completion of destination thread. */
  1062.     call IPCContextWait !._context.1
  1063.     if result \= 0 then signal CallFailed
  1064.  
  1065.     /* Close context. */
  1066.     call IPCContextClose !._context.1
  1067.     if result \= 0 then signal CallFailed
  1068.     !._context.1 = ''
  1069.  
  1070.     /* Close events. */
  1071.     call SemEventClose !._event.1
  1072.     if result \= 0 then signal CallFailed
  1073.     !._event.1 = ''
  1074.     call SemEventClose !._event.2
  1075.     if result \= 0 then signal CallFailed
  1076.     !._event.2 = ''
  1077.     if \!._profiler then do
  1078.         call SemEventClose !._event.3
  1079.         if result \= 0 then signal CallFailed
  1080.         !._event.3 = ''
  1081.         call SemEventClose !._event.4
  1082.         if result \= 0 then signal CallFailed
  1083.         !._event.4 = ''
  1084.     end
  1085.  
  1086.     /* Close the log file. */
  1087.     call LineOut !._logFile, ''
  1088.     call Stream !._logFile, 'C', 'Close'
  1089.     !._logFile = ''
  1090.  
  1091.     /* Delete the temporary data file. */
  1092.     if !._file \= '' then do
  1093.         call SysFileDelete !._file
  1094.         if result \= 0 then signal CallFailed
  1095.         !._file = ''
  1096.     end
  1097.  
  1098.     /* Resources released. */
  1099.     !._event.0 = ''
  1100.     !._context.0 = ''
  1101.  
  1102.     say 'Simple benchmark completed.'
  1103.     say
  1104.  
  1105.     return
  1106.  
  1107.  
  1108.  
  1109. /*:VRX         PipeThread
  1110. */
  1111.  
  1112. /* PipeThread -- Created for TestPipeOperations. */
  1113.  
  1114. PipeThread:
  1115.     procedure expose !.
  1116.  
  1117.     event = Arg(1)
  1118.  
  1119.     /* Resources used. */
  1120.     !._pipe.0 = 1
  1121.  
  1122.     /* Get the pipe name. */
  1123.     pipeName = !._CFG._Pipe._PipeName
  1124.     if pipeName = '' then signal Config
  1125.  
  1126.     /* Get a timeout value. */
  1127.     timeout = !._CFG._Pipe._Timeout
  1128.     if timeout = '' | \DataType(timeout, 'W') then signal Config
  1129.  
  1130.     /* Wait for the main to be ready. */
  1131.     call SemEventWait event, timeout * 1000
  1132.     if result \= 0 then signal CallFailed
  1133.     call SemEventReset event
  1134.     if result \= 0 then signal CallFailed
  1135.  
  1136.     /* Wait for the connect. */
  1137.     call PipeWait pipeName, timeout * 1000
  1138.     if result \= 0 then signal CallFailed
  1139.  
  1140.     /* Open the pipe. */
  1141.     call PipeOpen '!._pipe.1', pipeName
  1142.     if result \= 0 then signal CallFailed
  1143.  
  1144.     /* Get some data and return it reversed. */
  1145.     call PipeRead !._pipe.1, 'data'
  1146.     if result \= 0 then signal CallFailed
  1147.     call PipeWrite !._pipe.1, Reverse(data)
  1148.     if result \= 0 then signal CallFailed
  1149.  
  1150.     /* Close the pipe. */
  1151.     call PipeClose !._pipe.1
  1152.     if result \= 0 then signal CallFailed
  1153.     !._pipe.1 = ''
  1154.  
  1155.     /* Wait for the main to be ready. */
  1156.     call SemEventWait event, timeout * 1000
  1157.     if result \= 0 then signal CallFailed
  1158.     call SemEventReset event
  1159.     if result \= 0 then signal CallFailed
  1160.  
  1161.     /* Wait for the connect. */
  1162.     call PipeWait pipeName, timeout * 1000
  1163.     if result \= 0 then signal CallFailed
  1164.  
  1165.     /* Open the pipe (this should fail). */
  1166.     call PipeOpen '!._pipe.1', pipeName
  1167.     if result \= 087 then signal CallFailed
  1168.  
  1169.     /* Wait for the connect. */
  1170.     call PipeWait pipeName, timeout * 1000
  1171.     if result \= 0 then signal CallFailed
  1172.  
  1173.     /* Open the pipe (this should fail again). */
  1174.     call PipeOpen '!._pipe.1', pipeName, 'Duplex', 'Message'
  1175.     if result \= 087 then signal CallFailed
  1176.  
  1177.     /* Wait for the connect. */
  1178.     call PipeWait pipeName, timeout * 1000
  1179.     if result \= 0 then signal CallFailed
  1180.  
  1181.     /* Open the pipe (this should succeed). */
  1182.     call PipeOpen '!._pipe.1', pipeName, 'Duplex', 'Byte'
  1183.     if result \= 0 then signal CallFailed
  1184.  
  1185.     /* Get some data and return it reversed. */
  1186.     call PipeRead !._pipe.1, 'data'
  1187.     if result \= 0 then signal CallFailed
  1188.     call PipeWrite !._pipe.1, Reverse(data)
  1189.     if result \= 0 then signal CallFailed
  1190.  
  1191.     /* Close the pipe. */
  1192.     call PipeClose !._pipe.1
  1193.     if result \= 0 then signal CallFailed
  1194.     !._pipe.1 = ''
  1195.  
  1196.     /* Wait for the main to be ready. */
  1197.     call SemEventWait event, timeout * 1000
  1198.     if result \= 0 then signal CallFailed
  1199.     call SemEventReset event
  1200.     if result \= 0 then signal CallFailed
  1201.  
  1202.     /* Wait for the connect. */
  1203.     call PipeWait pipeName, timeout * 1000
  1204.     if result \= 0 then signal CallFailed
  1205.  
  1206.     /* Open the pipe (this should fail). */
  1207.     call PipeOpen '!._pipe.1', pipeName
  1208.     if result \= 005 then signal CallFailed
  1209.  
  1210.     /* Open the pipe (this should fail also). */
  1211.     call PipeOpen '!._pipe.1', pipeName, 'Outbound'
  1212.     if result \= 005 then signal CallFailed
  1213.  
  1214.     /* Open the pipe (this should succees). */
  1215.     call PipeOpen '!._pipe.1', pipeName, 'Inbound'
  1216.     if result \= 0 then signal CallFailed
  1217.  
  1218.     /* Get some data. */
  1219.     call PipeRead !._pipe.1, 'data'
  1220.     if result \= 0 then signal CallFailed
  1221.  
  1222.     /* Close the pipe. */
  1223.     call PipeClose !._pipe.1
  1224.     if result \= 0 then signal CallFailed
  1225.     !._pipe.1 = ''
  1226.  
  1227.     /* Wait for the main to be ready. */
  1228.     call SemEventWait event, timeout * 1000
  1229.     if result \= 0 then signal CallFailed
  1230.     call SemEventReset event
  1231.     if result \= 0 then signal CallFailed
  1232.  
  1233.     /* Wait for the connect. */
  1234.     call PipeWait pipeName, timeout * 1000
  1235.     if result \= 0 then signal CallFailed
  1236.  
  1237.     /* Open the pipe (this should fail). */
  1238.     call PipeOpen '!._pipe.1', pipeName
  1239.     if result \= 005 then signal CallFailed
  1240.  
  1241.     /* Open the pipe (this should fail also). */
  1242.     call PipeOpen '!._pipe.1', pipeName, 'Inbound'
  1243.     if result \= 005 then signal CallFailed
  1244.  
  1245.     /* Open the pipe (this should succees). */
  1246.     call PipeOpen '!._pipe.1', pipeName, 'Outbound'
  1247.     if result \= 0 then signal CallFailed
  1248.  
  1249.     /* Get some data (this should fail. */
  1250.     call PipeRead !._pipe.1, 'data'
  1251.     if result \= 005 then signal CallFailed
  1252.  
  1253.     /* Send some data. */
  1254.     call PipeWrite !._pipe.1, 'A'
  1255.     if result \= 0 then signal CallFailed
  1256.  
  1257.     /* Close the pipe. */
  1258.     call PipeClose !._pipe.1
  1259.     if result \= 0 then signal CallFailed
  1260.     !._pipe.1 = ''
  1261.  
  1262.     /* Resources released. */
  1263.     !._pipe.0 = ''
  1264.  
  1265.     return
  1266.  
  1267.  
  1268.  
  1269. /*:VRX         QueueProcess
  1270. */
  1271.  
  1272. /* QueueProcess -- Created for TestQueueOperations. */
  1273.  
  1274. QueueProcess:
  1275.     procedure expose !.
  1276.  
  1277.     event = Arg(1)
  1278.  
  1279.     /* Resources used. */
  1280.     !._queue.0 = 1
  1281.     !._event.0 = 1
  1282.  
  1283.     /* Get the queue name. */
  1284.     queueName = !._CFG._Queue._QueueName
  1285.     if queueName = '' then signal Config
  1286.  
  1287.     /* Open the queue. */
  1288.     call QueueOpen '!._queue.1', queueName
  1289.     if result \= 0 then signal CallFailed
  1290.  
  1291.     /* Open the event. */
  1292.     call SemEventOpen event
  1293.     if result \= 0 then signal CallFailed
  1294.     !._event.1 = event
  1295.  
  1296.     /* Get data value. */
  1297.     data = !._CFG._Queue._ProcessData
  1298.     if data = '' then signal Config
  1299.  
  1300.     /* Queue to the server. */
  1301.     call QueueWrite !._queue.1, data
  1302.     if result \= 0 then signal CallFailed
  1303.     call QueueWrite !._queue.1, Reverse(data)
  1304.     if result \= 0 then signal CallFailed
  1305.  
  1306.     /* Close the queue. */
  1307.     call QueueClose !._queue.1
  1308.     if result \= 0 then signal CallFailed
  1309.     !._queue.1 = ''
  1310.  
  1311.     /* Post the event for the server. */
  1312.     call SemEventPost !._event.1
  1313.     if result \= 0 then signal CallFailed
  1314.  
  1315.     /* Close the event. */
  1316.     call SemEventClose !._event.1
  1317.     if result \= 0 then signal CallFailed
  1318.     !._event.1 = ''
  1319.  
  1320.     /* Resources released. */
  1321.     !._queue.0 = ''
  1322.     !._event.0 = ''
  1323.  
  1324.     call Cleanup
  1325.  
  1326.     '@EXIT'
  1327.  
  1328.     return
  1329.  
  1330.  
  1331.  
  1332. /*:VRX         QueueThread
  1333. */
  1334.  
  1335. /* QueueThread -- Created for TestQueueOperations. */
  1336.  
  1337. QueueThread:
  1338.     procedure expose !.
  1339.  
  1340.     queue = Arg(1)
  1341.  
  1342.     /* Get data value. */
  1343.     data = !._CFG._Queue._ThreadData
  1344.     if data = '' then signal Config
  1345.  
  1346.     /* Queue to the server. */
  1347.     call QueueWrite queue, data, 1, 2
  1348.     if result \= 0 then signal CallFailed
  1349.     call QueueWrite queue, data, 2, 3
  1350.     if result \= 0 then signal CallFailed
  1351.     call QueueWrite queue, data, 3, 1
  1352.     if result \= 0 then signal CallFailed
  1353.  
  1354.     return
  1355.  
  1356.  
  1357.  
  1358. /*:VRX         SemaphoreThread
  1359. */
  1360.  
  1361. /* SemaphoreThread -- Created for TestSemaphoreOperations. */
  1362.  
  1363. SemaphoreThread:
  1364.     procedure expose !.
  1365.  
  1366.     event = Arg(1)
  1367.     mutex = Arg(2)
  1368.     muxwait = Arg(3)
  1369.  
  1370.     /* Resources used. */
  1371.     !._event.0 = 1
  1372.     !._mutex.0 = 1
  1373.     !._muxwait.0 = 1
  1374.  
  1375.     /* Open the named event semaphore. */
  1376.     name = !._CFG._Semaphore._EventName
  1377.     if name = '' then signal Config
  1378.     call SemEventOpen '!._event.1', name
  1379.     if result \= 0 then signal CallFailed
  1380.  
  1381.     /* Open the named mutex semaphore. */
  1382.     name = !._CFG._Semaphore._MutexName
  1383.     if name = '' then signal Config
  1384.     call SemMutexOpen '!._mutex.1', name
  1385.     if result \= 0 then signal CallFailed
  1386.  
  1387.     /* Open the named muxwait semaphore. */
  1388.     name = !._CFG._Semaphore._MuxwaitName
  1389.     if name = '' then signal Config
  1390.     call SemMuxwaitOpen '!._muxwait.1', name
  1391.     if result \= 0 then signal CallFailed
  1392.  
  1393.     /* Get a timeout value. */
  1394.     timeout = !._CFG._Semaphore._Timeout
  1395.     if timeout = '' | \DataType(timeout, 'W') then signal Config
  1396.  
  1397.     /* Wait for the mutex to be available. */
  1398.     call SemMutexRequest mutex, timeout * 1000
  1399.     if result \= 0 then signal CallFailed
  1400.  
  1401.     /* Request the named mutex. */
  1402.     call SemMutexRequest !._mutex.1, 0
  1403.     if result \= 0 then signal CallFailed
  1404.  
  1405.     /* Post the event. */
  1406.     call SemEventPost event
  1407.     if result \= 0 then signal CallFailed
  1408.  
  1409.     /* Release the mutex. */
  1410.     call SemMutexRelease mutex
  1411.     if result \= 0 then signal CallFailed
  1412.  
  1413.     /* Wait for signal from main. */
  1414.     call SemEventWait !._event.1, timeout * 1000
  1415.     if result \= 0 then signal CallFailed
  1416.     call SemEventReset !._event.1
  1417.     if result \= 0 then signal CallFailed
  1418.  
  1419.     /* Release the named mutex. */
  1420.     call SemMutexRelease !._mutex.1
  1421.     if result \= 0 then signal CallFailed
  1422.  
  1423.     /* Post the named event. */
  1424.     call SemEventPost !._event.1
  1425.     if result \= 0 then signal CallFailed
  1426.  
  1427.     /* Close the semaphores. */
  1428.     call SemEventClose !._event.1
  1429.     if result \= 0 then signal CallFailed
  1430.     !._event.1 = ''
  1431.     call SemMutexClose !._mutex.1
  1432.     if result \= 0 then signal CallFailed
  1433.     !._mutex.1 = ''
  1434.     call SemmuxwaitClose !._muxwait.1
  1435.     if result \= 0 then signal CallFailed
  1436.     !._muxwait.1 = ''
  1437.  
  1438.     /* Resources released. */
  1439.     !._event.0 = ''
  1440.     !._muxwait.0 = ''
  1441.     !._mutex.0 = ''
  1442.  
  1443.     return
  1444.  
  1445.  
  1446.  
  1447. /*:VRX         Signals
  1448. */
  1449.  
  1450. /* Signals. */
  1451.  
  1452. Halt:
  1453.  
  1454.     say 'Halted (line' sigl')!'
  1455.     signal Abort
  1456.  
  1457.  
  1458. Failure:
  1459.  
  1460.     say 'Failure (line' sigl', code' rc')!'
  1461.     say 'On command "'Condition('D')'"'
  1462.     signal abort
  1463.  
  1464.  
  1465. Error:
  1466.  
  1467.     say 'Error (line' sigl', code' rc')!'
  1468.     say 'On command "'Condition('D')'"'
  1469.     signal abort
  1470.  
  1471.  
  1472. Syntax:
  1473.  
  1474.     say 'Rexx syntax error detected (line' sigl')!'
  1475.     say 'On string "'Condition('D')'"!'
  1476.     say ErrorText(rc)'!'
  1477.     signal Abort
  1478.  
  1479.  
  1480. NoValue:
  1481.  
  1482.     say 'Undefined variable "'Condition('D')'" (line' sigl')!'
  1483.     signal Abort
  1484.  
  1485.  
  1486. NotReady:
  1487.  
  1488.     stream = Condition('D')
  1489.     say 'I/O error on stream "'stream'" (line' sigl')!'
  1490.     say '"'Stream(stream, 'D')'"!'
  1491.     signal Abort
  1492.  
  1493.  
  1494. CallFailed:
  1495.  
  1496.     say 'Test failed (line 'sigl - 1', code 'result')!'
  1497.     signal Abort
  1498.  
  1499.  
  1500. Config:
  1501.  
  1502.     say 'Configuration file error (line 'SIGL')!'
  1503.     signal Abort
  1504.  
  1505.  
  1506. CheckFailed:
  1507.  
  1508.     say 'Validity check failed (line 'SIGL')!'
  1509.     signal Abort
  1510.  
  1511.  
  1512. Abort:
  1513.  
  1514.     call Cleanup
  1515.     exit 1
  1516.  
  1517.  
  1518.  
  1519. /*:VRX         TestMinimalOperations
  1520. */
  1521.  
  1522. /* TestMinimalOperations -- Test minimal operations.
  1523. **
  1524. ** This procedure test the minimal operations
  1525. ** needed to perform the other tests.
  1526. **
  1527. ** Note: the asynchronous form of pipe calls
  1528. ** is used here to be able to detect malfunctions
  1529. ** with a timeout on event. */
  1530.  
  1531. TestMinimalOperations:
  1532.     procedure expose !.
  1533.  
  1534.     say 'Testing minimal operations...'
  1535.  
  1536.     /* Resources used. */
  1537.     !._event.0 = 2
  1538.     !._context.0 = 1
  1539.     !._pipe.0 = 1
  1540.  
  1541.     /* Event 1 will be used by context 1. */
  1542.     call SemEventCreate '!._event.1'
  1543.     if result \= 0 then signal CallFailed
  1544.  
  1545.     /* Context 1 will be used for thread monitoring and pipe operations. */
  1546.     call IPCContextCreate '!._context.1', !._event.1
  1547.     if result \= 0 then signal CallFailed
  1548.     call IPCContextQuery !._context.1, 'thread'
  1549.     if result \= 0 then signal CallFailed
  1550.     if thread \= 0 then signal CheckFailed
  1551.  
  1552.     /* Event 2 will be used for thread and process synchronisation. */
  1553.     call SemEventCreate '!._event.2', 'Shared'
  1554.     if result \= 0 then signal CallFailed
  1555.  
  1556.     /* Create the collaborating thread. */
  1557.     call ProcCreateThread !._context.1, !._source,,
  1558.         'call MinimalThread' !._event.2
  1559.     if result \= 0 then signal CallFailed
  1560.  
  1561.     /* Thread will be waiting for this. */
  1562.     call SemEventPost !._event.2
  1563.     if result \= 0 then signal CallFailed
  1564.  
  1565.     /* Get a thread timeout value. */
  1566.     timeout = !._CFG._Minimal._ThreadTimeout
  1567.     if timeout = '' | \DataType(timeout, 'W') then signal Config
  1568.  
  1569.     /* Wait for thread completion. */
  1570.     call SemEventWait !._event.1, timeout * 1000
  1571.     if result \= 0 then signal CallFailed
  1572.     call IPCContextQuery !._context.1
  1573.     if result \= 0 then signal CallFailed
  1574.  
  1575.     /* First event 2 reset should return success. */
  1576.     call SemEventReset !._event.2
  1577.     if result \= 0 then signal CallFailed
  1578.  
  1579.     /* Second event 2 reset should return failure. */
  1580.     call SemEventReset !._event.2
  1581.     if result \= 300 then signal CallFailed
  1582.  
  1583.     /* The process tests are skipped when profiling. */
  1584.     if \!._profiler then do
  1585.         /* Pipe 1 will be used for process handshaking. */
  1586.         name = !._CFG._Minimal._PipeName
  1587.         if name = '' then signal Config
  1588.         call PipeCreate '!._pipe.1', name
  1589.         if result \= 0 then signal CallFailed
  1590.  
  1591.         /* Start listening for a client. */
  1592.         call PipeConnectAsync !._pipe.1, !._context.1
  1593.         if result \= 0 then signal CallFailed
  1594.         call IPCContextQuery !._context.1, 'thread'
  1595.         if result \= 170 then signal CallFailed
  1596.         if thread = 0 then signal CheckFailed
  1597.  
  1598.         /* This wait should fail on timeout. */
  1599.         call SemEventWait !._event.1, 1
  1600.         if result \= 640 then signal CallFailed
  1601.  
  1602.         /* Start the client process. */
  1603.         '@START "TestIPC Minimal" /B /WIN /MIN' !._source,
  1604.             'call MinimalProcess' !._event.2',' !._event.1
  1605.  
  1606.         /* Get a process timeout value. */
  1607.         timeout = !._CFG._Minimal._ProcessTimeout
  1608.         if timeout = '' | \DataType(timeout, 'W') then signal Config
  1609.  
  1610.         /* Wait for the client to post the shared event. */
  1611.         call SemEventWait !._event.2, timeout * 1000
  1612.         if result \= 0 then signal CallFailed
  1613.  
  1614.         /* Wait for the client to request a connection. */
  1615.         call SemEventWait !._event.1, timeout * 1000
  1616.         if result \= 0 then signal CallFailed
  1617.         call IPCContextQuery !._context.1
  1618.         if result \= 0 then signal CallFailed
  1619.  
  1620.         /* Wait for the client to write on the pipe. */
  1621.         call PipeReadAsync !._pipe.1, !._context.1
  1622.         if result \= 0 then signal CallFailed
  1623.         call SemEventWait !._event.1, timeout * 1000
  1624.         if result \= 0 then signal CallFailed
  1625.         call IPCContextQuery !._context.1
  1626.         if result \= 0 then signal CallFailed
  1627.  
  1628.         /* The received data should be the client PID. */
  1629.         PID = IPCContextResult(!._context.1)
  1630.  
  1631.         /* Test for the ReadAsync bug. */
  1632.         call PipeReadAsync !._pipe.1, !._context.1
  1633.         if result \= 0 then signal CallFailed
  1634.         call IPCContextClose !._context.1
  1635.         if result \= 0 then signal CallFailed
  1636.         !._context.1 = ''
  1637.         call IPCContextCreate '!._context.1', !._event.1
  1638.         if result \= 0 then signal CallFailed
  1639.  
  1640.         /* Negate PID as response and wait for the client to read it. */
  1641.         call PipeWriteAsync !._pipe.1, !._context.1, -PID
  1642.         if result \= 0 then signal CallFailed
  1643.         call SemEventWait !._event.1, timeout * 1000
  1644.         if result \= 0 then signal CallFailed
  1645.         call IPCContextQuery !._context.1
  1646.         if result \= 0 then signal CallFailed
  1647.  
  1648.         /* Wait for the client to disconnect the pipe. */
  1649.         call PipeReadAsync !._pipe.1, !._context.1
  1650.         if result \= 0 then signal CallFailed
  1651.         call SemEventWait !._event.1, timeout * 1000
  1652.         if result \= 0 then signal CallFailed
  1653.         call IPCContextQuery !._context.1
  1654.         if result \= 0 then signal CallFailed
  1655.         if IPCContextResult(!._context.1) \= '' then signal CheckFailed
  1656.  
  1657.         /* Disconnect the server. */
  1658.         call PipeDisconnect !._pipe.1
  1659.         if result \= 0 then signal CallFailed
  1660.  
  1661.         /* Close the server's pipe. */
  1662.         call PipeClose !._pipe.1
  1663.         if result \= 0 then signal CallFailed
  1664.         !._pipe.1 = ''
  1665.     end
  1666.  
  1667.     /* Close the context. */
  1668.     call IPCContextClose !._context.1
  1669.     if result \= 0 then signal CallFailed
  1670.     !._context.1 = ''
  1671.  
  1672.     /* Close events. */
  1673.     call SemEventClose !._event.1
  1674.     if result \= 0 then signal CallFailed
  1675.     !._event.1 = ''
  1676.     call SemEventClose !._event.2
  1677.     if result \= 0 then signal CallFailed
  1678.     !._event.2 = ''
  1679.  
  1680.     /* Resources released. */
  1681.     !._event.0 = ''
  1682.     !._context.0 = ''
  1683.     !._pipe.0 = ''
  1684.  
  1685.     say 'Minimal operations test completed.'
  1686.     say
  1687.  
  1688.     return
  1689.  
  1690.  
  1691.  
  1692. /*:VRX         TestPipeOperations
  1693. */
  1694.  
  1695. /* TestPipeOperations -- Test pipe operations. */
  1696.  
  1697. TestPipeOperations:
  1698.     procedure expose !.
  1699.  
  1700.     say 'Testing pipe operations...'
  1701.  
  1702.     /* Resources used. */
  1703.     !._event.0 = 1
  1704.     !._pipe.0 = 3
  1705.     !._context.0 = 1
  1706.  
  1707.     /* Get the pipe name. */
  1708.     pipeName = !._CFG._Pipe._PipeName
  1709.     if pipeName = '' then signal Config
  1710.  
  1711.     /* Get a timeout value. */
  1712.     timeout = !._CFG._Pipe._Timeout
  1713.     if timeout = '' | \DataType(timeout, 'W') then signal Config
  1714.  
  1715.     /* Create synchronization event. */
  1716.     call SemEventCreate '!._event.1'
  1717.     if result \= 0 then signal CallFailed
  1718.  
  1719.     /* Create a context for the thread. */
  1720.     call IPCContextCreate '!._context.1'
  1721.     if result \= 0 then signal CallFailed
  1722.  
  1723.     /* Create the collaborating thread. */
  1724.     call ProcCreateThread !._context.1, !._source,,
  1725.         'call PipeThread' !._event.1
  1726.     if result \= 0 then signal CallFailed
  1727.  
  1728.     /* Create a message pipe. */
  1729.     call PipeCreate '!._pipe.1', pipeName, 'Duplex', 'Message'
  1730.     if result \= 0 then signal CallFailed
  1731.  
  1732.     /* It should not be possible to create a clone. */
  1733.     call PipeCreate '!._pipe.2', pipeName
  1734.     if result \= 231 then signal CallFailed
  1735.  
  1736.     /* Signal that the main is ready. */
  1737.     call SemEventPost !._event.1
  1738.     if result \= 0 then signal CallFailed
  1739.  
  1740.     /* Wait for the thread to connect. */
  1741.     call PipeConnect !._pipe.1
  1742.     if result \= 0 then signal CallFailed
  1743.  
  1744.     /* Send and receive some data. */
  1745.     data = 'AB'
  1746.     call PipeWrite !._pipe.1, data
  1747.     if result \= 0 then signal CallFailed
  1748.     call PipeRead !._pipe.1, 'received'
  1749.     if result \= 0 then signal CallFailed
  1750.     if received \= Reverse(data) then signal CheckFailed
  1751.  
  1752.     /* Close the pipe. */
  1753.     call PipeClose !._pipe.1
  1754.     if result \= 0 then signal CallFailed
  1755.     !._pipe.1 = ''
  1756.  
  1757.     /* Create a byte pipe. */
  1758.     call PipeCreate '!._pipe.1', pipeName, 'Duplex', 'Byte', 2
  1759.     if result \= 0 then signal CallFailed
  1760.  
  1761.     /* It should be possible to create a clone. */
  1762.     call PipeCreate '!._pipe.2', pipeName
  1763.     if result \= 0 then signal CallFailed
  1764.  
  1765.     /* But not 2 clones. */
  1766.     call PipeCreate '!._pipe.3', pipeName
  1767.     if result \= 231 then signal CallFailed
  1768.  
  1769.     /* Close the clone. */
  1770.     call PipeClose !._pipe.2
  1771.     if result \= 0 then signal CallFailed
  1772.     !._pipe.2 = ''
  1773.  
  1774.     /* Signal that the main is ready. */
  1775.     call SemEventPost !._event.1
  1776.     if result \= 0 then signal CallFailed
  1777.  
  1778.     /* Wait for the thread to connect. */
  1779.     call PipeConnect !._pipe.1
  1780.     if result \= 0 then signal CallFailed
  1781.  
  1782.     /* A send should fail. */
  1783.     call PipeWrite !._pipe.1, 'A'
  1784.     if result \= 109 then signal CallFailed
  1785.     call PipeDisconnect !._pipe.1
  1786.     if result \= 0 then signal CallFailed
  1787.  
  1788.     /* Wait for the thread to connect again. */
  1789.     call PipeConnect !._pipe.1
  1790.     if result \= 0 then signal CallFailed
  1791.  
  1792.     /* A send should fail again. */
  1793.     call PipeWrite !._pipe.1, 'A'
  1794.     if result \= 109 then signal CallFailed
  1795.     call PipeDisconnect !._pipe.1
  1796.     if result \= 0 then signal CallFailed
  1797.  
  1798.     /* Wait for the thread to connect again. */
  1799.     call PipeConnect !._pipe.1
  1800.     if result \= 0 then signal CallFailed
  1801.  
  1802.     /* Send and receive some data. */
  1803.     data = 'AB'
  1804.     call PipeWrite !._pipe.1, data
  1805.     if result \= 0 then signal CallFailed
  1806.     call PipeRead !._pipe.1, 'received'
  1807.     if result \= 0 then signal CallFailed
  1808.     if received \= Reverse(data) then signal CheckFailed
  1809.  
  1810.     /* Close the pipe. */
  1811.     call PipeClose !._pipe.1
  1812.     if result \= 0 then signal CallFailed
  1813.     !._pipe.1 = ''
  1814.  
  1815.     /* Create an outbound pipe. */
  1816.     call PipeCreate '!._pipe.1', pipeName, 'Outbound'
  1817.     if result \= 0 then signal CallFailed
  1818.  
  1819.     /* Signal that the main is ready. */
  1820.     call SemEventPost !._event.1
  1821.     if result \= 0 then signal CallFailed
  1822.  
  1823.     /* Wait for the thread to connect. */
  1824.     call PipeConnect !._pipe.1
  1825.     if result \= 0 then signal CallFailed
  1826.  
  1827.     /* Send some data. */
  1828.     call PipeWrite !._pipe.1, 'A'
  1829.     if result \= 0 then signal CallFailed
  1830.  
  1831.     /* Receive some data (this should fail). */
  1832.     call PipeRead !._pipe.1, 'received'
  1833.     if result \= 005 then signal CallFailed
  1834.  
  1835.     /* Close the pipe. */
  1836.     call PipeClose !._pipe.1
  1837.     if result \= 0 then signal CallFailed
  1838.     !._pipe.1 = ''
  1839.  
  1840.     /* Create an inbound pipe. */
  1841.     call PipeCreate '!._pipe.1', pipeName, 'Inbound'
  1842.     if result \= 0 then signal CallFailed
  1843.  
  1844.     /* Signal that the main is ready. */
  1845.     call SemEventPost !._event.1
  1846.     if result \= 0 then signal CallFailed
  1847.  
  1848.     /* Wait for the thread to connect. */
  1849.     call PipeConnect !._pipe.1
  1850.     if result \= 0 then signal CallFailed
  1851.  
  1852.     /* Send some data (this should fail). */
  1853.     call PipeWrite !._pipe.1, 'A'
  1854.     if result \= 005 then signal CallFailed
  1855.  
  1856.     /* Receive some data. */
  1857.     call PipeRead !._pipe.1, 'received'
  1858.     if result \= 0 then signal CallFailed
  1859.  
  1860.     /* Close the pipe. */
  1861.     call PipeClose !._pipe.1
  1862.     if result \= 0 then signal CallFailed
  1863.     !._pipe.1 = ''
  1864.  
  1865.     /* Wait for completion of collaborating thread. */
  1866.     call IPCContextWait !._context.1
  1867.     if result \= 0 then signal CallFailed
  1868.  
  1869.     /* Close the context. */
  1870.     call IPCContextClose !._context.1
  1871.     if result \= 0 then signal CallFailed
  1872.     !._context.1 = ''
  1873.  
  1874.     /* Close the event. */
  1875.     call SemEventClose !._event.1
  1876.     if result \= 0 then signal CallFailed
  1877.     !._event.1 = ''
  1878.  
  1879.     /* Resources released. */
  1880.     !._event.0 = ''
  1881.     !._pipe.0 = ''
  1882.     !._context.0 = ''
  1883.  
  1884.     say 'Pipe operations test completed.'
  1885.     say
  1886.  
  1887.     return
  1888.  
  1889.  
  1890.  
  1891. /*:VRX         TestQueueOperations
  1892. */
  1893.  
  1894. /* TestQueueOperations -- Test queue operations. */
  1895.  
  1896. TestQueueOperations:
  1897.     procedure expose !.
  1898.  
  1899.     /* Queue operations implementation starts with V1.21-100. */
  1900.     if !._major = 1 then
  1901.         if !._minor <= 20 then return
  1902.         else if !._minor = 21 then
  1903.             if !._revision < 100 then return
  1904.  
  1905.     say 'Testing queue operations...'
  1906.  
  1907.     /* Resources used. */
  1908.     !._queue.0 = 1
  1909.     !._event.0 = 2
  1910.     !._context.0 = 1
  1911.  
  1912.     /* Get the queue name. */
  1913.     queueName = !._CFG._Queue._QueueName
  1914.     if queueName = '' then signal Config
  1915.  
  1916.     /* Create the queue. */
  1917.     call QueueCreate '!._queue.1', queueName
  1918.     if result \= 0 then signal CallFailed
  1919.  
  1920.     /* Peek should fail on empty. */
  1921.     call QueuePeek !._queue.1
  1922.     if result \= 342 then signal CallFailed
  1923.  
  1924.     /* Close the queue. */
  1925.     call QueueClose !._queue.1
  1926.     if result \= 0 then signal CallFailed
  1927.     !._queue.1 = ''
  1928.  
  1929.     /* Get a timeout value. */
  1930.     timeout = !._CFG._Queue._Timeout
  1931.     if timeout = '' | \DataType(timeout, 'W') then signal Config
  1932.  
  1933.     /* Create the queue event. */
  1934.     call SemEventCreate '!._event.1', 'Shared'
  1935.     if result \= 0 then signal CallFailed
  1936.  
  1937.     /* Create the queue. */
  1938.     call QueueCreate '!._queue.1', queueName, 'FIFO', !._event.1
  1939.     if result \= 0 then signal CallFailed
  1940.  
  1941.     /* Peek should fail on empty. */
  1942.     call QueuePeek !._queue.1
  1943.     if result \= 342 then signal CallFailed
  1944.  
  1945.     /* Create a context for the thread. */
  1946.     call IPCContextCreate '!._context.1'
  1947.     if result \= 0 then signal CallFailed
  1948.  
  1949.     /* Create the collaborating thread. */
  1950.     call ProcCreateThread !._context.1, !._source,,
  1951.         'call QueueThread' !._queue.1
  1952.     if result \= 0 then signal CallFailed
  1953.  
  1954.     /* Wait for completion of collaborating thread. */
  1955.     call IPCContextWait !._context.1
  1956.     if result \= 0 then signal CallFailed
  1957.  
  1958.     /* The queue event should have been posted. */
  1959.     call SemEventQuery !._event.1, 'postCount'
  1960.     if result \= 0 then signal CallFailed
  1961.     if postCount \= 1 then signal CheckFailed
  1962.  
  1963.     /* Peek should now succeed. */
  1964.     call QueuePeek !._queue.1
  1965.     if result \= 0 then signal CallFailed
  1966.  
  1967.     /* There should be 3 entries in the queue. */
  1968.     call QueueQuery !._queue.1, 'elements'
  1969.     if result \= 0 then signal CallFailed
  1970.     if elements \= 3 then signal CheckFailed
  1971.  
  1972.     /* Get data value. */
  1973.     threadData = !._CFG._Queue._ThreadData
  1974.     if threadData = '' then signal Config
  1975.  
  1976.     /* Get the data queued by the thread. */
  1977.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  1978.     if result \= 0 then signal CallFailed
  1979.     if data \= threadData then signal CheckFailed
  1980.     if request \= 1 | priority \= 0 then signal CheckFailed
  1981.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  1982.     if result \= 0 then signal CallFailed
  1983.     if data \= threadData then signal CheckFailed
  1984.     if request \= 2 | priority \= 0 then signal CheckFailed
  1985.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  1986.     if result \= 0 then signal CallFailed
  1987.     if data \= threadData then signal CheckFailed
  1988.     if request \= 3 | priority \= 0 then signal CheckFailed
  1989.  
  1990.     /* There should be no entries in the queue. */
  1991.     call QueueQuery !._queue.1, 'elements'
  1992.     if result \= 0 then signal CallFailed
  1993.     if elements \= 0 then signal CheckFailed
  1994.  
  1995.     /* Peek should fail on empty. */
  1996.     call QueuePeek !._queue.1
  1997.     if result \= 342 then signal CallFailed
  1998.  
  1999.     /* The queue event should have been reset. */
  2000.     call SemEventQuery !._event.1, 'postCount'
  2001.     if result \= 0 then signal CallFailed
  2002.     if postCount \= 0 then signal CheckFailed
  2003.  
  2004.     /* Close the queue. */
  2005.     call QueueClose !._queue.1
  2006.     if result \= 0 then signal CallFailed
  2007.     !._queue.1 = ''
  2008.  
  2009.     /* Create the queue. */
  2010.     call QueueCreate '!._queue.1', queueName, 'LIFO'
  2011.     if result \= 0 then signal CallFailed
  2012.  
  2013.     /* Create the collaborating thread. */
  2014.     call ProcCreateThread !._context.1, !._source,,
  2015.         'call QueueThread' !._queue.1
  2016.     if result \= 0 then signal CallFailed
  2017.  
  2018.     /* Wait for completion of collaborating thread. */
  2019.     call IPCContextWait !._context.1
  2020.     if result \= 0 then signal CallFailed
  2021.  
  2022.     /* Get the data queued by the thread. */
  2023.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  2024.     if result \= 0 then signal CallFailed
  2025.     if data \= threadData then signal CheckFailed
  2026.     if request \= 3 | priority \= 0 then signal CheckFailed
  2027.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  2028.     if result \= 0 then signal CallFailed
  2029.     if data \= threadData then signal CheckFailed
  2030.     if request \= 2 | priority \= 0 then signal CheckFailed
  2031.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  2032.     if result \= 0 then signal CallFailed
  2033.     if data \= threadData then signal CheckFailed
  2034.     if request \= 1 | priority \= 0 then signal CheckFailed
  2035.  
  2036.     /* Close the queue. */
  2037.     call QueueClose !._queue.1
  2038.     if result \= 0 then signal CallFailed
  2039.     !._queue.1 = ''
  2040.  
  2041.     /* Create the queue. */
  2042.     call QueueCreate '!._queue.1', queueName, 'Priority'
  2043.     if result \= 0 then signal CallFailed
  2044.  
  2045.     /* Create the collaborating thread. */
  2046.     call ProcCreateThread !._context.1, !._source,,
  2047.         'call QueueThread' !._queue.1
  2048.     if result \= 0 then signal CallFailed
  2049.  
  2050.     /* Wait for completion of collaborating thread. */
  2051.     call IPCContextWait !._context.1
  2052.     if result \= 0 then signal CallFailed
  2053.  
  2054.     /* Get the data queued by the thread. */
  2055.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  2056.     if result \= 0 then signal CallFailed
  2057.     if data \= threadData then signal CheckFailed
  2058.     if request \= 2 | priority \= 3 then signal CheckFailed
  2059.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  2060.     if result \= 0 then signal CallFailed
  2061.     if data \= threadData then signal CheckFailed
  2062.     if request \= 1 | priority \= 2 then signal CheckFailed
  2063.     call QueueRead !._queue.1, 'data', 'request', 'priority'
  2064.     if result \= 0 then signal CallFailed
  2065.     if data \= threadData then signal CheckFailed
  2066.     if request \= 3 | priority \= 1 then signal CheckFailed
  2067.  
  2068.     /* Close the queue. */
  2069.     call QueueClose !._queue.1
  2070.     if result \= 0 then signal CallFailed
  2071.     !._queue.1 = ''
  2072.  
  2073.     /* Close the context. */
  2074.     call IPCContextClose !._context.1
  2075.     if result \= 0 then signal CallFailed
  2076.     !._context.1 = ''
  2077.  
  2078.     /* The process tests are skipped when profiling. */
  2079.     if \!._profiler then do
  2080.         /* Create the queue. */
  2081.         call QueueCreate '!._queue.1', queueName, , !._event.1
  2082.         if result \= 0 then signal CallFailed
  2083.  
  2084.         /* Peek to enable event posting. */
  2085.         call QueuePeek !._queue.1
  2086.         if result \= 342 then signal CallFailed
  2087.  
  2088.         /* Create the process synchronization event. */
  2089.         call SemEventCreate '!._event.2', 'Shared'
  2090.         if result \= 0 then signal CallFailed
  2091.  
  2092.         /* Start the client process. */
  2093.         '@START "TestIPC Queue" /B /WIN /MIN' !._source,
  2094.             'call QueueProcess' !._event.2
  2095.  
  2096.         /* Wait for the process to complete. */
  2097.         call SemEventWait !._event.2
  2098.         if result \= 0 then signal CallFailed
  2099.  
  2100.         /* The queue event should have been posted. */
  2101.         call SemEventQuery !._event.1, 'postCount'
  2102.         if result \= 0 then signal CallFailed
  2103.         if postCount \= 1 then signal CheckFailed
  2104.  
  2105.         /* Get data value. */
  2106.         processData = !._CFG._Queue._ProcessData
  2107.         if processData = '' then signal Config
  2108.  
  2109.         /* There should be 2 entries in the queue. */
  2110.         call QueueQuery !._queue.1, 'elements'
  2111.         if result \= 0 then signal CallFailed
  2112.         if elements \= 2 then signal CheckFailed
  2113.  
  2114.         /* Get the data queued by the process. */
  2115.         call QueueRead !._queue.1, 'data'
  2116.         if result \= 0 then signal CallFailed
  2117.         if data \= processData then signal CheckFailed
  2118.         call QueueRead !._queue.1, 'data'
  2119.         if result \= 0 then signal CallFailed
  2120.         if data \= Reverse(processData) then signal CheckFailed
  2121.  
  2122.         /* Close the process event. */
  2123.         call SemEventClose !._event.2
  2124.         if result \= 0 then signal CallFailed
  2125.         !._event.2 = ''
  2126.  
  2127.         /* Close the queue. */
  2128.         call QueueClose !._queue.1
  2129.         if result \= 0 then signal CallFailed
  2130.         !._queue.1 = ''
  2131.     end
  2132.  
  2133.     /* Close the queue event. */
  2134.     call SemEventClose !._event.1
  2135.     if result \= 0 then signal CallFailed
  2136.     !._event.1 = ''
  2137.  
  2138.     /* Resources released. */
  2139.     !._queue.0 = ''
  2140.     !._event.0 = ''
  2141.     !._context.0 = ''
  2142.  
  2143.     say 'Queue operations test completed.'
  2144.     say
  2145.  
  2146.     return
  2147.  
  2148.  
  2149.  
  2150. /*:VRX         TestSemaphoreOperations
  2151. */
  2152.  
  2153. /* TestSemaphoreOperations -- Test semaphore operations. */
  2154.  
  2155. TestSemaphoreOperations:
  2156.     procedure expose !.
  2157.  
  2158.     say 'Testing semaphore operations...'
  2159.  
  2160.     /* Resources used. */
  2161.     !._event.0 = 2
  2162.     !._mutex.0 = 2
  2163.     !._muxwait.0 = 2
  2164.     !._context.0 = 1
  2165.     !._timer.0 = 1
  2166.  
  2167.     /* Create a named event semaphore. */
  2168.     name = !._CFG._Semaphore._EventName
  2169.     if name = '' then signal Config
  2170.     call SemEventCreate '!._event.1', name
  2171.     if result \= 0 then signal CallFailed
  2172.  
  2173.     /* The event should be reset. */
  2174.     call SemEventQuery !._event.1, 'postCount'
  2175.     if result \= 0 then signal CallFailed
  2176.     if postCount \= 0 then CheckFailed
  2177.  
  2178.     /* Create a unnamed event semaphore. */
  2179.     call SemEventCreate '!._event.2', , 0
  2180.     if result \= 0 then signal CallFailed
  2181.  
  2182.     /* The event should be reset. */
  2183.     call SemEventQuery !._event.2, 'postCount'
  2184.     if result \= 0 then signal CallFailed
  2185.     if postCount \= 0 then CheckFailed
  2186.  
  2187.     /* Recreate the unnamed event semaphore. */
  2188.     call SemEventClose !._event.2
  2189.     if result \= 0 then signal CallFailed
  2190.     !._event.2 = ''
  2191.     call SemEventCreate '!._event.2', 'Shared', 1
  2192.     if result \= 0 then signal CallFailed
  2193.  
  2194.     /* The event should be posted. */
  2195.     call SemEventReset !._event.2, 'postCount'
  2196.     if result \= 0 then signal CallFailed
  2197.     if postCount \= 1 then CheckFailed
  2198.  
  2199.     /* Create a named mutex semaphore. */
  2200.     name = !._CFG._Semaphore._MutexName
  2201.     if name = '' then signal Config
  2202.     call SemMutexCreate '!._mutex.1', name
  2203.     if result \= 0 then signal CallFailed
  2204.  
  2205.     /* The mutex should not be owned. */
  2206.     call SemMutexQuery !._mutex.1, 'process', 'thread', 'owned'
  2207.     if result \= 0 then signal CallFailed
  2208.     if owned \= 0 then CheckFailed
  2209.     if process \= 0 then signal CheckFailed
  2210.     if thread \= 0 then signal CheckFailed
  2211.  
  2212.     /* Create a unnamed mutex semaphore. */
  2213.     call SemMutexCreate '!._mutex.2', , 0
  2214.     if result \= 0 then signal CallFailed
  2215.  
  2216.     /* The mutex should not be owned. */
  2217.     call SemMutexQuery !._mutex.2, , , 'owned'
  2218.     if result \= 0 then signal CallFailed
  2219.     if owned \= 0 then CheckFailed
  2220.  
  2221.     /* A release should fail. */
  2222.     call SemMutexRelease !._mutex.2
  2223.     if result \= 288 then signal CallFailed
  2224.  
  2225.     /* Recreate the unnamed mutex semaphore. */
  2226.     call SemMutexClose !._mutex.2
  2227.     if result \= 0 then signal CallFailed
  2228.     !._mutex.2 = ''
  2229.     call SemMutexCreate '!._mutex.2', 'Shared', 1
  2230.     if result \= 0 then signal CallFailed
  2231.  
  2232.     /* We should own the mutex. */
  2233.     call ProcGetThreadInfo 'tid', , , 'pid'
  2234.     call SemMutexQuery !._mutex.2, 'process', 'thread', 'owned'
  2235.     if result \= 0 then signal CallFailed
  2236.     if owned \= 1 then CheckFailed
  2237.     if process \= pid then signal CheckFailed
  2238.     if thread \= tid then signal CheckFailed
  2239.  
  2240.     /* Create a named muxwait semaphore. */
  2241.     name = !._CFG._Semaphore._MuxwaitName
  2242.     if name = '' then signal Config
  2243.     call SemMuxwaitCreate '!._muxwait.1', name, 'And'
  2244.     if result \= 0 then signal CallFailed
  2245.  
  2246.     /* Add the mutex semaphores to the muxwait. */
  2247.     call SemMuxwaitAdd !._muxwait.1, !._mutex.1
  2248.     if result \= 0 then signal CallFailed
  2249.     call SemMuxwaitAdd !._muxwait.1, !._mutex.2
  2250.     if result \= 0 then signal CallFailed
  2251.  
  2252.     /* Adding an event semaphore should fail. */
  2253.     call SemMuxwaitAdd !._muxwait.1, !._event.1
  2254.     if result \= 292 then signal CallFailed
  2255.  
  2256.     /* Create an unnamed muxwait semaphore. */
  2257.     call SemMuxwaitCreate '!._muxwait.2', , 'Or'
  2258.     if result \= 0 then signal CallFailed
  2259.  
  2260.     /* Add the event semaphores to the muxwait. */
  2261.     call SemMuxwaitAdd !._muxwait.2, !._event.1
  2262.     if result \= 0 then signal CallFailed
  2263.     call SemMuxwaitAdd !._muxwait.2, !._event.2
  2264.     if result \= 0 then signal CallFailed
  2265.  
  2266.     /* Adding a mutex semaphore should fail. */
  2267.     call SemMuxwaitAdd !._muxwait.2, !._mutex.1
  2268.     if result \= 292 then signal CallFailed
  2269.  
  2270.     /* Create a context for the thread. */
  2271.     call IPCContextCreate '!._context.1'
  2272.     if result \= 0 then signal CallFailed
  2273.  
  2274.     /* Create the collaborating thread. */
  2275.     call ProcCreateThread !._context.1, !._source,,
  2276.         'call SemaphoreThread' !._event.2',' !._mutex.2',' !._muxwait.2
  2277.     if result \= 0 then signal CallFailed
  2278.  
  2279.     /* Create a single timer and wait for a ms. */
  2280.     call SemStartTimer '!._timer.1', 100, !._event.1
  2281.     if result \= 0 then signal CallFailed
  2282.     call SemEventWait !._event.1, 500
  2283.     if result \= 0 then signal CallFailed
  2284.     call SemEventReset !._event.1
  2285.     if result \= 0 then signal CallFailed
  2286.     call SemStopTimer !._timer.1
  2287.     if result \= 326 then signal CallFailed
  2288.  
  2289.     /* Again with explicit type. */
  2290.     call SemStartTimer '!._timer.1', 100, !._event.1, 'Single'
  2291.     if result \= 0 then signal CallFailed
  2292.     call SemEventWait !._event.1, 500
  2293.     if result \= 0 then signal CallFailed
  2294.     call SemEventReset !._event.1
  2295.     if result \= 0 then signal CallFailed
  2296.     call SemStopTimer !._timer.1
  2297.     if result \= 326 then signal CallFailed
  2298.  
  2299.     /* Create a repeat timer and wait for a ms. */
  2300.     call SemStartTimer '!._timer.1', 100, !._event.1, 'Repeat'
  2301.     if result \= 0 then signal CallFailed
  2302.  
  2303.     /* Get at least 3 posts. */
  2304.     do posts = 0 until posts >= 3
  2305.         call SemEventWait !._event.1, 500
  2306.         if result \= 0 then signal CallFailed
  2307.         call SemEventReset !._event.1, 'postCount'
  2308.         if result \= 0 then signal CallFailed
  2309.         posts = posts + postCount
  2310.     end
  2311.  
  2312.     /* Stop the timer. */
  2313.     call SemStopTimer !._timer.1
  2314.     if result \= 0 then signal CallFailed
  2315.     !._timer = ''
  2316.  
  2317.     /* Make sure the event is reset. */
  2318.     call SemEventReset !._event.1
  2319.     if result \= 0 & result \= 300 then signal CallFailed
  2320.  
  2321.     /* The event should still be reset. */
  2322.     call SemEventQuery !._event.2, 'postCount'
  2323.     if result \= 0 then signal CallFailed
  2324.     if postCount \= 0 then CheckFailed
  2325.  
  2326.     /* Release the mutex. */
  2327.     call SemMutexRelease !._mutex.2
  2328.     if result \= 0 then signal CallFailed
  2329.  
  2330.     /* Get a timeout value. */
  2331.     timeout = !._CFG._Semaphore._Timeout
  2332.     if timeout = '' | \DataType(timeout, 'W') then signal Config
  2333.  
  2334.     /* Wait for the thread to post the event. */
  2335.     call SemEventWait !._event.2, timeout * 1000
  2336.     if result \= 0 then signal CallFailed
  2337.  
  2338.     /* Wait for the thread to release the mutex. */
  2339.     call SemMutexRequest !._mutex.2, timeout * 1000
  2340.     if result \= 0 then signal CallFailed
  2341.  
  2342.     /* Release the mutex. */
  2343.     call SemMutexRelease !._mutex.2
  2344.     if result \= 0 then signal CallFailed
  2345.  
  2346.     /* Reset the event. */
  2347.     call SemEventReset !._event.2
  2348.     if result \= 0 then signal CallFailed
  2349.  
  2350.     /* Check the mutex muxwait. */
  2351.     call SemMuxwaitWait !._muxwait.1, 0
  2352.     if result \= 640 then signal CallFailed
  2353.  
  2354.     /* Check the event muxwait. */
  2355.     call SemMuxwaitWait !._muxwait.2, 0
  2356.     if result \= 640 then signal CallFailed
  2357.  
  2358.     /* Post the named event. */
  2359.     call SemEventPost !._event.1
  2360.     if result \= 0 then signal CallFailed
  2361.  
  2362.     /* The mutex muxwait wait should now succeed. */
  2363.     call SemMuxwaitWait !._muxwait.1, timeout * 1000
  2364.     if result \= 0 then signal CallFailed
  2365.  
  2366.     /* The event muxwait wait should now succeed. */
  2367.     call SemMuxwaitWait !._muxwait.2, timeout * 1000
  2368.     if result \= 0 then signal CallFailed
  2369.  
  2370.     /* Release both mutexes. */
  2371.     call SemMutexRelease !._mutex.1
  2372.     if result \= 0 then signal CallFailed
  2373.     call SemMutexRelease !._mutex.2
  2374.     if result \= 0 then signal CallFailed
  2375.  
  2376.     /* Wait for completion of collaborating thread. */
  2377.     call IPCContextWait !._context.1
  2378.     if result \= 0 then signal CallFailed
  2379.  
  2380.     /* Close the context. */
  2381.     call IPCContextClose !._context.1
  2382.     if result \= 0 then signal CallFailed
  2383.     !._context.1 = ''
  2384.  
  2385.     /* Close the semaphores. */
  2386.     call SemEventClose !._event.1
  2387.     if result \= 0 then signal CallFailed
  2388.     !._event.1 = ''
  2389.     call SemEventClose !._event.2
  2390.     if result \= 0 then signal CallFailed
  2391.     !._event.2 = ''
  2392.     call SemMutexClose !._mutex.1
  2393.     if result \= 0 then signal CallFailed
  2394.     !._mutex.1 = ''
  2395.     call SemMutexClose !._mutex.2
  2396.     if result \= 0 then signal CallFailed
  2397.     !._mutex.2 = ''
  2398.     call SemmuxwaitClose !._muxwait.1
  2399.     if result \= 0 then signal CallFailed
  2400.     !._muxwait.1 = ''
  2401.     call SemmuxwaitClose !._muxwait.2
  2402.     if result \= 0 then signal CallFailed
  2403.     !._muxwait.2 = ''
  2404.  
  2405.     /* Resources released. */
  2406.     !._event.0 = ''
  2407.     !._muxwait.0 = ''
  2408.     !._mutex.0 = ''
  2409.     !._context.0 = ''
  2410.     !._timer.0 = ''
  2411.  
  2412.     say 'Semaphore operations test completed.'
  2413.     say
  2414.  
  2415.     return
  2416.  
  2417.  
  2418.  
  2419.