From: pop@cs.umass.edu ( Robin Popplestone )
Newsgroups: comp.lang.pop
Subject: lib example
Summary: The example macro allows illustrative examples to be included in
Keywords: example test
Date: 18 Dec 92 16:50:22 GMT
Organization: University of Massachusetts, Amherst
Originator: pop@roo.cs.umass.edu

[This is required for memo_tree_2 etc. posted as requested]
=============================================================================


;;; example.p                               R.J.Popplestone January 1990

;;; The macro example provides for self-checking of programs. It reads lines
;;; of text until endexample is encountered. Any line not beginning with '**'
;;; is compiled, and any output is recorded in a string, ss_out. Any line
;;; beginning with '**' is read into a string, which is compared with ss_out.
;;; If there is a difference, a warning message is printed out.

section examples => example, endexample example_off;
vars n_call, ss_out,i_out, procedure(out_to_string);
vars example_off = false;

;;; example <f> <examples> endexample runs the examples and checks output OK

;;; Disabling the example macro.
/*
define macro example;
  until readitem() = "endexample" do
  enduntil
enddefine;
*/

define macro example;                    ;;; Full explanation at TOP of FILE
	lvars f_name = readstringline();     ;;; Read function name (ignored)
	dlocal cucharout,
         popgctrace     = false,         ;;; Turn off tracing of garbage coll.
       	 tracing        = false,         ;;; Turn off tracing.
       	 n_call = callstacklength(1);    ;;; Used for exit at endexample
    dlocal pr = syspr;
  	repeat lvars ss = readstringline();  ;;; Read the next line of text
        if example_off then
          if issubstring('endexample',ss)
          then return
          endif;
    	elseif ss.datalength>=2            ;;; Begins with ** ?
		and ss(1) = `*`
		and ss(2) = `*` then                ;;; If so, compare with previous
      		unless issubstring(ss,ss_out)=1 ;;; output, they should be
      		and i_out <= datalength(ss)+3   ;;; identical substrings.
      		then                            ;;; Not identical, so print
      			charout -> cucharout;       ;;; error message
      			pr('\nexample failed for ');
				pr(f_name);
      			pr('.\n    Expected ');
				pr(ss);
      			pr('\n    Produced ');
				pr(ss_out); nl(1);
      		endunless;
    	else                                ;;; Line did not begin with **
      		dlocal                          ;;; switch standard output to
				cucharout = out_to_string(); ;;; the string ss_out
      		compile(stringin(ss));          ;;; and compile the example line.
    	endif;
  	endrepeat
enddefine;

vars i_out, ss_out = inits(100);
for i_out from 1 to 100 do ` ` -> subscrs(i_out,ss_out)
endfor;

define out_to_string;   ;;; is a (not very subtle) consumer.
  1->i_out;
  procedure(c);
  c -> ss_out(i_out); i_out+1 -> i_out;
  endprocedure;
enddefine;

define macro endexample;
  exitfrom(n_call);
enddefine;


example +
1+4=>
** 5
endexample
/* Commented out since Prolog may not be loaded.
example is
:- X is 4+5, print('** '), print(X).
** 9
endexample
*/

/*
example -
;;; This shows a failure.
1-8 =>
** 9
endexample
*/
endsection;
From: sfk@otter.hpl.hp.com (Steve Knight)
Date: Sun, 13 Dec 1992 13:37:10 GMT
Subject: Re: rc_graphic
Organization: Hewlett-Packard Laboratories, Bristol, UK.