help with test harness

[Peter Achten]

Hi Alan,

At 05:52 PM 4/8/98 -0500, you wrote:
>As I'm building various utilities or applications, I often want a little
>test harness to try things out. I've got it figured out for the simple case
>of console/file i/o. However, I am lost with the object i/o. 
>
>Could someone be so kind as to provide a little test harness that:
>
>shows how to display text (it doesn't even have to scroll)
>shows how to get access to the "!PSt .l .p" datum
>emphasizes clarity rather than optimization
>
>A concrete example would be:
>Initialize the random function
>	getNewRandomSeed:: !(PSt .l .p)	-> (!RandomSeed, !PSt .l .p)
>Produce an infinite-lazy list of random numbers
>Display the first 10 of that list (I'll do the proper "toString").
>Wait for the user to indicate quit (as primitively as you want).
>Quits.
>
>That nasty getNewRandomSeed is the only reason I have to have an object i/o
>harness at this point.
>
>Thanks, I will really appreciate it, and try to repay it with the little
>toolkit I'm working on.

Below I have included a small Clean program that should do what you like. Just save the program text between the two
################################################################################################################################
lines, compile it, and it will show the first ten random numbers.
The ### lines contain exactly the same number of characters as the longest line in the program text. To avoid problems with mailing programs I have removed all tabs, hope this is not to much of a nuisance because I actually like tabs a lot.
For simplicity I have put everything inside one module, but ofcourse you can play around with it. The idea is that the function testSetup should have a type of the following form:

testSetup :: (data, IdFun (PSt data .p), data -> [String])

where the first triple element contains the initial data,
the second triple element contains the test function you want to evaluate,
the third triple element contains the function that transforms the resulting data into a list of strings.

The program does the following steps (defined by initHarness):
* open the console window;
* open the menu by which you can quit the program;
* evaluate the test function;
* display the result in the console window;

* wait for you to quit.

I hope this was about what you requested.

Cheers,

Peter Achten

################################################################################################################################
module harness


/*  A small test harness to lift (PSt data .p) functions to a small console window.
*/

import StdEnv, StdIO            // Just import everything we might need.
import Random

::  NoState = NoState           // A dummy state.

Start :: *World -> *World
Start world
    = startIO testData NoState [initHarness] [] world
where
    (testData,testFunction,displayData) = testSetup
    
    initHarness ps
        # (consoleFont,ps)      = openDefaultFont ps                        // Retrieve the font used for the console window.
        # (metrics,ps)          = getFontMetrics consoleFont ps             // Retrieve the font metrics of the console window.
        # (consoleId,ps)        = accPIO openId ps                          // Generate an Id for the console window.
        # (error,    ps)        = openWindow 0 (console consoleId) ps       // Open a simple console window.
        | error<>NoError
            = abort "harness failed to open window."
        # (error,ps)            = openMenu 0 menu ps                        // Open the menu that contains the quit command.
        | error<>NoError
            = abort "harness failed to open menu."
        # ps                    = testFunction ps                           // Apply the test function to the initial test data.
        # ps                    = showResults metrics consoleId ps          // Display the results in the console window.
        | otherwise
            = ps
    
    showResults metrics consoleId ps=:{ls}
        = setWindowLook consoleId True (look (displayData ls)) ps
    where
        lineHeight  = metrics.fAscent + metrics.fDescent + metrics.fLeading
        
        look :: [String] SelectState UpdateState -> [DrawFunction]
        look data _ {newFrame}
            = [	setPenColour White
              ,	fill         newFrame
              , setPenColour Black 
              : fst (statemap (\datum y -> (drawAt {x=0,y=y} datum,y+lineHeight)) data lineHeight)
              ]
    
    console	id  = Window "Harness" NilLS
                    [   WindowClose (noLS closeProcess)     // Closing the window will close harness.
                    ,   WindowId    id                      // The identification of the console window.
                    ,   WindowSize  {w=500,h=500}           // The initial size of the window.
                    ,   WindowResize                        // The window can be resized.
                    ]
    
    menu        = Menu "File" 
                    (   MenuItem "Quit" [MenuFunction (noLS closeProcess)]
                    )   []

statemap :: !(.x -> .s -> (.y,.s)) ![.x] !.s -> (![.y],!.s)
statemap f [x:xs] s
    #! (y, s)	= f x s
       (ys,s)	= statemap f xs s
    = ([y:ys],s)
statemap _ _ s
    = ([],s)

/*  testSetup defines the initial test data and the test function.
    If you want to use it several times, then it is probably better to put this
    function in a separate module.
*/
testSetup :: ([Int], IdFun (PSt [Int] .p), [Int] -> [String])
testSetup = ([],infiniteRandoms,displayData)
where
    infiniteRandoms ps
        # (seed,ps)	= getNewRandomSeed ps
        = {ps & ls=generateRandoms seed}
    generateRandoms seed
        # (r,seed) = random seed
        = [r:generateRandoms seed]
    displayData inflist
        = map toString (take 10 inflist)
################################################################################################################################