From d9f5f5e864313980a2265859f83f6492ffa728c1 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 26 Sep 2021 23:32:29 +0100
Subject: [PATCH 01/32] Work in progress

---
 base/pop/getpoploglib/lib/define_unittest.p | 277 ++++++++++++++++++++
 1 file changed, 277 insertions(+)
 create mode 100644 base/pop/getpoploglib/lib/define_unittest.p

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
new file mode 100644
index 00000000..ea6cf44a
--- /dev/null
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -0,0 +1,277 @@
+compile_mode :pop11 +strict;
+
+section $-unittest => 
+    define_unittest 
+    define_testblock
+    ved_test 
+    register_unittest 
+    fail_unittest
+    ved_tmr 
+    ved_discover
+    pop_unittests;
+
+vars pop_unittests = undef;
+vars unittest_passes = undef;
+vars unittest_failures = undef;
+vars current_unittest = undef;
+
+;;; At top-level do nothing.
+define vars register_unittest( u );
+enddefine;
+
+constant procedure registration_table =
+    newanyproperty( 
+        [], 8, 1, 8,
+        false, false, "tmpval",
+        false, false
+    );
+
+define vars register_unittest_during_discovery( u );
+    lvars index = popfilename or vedpathname;
+    if index do
+        index -> registration_table( u );
+    endif; 
+    u :: pop_unittests -> pop_unittests;
+enddefine;
+
+define vars run_unittest( p );
+    p();
+enddefine;
+
+define run_unittest_during_execution( p );
+    dlocal current_unittest = p;
+    p();
+    p :: unittest_passes -> unittest_passes;
+enddefine;
+
+define vars fail_unittest();
+    mishap( 'Unittest failed', [] )
+enddefine;
+
+define fail_unittest_during_execution();
+    current_unittest :: unittest_failures -> unittest_failures;
+    exitfrom( run_unittest )
+enddefine;
+
+define discover_unittests( p );
+    dlocal pop_unittests = [];
+    dlocal register_unittest = register_unittest_during_discovery;
+    erasenum(#| p() |#);
+    return( pop_unittests )
+enddefine;
+
+define run_all_unittests( unittest_list );
+    dlocal unittest_passes = [];
+    dlocal unittest_failures = [];
+    applist( unittest_list, run_unittest );
+    ( unittest_passes, unittest_failures )
+enddefine;
+
+vars procedure unittest_sysVARS = sysVARS;
+
+define read_declaration( defdec ) -> ( pdrname, is_global, declarator );
+    lvars attributes = (
+        [%
+            repeat
+                lvars item = nextreaditem();
+                if item == termin then
+                    mishap( 'Unexpected end of input in unittest definition', [] ) 
+                endif;
+                lvars id = identprops( item );
+                quitunless( id.isword );
+                quitunless( isstartstring( "syntax", id ) );
+                quitif( item == ";" );               
+                readitem()
+            endrepeat
+        %]
+    );
+    readitem() -> pdrname;
+    
+    false -> is_global;
+    defdec -> declarator;
+
+    lvars a;
+    for a in attributes do
+        if a == "global" then 
+            true -> is_global
+        elseif a == "lconstant" then
+            sysLCONSTANT -> declarator;
+        elseif a == "lvars" then 
+            sysLVARS -> declarator;
+        elseif a == "constant" then 
+            sysCONSTANT -> declarator;
+        elseif a == "vars" then 
+            sysVARS -> declarator;
+        else 
+            mishap( 'Unexpected syntax word', [^a] )
+        endif
+    endfor;
+
+    if pdrname == ";" then
+        sysNEW_LVAR() -> pdrname;
+        false -> is_global;
+        procedure( w, n ); endprocedure -> declarator;
+    endif;
+enddefine;
+
+define :define_form global unittest;
+    lvars ( pdrname, is_global, declarator ) = read_declaration( unittest_sysVARS );
+    declarator( pdrname.isword and pdrname, 0 );
+    if is_global then sysGLOBAL( pdrname, is_global ) endif;
+    sysPROCEDURE( pdrname, 0 );
+
+    ;;; Set up dynamic test discovery.
+    sysLOCAL( "pop_unittests" );
+    sysPUSH( "nil" );
+    sysPOP( "pop_unittests" );
+    sysLOCAL( "register_unittest" );
+    sysPUSHQ( procedure(u); u :: pop_unittests -> pop_unittests endprocedure );
+    sysPOP( "register_unittest" );
+
+    ;;; Main body.
+    pop11_comp_stmnt_seq_to( "enddefine" ) -> _;
+  
+    ;;; Run any registered tests.
+    sysPUSH( "pop_unittests" );
+    sysPUSHQ( run_unittest );  
+    sysCALL( "applist" );
+  
+    sysPASSIGN( sysENDPROCEDURE(), pdrname );
+    sysPUSH( pdrname );
+    sysCALL( "register_unittest" );
+enddefine;
+
+
+define ved_tmr();
+    lvars ( passes, failures ) = run_all_unittests( discover_unittests( ved_lmr ) );
+    sprintf(
+        '%p passes, %p failures',
+        [% length( passes ), length( failures ) %]
+    ).vedputmessage;
+enddefine;
+
+constant unittest_suffix = '.test.p';
+
+define discover_unittest_scope();
+    if vedargument = '' then
+        if hasendstring( vedcurrent, unittest_suffix ) then            
+            ved_l1
+        elseif hasendstring( vedcurrent, '.p' ) then  
+            lvars dir = sys_fname_path( vedcurrent ); 
+            lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
+            procedure();
+                lvars file;
+                for file in sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist do
+                    vedputmessage( 'COMPILING ' >< file );
+                    pop11_compile( file )
+                endfor
+            endprocedure
+        else    
+            mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
+        endif
+    else
+        lvars folder = sys_fname_path( vedcurrent ); 
+        procedure();
+            lvars file;
+            for file in sys_file_match( folder, '*' <> unittest_suffix, false, false ).pdtolist do
+                vedputmessage( 'COMPILING ' >< file );
+                pop11_compile( file )
+            endfor
+        endprocedure
+    endif 
+enddefine;
+
+defclass discovered {
+    discovered_unittests,
+    discovered_files_cache
+};
+
+define newdiscovered( unittests );
+    consdiscovered( unittests, false )
+enddefine;
+
+define discovered_files( d );
+    if d.discovered_files_cache then
+        d.discovered_files_cache
+    else
+        lvars t =  newanyproperty( 
+            [], 8, 1, 8,
+            syshash, nonop =, "perm",
+            false, false
+        );
+        lvars u;
+        for u in d.discovered_unittests do
+            lvars parent = registration_table( u );
+            if parent.isstring do
+                true -> t( parent )
+            endif
+        endfor;
+        nc_listsort( [% fast_appproperty( t, erase ) %], alphabefore ) ->> d.discovered_files_cache;
+    endif
+enddefine;
+
+define test_discovery_in_ved();
+    newdiscovered( discover_unittests( discover_unittest_scope() ) )
+enddefine;
+
+define up_from( n );
+    procedure();
+        n;
+        n + 1 -> n;
+    endprocedure.pdtolist
+enddefine;
+
+define ved_discover();
+    dlocal vedpositionstack;
+    lvars d = test_discovery_in_ved();
+
+    vededit( '*TESTS DISCOVERED*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
+    ved_clear();
+    vedpositionpush();
+
+    dlocal cucharout = vedcharinsert;
+    
+    nprintf( 'Test discovery at: ' <> sysdaytime() );
+    nl( 1 );
+
+    nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
+    ;;; vedinsertstring( sprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] ) );
+    ;;; vedlinebelow();
+    
+    lvars u, n;
+    for u, n in d.discovered_unittests, up_from(1) do
+        vedinsertstring( sprintf( '%p. %p', [% n, u %] ) );
+        vedlinebelow();
+    endfor; 
+    vedlinebelow();
+    
+    vedinsertstring( sprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] ) );
+    vedlinebelow();
+    lvars file, n;
+    for file, n in d.discovered_files, up_from(1) do
+        vedinsertstring( sprintf( '%p. %p', [% n, file %] ) );
+        vedlinebelow();
+    endfor; 
+    
+    vedpositionpop();
+enddefine;
+
+define ved_test();
+    lvars d = test_discovery_in_ved();
+    dlocal run_unittest = run_unittest_during_execution;
+    dlocal fail_unittest = fail_unittest_during_execution;
+    lvars ( passes, failures ) = run_all_unittests( d.discovered_unittests );
+    lvars n_passes = passes.length;
+    lvars n_failures = failures.length;
+    sprintf(
+        '%p pass%p, %p failure%p',
+        [% 
+            n_passes, 
+            if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
+            n_failures, 
+            if n_failures == 1 then '' else 's' endif ;;; singular v plural
+        %]
+    ).vedputmessage;
+enddefine;
+
+endsection;

From 3a2eac15913423423669421a923783c69c3cd3df Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 26 Sep 2021 23:33:13 +0100
Subject: [PATCH 02/32] Examples for unit testing

---
 base/pop/getpoploglib/auto/splitstring.p      | 40 +++++++++++++++++++
 base/pop/getpoploglib/help/splitstring        |  5 +++
 .../getpoploglib/unittests/splitstring.test.p | 17 ++++++++
 3 files changed, 62 insertions(+)
 create mode 100644 base/pop/getpoploglib/auto/splitstring.p
 create mode 100644 base/pop/getpoploglib/help/splitstring
 create mode 100644 base/pop/getpoploglib/unittests/splitstring.test.p

diff --git a/base/pop/getpoploglib/auto/splitstring.p b/base/pop/getpoploglib/auto/splitstring.p
new file mode 100644
index 00000000..643f5983
--- /dev/null
+++ b/base/pop/getpoploglib/auto/splitstring.p
@@ -0,0 +1,40 @@
+compile_mode :pop11 +strict;
+
+section;
+
+define global splitstring() with_props 3;
+    lvars s, sep, procedure constructor;
+    if dup().isprocedure then
+        () -> ( s, sep, constructor );
+    else
+        consvector -> constructor;
+        () -> ( s, sep )
+    endif;
+    lvars ( procedure finder, sep_n ) = (
+        if sep.isstring then
+            if sep.datalength == 0 then
+                mishap( 'Invalid empty separator argument', [^sep] )
+            endif;
+            ( issubstring, datalength(sep) )
+        elseif sep.isinteger then
+            ( locchar, 1 )
+        else
+            mishap( 'Unexpected separator', [^sep] )
+        endif
+    );
+    constructor(#|
+        lvars position = 1;
+        repeat
+            lvars n = finder( sep, position, s);
+            if n then
+                substring( position, n - position, s );
+                n + sep_n -> position;
+            else
+                substring( position, s.datalength - position + 1, s );
+                quitloop
+            endif
+        endrepeat
+    |#)
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/help/splitstring b/base/pop/getpoploglib/help/splitstring
new file mode 100644
index 00000000..28a771aa
--- /dev/null
+++ b/base/pop/getpoploglib/help/splitstring
@@ -0,0 +1,5 @@
+HELP SPLITSTRING                                         Stephen Leach, Sep 2021
+
+    splitstring( string, separator, constructor ) -> constructor( N )
+    splitstring( string, separator ) -> vector
+
diff --git a/base/pop/getpoploglib/unittests/splitstring.test.p b/base/pop/getpoploglib/unittests/splitstring.test.p
new file mode 100644
index 00000000..b83ad200
--- /dev/null
+++ b/base/pop/getpoploglib/unittests/splitstring.test.p
@@ -0,0 +1,17 @@
+
+define :unittest;
+enddefine;
+
+define :unittest hello;
+    ;;; This is a pass
+enddefine;
+
+define :unittest hiya;
+enddefine;
+
+define :unittest hi;
+enddefine;
+
+define :unittest byebye;
+    fail_unittest()
+enddefine;

From cb18c45a947e007ec9411bf0276517bfa0b683f7 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 28 Sep 2021 09:08:07 +0100
Subject: [PATCH 03/32] Work in progress - rudimentary listing in results file

---
 base/pop/getpoploglib/lib/define_unittest.p | 147 ++++++++++++++------
 1 file changed, 108 insertions(+), 39 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index ea6cf44a..61fb7585 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -2,23 +2,30 @@ compile_mode :pop11 +strict;
 
 section $-unittest => 
     define_unittest 
-    define_testblock
     ved_test 
     register_unittest 
     fail_unittest
-    ved_tmr 
     ved_discover
-    pop_unittests;
+    pop_unittests
+    assert;
 
-vars pop_unittests = undef;
-vars unittest_passes = undef;
-vars unittest_failures = undef;
-vars current_unittest = undef;
+vars pop_unittests = undef;     ;;; Part of test-discovery.
+vars unittest_passes = undef;   ;;; Part of test-execution.
+vars unittest_failures = undef; ;;; Part of test-execution.
+vars current_unittest = undef;  ;;; Part of test-execution.
 
+;;; Part of test-discovery, although may be re-invoked during execution.
 ;;; At top-level do nothing.
 define vars register_unittest( u );
 enddefine;
 
+defclass context {
+    context_parent,
+    context_linenum
+};
+
+;;; This is a map from unit-tests, which are procedures, to the context in 
+;;; which they were defined.
 constant procedure registration_table =
     newanyproperty( 
         [], 8, 1, 8,
@@ -26,30 +33,47 @@ constant procedure registration_table =
         false, false
     );
 
+;;; Inside a test-context we record the notional parent. This is purely 
+;;; so we can present the test results inside a nice-looking classification tree.
 define vars register_unittest_during_discovery( u );
     lvars index = popfilename or vedpathname;
     if index do
-        index -> registration_table( u );
+        conscontext( index, poplinenum ) -> registration_table( u );
     endif; 
     u :: pop_unittests -> pop_unittests;
 enddefine;
 
+;;; Part of test-execution.
+;;; This is defensive - we only want to run unit tests inside an appropriate
+;;; dynamic context.
 define vars run_unittest( p );
-    p();
+    mishap( 'Trying to trace unit tests with context (this should never happen)', [] )
 enddefine;
 
+;;; This is the normal way to run a unit test & we will dlocalise run_unittest
+;;; to its value.
 define run_unittest_during_execution( p );
+
+    define dlocal pop_exception_final( N, mess, idstring, severity );
+        returnunless( severity == `E` or severity == `R` )( false );
+        lvars args = conslist( N );
+        chain( [ ^mess ^idstring ^args ], fail_unittest ) 
+    enddefine;
+
     dlocal current_unittest = p;
     p();
     p :: unittest_passes -> unittest_passes;
 enddefine;
 
-define vars fail_unittest();
+;;; Part of test-execution.
+;;; This will only be invoked at top-level and hence outside of a test
+;;; context, so it is OK for it to simply mishap.
+define vars fail_unittest( info );
     mishap( 'Unittest failed', [] )
 enddefine;
 
-define fail_unittest_during_execution();
-    current_unittest :: unittest_failures -> unittest_failures;
+define fail_unittest_during_execution( info );
+    conspair( current_unittest, info ) :: unittest_failures -> unittest_failures;
     exitfrom( run_unittest )
 enddefine;
 
@@ -141,18 +165,9 @@ define :define_form global unittest;
     sysCALL( "register_unittest" );
 enddefine;
 
-
-define ved_tmr();
-    lvars ( passes, failures ) = run_all_unittests( discover_unittests( ved_lmr ) );
-    sprintf(
-        '%p passes, %p failures',
-        [% length( passes ), length( failures ) %]
-    ).vedputmessage;
-enddefine;
-
 constant unittest_suffix = '.test.p';
 
-define discover_unittest_scope();
+define select_scope();
     if vedargument = '' then
         if hasendstring( vedcurrent, unittest_suffix ) then            
             ved_l1
@@ -194,14 +209,16 @@ define discovered_files( d );
     if d.discovered_files_cache then
         d.discovered_files_cache
     else
-        lvars t =  newanyproperty( 
-            [], 8, 1, 8,
-            syshash, nonop =, "perm",
-            false, false
+        lvars t = (
+            newanyproperty( 
+                [], 8, 1, 8,
+                syshash, nonop =, "perm",
+                false, false
+            )
         );
         lvars u;
         for u in d.discovered_unittests do
-            lvars parent = registration_table( u );
+            lvars parent = context_parent( registration_table( u ) );
             if parent.isstring do
                 true -> t( parent )
             endif
@@ -210,8 +227,36 @@ define discovered_files( d );
     endif
 enddefine;
 
+define global syntax assert();
+
+    define lconstant check_assertion( N );
+        if N == 0 then
+            mishap( 0, 'No results from assertion', 'unittest-assert:stack-empty' )
+        elseif N > 2 then 
+            mishap( N, 'Too many results from assertion', 'unittest-assert:stack-many' )
+        else
+            lvars result = ();
+            unless result do
+                mishap( 0, 'Failed', 'unittest-assert:unittest-fail' )
+            endunless
+        endif
+    enddefine;
+
+    dlocal pop_new_lvar_list;
+    lvars t = sysNEW_LVAR();
+    sysCALL( "stacklength" );
+    sysPOP( t );
+    pop11_comp_expr_to( ";" ) -> _;
+    sysCALL( "stacklength" );
+    sysPUSH( t );
+    sysCALL( "fi_-" );
+    sysCALLQ( check_assertion );
+enddefine;
+
+;;; -- VED integration ---
+
 define test_discovery_in_ved();
-    newdiscovered( discover_unittests( discover_unittest_scope() ) )
+    newdiscovered( discover_unittests( select_scope() ) )
 enddefine;
 
 define up_from( n );
@@ -221,6 +266,26 @@ define up_from( n );
     endprocedure.pdtolist
 enddefine;
 
+define show_failures( passes, failures );
+    dlocal vedpositionstack;
+    lvars d = test_discovery_in_ved();
+
+    vededit( '*TEST RESULTS*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
+    ved_clear();
+    vedpositionpush();
+    dlocal cucharout = vedcharinsert;
+
+    nprintf( 'Test results at: ' <> sysdaytime() );
+    nl(1);
+
+    lvars u;
+    for u, n in failures, up_from(1) do
+        nprintf( '%p.\t%p', [^n ^u] );
+    endfor;
+
+    vedpositionpop();
+enddefine;
+
 define ved_discover();
     dlocal vedpositionstack;
     lvars d = test_discovery_in_ved();
@@ -261,17 +326,21 @@ define ved_test();
     dlocal run_unittest = run_unittest_during_execution;
     dlocal fail_unittest = fail_unittest_during_execution;
     lvars ( passes, failures ) = run_all_unittests( d.discovered_unittests );
-    lvars n_passes = passes.length;
-    lvars n_failures = failures.length;
-    sprintf(
-        '%p pass%p, %p failure%p',
-        [% 
-            n_passes, 
-            if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
-            n_failures, 
-            if n_failures == 1 then '' else 's' endif ;;; singular v plural
-        %]
-    ).vedputmessage;
+    if null(failures) then
+        lvars n_passes = passes.length;
+        lvars n_failures = failures.length;
+        sprintf(
+            '%p pass%p, %p failure%p',
+            [% 
+                n_passes, 
+                if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
+                n_failures, 
+                if n_failures == 1 then '' else 's' endif ;;; singular v plural
+            %]
+        ).vedputmessage;
+    else
+        show_failures( passes, failures )
+    endif;
 enddefine;
 
 endsection;

From dd4b01b1887fa7a5bdae9749ed2afaa255945415 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 28 Sep 2021 13:11:16 +0100
Subject: [PATCH 04/32] Incremental improvement in quality of error reporting -
 work in progress

---
 base/pop/getpoploglib/lib/define_unittest.p | 19 +++++++++++++++----
 1 file changed, 15 insertions(+), 4 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index 61fb7585..b67f7db6 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -237,7 +237,7 @@ define global syntax assert();
         else
             lvars result = ();
             unless result do
-                mishap( 0, 'Failed', 'unittest-assert:unittest-fail' )
+                mishap( 0, 'Assertion failed', 'unittest-assert:unittest-fail' )
             endunless
         endif
     enddefine;
@@ -278,9 +278,20 @@ define show_failures( passes, failures );
     nprintf( 'Test results at: ' <> sysdaytime() );
     nl(1);
 
-    lvars u;
-    for u, n in failures, up_from(1) do
-        nprintf( '%p.\t%p', [^n ^u] );
+    lvars p;
+    for p, n in failures, up_from(1) do
+        lvars ( u, mishap_details ) = p.destpair;
+        lvars ( msg, idstring, args ) = mishap_details.dl;
+        lvars name = u.pdprops;
+        nprintf( '%p.\tUnit test: %p', [^n ^name] );
+        nprintf( '\tMessage  : %p', [ ^msg ] );
+        unless args.null do
+            npr( 'Argument: ' );
+            lvars a;
+            for a in args do
+                nprintf( '\t\t%p', [^a] )
+            endfor;
+        endunless;
     endfor;
 
     vedpositionpop();

From 3210f1e2bc1c2ad1f539e1bd5ba5509d765674d0 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 28 Sep 2021 13:14:38 +0100
Subject: [PATCH 05/32] Move function to correct section of file - for later
 extraction

---
 base/pop/getpoploglib/lib/define_unittest.p | 60 ++++++++++-----------
 1 file changed, 30 insertions(+), 30 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index b67f7db6..29ac8197 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -167,35 +167,6 @@ enddefine;
 
 constant unittest_suffix = '.test.p';
 
-define select_scope();
-    if vedargument = '' then
-        if hasendstring( vedcurrent, unittest_suffix ) then            
-            ved_l1
-        elseif hasendstring( vedcurrent, '.p' ) then  
-            lvars dir = sys_fname_path( vedcurrent ); 
-            lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
-            procedure();
-                lvars file;
-                for file in sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist do
-                    vedputmessage( 'COMPILING ' >< file );
-                    pop11_compile( file )
-                endfor
-            endprocedure
-        else    
-            mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
-        endif
-    else
-        lvars folder = sys_fname_path( vedcurrent ); 
-        procedure();
-            lvars file;
-            for file in sys_file_match( folder, '*' <> unittest_suffix, false, false ).pdtolist do
-                vedputmessage( 'COMPILING ' >< file );
-                pop11_compile( file )
-            endfor
-        endprocedure
-    endif 
-enddefine;
-
 defclass discovered {
     discovered_unittests,
     discovered_files_cache
@@ -255,8 +226,37 @@ enddefine;
 
 ;;; -- VED integration ---
 
+define select_scope_for_vedargument();
+    if vedargument = '' then
+        if hasendstring( vedcurrent, unittest_suffix ) then            
+            ved_l1
+        elseif hasendstring( vedcurrent, '.p' ) then  
+            lvars dir = sys_fname_path( vedcurrent ); 
+            lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
+            procedure();
+                lvars file;
+                for file in sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist do
+                    vedputmessage( 'COMPILING ' >< file );
+                    pop11_compile( file )
+                endfor
+            endprocedure
+        else    
+            mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
+        endif
+    else
+        lvars folder = sys_fname_path( vedcurrent ); 
+        procedure();
+            lvars file;
+            for file in sys_file_match( folder, '*' <> unittest_suffix, false, false ).pdtolist do
+                vedputmessage( 'COMPILING ' >< file );
+                pop11_compile( file )
+            endfor
+        endprocedure
+    endif 
+enddefine;
+
 define test_discovery_in_ved();
-    newdiscovered( discover_unittests( select_scope() ) )
+    newdiscovered( discover_unittests( select_scope_for_vedargument() ) )
 enddefine;
 
 define up_from( n );

From 2782bd9c6d42fd6b91ade5d34e0419b390c7df51 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 28 Sep 2021 13:29:23 +0100
Subject: [PATCH 06/32] Additional debugging support

---
 base/pop/getpoploglib/lib/define_unittest.p | 35 +++++++++++++++++++++
 1 file changed, 35 insertions(+)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index 29ac8197..ca7f7a41 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -6,6 +6,7 @@ section $-unittest =>
     register_unittest 
     fail_unittest
     ved_discover
+    ved_discover_files
     pop_unittests
     assert;
 
@@ -255,6 +256,40 @@ define select_scope_for_vedargument();
     endif 
 enddefine;
 
+define select_file_scope_for_vedargument();
+    if vedargument = '' then
+        if hasendstring( vedcurrent, unittest_suffix ) then            
+            ['CURRENT_BUFFER']
+        elseif hasendstring( vedcurrent, '.p' ) then  
+            lvars dir = sys_fname_path( vedcurrent ); 
+            lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
+            sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist;
+        else    
+            mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
+        endif
+    else
+        lvars folder = sys_fname_path( vedargument ); 
+        sys_file_match( folder, '.../*' <> unittest_suffix, false, false ).pdtolist;
+    endif 
+enddefine;
+
+define ved_discover_files();
+    lvars files = select_file_scope_for_vedargument();
+    dlocal vedpositionstack;
+
+    vededit( '*TEST FILES IN SCOPE*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
+    ved_clear();
+    vedpositionpush();
+    dlocal cucharout = vedcharinsert;
+    
+    lvars f;
+    for f in files do
+        npr( f )
+    endfor;
+
+    vedpositionpop();
+enddefine;
+
 define test_discovery_in_ved();
     newdiscovered( discover_unittests( select_scope_for_vedargument() ) )
 enddefine;

From f3669db2e7a7ac656b7d327a13802f48877d8860 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 28 Sep 2021 20:29:47 +0100
Subject: [PATCH 07/32] Fix undeclared variables

---
 base/pop/getpoploglib/lib/define_unittest.p | 24 +++++++++++----------
 1 file changed, 13 insertions(+), 11 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index ca7f7a41..88071f3d 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -51,6 +51,18 @@ define vars run_unittest( p );
     mishap( 'Trying to trace unit tests with context (this should never happen)', [] )
 enddefine;
 
+;;; Part of test-execution.
+;;; This will only be invoked at top-level and hence outside of a test
+;;; context, so it is OK for it to simply mishap.
+define vars fail_unittest( info );
+    mishap( 'Unittest failed', [] )
+enddefine;
+
+define fail_unittest_during_execution( info );
+    conspair( current_unittest, info ) :: unittest_failures -> unittest_failures;
+    exitfrom( run_unittest )
+enddefine;
+
 ;;; This is the normal way to run a unit test & we will dlocalise run_unittest
 ;;; to its value.
 define run_unittest_during_execution( p );
@@ -66,17 +78,7 @@ define run_unittest_during_execution( p );
     p :: unittest_passes -> unittest_passes;
 enddefine;
 
-;;; Part of test-execution.
-;;; This will only be invoked at top-level and hence outside of a test
-;;; context, so it is OK for it to simply mishap.
-define vars fail_unittest( info );
-    mishap( 'Unittest failed', [] )
-enddefine;
 
-define fail_unittest_during_execution( info );
-    conspair( current_unittest, info ) :: unittest_failures -> unittest_failures;
-    exitfrom( run_unittest )
-enddefine;
 
 define discover_unittests( p );
     dlocal pop_unittests = [];
@@ -313,7 +315,7 @@ define show_failures( passes, failures );
     nprintf( 'Test results at: ' <> sysdaytime() );
     nl(1);
 
-    lvars p;
+    lvars p, n;
     for p, n in failures, up_from(1) do
         lvars ( u, mishap_details ) = p.destpair;
         lvars ( msg, idstring, args ) = mishap_details.dl;

From 2dddad2e723a4403fb6e304037b283fc0a86820a Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 28 Sep 2021 21:48:48 +0100
Subject: [PATCH 08/32] More incremental progress [ci skip]

---
 base/pop/getpoploglib/lib/define_unittest.p | 72 +++++++++++++++------
 1 file changed, 53 insertions(+), 19 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index 88071f3d..b45c70f4 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -51,6 +51,12 @@ define vars run_unittest( p );
     mishap( 'Trying to trace unit tests with context (this should never happen)', [] )
 enddefine;
 
+defclass failureinfo {
+    failureinfo_message,
+    failureinfo_idstring,
+    failureinfo_argv
+};
+
 ;;; Part of test-execution.
 ;;; This will only be invoked at top-level and hence outside of a test
 ;;; context, so it is OK for it to simply mishap.
@@ -70,7 +76,7 @@ define run_unittest_during_execution( p );
     define dlocal pop_exception_final( N, mess, idstring, severity );
         returnunless( severity == `E` or severity == `R` )( false );
         lvars args = conslist( N );
-        chain( [ ^mess ^idstring ^args ], fail_unittest ) 
+        chain( consfailureinfo( mess, idstring, args ), fail_unittest ) 
     enddefine;
 
     dlocal current_unittest = p;
@@ -78,8 +84,6 @@ define run_unittest_during_execution( p );
     p :: unittest_passes -> unittest_passes;
 enddefine;
 
-
-
 define discover_unittests( p );
     dlocal pop_unittests = [];
     dlocal register_unittest = register_unittest_during_discovery;
@@ -90,7 +94,7 @@ enddefine;
 define run_all_unittests( unittest_list );
     dlocal unittest_passes = [];
     dlocal unittest_failures = [];
-    applist( unittest_list, run_unittest );
+    lvars L = [RETURNS % applist( unittest_list, run_unittest ) %]; 
     ( unittest_passes, unittest_failures )
 enddefine;
 
@@ -201,17 +205,29 @@ define discovered_files( d );
     endif
 enddefine;
 
+define peek_expr_to( closing_keyword );
+    dlocal pop_syntax_only = true;
+    dlocal proglist_state;
+    lvars old_proglist = proglist;
+    pop11_comp_expr_to( ";" ) -> _;
+    [%
+        while old_proglist.ispair and not( old_proglist.back.isprocedure ) do
+            old_proglist.destpair -> old_proglist
+        endwhile;
+    %]
+enddefine;
+
 define global syntax assert();
 
-    define lconstant check_assertion( N );
+    define lconstant check_assertion( N, filename, linenum, expr );
         if N == 0 then
             mishap( 0, 'No results from assertion', 'unittest-assert:stack-empty' )
-        elseif N > 2 then 
+        elseif N > 1 then 
             mishap( N, 'Too many results from assertion', 'unittest-assert:stack-many' )
         else
             lvars result = ();
             unless result do
-                mishap( 0, 'Assertion failed', 'unittest-assert:unittest-fail' )
+                mishap( #| filename, linenum, expr |#, 'Assertion failed', 'unittest-assert:unittest-fail' )
             endunless
         endif
     enddefine;
@@ -220,10 +236,14 @@ define global syntax assert();
     lvars t = sysNEW_LVAR();
     sysCALL( "stacklength" );
     sysPOP( t );
+    lvars expr = peek_expr_to( ";" );
     pop11_comp_expr_to( ";" ) -> _;
     sysCALL( "stacklength" );
     sysPUSH( t );
     sysCALL( "fi_-" );
+    sysPUSHQ( popfilename );
+    sysPUSHQ( poplinenum );
+    sysPUSHQ( expr );
     sysCALLQ( check_assertion );
 enddefine;
 
@@ -318,17 +338,29 @@ define show_failures( passes, failures );
     lvars p, n;
     for p, n in failures, up_from(1) do
         lvars ( u, mishap_details ) = p.destpair;
-        lvars ( msg, idstring, args ) = mishap_details.dl;
-        lvars name = u.pdprops;
-        nprintf( '%p.\tUnit test: %p', [^n ^name] );
-        nprintf( '\tMessage  : %p', [ ^msg ] );
-        unless args.null do
-            npr( 'Argument: ' );
-            lvars a;
-            for a in args do
-                nprintf( '\t\t%p', [^a] )
-            endfor;
-        endunless;
+        lvars ( msg, idstring, args ) = mishap_details.destfailureinfo;
+        if idstring = 'unittest-assert:unittest-fail' then
+            lvars name = u.pdprops;
+            nprintf( '%p.\tFailed    : %p', [^n ^name] );
+            lvars (filename, linenumber, assert_expr, _n) = args.destlist;
+            printf( '\tExpression: ' );
+            applist( [assert ^^assert_expr], spr );
+            nl(1);
+            nprintf( '\tLine num  : %p', [ ^linenumber ] );
+            nprintf( '\tFile name : %p', [ ^filename ] );
+        else
+            lvars name = u.pdprops;
+            nprintf( '%p.\tUnit test : %p', [^n ^name] );
+            nprintf( '\tMessage   : %p', [ ^msg ] );
+            unless args.null do
+                npr( '\tInvolving : ' );
+                lvars a;
+                for a in args do
+                    nprintf( '\t *\t%p', [^a] )
+                endfor;
+            endunless;
+        endif;
+        nl( 1 );
     endfor;
 
     vedpositionpop();
@@ -373,7 +405,9 @@ define ved_test();
     lvars d = test_discovery_in_ved();
     dlocal run_unittest = run_unittest_during_execution;
     dlocal fail_unittest = fail_unittest_during_execution;
-    lvars ( passes, failures ) = run_all_unittests( d.discovered_unittests );
+    lvars disco = d.discovered_unittests;
+    lvars ( passes, failures ) = run_all_unittests( disco ); 
+
     if null(failures) then
         lvars n_passes = passes.length;
         lvars n_failures = failures.length;

From 356b729cb3ed5eec9349a758d6359f837ac272fc Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Wed, 29 Sep 2021 23:28:55 +0100
Subject: [PATCH 09/32] More incremental progress [ci skip]

---
 base/pop/getpoploglib/lib/define_unittest.p | 128 ++++++++++++--------
 1 file changed, 79 insertions(+), 49 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index b45c70f4..8587c56d 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -1,14 +1,17 @@
 compile_mode :pop11 +strict;
 
-section $-unittest => 
-    define_unittest 
-    ved_test 
-    register_unittest 
+section $-unittest =>
+    define_unittest
+    ved_test
+    register_unittest
     fail_unittest
     ved_discover
     ved_discover_files
     pop_unittests
-    assert;
+    assert
+    expect_mishap;
+
+vars expect_mishap = false;      ;;; Part of test-execution.
 
 vars pop_unittests = undef;     ;;; Part of test-discovery.
 vars unittest_passes = undef;   ;;; Part of test-execution.
@@ -25,22 +28,22 @@ defclass context {
     context_linenum
 };
 
-;;; This is a map from unit-tests, which are procedures, to the context in 
+;;; This is a map from unit-tests, which are procedures, to the context in
 ;;; which they were defined.
 constant procedure registration_table =
-    newanyproperty( 
+    newanyproperty(
         [], 8, 1, 8,
         false, false, "tmpval",
         false, false
     );
 
-;;; Inside a test-context we record the notional parent. This is purely 
+;;; Inside a test-context we record the notional parent. This is purely
 ;;; so we can present the test results inside a nice-looking classification tree.
 define vars register_unittest_during_discovery( u );
     lvars index = popfilename or vedpathname;
     if index do
         conscontext( index, poplinenum ) -> registration_table( u );
-    endif; 
+    endif;
     u :: pop_unittests -> pop_unittests;
 enddefine;
 
@@ -52,6 +55,7 @@ define vars run_unittest( p );
 enddefine;
 
 defclass failureinfo {
+    failureinfo_unittest,
     failureinfo_message,
     failureinfo_idstring,
     failureinfo_argv
@@ -65,7 +69,7 @@ define vars fail_unittest( info );
 enddefine;
 
 define fail_unittest_during_execution( info );
-    conspair( current_unittest, info ) :: unittest_failures -> unittest_failures;
+    info :: unittest_failures -> unittest_failures;
     exitfrom( run_unittest )
 enddefine;
 
@@ -73,15 +77,41 @@ enddefine;
 ;;; to its value.
 define run_unittest_during_execution( p );
 
+    define lconstant is_expected_mishap( mess, idstring, severity, args );
+        if isstartstring( 'unittest-assert:', idstring ) then
+            false
+        elseif expect_mishap == true then
+            true
+        elseif expect_mishap.isstring then
+            idstring = expect_mishap or mess = expect_mishap
+        elseif expect_mishap.isregexp then
+            expect_mishap( 1, idstring, false, false ) or expect_mishap( 1, mess, false, false )
+        elseif expect_mishap.isprocedure and not( expect_mishap.isregexp ) then
+            expect_mishap( mess, idstring, severity, args )
+        else
+            false
+        endif;
+    enddefine;
+
     define dlocal pop_exception_final( N, mess, idstring, severity );
         returnunless( severity == `E` or severity == `R` )( false );
         lvars args = conslist( N );
-        chain( consfailureinfo( mess, idstring, args ), fail_unittest ) 
+        lvars is_expected = is_expected_mishap( mess, idstring, severity, args );
+        if is_expected then
+            exitto( run_unittest );
+        else
+            chain( consfailureinfo( current_unittest, mess, idstring, args ), fail_unittest )
+        endif;
     enddefine;
 
     dlocal current_unittest = p;
     p();
-    p :: unittest_passes -> unittest_passes;
+    if expect_mishap then
+        lvars info = consfailureinfo( current_unittest, 'Required mishap skipped', '', [] );
+        p :: unittest_failures -> unittest_failures;
+    else
+        p :: unittest_passes -> unittest_passes;
+    endif
 enddefine;
 
 define discover_unittests( p );
@@ -94,7 +124,7 @@ enddefine;
 define run_all_unittests( unittest_list );
     dlocal unittest_passes = [];
     dlocal unittest_failures = [];
-    lvars L = [RETURNS % applist( unittest_list, run_unittest ) %]; 
+    lvars L = [RETURNS % applist( unittest_list, run_unittest ) %];
     ( unittest_passes, unittest_failures )
 enddefine;
 
@@ -106,34 +136,34 @@ define read_declaration( defdec ) -> ( pdrname, is_global, declarator );
             repeat
                 lvars item = nextreaditem();
                 if item == termin then
-                    mishap( 'Unexpected end of input in unittest definition', [] ) 
+                    mishap( 'Unexpected end of input in unittest definition', [] )
                 endif;
                 lvars id = identprops( item );
                 quitunless( id.isword );
                 quitunless( isstartstring( "syntax", id ) );
-                quitif( item == ";" );               
+                quitif( item == ";" );
                 readitem()
             endrepeat
         %]
     );
     readitem() -> pdrname;
-    
+
     false -> is_global;
     defdec -> declarator;
 
     lvars a;
     for a in attributes do
-        if a == "global" then 
+        if a == "global" then
             true -> is_global
         elseif a == "lconstant" then
             sysLCONSTANT -> declarator;
-        elseif a == "lvars" then 
+        elseif a == "lvars" then
             sysLVARS -> declarator;
-        elseif a == "constant" then 
+        elseif a == "constant" then
             sysCONSTANT -> declarator;
-        elseif a == "vars" then 
+        elseif a == "vars" then
             sysVARS -> declarator;
-        else 
+        else
             mishap( 'Unexpected syntax word', [^a] )
         endif
     endfor;
@@ -161,12 +191,12 @@ define :define_form global unittest;
 
     ;;; Main body.
     pop11_comp_stmnt_seq_to( "enddefine" ) -> _;
-  
+
     ;;; Run any registered tests.
     sysPUSH( "pop_unittests" );
-    sysPUSHQ( run_unittest );  
+    sysPUSHQ( run_unittest );
     sysCALL( "applist" );
-  
+
     sysPASSIGN( sysENDPROCEDURE(), pdrname );
     sysPUSH( pdrname );
     sysCALL( "register_unittest" );
@@ -188,7 +218,7 @@ define discovered_files( d );
         d.discovered_files_cache
     else
         lvars t = (
-            newanyproperty( 
+            newanyproperty(
                 [], 8, 1, 8,
                 syshash, nonop =, "perm",
                 false, false
@@ -222,7 +252,7 @@ define global syntax assert();
     define lconstant check_assertion( N, filename, linenum, expr );
         if N == 0 then
             mishap( 0, 'No results from assertion', 'unittest-assert:stack-empty' )
-        elseif N > 1 then 
+        elseif N > 1 then
             mishap( N, 'Too many results from assertion', 'unittest-assert:stack-many' )
         else
             lvars result = ();
@@ -251,10 +281,10 @@ enddefine;
 
 define select_scope_for_vedargument();
     if vedargument = '' then
-        if hasendstring( vedcurrent, unittest_suffix ) then            
+        if hasendstring( vedcurrent, unittest_suffix ) then
             ved_l1
-        elseif hasendstring( vedcurrent, '.p' ) then  
-            lvars dir = sys_fname_path( vedcurrent ); 
+        elseif hasendstring( vedcurrent, '.p' ) then
+            lvars dir = sys_fname_path( vedcurrent );
             lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
             procedure();
                 lvars file;
@@ -263,11 +293,11 @@ define select_scope_for_vedargument();
                     pop11_compile( file )
                 endfor
             endprocedure
-        else    
+        else
             mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
         endif
     else
-        lvars folder = sys_fname_path( vedcurrent ); 
+        lvars folder = sys_fname_path( vedcurrent );
         procedure();
             lvars file;
             for file in sys_file_match( folder, '*' <> unittest_suffix, false, false ).pdtolist do
@@ -275,24 +305,24 @@ define select_scope_for_vedargument();
                 pop11_compile( file )
             endfor
         endprocedure
-    endif 
+    endif
 enddefine;
 
 define select_file_scope_for_vedargument();
     if vedargument = '' then
-        if hasendstring( vedcurrent, unittest_suffix ) then            
+        if hasendstring( vedcurrent, unittest_suffix ) then
             ['CURRENT_BUFFER']
-        elseif hasendstring( vedcurrent, '.p' ) then  
-            lvars dir = sys_fname_path( vedcurrent ); 
+        elseif hasendstring( vedcurrent, '.p' ) then
+            lvars dir = sys_fname_path( vedcurrent );
             lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
             sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist;
-        else    
+        else
             mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
         endif
     else
-        lvars folder = sys_fname_path( vedargument ); 
+        lvars folder = sys_fname_path( vedargument );
         sys_file_match( folder, '.../*' <> unittest_suffix, false, false ).pdtolist;
-    endif 
+    endif
 enddefine;
 
 define ved_discover_files();
@@ -303,7 +333,7 @@ define ved_discover_files();
     ved_clear();
     vedpositionpush();
     dlocal cucharout = vedcharinsert;
-    
+
     lvars f;
     for f in files do
         npr( f )
@@ -375,29 +405,29 @@ define ved_discover();
     vedpositionpush();
 
     dlocal cucharout = vedcharinsert;
-    
+
     nprintf( 'Test discovery at: ' <> sysdaytime() );
     nl( 1 );
 
     nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
     ;;; vedinsertstring( sprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] ) );
     ;;; vedlinebelow();
-    
+
     lvars u, n;
     for u, n in d.discovered_unittests, up_from(1) do
         vedinsertstring( sprintf( '%p. %p', [% n, u %] ) );
         vedlinebelow();
-    endfor; 
+    endfor;
     vedlinebelow();
-    
+
     vedinsertstring( sprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] ) );
     vedlinebelow();
     lvars file, n;
     for file, n in d.discovered_files, up_from(1) do
         vedinsertstring( sprintf( '%p. %p', [% n, file %] ) );
         vedlinebelow();
-    endfor; 
-    
+    endfor;
+
     vedpositionpop();
 enddefine;
 
@@ -406,17 +436,17 @@ define ved_test();
     dlocal run_unittest = run_unittest_during_execution;
     dlocal fail_unittest = fail_unittest_during_execution;
     lvars disco = d.discovered_unittests;
-    lvars ( passes, failures ) = run_all_unittests( disco ); 
+    lvars ( passes, failures ) = run_all_unittests( disco );
 
     if null(failures) then
         lvars n_passes = passes.length;
         lvars n_failures = failures.length;
         sprintf(
             '%p pass%p, %p failure%p',
-            [% 
-                n_passes, 
+            [%
+                n_passes,
                 if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
-                n_failures, 
+                n_failures,
                 if n_failures == 1 then '' else 's' endif ;;; singular v plural
             %]
         ).vedputmessage;

From 5889fb36d5764dc028fdb4e0b1a01fa8d78e0f88 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 1 Oct 2021 12:56:55 +0100
Subject: [PATCH 10/32] Work in progress

---
 base/pop/getpoploglib/lib/define_unittest.p | 181 ++++++++++----------
 1 file changed, 90 insertions(+), 91 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index 8587c56d..c7267d6c 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -1,15 +1,18 @@
 compile_mode :pop11 +strict;
 
 section $-unittest =>
-    define_unittest
-    ved_test
-    register_unittest
+    define_unittest         ;;; used for defining unit tests
+    assert                  ;;; used for defining unit tests
+    expect_mishap           ;;; used for defining unit tests
+    ved_test                ;;; discovery and execution
     fail_unittest
-    ved_discover
-    ved_discover_files
-    pop_unittests
-    assert
-    expect_mishap;
+    ved_discover            ;;; performs test-discovery
+    run_unittests_files
+    unittests_discover
+    unittests_run
+    register_unittest       ;;; exported because of code-planting
+    pop_unittests           ;;; exported because of code-planting
+;
 
 vars expect_mishap = false;      ;;; Part of test-execution.
 
@@ -44,7 +47,7 @@ define vars register_unittest_during_discovery( u );
     if index do
         conscontext( index, poplinenum ) -> registration_table( u );
     endif;
-    u :: pop_unittests -> pop_unittests;
+    pop_unittests( u );
 enddefine;
 
 ;;; Part of test-execution.
@@ -69,10 +72,49 @@ define vars fail_unittest( info );
 enddefine;
 
 define fail_unittest_during_execution( info );
-    info :: unittest_failures -> unittest_failures;
+    unittest_failures( info ); 
     exitfrom( run_unittest )
 enddefine;
 
+define up_from( n );
+    procedure();
+        n;
+        n + 1 -> n;
+    endprocedure.pdtolist
+enddefine;
+
+define pr_show_failures( passes, failures );
+    nprintf( 'Test results at: ' <> sysdaytime() );
+    nl(1);
+
+    lvars i, n;
+    for i, n in failures, up_from(1) do
+        lvars ( u, msg, idstring, args ) = i.destfailureinfo;
+        if idstring = 'unittest-assert:unittest-fail' then
+            lvars name = u.pdprops;
+            nprintf( '%p.\tFailed    : %p', [^n ^name] );
+            lvars (filename, linenumber, assert_expr, _n) = args.destlist;
+            printf( '\tExpression: ' );
+            applist( [assert ^^assert_expr], spr );
+            nl(1);
+            nprintf( '\tLine num  : %p', [ ^linenumber ] );
+            nprintf( '\tFile name : %p', [ ^filename ] );
+        else
+            lvars name = u.pdprops;
+            nprintf( '%p.\tUnit test : %p', [^n ^name] );
+            nprintf( '\tMessage   : %p', [ ^msg ] );
+            unless args.null do
+                npr( '\tInvolving : ' );
+                lvars a;
+                for a in args do
+                    nprintf( '\t *\t%p', [^a] )
+                endfor;
+            endunless;
+        endif;
+        nl( 1 );
+    endfor;
+enddefine;
+
 ;;; This is the normal way to run a unit test & we will dlocalise run_unittest
 ;;; to its value.
 define run_unittest_during_execution( p );
@@ -108,24 +150,24 @@ define run_unittest_during_execution( p );
     p();
     if expect_mishap then
         lvars info = consfailureinfo( current_unittest, 'Required mishap skipped', '', [] );
-        p :: unittest_failures -> unittest_failures;
+        unittest_failures( p );
     else
-        p :: unittest_passes -> unittest_passes;
+        unittest_passes( p );
     endif
 enddefine;
 
 define discover_unittests( p );
-    dlocal pop_unittests = [];
+    dlocal pop_unittests = new_list_builder();
     dlocal register_unittest = register_unittest_during_discovery;
     erasenum(#| p() |#);
-    return( pop_unittests )
+    return( pop_unittests( termin ) )
 enddefine;
 
 define run_all_unittests( unittest_list );
-    dlocal unittest_passes = [];
-    dlocal unittest_failures = [];
-    lvars L = [RETURNS % applist( unittest_list, run_unittest ) %];
-    ( unittest_passes, unittest_failures )
+    dlocal unittest_passes = new_list_builder();
+    dlocal unittest_failures = new_list_builder();
+    [% applist( unittest_list, run_unittest ) %] -> _; ;;; defensive.
+    ( unittest_passes( termin ), unittest_failures( termin ) )
 enddefine;
 
 vars procedure unittest_sysVARS = sysVARS;
@@ -186,7 +228,7 @@ define :define_form global unittest;
     sysPUSH( "nil" );
     sysPOP( "pop_unittests" );
     sysLOCAL( "register_unittest" );
-    sysPUSHQ( procedure(u); u :: pop_unittests -> pop_unittests endprocedure );
+    sysPUSHQ( procedure(u); pop_unittests( u ) endprocedure );
     sysPOP( "register_unittest" );
 
     ;;; Main body.
@@ -308,90 +350,19 @@ define select_scope_for_vedargument();
     endif
 enddefine;
 
-define select_file_scope_for_vedargument();
-    if vedargument = '' then
-        if hasendstring( vedcurrent, unittest_suffix ) then
-            ['CURRENT_BUFFER']
-        elseif hasendstring( vedcurrent, '.p' ) then
-            lvars dir = sys_fname_path( vedcurrent );
-            lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
-            sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist;
-        else
-            mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
-        endif
-    else
-        lvars folder = sys_fname_path( vedargument );
-        sys_file_match( folder, '.../*' <> unittest_suffix, false, false ).pdtolist;
-    endif
-enddefine;
-
-define ved_discover_files();
-    lvars files = select_file_scope_for_vedargument();
-    dlocal vedpositionstack;
-
-    vededit( '*TEST FILES IN SCOPE*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
-    ved_clear();
-    vedpositionpush();
-    dlocal cucharout = vedcharinsert;
-
-    lvars f;
-    for f in files do
-        npr( f )
-    endfor;
-
-    vedpositionpop();
-enddefine;
-
 define test_discovery_in_ved();
     newdiscovered( discover_unittests( select_scope_for_vedargument() ) )
 enddefine;
 
-define up_from( n );
-    procedure();
-        n;
-        n + 1 -> n;
-    endprocedure.pdtolist
-enddefine;
-
 define show_failures( passes, failures );
     dlocal vedpositionstack;
-    lvars d = test_discovery_in_ved();
 
     vededit( '*TEST RESULTS*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
     ved_clear();
     vedpositionpush();
     dlocal cucharout = vedcharinsert;
 
-    nprintf( 'Test results at: ' <> sysdaytime() );
-    nl(1);
-
-    lvars p, n;
-    for p, n in failures, up_from(1) do
-        lvars ( u, mishap_details ) = p.destpair;
-        lvars ( msg, idstring, args ) = mishap_details.destfailureinfo;
-        if idstring = 'unittest-assert:unittest-fail' then
-            lvars name = u.pdprops;
-            nprintf( '%p.\tFailed    : %p', [^n ^name] );
-            lvars (filename, linenumber, assert_expr, _n) = args.destlist;
-            printf( '\tExpression: ' );
-            applist( [assert ^^assert_expr], spr );
-            nl(1);
-            nprintf( '\tLine num  : %p', [ ^linenumber ] );
-            nprintf( '\tFile name : %p', [ ^filename ] );
-        else
-            lvars name = u.pdprops;
-            nprintf( '%p.\tUnit test : %p', [^n ^name] );
-            nprintf( '\tMessage   : %p', [ ^msg ] );
-            unless args.null do
-                npr( '\tInvolving : ' );
-                lvars a;
-                for a in args do
-                    nprintf( '\t *\t%p', [^a] )
-                endfor;
-            endunless;
-        endif;
-        nl( 1 );
-    endfor;
+    pr_show_failures( passes, failures );
 
     vedpositionpop();
 enddefine;
@@ -455,4 +426,32 @@ define ved_test();
     endif;
 enddefine;
 
+;;; --- Loading from outside Ved ---
+
+define unittests_discover( location );
+    if hasendstring( location, unittest_suffix ) then
+        [% location %]
+    elseif hasendstring( location, '.p' ) then
+        lvars dir = sys_fname_path( location );
+        lvars name = sys_fname_nam( location ) <> unittest_suffix;
+        sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist;
+    else
+        lvars folder = sys_fname_path( location );
+        sys_file_match( folder, '*' <> unittest_suffix, false, false ).pdtolist
+    endif
+enddefine;
+
+define unittests_run( location );
+    lvars files = unittests_discover( location );
+    lvars tests = applist(% files, loadcompiler %).discover_unittests;
+    lvars d = newdiscovered( tests );
+
+    dlocal run_unittest = run_unittest_during_execution;
+    dlocal fail_unittest = fail_unittest_during_execution;
+    lvars disco = d.discovered_unittests;
+    lvars ( passes, failures ) = run_all_unittests( disco );
+
+    pr_show_failures( passes, failures );
+enddefine;
+
 endsection;

From 8ee71c0ee6d9c39e2b74f53aaf5b1d95af21729c Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 1 Oct 2021 13:09:38 +0100
Subject: [PATCH 11/32] Corrected bug

---
 base/pop/getpoploglib/lib/define_unittest.p | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index c7267d6c..e21eec64 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -5,11 +5,9 @@ section $-unittest =>
     assert                  ;;; used for defining unit tests
     expect_mishap           ;;; used for defining unit tests
     ved_test                ;;; discovery and execution
-    fail_unittest
     ved_discover            ;;; performs test-discovery
-    run_unittests_files
-    unittests_discover
-    unittests_run
+    unittests_discover      ;;; performs test-discovery at Pop-11 prompt
+    unittests_run           ;;; performs test discovery-and-execution at Pop-11 prompt
     register_unittest       ;;; exported because of code-planting
     pop_unittests           ;;; exported because of code-planting
 ;
@@ -225,7 +223,7 @@ define :define_form global unittest;
 
     ;;; Set up dynamic test discovery.
     sysLOCAL( "pop_unittests" );
-    sysPUSH( "nil" );
+    sysCALL( "new_list_builder" );
     sysPOP( "pop_unittests" );
     sysLOCAL( "register_unittest" );
     sysPUSHQ( procedure(u); pop_unittests( u ) endprocedure );

From c1ae3420b2bbbcb2015676c9731bc50356a708b0 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 1 Oct 2021 13:45:10 +0100
Subject: [PATCH 12/32] Numerous small fixes [ci skip]

---
 base/pop/getpoploglib/lib/define_unittest.p | 100 ++++++++++++--------
 1 file changed, 60 insertions(+), 40 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index e21eec64..d520edb9 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -9,7 +9,6 @@ section $-unittest =>
     unittests_discover      ;;; performs test-discovery at Pop-11 prompt
     unittests_run           ;;; performs test discovery-and-execution at Pop-11 prompt
     register_unittest       ;;; exported because of code-planting
-    pop_unittests           ;;; exported because of code-planting
 ;
 
 vars expect_mishap = false;      ;;; Part of test-execution.
@@ -82,6 +81,7 @@ define up_from( n );
 enddefine;
 
 define pr_show_failures( passes, failures );
+    dlocal poplinewidth = false;
     nprintf( 'Test results at: ' <> sysdaytime() );
     nl(1);
 
@@ -113,6 +113,7 @@ define pr_show_failures( passes, failures );
     endfor;
 enddefine;
 
+
 ;;; This is the normal way to run a unit test & we will dlocalise run_unittest
 ;;; to its value.
 define run_unittest_during_execution( p );
@@ -216,26 +217,31 @@ define read_declaration( defdec ) -> ( pdrname, is_global, declarator );
 enddefine;
 
 define :define_form global unittest;
+    dlocal pop_new_lvar_list;
+
+    define lconstant run_all( list_builder );
+        applist( list_builder( termin ), run_unittest )
+    enddefine;
+
     lvars ( pdrname, is_global, declarator ) = read_declaration( unittest_sysVARS );
     declarator( pdrname.isword and pdrname, 0 );
     if is_global then sysGLOBAL( pdrname, is_global ) endif;
     sysPROCEDURE( pdrname, 0 );
 
     ;;; Set up dynamic test discovery.
-    sysLOCAL( "pop_unittests" );
+    lvars collector = sysNEW_LVAR();
     sysCALL( "new_list_builder" );
-    sysPOP( "pop_unittests" );
+    sysPOP( collector );
     sysLOCAL( "register_unittest" );
-    sysPUSHQ( procedure(u); pop_unittests( u ) endprocedure );
+    sysPUSH( collector );
     sysPOP( "register_unittest" );
 
     ;;; Main body.
     pop11_comp_stmnt_seq_to( "enddefine" ) -> _;
 
     ;;; Run any registered tests.
-    sysPUSH( "pop_unittests" );
-    sysPUSHQ( run_unittest );
-    sysCALL( "applist" );
+    sysPUSH( collector );
+    sysCALLQ( run_all );
 
     sysPASSIGN( sysENDPROCEDURE(), pdrname );
     sysPUSH( pdrname );
@@ -275,6 +281,27 @@ define discovered_files( d );
     endif
 enddefine;
 
+define pr_show_discovered( d );
+    dlocal poplinewidth = false;
+    nprintf( 'Test discovery at: ' <> sysdaytime() );
+    nl( 1 );
+
+    nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
+
+    lvars u, n;
+    for u, n in d.discovered_unittests, up_from(1) do
+        nprintf( '%p. %p', [% n, u %] );
+    endfor;
+    nl(1);
+
+    nprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] );
+    lvars file, n;
+    for file, n in d.discovered_files, up_from(1) do
+        nprintf( '%p. %p', [% n, file %] );
+    endfor;
+enddefine;
+
+
 define peek_expr_to( closing_keyword );
     dlocal pop_syntax_only = true;
     dlocal proglist_state;
@@ -336,15 +363,16 @@ define select_scope_for_vedargument();
         else
             mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
         endif
-    else
-        lvars folder = sys_fname_path( vedcurrent );
-        procedure();
+    elseif sysisdirectory( vedargument ) then
+        procedure( folder );
             lvars file;
-            for file in sys_file_match( folder, '*' <> unittest_suffix, false, false ).pdtolist do
+            for file in sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist do
                 vedputmessage( 'COMPILING ' >< file );
                 pop11_compile( file )
             endfor
-        endprocedure
+        endprocedure(% vedargument %)
+    else
+        identfn(% [] %)
     endif
 enddefine;
 
@@ -365,6 +393,7 @@ define show_failures( passes, failures );
     vedpositionpop();
 enddefine;
 
+
 define ved_discover();
     dlocal vedpositionstack;
     lvars d = test_discovery_in_ved();
@@ -375,27 +404,7 @@ define ved_discover();
 
     dlocal cucharout = vedcharinsert;
 
-    nprintf( 'Test discovery at: ' <> sysdaytime() );
-    nl( 1 );
-
-    nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
-    ;;; vedinsertstring( sprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] ) );
-    ;;; vedlinebelow();
-
-    lvars u, n;
-    for u, n in d.discovered_unittests, up_from(1) do
-        vedinsertstring( sprintf( '%p. %p', [% n, u %] ) );
-        vedlinebelow();
-    endfor;
-    vedlinebelow();
-
-    vedinsertstring( sprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] ) );
-    vedlinebelow();
-    lvars file, n;
-    for file, n in d.discovered_files, up_from(1) do
-        vedinsertstring( sprintf( '%p. %p', [% n, file %] ) );
-        vedlinebelow();
-    endfor;
+    pr_show_discovered( d );
 
     vedpositionpop();
 enddefine;
@@ -426,23 +435,34 @@ enddefine;
 
 ;;; --- Loading from outside Ved ---
 
-define unittests_discover( location );
+define find_unittest_files( location );
     if hasendstring( location, unittest_suffix ) then
         [% location %]
     elseif hasendstring( location, '.p' ) then
         lvars dir = sys_fname_path( location );
         lvars name = sys_fname_nam( location ) <> unittest_suffix;
         sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist;
-    else
+    elseif sysisdirectory( location ) then
         lvars folder = sys_fname_path( location );
-        sys_file_match( folder, '*' <> unittest_suffix, false, false ).pdtolist
-    endif
+        sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist
+    else 
+        []
+    endif.expandlist
 enddefine;
 
-define unittests_run( location );
-    lvars files = unittests_discover( location );
+define find_unittests( location );
+    lvars files = find_unittest_files( location );
     lvars tests = applist(% files, loadcompiler %).discover_unittests;
-    lvars d = newdiscovered( tests );
+    return( newdiscovered( tests ) )
+enddefine;
+
+define unittests_discover( location );
+    lvars d = find_unittests( location );
+    pr_show_discovered( d );
+enddefine;
+
+define unittests_run( location );
+    lvars d = find_unittests( location );
 
     dlocal run_unittest = run_unittest_during_execution;
     dlocal fail_unittest = fail_unittest_during_execution;

From 228254030ef798cf5558b54c43b22b2f1d5aa7bd Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 1 Oct 2021 19:22:57 +0100
Subject: [PATCH 13/32] new_list_builder in progress

---
 base/pop/getpoploglib/auto/new_list_builder.p | 20 +++++++++++++++++++
 1 file changed, 20 insertions(+)
 create mode 100644 base/pop/getpoploglib/auto/new_list_builder.p

diff --git a/base/pop/getpoploglib/auto/new_list_builder.p b/base/pop/getpoploglib/auto/new_list_builder.p
new file mode 100644
index 00000000..a1769c46
--- /dev/null
+++ b/base/pop/getpoploglib/auto/new_list_builder.p
@@ -0,0 +1,20 @@
+compile_mode :pop11 +strict;
+
+section;
+
+define new_list_builder();
+    lvars first_pair = conspair( _, nil );
+    lvars last_pair = first_pair;
+    procedure( item ) with_props list_builder;
+        if item == termin then
+            lvars result = fast_back( first_pair );
+            nil -> fast_back( first_pair );
+            first_pair -> last_pair;
+            result
+        else
+            conspair( item, nil ) ->> fast_back( last_pair ) -> last_pair
+        endif
+    endprocedure 
+enddefine;
+
+endsection;
\ No newline at end of file

From 61cc7c97265fdae2965ec392b1b01c5cd18ca7fa Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 1 Oct 2021 23:48:39 +0100
Subject: [PATCH 14/32] Add library new_list_builder

---
 base/pop/getpoploglib/auto/new_list_builder.p | 68 +++++++++++++---
 base/pop/getpoploglib/help/new_list_builder   | 79 +++++++++++++++++++
 2 files changed, 136 insertions(+), 11 deletions(-)
 create mode 100644 base/pop/getpoploglib/help/new_list_builder

diff --git a/base/pop/getpoploglib/auto/new_list_builder.p b/base/pop/getpoploglib/auto/new_list_builder.p
index a1769c46..a3305616 100644
--- a/base/pop/getpoploglib/auto/new_list_builder.p
+++ b/base/pop/getpoploglib/auto/new_list_builder.p
@@ -2,19 +2,65 @@ compile_mode :pop11 +strict;
 
 section;
 
-define new_list_builder();
+define lconstant list_builder( item, first_pair_ref, last_pair_ref );
+    if item == termin then
+        lvars first_pair = fast_cont( first_pair_ref );
+        lvars result = fast_back( first_pair );
+        nil -> fast_back( first_pair );
+        first_pair -> fast_cont( last_pair_ref );
+        result
+    else
+        lvars last_pair = fast_cont( last_pair_ref );
+        conspair( item, nil ) ->> fast_back( last_pair ) -> fast_cont( last_pair_ref )
+    endif
+enddefine;
+
+define global new_list_builder();
     lvars first_pair = conspair( _, nil );
     lvars last_pair = first_pair;
-    procedure( item ) with_props list_builder;
-        if item == termin then
-            lvars result = fast_back( first_pair );
-            nil -> fast_back( first_pair );
-            first_pair -> last_pair;
-            result
-        else
-            conspair( item, nil ) ->> fast_back( last_pair ) -> last_pair
+    list_builder(% consref( first_pair ), consref( last_pair ) %)
+enddefine;
+
+define global is_list_builder( p );
+    p.isclosure and p.pdpart == list_builder
+enddefine;
+
+define global list_builder_copylist( p );
+    if p.is_list_builder then
+        copylist( frozval( 1, p ).cont.back )
+    else
+        mishap( 'List builder required', [^p] )
+    endif
+enddefine;
+
+define global list_builder_push_front( item, p );
+    if p.is_list_builder then
+        lvars r = frozval( 1, p );
+        lvars s = frozval( 2, p );
+        lvars same = r.cont == s.cont;
+        conspair( item, r.cont.back ) -> r.cont.back;
+        if same then
+            r.cont.back -> s.cont
         endif
-    endprocedure 
+    else
+        mishap( 'List builder required', [^p] )
+    endif
+enddefine;
+
+define global list_builder_push_back( item, p );
+    if p.is_list_builder then
+        p( item )
+    else
+        mishap( 'List builder required', [^p] )
+    endif
+enddefine;
+
+define global list_builder_newlist( p );
+    if p.is_list_builder then
+        p( termin )
+    else
+        mishap( 'List builder required', [^p] )
+    endif
 enddefine;
 
-endsection;
\ No newline at end of file
+endsection;
diff --git a/base/pop/getpoploglib/help/new_list_builder b/base/pop/getpoploglib/help/new_list_builder
new file mode 100644
index 00000000..b9529778
--- /dev/null
+++ b/base/pop/getpoploglib/help/new_list_builder
@@ -0,0 +1,79 @@
+HELP NEW_LIST_BUILDER                                 Stephen Leach, Sept 2021
+
+    new_list_builder() -> builder
+    builder( item )
+    builder( termin ) -> list
+
+    is_list_builder( item ) -> bool
+    list_builder_push_front( item, builder )
+    list_builder_push_back( item, builder )
+    list_builder_copylist( builder ) -> list
+    list_builder_newlist( builder ) -> list
+
+
+         CONTENTS - (Use <ENTER> g to access required sections)
+
+ -- Introduction
+ -- Predicates on List Builders
+ -- Constructing List Builders
+ -- Manipulating List Builders
+
+
+-- Introduction -------------------------------------------------------
+
+A list-builder is a consumer procedure that constructs a list from all the
+items that it is applied to. It is particularly useful for building lists
+by adding to the end of the list, although you can also add to the start of
+the list as an alternative.
+
+The builder returns the list when it is applied to the special item <termin>.
+For example:
+
+
+    Setpop
+    : vars b = new_list_builder();
+    : b( 1 );
+    : b( true );
+    : b( 'three' );
+    : b( termin ) =>
+    ** [1 <true> three]
+    :
+
+
+-- Predicates on List Builders ----------------------------------------
+
+List builders are closures so both isprocedure and isclosure is true
+for any list builder.
+
+is_list_builder( item ) -> bool
+        Returns true if item is a list builder, false if not.
+
+
+-- Constructing List Builders -----------------------------------------
+
+
+new_list_builder() -> list_builder
+        Returns a new, empty list builder.
+
+
+-- Manipulating List Builders -----------------------------------------
+
+list_builder_push_front( item, builder )
+        Adds an item to the start of the list that is being built.
+
+
+list_builder_push_back( item, builder )
+        Adds an item to the end of the list that is being built. This
+        is the same as calling builder( item )
+
+
+list_builder_copylist( builder ) -> list
+        This takes a copy of the in-progress list that is being built.
+        Each time you take a copy you get a completely new list.
+
+
+list_builder_newlist( builder ) -> list
+        This returns the in-progress list _and_ resets the builder back
+        to its initial empty state.
+
+--- Copyright GetPoplog (c) 2021.

From 67f3ea942c33dcabdfb90e2efeb9c274ca9718db Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 1 Oct 2021 23:52:26 +0100
Subject: [PATCH 15/32] Add more documentation

---
 base/pop/getpoploglib/help/new_list_builder | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/base/pop/getpoploglib/help/new_list_builder b/base/pop/getpoploglib/help/new_list_builder
index b9529778..e530f7fa 100644
--- a/base/pop/getpoploglib/help/new_list_builder
+++ b/base/pop/getpoploglib/help/new_list_builder
@@ -1,5 +1,7 @@
 HELP NEW_LIST_BUILDER                                 Stephen Leach, Sept 2021
 
+    uses new_list_builder
+
     new_list_builder() -> builder
     builder( item )
     builder( termin ) -> list

From 86ea1d0ab45b7eea042184d52367ad300aaf87dd Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 00:21:56 +0100
Subject: [PATCH 16/32] Fix issue with semi-colon being eaten [ci skip]

---
 base/pop/getpoploglib/lib/define_unittest.p | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index d520edb9..912ecb55 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -306,7 +306,7 @@ define peek_expr_to( closing_keyword );
     dlocal pop_syntax_only = true;
     dlocal proglist_state;
     lvars old_proglist = proglist;
-    pop11_comp_expr_to( ";" ) -> _;
+    pop11_comp_expr_to( closing_keyword ) -> _;
     [%
         while old_proglist.ispair and not( old_proglist.back.isprocedure ) do
             old_proglist.destpair -> old_proglist
@@ -334,7 +334,7 @@ define global syntax assert();
     sysCALL( "stacklength" );
     sysPOP( t );
     lvars expr = peek_expr_to( ";" );
-    pop11_comp_expr_to( ";" ) -> _;
+    pop11_comp_expr();
     sysCALL( "stacklength" );
     sysPUSH( t );
     sysCALL( "fi_-" );

From 07f844ea0e861e04cf820e6e293813661c3a5c69 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 11:23:44 +0100
Subject: [PATCH 17/32] Replacing up_from with an autoloadable list_from,
 anticipating the restructuring [ci skip]

---
 base/pop/getpoploglib/auto/list_from.p      | 11 ++++++
 base/pop/getpoploglib/auto/repeater_from.p  | 25 +++++++++++++
 base/pop/getpoploglib/help/list_from        | 41 +++++++++++++++++++++
 base/pop/getpoploglib/help/repeater_from    | 34 +++++++++++++++++
 base/pop/getpoploglib/lib/define_unittest.p | 13 ++-----
 5 files changed, 114 insertions(+), 10 deletions(-)
 create mode 100644 base/pop/getpoploglib/auto/list_from.p
 create mode 100644 base/pop/getpoploglib/auto/repeater_from.p
 create mode 100644 base/pop/getpoploglib/help/list_from
 create mode 100644 base/pop/getpoploglib/help/repeater_from

diff --git a/base/pop/getpoploglib/auto/list_from.p b/base/pop/getpoploglib/auto/list_from.p
new file mode 100644
index 00000000..92b63e6b
--- /dev/null
+++ b/base/pop/getpoploglib/auto/list_from.p
@@ -0,0 +1,11 @@
+compile_mode :pop11 +strict;
+
+section;
+
+;;; list_from( n: num ) -> [ n, n+1, ... ]
+;;; list_from( item, p: item -> item ) -> [ item, p(item), p(p(item)), ... ]
+define global list_from() with_nargs 1;
+    repeater_from( /* take args from stack */ ).pdtolist
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/repeater_from.p b/base/pop/getpoploglib/auto/repeater_from.p
new file mode 100644
index 00000000..c682926b
--- /dev/null
+++ b/base/pop/getpoploglib/auto/repeater_from.p
@@ -0,0 +1,25 @@
+compile_mode :pop11 +strict;
+
+section;
+
+;;; repeater_from( n: num )
+;;; repeater_from( item, p: item -> item )
+define global repeater_from( n );
+    if n.isnumber then
+        procedure();
+            n;
+            n + 1 -> n;
+        endprocedure
+    elseif n.isprocedure then
+        lvars p = n;
+        lvars n = ();
+        procedure();
+            n;
+            p( n ) -> n
+        endprocedure
+    else
+        mishap( 'Unexpected argument', [^n] )
+    endif
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/help/list_from b/base/pop/getpoploglib/help/list_from
new file mode 100644
index 00000000..b7196c98
--- /dev/null
+++ b/base/pop/getpoploglib/help/list_from
@@ -0,0 +1,41 @@
+HELP LIST_FROM                                          Stephen Leach, Oct 2021
+
+    list_from( n: num ) -> [ n, n+1, n+2, ... ]
+    list_from( n: item, procedure p ) -> [ n, p(n), p(p(n)), ... ]
+
+This function is used to construct non-terminating lists. If called with a
+single numerical argument it returns a list whose first member is n, and
+whose next member is n+1, then n+2 etc. For example:
+
+    Setpop
+    : vars list = list_from(1);
+    : list =>
+    ** [...]
+    : list(1) =>
+    ** 1
+    : list(2) =>
+    ** 2
+    : list(3) =>
+    ** 3
+    : list =>
+    ** [1 2 3 ...]
+    :
+
+If it is called with a procedure then the list that is returned contains
+n, p(n), p(p(n)), etc. For example:
+
+    Setpop
+    : vars L = list_from( 1, nonop *(% 2 %) );
+    : L =>
+    ** [...]
+    : L(1) =>
+    ** 1
+    : L(2) =>
+    ** 2
+    : L(3) =>
+    ** 4
+    : L(4) =>
+    ** 8
+    : L =>
+    ** [1 2 4 8 ...]
+    :
diff --git a/base/pop/getpoploglib/help/repeater_from b/base/pop/getpoploglib/help/repeater_from
new file mode 100644
index 00000000..37ac5dab
--- /dev/null
+++ b/base/pop/getpoploglib/help/repeater_from
@@ -0,0 +1,34 @@
+HELP REPEATER_FROM                                      Stephen Leach, Oct 2021
+
+    repeater_from( n: num ) -> r
+    repeater_from( n: item, procedure p ) -> r
+
+This function is used to construct non-terminating repeaters. If called with a
+single numerical argument it returns a repeater that generates n, then n+1,
+then n+2 etc. For example:
+
+    Setpop
+    : vars r = repeater_from(1);
+    : r() =>
+    ** 1
+    : r() =>
+    ** 2
+    : r() =>
+    ** 3
+    :
+
+
+If it is called with a procedure then the repeater that is returned, when called,
+will generate n, p(n), p(p(n)), etc. For example:
+
+    Setpop
+    : vars r = repeater_from( false, not );
+    : r() =>
+    ** <false>
+    : r() =>
+    ** <true>
+    : r() =>
+    ** <false>
+    : r() =>
+    ** <true>
+    :
diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index 912ecb55..92e96eb2 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -73,20 +73,13 @@ define fail_unittest_during_execution( info );
     exitfrom( run_unittest )
 enddefine;
 
-define up_from( n );
-    procedure();
-        n;
-        n + 1 -> n;
-    endprocedure.pdtolist
-enddefine;
-
 define pr_show_failures( passes, failures );
     dlocal poplinewidth = false;
     nprintf( 'Test results at: ' <> sysdaytime() );
     nl(1);
 
     lvars i, n;
-    for i, n in failures, up_from(1) do
+    for i, n in failures, list_from(1) do
         lvars ( u, msg, idstring, args ) = i.destfailureinfo;
         if idstring = 'unittest-assert:unittest-fail' then
             lvars name = u.pdprops;
@@ -289,14 +282,14 @@ define pr_show_discovered( d );
     nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
 
     lvars u, n;
-    for u, n in d.discovered_unittests, up_from(1) do
+    for u, n in d.discovered_unittests, list_from(1) do
         nprintf( '%p. %p', [% n, u %] );
     endfor;
     nl(1);
 
     nprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] );
     lvars file, n;
-    for file, n in d.discovered_files, up_from(1) do
+    for file, n in d.discovered_files, list_from(1) do
         nprintf( '%p. %p', [% n, file %] );
     endfor;
 enddefine;

From e43b79716061921b0f18984870e40d488da32b91 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 12:23:41 +0100
Subject: [PATCH 18/32] Splitting up the main file

---
 .../getpoploglib/auto/unittests_discover.p    |  1 +
 base/pop/getpoploglib/auto/unittests_run.p    | 47 +++++++++
 base/pop/getpoploglib/auto/ved_discover.p     |  1 +
 base/pop/getpoploglib/auto/ved_test.p         | 99 +++++++++++++++++++
 4 files changed, 148 insertions(+)
 create mode 100644 base/pop/getpoploglib/auto/unittests_discover.p
 create mode 100644 base/pop/getpoploglib/auto/unittests_run.p
 create mode 100644 base/pop/getpoploglib/auto/ved_discover.p
 create mode 100644 base/pop/getpoploglib/auto/ved_test.p

diff --git a/base/pop/getpoploglib/auto/unittests_discover.p b/base/pop/getpoploglib/auto/unittests_discover.p
new file mode 100644
index 00000000..46d73f8b
--- /dev/null
+++ b/base/pop/getpoploglib/auto/unittests_discover.p
@@ -0,0 +1 @@
+uses unittests_run;
diff --git a/base/pop/getpoploglib/auto/unittests_run.p b/base/pop/getpoploglib/auto/unittests_run.p
new file mode 100644
index 00000000..79441ba8
--- /dev/null
+++ b/base/pop/getpoploglib/auto/unittests_run.p
@@ -0,0 +1,47 @@
+compile_mode :pop11 +strict;
+
+uses define_unittest;
+
+section $-unittest =>
+    unittests_discover      ;;; performs test-discovery at Pop-11 prompt
+    unittests_run           ;;; performs test discovery-and-execution at Pop-11 prompt
+;
+
+define find_unittest_files( location );
+    if hasendstring( location, unittest_suffix ) then
+        [% location %]
+    elseif hasendstring( location, '.p' ) then
+        lvars dir = sys_fname_path( location );
+        lvars name = sys_fname_nam( location ) <> unittest_suffix;
+        sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist;
+    elseif sysisdirectory( location ) then
+        lvars folder = sys_fname_path( location );
+        sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist
+    else 
+        []
+    endif.expandlist
+enddefine;
+
+define find_unittests( location );
+    lvars files = find_unittest_files( location );
+    lvars tests = applist(% files, loadcompiler %).discover_unittests;
+    return( newdiscovered( tests ) )
+enddefine;
+
+define unittests_discover( location );
+    lvars d = find_unittests( location );
+    pr_show_discovered( d );
+enddefine;
+
+define unittests_run( location );
+    lvars d = find_unittests( location );
+
+    dlocal run_unittest = run_unittest_during_execution;
+    dlocal fail_unittest = fail_unittest_during_execution;
+    lvars disco = d.discovered_unittests;
+    lvars ( passes, failures ) = run_all_unittests( disco );
+
+    pr_show_failures( passes, failures );
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/ved_discover.p b/base/pop/getpoploglib/auto/ved_discover.p
new file mode 100644
index 00000000..37590841
--- /dev/null
+++ b/base/pop/getpoploglib/auto/ved_discover.p
@@ -0,0 +1 @@
+uses ved_test;
diff --git a/base/pop/getpoploglib/auto/ved_test.p b/base/pop/getpoploglib/auto/ved_test.p
new file mode 100644
index 00000000..4991012e
--- /dev/null
+++ b/base/pop/getpoploglib/auto/ved_test.p
@@ -0,0 +1,99 @@
+compile_mode :pop11 +strict;
+
+uses define_unittest;
+
+section $-unittest =>
+    ved_test                ;;; discovery and execution
+    ved_discover            ;;; performs test-discovery
+;
+
+;;; -- VED integration ---
+
+define select_scope_for_vedargument();
+    if vedargument = '' then
+        if hasendstring( vedcurrent, unittest_suffix ) then
+            ved_l1
+        elseif hasendstring( vedcurrent, '.p' ) then
+            lvars dir = sys_fname_path( vedcurrent );
+            lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
+            procedure();
+                lvars file;
+                for file in sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist do
+                    vedputmessage( 'COMPILING ' >< file );
+                    pop11_compile( file )
+                endfor
+            endprocedure
+        else
+            mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
+        endif
+    elseif sysisdirectory( vedargument ) then
+        procedure( folder );
+            lvars file;
+            for file in sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist do
+                vedputmessage( 'COMPILING ' >< file );
+                pop11_compile( file )
+            endfor
+        endprocedure(% vedargument %)
+    else
+        identfn(% [] %)
+    endif
+enddefine;
+
+define test_discovery_in_ved();
+    newdiscovered( discover_unittests( select_scope_for_vedargument() ) )
+enddefine;
+
+define show_failures( passes, failures );
+    dlocal vedpositionstack;
+
+    vededit( '*TEST RESULTS*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
+    ved_clear();
+    vedpositionpush();
+    dlocal cucharout = vedcharinsert;
+
+    pr_show_failures( passes, failures );
+
+    vedpositionpop();
+enddefine;
+
+
+define ved_discover();
+    dlocal vedpositionstack;
+    lvars d = test_discovery_in_ved();
+
+    vededit( '*TESTS DISCOVERED*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
+    ved_clear();
+    vedpositionpush();
+
+    dlocal cucharout = vedcharinsert;
+
+    pr_show_discovered( d );
+
+    vedpositionpop();
+enddefine;
+
+define ved_test();
+    lvars d = test_discovery_in_ved();
+    dlocal run_unittest = run_unittest_during_execution;
+    dlocal fail_unittest = fail_unittest_during_execution;
+    lvars disco = d.discovered_unittests;
+    lvars ( passes, failures ) = run_all_unittests( disco );
+
+    if null(failures) then
+        lvars n_passes = passes.length;
+        lvars n_failures = failures.length;
+        sprintf(
+            '%p pass%p, %p failure%p',
+            [%
+                n_passes,
+                if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
+                n_failures,
+                if n_failures == 1 then '' else 's' endif ;;; singular v plural
+            %]
+        ).vedputmessage;
+    else
+        show_failures( passes, failures )
+    endif;
+enddefine;
+
+endsection;

From 18931af0e85466bf95a82b10417db75902ad695e Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 14:20:08 +0100
Subject: [PATCH 19/32] Implemented with_data [ci skip]

---
 base/pop/getpoploglib/auto/ved_test.p       |  28 +-
 base/pop/getpoploglib/lib/define_unittest.p | 277 +++++++-------------
 2 files changed, 106 insertions(+), 199 deletions(-)

diff --git a/base/pop/getpoploglib/auto/ved_test.p b/base/pop/getpoploglib/auto/ved_test.p
index 4991012e..4bd2f137 100644
--- a/base/pop/getpoploglib/auto/ved_test.p
+++ b/base/pop/getpoploglib/auto/ved_test.p
@@ -79,21 +79,21 @@ define ved_test();
     lvars disco = d.discovered_unittests;
     lvars ( passes, failures ) = run_all_unittests( disco );
 
-    if null(failures) then
-        lvars n_passes = passes.length;
-        lvars n_failures = failures.length;
-        sprintf(
-            '%p pass%p, %p failure%p',
-            [%
-                n_passes,
-                if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
-                n_failures,
-                if n_failures == 1 then '' else 's' endif ;;; singular v plural
-            %]
-        ).vedputmessage;
-    else
+    unless null(failures) then
         show_failures( passes, failures )
-    endif;
+    endunless;
+
+    lvars n_passes = passes.length;
+    lvars n_failures = failures.length;
+    sprintf(
+        '%p pass%p, %p failure%p',
+        [%
+            n_passes,
+            if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
+            n_failures,
+            if n_failures == 1 then '' else 's' endif ;;; singular v plural
+        %]
+    ).vedputmessage;
 enddefine;
 
 endsection;
diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index 92e96eb2..0138fe37 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -4,14 +4,11 @@ section $-unittest =>
     define_unittest         ;;; used for defining unit tests
     assert                  ;;; used for defining unit tests
     expect_mishap           ;;; used for defining unit tests
-    ved_test                ;;; discovery and execution
-    ved_discover            ;;; performs test-discovery
-    unittests_discover      ;;; performs test-discovery at Pop-11 prompt
-    unittests_run           ;;; performs test discovery-and-execution at Pop-11 prompt
+    with_data               ;;; used for defining unit tests with scenario data
     register_unittest       ;;; exported because of code-planting
 ;
 
-vars expect_mishap = false;      ;;; Part of test-execution.
+vars expect_mishap = false;     ;;; Part of test-execution.
 
 vars pop_unittests = undef;     ;;; Part of test-discovery.
 vars unittest_passes = undef;   ;;; Part of test-execution.
@@ -73,40 +70,6 @@ define fail_unittest_during_execution( info );
     exitfrom( run_unittest )
 enddefine;
 
-define pr_show_failures( passes, failures );
-    dlocal poplinewidth = false;
-    nprintf( 'Test results at: ' <> sysdaytime() );
-    nl(1);
-
-    lvars i, n;
-    for i, n in failures, list_from(1) do
-        lvars ( u, msg, idstring, args ) = i.destfailureinfo;
-        if idstring = 'unittest-assert:unittest-fail' then
-            lvars name = u.pdprops;
-            nprintf( '%p.\tFailed    : %p', [^n ^name] );
-            lvars (filename, linenumber, assert_expr, _n) = args.destlist;
-            printf( '\tExpression: ' );
-            applist( [assert ^^assert_expr], spr );
-            nl(1);
-            nprintf( '\tLine num  : %p', [ ^linenumber ] );
-            nprintf( '\tFile name : %p', [ ^filename ] );
-        else
-            lvars name = u.pdprops;
-            nprintf( '%p.\tUnit test : %p', [^n ^name] );
-            nprintf( '\tMessage   : %p', [ ^msg ] );
-            unless args.null do
-                npr( '\tInvolving : ' );
-                lvars a;
-                for a in args do
-                    nprintf( '\t *\t%p', [^a] )
-                endfor;
-            endunless;
-        endif;
-        nl( 1 );
-    endfor;
-enddefine;
-
-
 ;;; This is the normal way to run a unit test & we will dlocalise run_unittest
 ;;; to its value.
 define run_unittest_during_execution( p );
@@ -175,7 +138,7 @@ define read_declaration( defdec ) -> ( pdrname, is_global, declarator );
                 lvars id = identprops( item );
                 quitunless( id.isword );
                 quitunless( isstartstring( "syntax", id ) );
-                quitif( item == ";" );
+                quitif( item == ";" or item == "(" );
                 readitem()
             endrepeat
         %]
@@ -202,14 +165,15 @@ define read_declaration( defdec ) -> ( pdrname, is_global, declarator );
         endif
     endfor;
 
-    if pdrname == ";" then
+    if pdrname == ";" or item == "(" then
+        pdrname :: proglist -> proglist;
         sysNEW_LVAR() -> pdrname;
         false -> is_global;
         procedure( w, n ); endprocedure -> declarator;
     endif;
 enddefine;
 
-define :define_form global unittest;
+define core_define_unittest();
     dlocal pop_new_lvar_list;
 
     define lconstant run_all( list_builder );
@@ -230,17 +194,53 @@ define :define_form global unittest;
     sysPOP( "register_unittest" );
 
     ;;; Main body.
-    pop11_comp_stmnt_seq_to( "enddefine" ) -> _;
+    sysCALLQ( pop11_comp_procedure( "enddefine", false, pdrname and pdrname >< "_body" or "unittest_body" ) );
 
     ;;; Run any registered tests.
     sysPUSH( collector );
     sysCALLQ( run_all );
 
     sysPASSIGN( sysENDPROCEDURE(), pdrname );
+
+    return( pdrname );
+enddefine;
+
+define :define_form global unittest;
+    lvars pdrname = core_define_unittest();
     sysPUSH( pdrname );
     sysCALL( "register_unittest" );
 enddefine;
 
+;;; with_data
+;;;     [0 1]
+;;;     [1 2]
+;;; define :unittest foo( x, y );
+;;; enddefine;
+define syntax with_data;
+
+    define register_closures( data, pdr );
+        lvars d;
+        for d in data do
+            register_unittest( pdr(% d.explode %) )
+        endfor
+    enddefine;
+
+    dlocal pop_new_lvar_list;
+    lvars data = sysNEW_LVAR();
+    sysPUSH( "popstackmark" );
+    until pop11_try_nextitem( "define" ) do
+        pop11_comp_expr();
+    enduntil;
+    pop11_need_nextreaditem( ":" ) -> _;
+    pop11_need_nextreaditem( "unittest" ) -> _;
+    sysCALL( "sysconslist" );
+    sysPOP( data );
+    lvars pdrname = core_define_unittest();
+    sysPUSH( data );
+    sysPUSH( pdrname );
+    sysCALLQ( register_closures );
+enddefine;
+
 constant unittest_suffix = '.test.p';
 
 defclass discovered {
@@ -274,28 +274,7 @@ define discovered_files( d );
     endif
 enddefine;
 
-define pr_show_discovered( d );
-    dlocal poplinewidth = false;
-    nprintf( 'Test discovery at: ' <> sysdaytime() );
-    nl( 1 );
-
-    nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
-
-    lvars u, n;
-    for u, n in d.discovered_unittests, list_from(1) do
-        nprintf( '%p. %p', [% n, u %] );
-    endfor;
-    nl(1);
-
-    nprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] );
-    lvars file, n;
-    for file, n in d.discovered_files, list_from(1) do
-        nprintf( '%p. %p', [% n, file %] );
-    endfor;
-enddefine;
-
-
-define peek_expr_to( closing_keyword );
+define lconstant peek_expr_to( closing_keyword );
     dlocal pop_syntax_only = true;
     dlocal proglist_state;
     lvars old_proglist = proglist;
@@ -337,132 +316,60 @@ define global syntax assert();
     sysCALLQ( check_assertion );
 enddefine;
 
-;;; -- VED integration ---
-
-define select_scope_for_vedargument();
-    if vedargument = '' then
-        if hasendstring( vedcurrent, unittest_suffix ) then
-            ved_l1
-        elseif hasendstring( vedcurrent, '.p' ) then
-            lvars dir = sys_fname_path( vedcurrent );
-            lvars name = sys_fname_nam( vedcurrent ) <> unittest_suffix;
-            procedure();
-                lvars file;
-                for file in sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist do
-                    vedputmessage( 'COMPILING ' >< file );
-                    pop11_compile( file )
-                endfor
-            endprocedure
-        else
-            mishap( 'No tests found', [vedargument ^vedargument vedcurrent ^vedcurrent] )
-        endif
-    elseif sysisdirectory( vedargument ) then
-        procedure( folder );
-            lvars file;
-            for file in sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist do
-                vedputmessage( 'COMPILING ' >< file );
-                pop11_compile( file )
-            endfor
-        endprocedure(% vedargument %)
-    else
-        identfn(% [] %)
-    endif
-enddefine;
-
-define test_discovery_in_ved();
-    newdiscovered( discover_unittests( select_scope_for_vedargument() ) )
-enddefine;
-
-define show_failures( passes, failures );
-    dlocal vedpositionstack;
-
-    vededit( '*TEST RESULTS*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
-    ved_clear();
-    vedpositionpush();
-    dlocal cucharout = vedcharinsert;
-
-    pr_show_failures( passes, failures );
-
-    vedpositionpop();
-enddefine;
-
-
-define ved_discover();
-    dlocal vedpositionstack;
-    lvars d = test_discovery_in_ved();
-
-    vededit( '*TESTS DISCOVERED*', procedure(); vedhelpdefaults(); false -> vedbreak; endprocedure );
-    ved_clear();
-    vedpositionpush();
-
-    dlocal cucharout = vedcharinsert;
-
-    pr_show_discovered( d );
-
-    vedpositionpop();
-enddefine;
-
-define ved_test();
-    lvars d = test_discovery_in_ved();
-    dlocal run_unittest = run_unittest_during_execution;
-    dlocal fail_unittest = fail_unittest_during_execution;
-    lvars disco = d.discovered_unittests;
-    lvars ( passes, failures ) = run_all_unittests( disco );
-
-    if null(failures) then
-        lvars n_passes = passes.length;
-        lvars n_failures = failures.length;
-        sprintf(
-            '%p pass%p, %p failure%p',
-            [%
-                n_passes,
-                if n_passes == 1 then '' else 'es' endif, ;;; singular v plural
-                n_failures,
-                if n_failures == 1 then '' else 's' endif ;;; singular v plural
-            %]
-        ).vedputmessage;
-    else
-        show_failures( passes, failures )
-    endif;
-enddefine;
-
-;;; --- Loading from outside Ved ---
-
-define find_unittest_files( location );
-    if hasendstring( location, unittest_suffix ) then
-        [% location %]
-    elseif hasendstring( location, '.p' ) then
-        lvars dir = sys_fname_path( location );
-        lvars name = sys_fname_nam( location ) <> unittest_suffix;
-        sys_file_match( name, dir dir_>< '../*/', false, false ).pdtolist;
-    elseif sysisdirectory( location ) then
-        lvars folder = sys_fname_path( location );
-        sys_file_match( folder dir_>< '.../', '*' <> unittest_suffix, false, false ).pdtolist
-    else 
-        []
-    endif.expandlist
-enddefine;
+define pr_show_failures( passes, failures );
+    dlocal poplinewidth = false;
+    nprintf( 'Test results at: ' <> sysdaytime() );
+    nl(1);
 
-define find_unittests( location );
-    lvars files = find_unittest_files( location );
-    lvars tests = applist(% files, loadcompiler %).discover_unittests;
-    return( newdiscovered( tests ) )
+    lvars i, n;
+    for i, n in failures, list_from(1) do
+        lvars ( u, msg, idstring, args ) = i.destfailureinfo;
+        if idstring = 'unittest-assert:unittest-fail' then
+            lvars name = u.pdprops;
+            nprintf( '%p.\tFailed    : %p', [^n ^name] );
+            if u.isclosure then
+                nprintf( '\tData      : %p', [[% u.explode %]])
+            endif;
+            lvars (filename, linenumber, assert_expr, _n) = args.destlist;
+            printf( '\tExpression: ' );
+            applist( [assert ^^assert_expr], spr );
+            nl(1);
+            nprintf( '\tLine num  : %p', [ ^linenumber ] );
+            nprintf( '\tFile name : %p', [ ^filename ] );
+        else
+            lvars name = u.pdprops;
+            nprintf( '%p.\tUnit test : %p', [^n ^name] );
+            nprintf( '\tMessage   : %p', [ ^msg ] );
+            unless args.null do
+                npr( '\tInvolving : ' );
+                lvars a;
+                for a in args do
+                    nprintf( '\t *\t%p', [^a] )
+                endfor;
+            endunless;
+        endif;
+        nl( 1 );
+    endfor;
 enddefine;
 
-define unittests_discover( location );
-    lvars d = find_unittests( location );
-    pr_show_discovered( d );
-enddefine;
+define pr_show_discovered( d );
+    dlocal poplinewidth = false;
+    nprintf( 'Test discovery at: ' <> sysdaytime() );
+    nl( 1 );
 
-define unittests_run( location );
-    lvars d = find_unittests( location );
+    nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
 
-    dlocal run_unittest = run_unittest_during_execution;
-    dlocal fail_unittest = fail_unittest_during_execution;
-    lvars disco = d.discovered_unittests;
-    lvars ( passes, failures ) = run_all_unittests( disco );
+    lvars u, n;
+    for u, n in d.discovered_unittests, list_from(1) do
+        nprintf( '%p. %p', [% n, u %] );
+    endfor;
+    nl(1);
 
-    pr_show_failures( passes, failures );
+    nprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] );
+    lvars file, n;
+    for file, n in d.discovered_files, list_from(1) do
+        nprintf( '%p. %p', [% n, file %] );
+    endfor;
 enddefine;
 
 endsection;

From 58d46535de80b4c3b2545d3196a10ca9471c50cb Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 14:53:10 +0100
Subject: [PATCH 20/32] Improved reporting on the unittest context

---
 base/pop/getpoploglib/lib/define_unittest.p | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/lib/define_unittest.p
index 0138fe37..dac95905 100644
--- a/base/pop/getpoploglib/lib/define_unittest.p
+++ b/base/pop/getpoploglib/lib/define_unittest.p
@@ -316,6 +316,13 @@ define global syntax assert();
     sysCALLQ( check_assertion );
 enddefine;
 
+define r_pdprops( u );
+    while u.isclosure and not( u.pdprops ) do
+        u.pdpart -> u
+    endwhile;
+    u.pdprops
+enddefine;
+
 define pr_show_failures( passes, failures );
     dlocal poplinewidth = false;
     nprintf( 'Test results at: ' <> sysdaytime() );
@@ -325,19 +332,22 @@ define pr_show_failures( passes, failures );
     for i, n in failures, list_from(1) do
         lvars ( u, msg, idstring, args ) = i.destfailureinfo;
         if idstring = 'unittest-assert:unittest-fail' then
-            lvars name = u.pdprops;
+            lvars name = u.r_pdprops;
             nprintf( '%p.\tFailed    : %p', [^n ^name] );
             if u.isclosure then
                 nprintf( '\tData      : %p', [[% u.explode %]])
             endif;
             lvars (filename, linenumber, assert_expr, _n) = args.destlist;
+            if hasstartstring( filename, current_directory ) then
+                allbutfirst( datalength(current_directory) + 1, filename ) -> filename;
+            endif;
             printf( '\tExpression: ' );
             applist( [assert ^^assert_expr], spr );
             nl(1);
             nprintf( '\tLine num  : %p', [ ^linenumber ] );
             nprintf( '\tFile name : %p', [ ^filename ] );
         else
-            lvars name = u.pdprops;
+            lvars name = u.r_pdprops;
             nprintf( '%p.\tUnit test : %p', [^n ^name] );
             nprintf( '\tMessage   : %p', [ ^msg ] );
             unless args.null do

From 759ce2272244d4702ed27e5155e0f7513fb50b05 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 14:54:14 +0100
Subject: [PATCH 21/32] Remove examples folder

---
 base/pop/getpoploglib/examples/.gitignore | 0
 1 file changed, 0 insertions(+), 0 deletions(-)
 delete mode 100644 base/pop/getpoploglib/examples/.gitignore

diff --git a/base/pop/getpoploglib/examples/.gitignore b/base/pop/getpoploglib/examples/.gitignore
deleted file mode 100644
index e69de29b..00000000

From 4b465601c41c6d28389cc78307ba38c7bdd14809 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 15:02:16 +0100
Subject: [PATCH 22/32] Make the unittest code more fully autoloadable

---
 base/pop/getpoploglib/auto/assert.p           |  1 +
 .../{lib => auto}/define_unittest.p           |  0
 base/pop/getpoploglib/auto/expect_mishap.p    |  1 +
 base/pop/getpoploglib/auto/with_data.p        |  1 +
 .../unittests/new_list_builder.test.p         | 29 +++++++++++++++++++
 5 files changed, 32 insertions(+)
 create mode 100644 base/pop/getpoploglib/auto/assert.p
 rename base/pop/getpoploglib/{lib => auto}/define_unittest.p (100%)
 create mode 100644 base/pop/getpoploglib/auto/expect_mishap.p
 create mode 100644 base/pop/getpoploglib/auto/with_data.p
 create mode 100644 base/pop/getpoploglib/unittests/new_list_builder.test.p

diff --git a/base/pop/getpoploglib/auto/assert.p b/base/pop/getpoploglib/auto/assert.p
new file mode 100644
index 00000000..d2c0b44a
--- /dev/null
+++ b/base/pop/getpoploglib/auto/assert.p
@@ -0,0 +1 @@
+uses define_unittest;
\ No newline at end of file
diff --git a/base/pop/getpoploglib/lib/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p
similarity index 100%
rename from base/pop/getpoploglib/lib/define_unittest.p
rename to base/pop/getpoploglib/auto/define_unittest.p
diff --git a/base/pop/getpoploglib/auto/expect_mishap.p b/base/pop/getpoploglib/auto/expect_mishap.p
new file mode 100644
index 00000000..d2c0b44a
--- /dev/null
+++ b/base/pop/getpoploglib/auto/expect_mishap.p
@@ -0,0 +1 @@
+uses define_unittest;
\ No newline at end of file
diff --git a/base/pop/getpoploglib/auto/with_data.p b/base/pop/getpoploglib/auto/with_data.p
new file mode 100644
index 00000000..d2c0b44a
--- /dev/null
+++ b/base/pop/getpoploglib/auto/with_data.p
@@ -0,0 +1 @@
+uses define_unittest;
\ No newline at end of file
diff --git a/base/pop/getpoploglib/unittests/new_list_builder.test.p b/base/pop/getpoploglib/unittests/new_list_builder.test.p
new file mode 100644
index 00000000..644b08ac
--- /dev/null
+++ b/base/pop/getpoploglib/unittests/new_list_builder.test.p
@@ -0,0 +1,29 @@
+
+define :unittest test_new_list_builder;
+
+    define :unittest empty;
+        ;;; Arrange
+        lvars b = new_list_builder();
+        ;;; Act
+        lvars L = b( termin );
+        lvars M = b( termin );
+        ;;; Assert
+        assert L == nil;
+        assert M == nil;
+    enddefine;
+
+    define :unittest some;
+        ;;; Arrange
+        lvars b = new_list_builder();
+        lvars items = [ a b c ];
+        applist( items, b );
+        ;;; Act
+        lvars L = b( termin );
+        lvars M = b( termin );
+        ;;; Assert
+        assert L = items;
+        assert L /== items;
+        assert M == nil;
+    enddefine;
+
+enddefine;

From a7a0ea399d99ca5c51a38a08804de19784e123d9 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 15:31:21 +0100
Subject: [PATCH 23/32] Fixes for better context in failure messages and extra
 unit tests for new_list_builder [ci skip]

---
 base/pop/getpoploglib/auto/define_unittest.p         | 11 +++++++----
 .../getpoploglib/unittests/new_list_builder.test.p   | 12 ++++++++++++
 2 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/base/pop/getpoploglib/auto/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p
index dac95905..6f9b382d 100644
--- a/base/pop/getpoploglib/auto/define_unittest.p
+++ b/base/pop/getpoploglib/auto/define_unittest.p
@@ -127,7 +127,7 @@ enddefine;
 
 vars procedure unittest_sysVARS = sysVARS;
 
-define read_declaration( defdec ) -> ( pdrname, is_global, declarator );
+define read_declaration( defdec ) -> ( pdrname, props, is_global, declarator );
     lvars attributes = (
         [%
             repeat
@@ -170,6 +170,9 @@ define read_declaration( defdec ) -> ( pdrname, is_global, declarator );
         sysNEW_LVAR() -> pdrname;
         false -> is_global;
         procedure( w, n ); endprocedure -> declarator;
+        "anonymous_unittest" -> props;
+    else
+        pdrname -> props
     endif;
 enddefine;
 
@@ -180,10 +183,10 @@ define core_define_unittest();
         applist( list_builder( termin ), run_unittest )
     enddefine;
 
-    lvars ( pdrname, is_global, declarator ) = read_declaration( unittest_sysVARS );
-    declarator( pdrname.isword and pdrname, 0 );
+    lvars ( pdrname, props, is_global, declarator ) = read_declaration( unittest_sysVARS );
+    declarator( pdrname, 0 );
     if is_global then sysGLOBAL( pdrname, is_global ) endif;
-    sysPROCEDURE( pdrname, 0 );
+    sysPROCEDURE( props, 0 );
 
     ;;; Set up dynamic test discovery.
     lvars collector = sysNEW_LVAR();
diff --git a/base/pop/getpoploglib/unittests/new_list_builder.test.p b/base/pop/getpoploglib/unittests/new_list_builder.test.p
index 644b08ac..0450d963 100644
--- a/base/pop/getpoploglib/unittests/new_list_builder.test.p
+++ b/base/pop/getpoploglib/unittests/new_list_builder.test.p
@@ -26,4 +26,16 @@ define :unittest test_new_list_builder;
         assert M == nil;
     enddefine;
 
+    define :unittest is;
+        ;;; Arrange
+        lvars banana = "banana";
+        lvars b = new_list_builder();
+        ;;; Act
+        lvars banana_is = is_list_builder( banana );
+        lvars b_is = is_list_builder( b );
+        ;;; Assert
+        assert banana_is.not;
+        assert b_is;
+    enddefine;
+
 enddefine;

From b23692b35cb19e96b2396d0a2c51e821e7366b33 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 15:32:43 +0100
Subject: [PATCH 24/32] Remove early test file [ci skip]

---
 .../getpoploglib/unittests/splitstring.test.p   | 17 -----------------
 1 file changed, 17 deletions(-)
 delete mode 100644 base/pop/getpoploglib/unittests/splitstring.test.p

diff --git a/base/pop/getpoploglib/unittests/splitstring.test.p b/base/pop/getpoploglib/unittests/splitstring.test.p
deleted file mode 100644
index b83ad200..00000000
--- a/base/pop/getpoploglib/unittests/splitstring.test.p
+++ /dev/null
@@ -1,17 +0,0 @@
-
-define :unittest;
-enddefine;
-
-define :unittest hello;
-    ;;; This is a pass
-enddefine;
-
-define :unittest hiya;
-enddefine;
-
-define :unittest hi;
-enddefine;
-
-define :unittest byebye;
-    fail_unittest()
-enddefine;

From cb9ec504093cae12403dc05848f74a7adf4c1f2c Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 2 Oct 2021 18:18:54 +0100
Subject: [PATCH 25/32] Ensure that nested tests default to lvars

---
 base/pop/getpoploglib/auto/define_unittest.p | 1 +
 1 file changed, 1 insertion(+)

diff --git a/base/pop/getpoploglib/auto/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p
index 6f9b382d..688ccb60 100644
--- a/base/pop/getpoploglib/auto/define_unittest.p
+++ b/base/pop/getpoploglib/auto/define_unittest.p
@@ -187,6 +187,7 @@ define core_define_unittest();
     declarator( pdrname, 0 );
     if is_global then sysGLOBAL( pdrname, is_global ) endif;
     sysPROCEDURE( props, 0 );
+    dlocal unittest_sysVARS = sysLVARS;
 
     ;;; Set up dynamic test discovery.
     lvars collector = sysNEW_LVAR();

From be4b2a6cb1e662dab29f7813a2835e8cce7912c0 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 3 Oct 2021 22:30:43 +0100
Subject: [PATCH 26/32] Add files for demo

---
 base/pop/getpoploglib/auto/split_by_spaces.p |  60 ++++++++++
 base/pop/getpoploglib/auto/splitstring.p     | 115 ++++++++++++++-----
 base/pop/getpoploglib/help/splitstring       |  30 ++++-
 3 files changed, 175 insertions(+), 30 deletions(-)
 create mode 100644 base/pop/getpoploglib/auto/split_by_spaces.p

diff --git a/base/pop/getpoploglib/auto/split_by_spaces.p b/base/pop/getpoploglib/auto/split_by_spaces.p
new file mode 100644
index 00000000..d6002b15
--- /dev/null
+++ b/base/pop/getpoploglib/auto/split_by_spaces.p
@@ -0,0 +1,60 @@
+compile_mode :pop11 +strict;
+
+section;
+
+;;;
+;;; split_by_spaces( s, [maxsplit], [constructor] ) -> constructor( N )
+;;;
+define global procedure split_by_spaces() with_props 1;
+    lvars s, maxsplit, constructor;
+
+    false -> maxsplit;
+    consvector -> constructor;
+
+    if dup().isprocedure then
+        () -> constructor
+    endif;
+
+    if dup().isinteger or dup() == false or dup() == _ do
+        () -> maxsplit;
+        if maxsplit == _ then
+            false -> maxsplit
+        endif
+    endif;
+
+    () -> s;
+    unless s.isstring then
+        mishap( 'Invalid argument for splitstring', [ ^s ] )
+    endunless;
+    if maxsplit == false or maxsplit == _ do
+        ;;; Stop maxsplit ever being a limit by making it 'very big'.
+        datalength(s) + 1 -> maxsplit;
+    endif;
+
+    constructor(#|
+        lvars position = 1;
+        lvars count = 0;
+        repeat
+            skipchar( ` `, position, s ) -> position;
+            quitunless( position );
+
+            if count >= maxsplit then
+                substring( position, s.datalength - position + 1, s );
+                quitloop
+            endif;
+
+            lvars n = locchar( ` `, position, s);
+            if n then
+                substring( position, n - position, s );
+                count fi_+ 1 -> count;
+                n -> position;
+            else
+                lvars len = s.datalength - position + 1;
+                substring( position, len, s );
+                quitloop
+            endif
+        endrepeat
+    |#)
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/splitstring.p b/base/pop/getpoploglib/auto/splitstring.p
index 643f5983..dea5ead4 100644
--- a/base/pop/getpoploglib/auto/splitstring.p
+++ b/base/pop/getpoploglib/auto/splitstring.p
@@ -2,39 +2,96 @@ compile_mode :pop11 +strict;
 
 section;
 
-define global splitstring() with_props 3;
-    lvars s, sep, procedure constructor;
-    if dup().isprocedure then
-        () -> ( s, sep, constructor );
-    else
-        consvector -> constructor;
-        () -> ( s, sep )
+;;;
+;;;     splitstring( string, separator ) -> vector
+;;;     splitstring( string, separator, maxsplit: int_or_false, constructor: procedure ) -> constructor( N )
+;;;
+define global splitstring() with_props 2;
+    lvars s, sep, maxsplit, procedure constructor;
+
+    ;;; Set default values for optionals.
+    consvector -> constructor;
+    false -> maxsplit;
+
+    ;;; Decode optional arguments directly from the stack.
+    if not(dup().isregexp) and dup().isprocedure then
+        () -> ( maxsplit, constructor );
     endif;
-    lvars ( procedure finder, sep_n ) = (
-        if sep.isstring then
-            if sep.datalength == 0 then
-                mishap( 'Invalid empty separator argument', [^sep] )
-            endif;
-            ( issubstring, datalength(sep) )
-        elseif sep.isinteger then
-            ( locchar, 1 )
-        else
-            mishap( 'Unexpected separator', [^sep] )
+
+    () -> ( s, sep );
+
+    if sep.isstring then
+        if sep.datalength == 1 then
+            ;;; Take advantage of locchar.
+            subscrs( 1, sep ) -> sep
         endif
-    );
-    constructor(#|
-        lvars position = 1;
-        repeat
-            lvars n = finder( sep, position, s);
-            if n then
-                substring( position, n - position, s );
-                n + sep_n -> position;
+    elseunless sep.isinteger or sep.isregexp then
+        mishap( 'Invalid separator for split', [ ^sep ] )
+    endif;
+
+    unless s.isstring then
+        mishap( 'Invalid argument for splitstring', [ ^s ] )
+    endunless;
+
+    if maxsplit == false or maxsplit == _ do
+        ;;; Stop maxsplit ever being a limit by making it 'big enough'.
+        datalength(s) + 1 -> maxsplit;
+    endif;
+
+    ;;; Deal separately with regular expressions and string/integer separators.
+    if sep.isregexp then
+        constructor(#|
+            lvars position = 1;
+            lvars count = 0;
+            lvars s_len = datalength( s );
+            repeat
+                if position > s_len then
+                    '';
+                    quitloop
+                endif;
+                lvars ( n, sep_n ) = if maxsplit > count then sep( position, s, false, false ) else false, false endif;
+                if n then
+                    substring( position, n - position, s );
+                    count fi_+ 1 -> count;
+                    n + sep_n -> position;
+                else
+                    lvars len = s_len fi_- position fi_+ 1;
+                    substring( position, s.datalength - position + 1, s );
+                    quitloop
+                endif
+            endrepeat
+        |#)
+    else
+        lvars ( procedure finder, sep_n ) = (
+            if sep.isstring then
+                lvars d = sep.datalength;
+                if d == 0 then
+                    mishap( 'Invalid empty separator argument', [^sep] )
+                endif;
+                ( issubstring, datalength(sep) )
+            elseif sep.isinteger then
+                ( locchar, 1 )
             else
-                substring( position, s.datalength - position + 1, s );
-                quitloop
+                mishap( 'Unexpected separator', [^sep] )
             endif
-        endrepeat
-    |#)
+        );
+        constructor(#|
+            lvars position = 1;
+            lvars count = 0;
+            repeat
+                lvars n = (maxsplit > count) and finder( sep, position, s );
+                if n then
+                    substring( position, n - position, s );
+                    count fi_+ 1 -> count;
+                    n + sep_n -> position;
+                else
+                    lvars len = s.datalength - position + 1;
+                    substring( position, len, s );
+                    quitloop
+                endif
+            endrepeat
+        |#)
+    endif
 enddefine;
 
 endsection;
diff --git a/base/pop/getpoploglib/help/splitstring b/base/pop/getpoploglib/help/splitstring
index 28a771aa..5ac392dc 100644
--- a/base/pop/getpoploglib/help/splitstring
+++ b/base/pop/getpoploglib/help/splitstring
@@ -1,5 +1,33 @@
 HELP SPLITSTRING                                         Stephen Leach, Sep 2021
 
-    splitstring( string, separator, constructor ) -> constructor( N )
     splitstring( string, separator ) -> vector
+    splitstring( string, separator, maxsplit: int_or_false, constructor: procedure ) -> constructor( N )
 
+In the first form, -splitstring- returns a vector of the sub-strings in the
+-string-, using -sep- as the delimiter. The delimiter can be specified as a
+string, character or regexp. For example:
+
+    Setpop
+    : splitstring( 'abc,def,ghi', `,` ) =>
+    ** {'abc' 'def' 'ghi'}
+    :
+
+In the second form, a limit on the number of splits can be specified and also
+a different constructor from -consvector-. The constructor should be a
+procedure that expects the top of the stack to be a count of the items beneath
+it.
+
+If maxsplit is given as an integer, at most maxsplit splits are done (thus,
+the list will have at most maxsplit+1 elements). If maxsplit is not specified
+or -false- or -pop_undef-, then there is no limit on the number of splits (all
+possible splits are made).
+
+For example:
+
+    Setpop
+    : splitstring( 'abc,def,ghi', `,`, 1, conslist ) =>
+    ** ['abc' 'def,ghi']
+    :
+    : splitstring( 'abc,def,ghi', `,`, _, conslist ) =>
+    ** ['abc' 'def' 'ghi']
+    :

From 73a62949461c9dd14ebc9a4967fcf931f93df093 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 3 Oct 2021 22:35:16 +0100
Subject: [PATCH 27/32] Isolate the print routines from pop_pr_quotes for demo

---
 base/pop/getpoploglib/auto/define_unittest.p | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/base/pop/getpoploglib/auto/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p
index 688ccb60..420a8900 100644
--- a/base/pop/getpoploglib/auto/define_unittest.p
+++ b/base/pop/getpoploglib/auto/define_unittest.p
@@ -66,7 +66,7 @@ define vars fail_unittest( info );
 enddefine;
 
 define fail_unittest_during_execution( info );
-    unittest_failures( info ); 
+    unittest_failures( info );
     exitfrom( run_unittest )
 enddefine;
 
@@ -329,6 +329,7 @@ enddefine;
 
 define pr_show_failures( passes, failures );
     dlocal poplinewidth = false;
+    dlocal pop_pr_quotes = false;
     nprintf( 'Test results at: ' <> sysdaytime() );
     nl(1);
 
@@ -368,6 +369,7 @@ enddefine;
 
 define pr_show_discovered( d );
     dlocal poplinewidth = false;
+    dlocal pop_pr_quotes = false;
     nprintf( 'Test discovery at: ' <> sysdaytime() );
     nl( 1 );
 

From fca33173f23025190f427a8b135c4420caa5af05 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 3 Oct 2021 22:38:10 +0100
Subject: [PATCH 28/32] Isolate the print routines from pop_pr_quotes for demo

---
 base/pop/getpoploglib/auto/ved_test.p | 1 +
 1 file changed, 1 insertion(+)

diff --git a/base/pop/getpoploglib/auto/ved_test.p b/base/pop/getpoploglib/auto/ved_test.p
index 4bd2f137..1b367ca4 100644
--- a/base/pop/getpoploglib/auto/ved_test.p
+++ b/base/pop/getpoploglib/auto/ved_test.p
@@ -85,6 +85,7 @@ define ved_test();
 
     lvars n_passes = passes.length;
     lvars n_failures = failures.length;
+    dlocal pop_pr_quotes = false;
     sprintf(
         '%p pass%p, %p failure%p',
         [%

From 80045280fa005c44d3a13a7778deb65bfd42017b Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 8 Oct 2021 22:33:10 +0100
Subject: [PATCH 29/32] Fixed expect_mishap and improved the reporting

---
 base/pop/getpoploglib/auto/define_unittest.p | 39 +++++++++++++++-----
 1 file changed, 30 insertions(+), 9 deletions(-)

diff --git a/base/pop/getpoploglib/auto/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p
index 420a8900..2e1f83e0 100644
--- a/base/pop/getpoploglib/auto/define_unittest.p
+++ b/base/pop/getpoploglib/auto/define_unittest.p
@@ -8,7 +8,17 @@ section $-unittest =>
     register_unittest       ;;; exported because of code-planting
 ;
 
-vars expect_mishap = false;     ;;; Part of test-execution.
+vars mishap_happened = false;
+vars _expect_mishap = false;
+define global active:1 expect_mishap();
+    _expect_mishap;
+enddefine;
+define updaterof active:1 expect_mishap( saved );
+    saved -> _expect_mishap;
+    if not(saved) and not( mishap_happened ) do
+        mishap( 'Expected mishap was skipped', [] )
+    endif;
+enddefine;
 
 vars pop_unittests = undef;     ;;; Part of test-discovery.
 vars unittest_passes = undef;   ;;; Part of test-execution.
@@ -92,6 +102,7 @@ define run_unittest_during_execution( p );
 
     define dlocal pop_exception_final( N, mess, idstring, severity );
         returnunless( severity == `E` or severity == `R` )( false );
+        true -> mishap_happened;
         lvars args = conslist( N );
         lvars is_expected = is_expected_mishap( mess, idstring, severity, args );
         if is_expected then
@@ -102,13 +113,9 @@ define run_unittest_during_execution( p );
     enddefine;
 
     dlocal current_unittest = p;
+    dlocal mishap_happened = false;
     p();
-    if expect_mishap then
-        lvars info = consfailureinfo( current_unittest, 'Required mishap skipped', '', [] );
-        unittest_failures( p );
-    else
-        unittest_passes( p );
-    endif
+    unittest_passes( p );
 enddefine;
 
 define discover_unittests( p );
@@ -188,6 +195,7 @@ define core_define_unittest();
     if is_global then sysGLOBAL( pdrname, is_global ) endif;
     sysPROCEDURE( props, 0 );
     dlocal unittest_sysVARS = sysLVARS;
+    sysLOCAL( "ident $-unittest$-mishap_happened" );
 
     ;;; Set up dynamic test discovery.
     lvars collector = sysNEW_LVAR();
@@ -203,7 +211,7 @@ define core_define_unittest();
     ;;; Run any registered tests.
     sysPUSH( collector );
     sysCALLQ( run_all );
-
+    sysLABEL( "return" );
     sysPASSIGN( sysENDPROCEDURE(), pdrname );
 
     return( pdrname );
@@ -347,12 +355,13 @@ define pr_show_failures( passes, failures );
                 allbutfirst( datalength(current_directory) + 1, filename ) -> filename;
             endif;
             printf( '\tExpression: ' );
-            applist( [assert ^^assert_expr], spr );
+            applist( [assert ^^assert_expr], procedure(); dlocal pop_pr_quotes = true; spr() endprocedure );
             nl(1);
             nprintf( '\tLine num  : %p', [ ^linenumber ] );
             nprintf( '\tFile name : %p', [ ^filename ] );
         else
             lvars name = u.r_pdprops;
+            lvars ctx = u.registration_table;
             nprintf( '%p.\tUnit test : %p', [^n ^name] );
             nprintf( '\tMessage   : %p', [ ^msg ] );
             unless args.null do
@@ -362,6 +371,18 @@ define pr_show_failures( passes, failures );
                     nprintf( '\t *\t%p', [^a] )
                 endfor;
             endunless;
+            if ctx.iscontext then
+                lvars (parent, linenum) = ctx.destcontext;
+                if linenum then
+                    nprintf( '\tLine num  : %p', [ ^linenum ] );
+                endif;
+                if parent.isstring then
+                    if hasstartstring( parent, current_directory ) then
+                        allbutfirst( datalength(current_directory) + 1, parent ) -> parent;
+                    endif;
+                    nprintf( '\tFrom      : %p', [ ^parent ] );
+                endif;
+            endif;
         endif;
         nl( 1 );
     endfor;

From 16b7c170eacfcfcf37b042adb9d25c80e81630bd Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 15 Oct 2021 19:56:16 +0100
Subject: [PATCH 30/32] Adding unit tests

---
 .gitignore                                    |  1 +
 .../getpoploglib/unittests/splitstring.test.p | 72 +++++++++++++++++++
 2 files changed, 73 insertions(+)
 create mode 100644 base/pop/getpoploglib/unittests/splitstring.test.p

diff --git a/.gitignore b/.gitignore
index 2d13a2c9..8c53ec64 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,4 @@
 __pycache__
 .ropeproject
 report.xml
+/base/pop/getpoploglib/scrapbook/
diff --git a/base/pop/getpoploglib/unittests/splitstring.test.p b/base/pop/getpoploglib/unittests/splitstring.test.p
new file mode 100644
index 00000000..d5a29f54
--- /dev/null
+++ b/base/pop/getpoploglib/unittests/splitstring.test.p
@@ -0,0 +1,72 @@
+;;; --- Anonymous tests ---
+
+define :unittest;
+    ;;; Act
+    lvars actual = splitstring( 'abc|def|ghi', '|' );
+    ;;; Assert
+    assert { 'abc' 'def' 'ghi' } = actual;
+enddefine;
+
+;;; --- with_data tests ---
+
+with_data
+    [ '' ','                    {''} ]
+    [ '' ',' ^false ^consvector {''} ]
+    [ 'abc' ','                 {'abc'} ]
+    [ ',' ','                   {'' ''} ]
+    [ ',' `,`                   {'' ''} ]
+    [ 'abc,' ','                {'abc' ''} ]
+    [ 'abc--def' '--'           {'abc' 'def'} ]
+    [ 'abc----def' '--'         {'abc' '' 'def'} ]
+    [ 'abc----def' '--'         {'abc' '' 'def'} ]
+    [ 'abc--def--ghi' '--'      {'abc' 'def' 'ghi'} ]
+    [ '---abc--def--ghi' '--'   {'' '-abc' 'def' 'ghi'} ]
+    [ 'a b c' ' ' ^false ^conslist  ['a' 'b' 'c'] ]
+    [ 'a b c' ' ' 1 ^conslist   ['a' 'b c'] ]
+define :unittest( expected );
+    ;;; Act
+    lvars actual = splitstring( /*stack*/ );
+    ;;; Assert
+    assert actual = expected;
+enddefine;
+
+;;; --- Named tests ---
+
+define :unittest test_splitstring_nested;
+
+    define :unittest test_splitstring_regexp();
+        ;;; Arrange
+        lvars ( _, regexp_p ) = regexp_compile( '@[,;@]' );
+        ;;; Act
+        lvars actual = splitstring( 'abc,def;ghi', regexp_p );
+        ;;; Assert
+        assert actual = { 'abc' 'def' 'ghi' };
+    enddefine;
+
+    define :unittest test_splitstring_regexp_conslist();
+        ;;; Arrange
+        lvars ( _, regexp_p ) = regexp_compile( '@[,;@]' );
+        ;;; Act
+        lvars actual = splitstring( 'abc,def;ghi', regexp_p, false, conslist );
+        ;;; Assert
+        assert actual = [ 'abc' 'def' 'ghi' ];
+    enddefine;
+
+    define :unittest test_splitstring_regexp_conslist_max1();
+        ;;; Arrange
+        lvars ( _, regexp_p ) = regexp_compile( '@[,;@]' );
+        ;;; Act
+        lvars actual = splitstring( 'abc,def;ghi', regexp_p, 1, conslist );
+        ;;; Assert
+        assert actual = [ 'abc' 'def;ghi' ];
+    enddefine;
+
+enddefine;
+
+
+;;; --- expect_mishap tests ---
+
+define :unittest;
+    dlocal expect_mishap = true;
+    splitstring( "wordsarenotstrings", `,` ) -> _;
+enddefine;

From b6f8f46cd5271bc12346769682cf537f1272f893 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 15 Oct 2021 19:59:49 +0100
Subject: [PATCH 31/32] Cosmetic improvements

---
 base/pop/getpoploglib/auto/define_unittest.p | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/base/pop/getpoploglib/auto/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p
index 2e1f83e0..0e3ba8d6 100644
--- a/base/pop/getpoploglib/auto/define_unittest.p
+++ b/base/pop/getpoploglib/auto/define_unittest.p
@@ -8,11 +8,16 @@ section $-unittest =>
     register_unittest       ;;; exported because of code-planting
 ;
 
+;;; --- expecting mishaps ---
+
 vars mishap_happened = false;
+
 vars _expect_mishap = false;
+
 define global active:1 expect_mishap();
     _expect_mishap;
 enddefine;
+
 define updaterof active:1 expect_mishap( saved );
     saved -> _expect_mishap;
     if not(saved) and not( mishap_happened ) do
@@ -20,6 +25,8 @@ define updaterof active:1 expect_mishap( saved );
     endif;
 enddefine;
 
+;;; --- test discovery and execution ---
+
 vars pop_unittests = undef;     ;;; Part of test-discovery.
 vars unittest_passes = undef;   ;;; Part of test-execution.
 vars unittest_failures = undef; ;;; Part of test-execution.

From 78b2a512e8f4ac3db990ee9bdcaf5aabb214ac15 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Fri, 15 Oct 2021 22:49:26 +0100
Subject: [PATCH 32/32] Split off define:testsuite from define:unittest

---
 base/pop/getpoploglib/auto/define_unittest.p | 191 ++++++++++---------
 base/pop/getpoploglib/auto/pdorigin.p        |  23 +++
 2 files changed, 121 insertions(+), 93 deletions(-)
 create mode 100644 base/pop/getpoploglib/auto/pdorigin.p

diff --git a/base/pop/getpoploglib/auto/define_unittest.p b/base/pop/getpoploglib/auto/define_unittest.p
index 0e3ba8d6..3a7f0889 100644
--- a/base/pop/getpoploglib/auto/define_unittest.p
+++ b/base/pop/getpoploglib/auto/define_unittest.p
@@ -1,6 +1,7 @@
 compile_mode :pop11 +strict;
 
 section $-unittest =>
+    define_testsuite        ;;; used for defining test collections
     define_unittest         ;;; used for defining unit tests
     assert                  ;;; used for defining unit tests
     expect_mishap           ;;; used for defining unit tests
@@ -8,6 +9,9 @@ section $-unittest =>
     register_unittest       ;;; exported because of code-planting
 ;
 
+
+constant unittest_suffix = '.test.p';
+
 ;;; --- expecting mishaps ---
 
 vars mishap_happened = false;
@@ -27,40 +31,15 @@ enddefine;
 
 ;;; --- test discovery and execution ---
 
-vars pop_unittests = undef;     ;;; Part of test-discovery.
-vars unittest_passes = undef;   ;;; Part of test-execution.
-vars unittest_failures = undef; ;;; Part of test-execution.
-vars current_unittest = undef;  ;;; Part of test-execution.
+vars unittest_passes = undef;           ;;; Part of test-execution.
+vars unittest_failures = undef;         ;;; Part of test-execution.
+vars current_unittest = undef;          ;;; Part of test-execution.
 
 ;;; Part of test-discovery, although may be re-invoked during execution.
-;;; At top-level do nothing.
+;;; At top-level do nothing. This will be dlocalised during test-discovery.
 define vars register_unittest( u );
 enddefine;
 
-defclass context {
-    context_parent,
-    context_linenum
-};
-
-;;; This is a map from unit-tests, which are procedures, to the context in
-;;; which they were defined.
-constant procedure registration_table =
-    newanyproperty(
-        [], 8, 1, 8,
-        false, false, "tmpval",
-        false, false
-    );
-
-;;; Inside a test-context we record the notional parent. This is purely
-;;; so we can present the test results inside a nice-looking classification tree.
-define vars register_unittest_during_discovery( u );
-    lvars index = popfilename or vedpathname;
-    if index do
-        conscontext( index, poplinenum ) -> registration_table( u );
-    endif;
-    pop_unittests( u );
-enddefine;
-
 ;;; Part of test-execution.
 ;;; This is defensive - we only want to run unit tests inside an appropriate
 ;;; dynamic context.
@@ -126,10 +105,9 @@ define run_unittest_during_execution( p );
 enddefine;
 
 define discover_unittests( p );
-    dlocal pop_unittests = new_list_builder();
-    dlocal register_unittest = register_unittest_during_discovery;
+    dlocal register_unittest = new_list_builder();
     erasenum(#| p() |#);
-    return( pop_unittests( termin ) )
+    return( register_unittest( termin ) )
 enddefine;
 
 define run_all_unittests( unittest_list );
@@ -139,6 +117,44 @@ define run_all_unittests( unittest_list );
     ( unittest_passes( termin ), unittest_failures( termin ) )
 enddefine;
 
+
+;;; --- Discovery ---
+
+;;; This is a class to collect the results from discovery - especially inside VED.
+defclass discovered {
+    discovered_unittests,
+    discovered_files_cache
+};
+
+define newdiscovered( unittests );
+    consdiscovered( unittests, false )
+enddefine;
+
+define discovered_files( d );
+    if d.discovered_files_cache then
+        d.discovered_files_cache
+    else
+        lvars t = (
+            newanyproperty(
+                [], 8, 1, 8,
+                syshash, nonop =, "perm",
+                false, false
+            )
+        );
+        lvars u;
+        for u in d.discovered_unittests do
+            lvars ( parent, linenum ) = pdorigin( u );
+            if parent.isstring do
+                true -> t( parent )
+            endif
+        endfor;
+        nc_listsort( [% fast_appproperty( t, erase ) %], alphabefore ) ->> d.discovered_files_cache;
+    endif
+enddefine;
+
+
+;;; --- Syntax ---
+
 vars procedure unittest_sysVARS = sysVARS;
 
 define read_declaration( defdec ) -> ( pdrname, props, is_global, declarator );
@@ -191,36 +207,25 @@ define read_declaration( defdec ) -> ( pdrname, props, is_global, declarator );
 enddefine;
 
 define core_define_unittest();
-    dlocal pop_new_lvar_list;
+    lvars ( pdrname, props, is_global, declarator ) = read_declaration( unittest_sysVARS );
 
-    define lconstant run_all( list_builder );
-        applist( list_builder( termin ), run_unittest )
-    enddefine;
+    lvars captured_popfilename = popfilename or vedpathname;
+    lvars captured_poplinenum = poplinenum;
 
-    lvars ( pdrname, props, is_global, declarator ) = read_declaration( unittest_sysVARS );
     declarator( pdrname, 0 );
     if is_global then sysGLOBAL( pdrname, is_global ) endif;
     sysPROCEDURE( props, 0 );
     dlocal unittest_sysVARS = sysLVARS;
     sysLOCAL( "ident $-unittest$-mishap_happened" );
-
-    ;;; Set up dynamic test discovery.
-    lvars collector = sysNEW_LVAR();
-    sysCALL( "new_list_builder" );
-    sysPOP( collector );
-    sysLOCAL( "register_unittest" );
-    sysPUSH( collector );
-    sysPOP( "register_unittest" );
-
     ;;; Main body.
     sysCALLQ( pop11_comp_procedure( "enddefine", false, pdrname and pdrname >< "_body" or "unittest_body" ) );
-
-    ;;; Run any registered tests.
-    sysPUSH( collector );
-    sysCALLQ( run_all );
-    sysLABEL( "return" );
     sysPASSIGN( sysENDPROCEDURE(), pdrname );
 
+    sysPUSHQ( captured_popfilename );
+    sysPUSHQ( captured_poplinenum );
+    sysPUSH( pdrname );
+    sysUCALL( "pdorigin" );
+
     return( pdrname );
 enddefine;
 
@@ -260,49 +265,42 @@ define syntax with_data;
     sysCALLQ( register_closures );
 enddefine;
 
-constant unittest_suffix = '.test.p';
 
-defclass discovered {
-    discovered_unittests,
-    discovered_files_cache
-};
+;;; --- Syntax: testsuite
 
-define newdiscovered( unittests );
-    consdiscovered( unittests, false )
+define :define_form global testsuite;
+    lvars ( pdrname, props, is_global, declarator ) = read_declaration( unittest_sysVARS );
+    pop11_need_nextreaditem( ";" ) -> _;
+    declarator( pdrname, 0 );
+    if is_global then sysGLOBAL( pdrname, is_global ) endif;
+    sysPROCEDURE( props, 0 );
+    dlocal unittest_sysVARS = sysLVARS;
+    pop11_comp_stmnt_seq_to( "enddefine" ) -> _;
+    sysPASSIGN( sysENDPROCEDURE(), pdrname );
+    sysCALL( pdrname );
 enddefine;
 
-define discovered_files( d );
-    if d.discovered_files_cache then
-        d.discovered_files_cache
-    else
-        lvars t = (
-            newanyproperty(
-                [], 8, 1, 8,
-                syshash, nonop =, "perm",
-                false, false
-            )
-        );
-        lvars u;
-        for u in d.discovered_unittests do
-            lvars parent = context_parent( registration_table( u ) );
-            if parent.isstring do
-                true -> t( parent )
-            endif
-        endfor;
-        nc_listsort( [% fast_appproperty( t, erase ) %], alphabefore ) ->> d.discovered_files_cache;
-    endif
+
+;;; --- Syntax: assert ---
+
+;;; Return a copy of the expanded portion of a partially expanded
+;;; dynamic list without causing any further expansion.
+define lconstant only_expanded( L );
+    [%
+        while L.ispair and not( L.fast_back.isprocedure ) do
+            L.fast_destpair -> L
+        endwhile;
+    %]
 enddefine;
 
+;;; -peek_expr_to- does not consume any input nor plant any code but expands -proglist-
+;;; by exactly one Pop-11 expression and returns the expanded portion.
 define lconstant peek_expr_to( closing_keyword );
     dlocal pop_syntax_only = true;
     dlocal proglist_state;
     lvars old_proglist = proglist;
     pop11_comp_expr_to( closing_keyword ) -> _;
-    [%
-        while old_proglist.ispair and not( old_proglist.back.isprocedure ) do
-            old_proglist.destpair -> old_proglist
-        endwhile;
-    %]
+    old_proglist.only_expanded;
 enddefine;
 
 define global syntax assert();
@@ -335,11 +333,18 @@ define global syntax assert();
     sysCALLQ( check_assertion );
 enddefine;
 
+
+;;; --- Common reporting ---
+
 define r_pdprops( u );
     while u.isclosure and not( u.pdprops ) do
         u.pdpart -> u
     endwhile;
-    u.pdprops
+    lvars props = u.pdprops;
+    while props.islist and not( null( props ) ) do
+        props.hd -> props
+    endwhile;
+    props;
 enddefine;
 
 define pr_show_failures( passes, failures );
@@ -368,7 +373,7 @@ define pr_show_failures( passes, failures );
             nprintf( '\tFile name : %p', [ ^filename ] );
         else
             lvars name = u.r_pdprops;
-            lvars ctx = u.registration_table;
+            lvars ( parent, linenum ) = u.pdorigin;
             nprintf( '%p.\tUnit test : %p', [^n ^name] );
             nprintf( '\tMessage   : %p', [ ^msg ] );
             unless args.null do
@@ -378,8 +383,7 @@ define pr_show_failures( passes, failures );
                     nprintf( '\t *\t%p', [^a] )
                 endfor;
             endunless;
-            if ctx.iscontext then
-                lvars (parent, linenum) = ctx.destcontext;
+            if parent then
                 if linenum then
                     nprintf( '\tLine num  : %p', [ ^linenum ] );
                 endif;
@@ -401,19 +405,20 @@ define pr_show_discovered( d );
     nprintf( 'Test discovery at: ' <> sysdaytime() );
     nl( 1 );
 
-    nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
+    nprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] );
+    lvars file, n;
+    for file, n in d.discovered_files, list_from(1) do
+        nprintf( '%p. %p', [% n, file %] );
+    endfor;
+    nl(1);
 
+    nprintf( 'Unittests discovered (total of %p)', [% d.discovered_unittests.length %] );
     lvars u, n;
     for u, n in d.discovered_unittests, list_from(1) do
         nprintf( '%p. %p', [% n, u %] );
     endfor;
     nl(1);
 
-    nprintf( 'Files compiled during discovery (total of %p)', [% d.discovered_files.length %] );
-    lvars file, n;
-    for file, n in d.discovered_files, list_from(1) do
-        nprintf( '%p. %p', [% n, file %] );
-    endfor;
 enddefine;
 
 endsection;
diff --git a/base/pop/getpoploglib/auto/pdorigin.p b/base/pop/getpoploglib/auto/pdorigin.p
new file mode 100644
index 00000000..10c4d814
--- /dev/null
+++ b/base/pop/getpoploglib/auto/pdorigin.p
@@ -0,0 +1,23 @@
+compile_mode :pop11 +strict;
+
+#_TERMIN_IF DEF pdorigin
+
+section;
+
+lconstant procedure pdorigin_table =
+    newanyproperty(
+        [], 8, 1, 8,
+        false, false, "tmpval",
+        conspair( false, false ),
+        false
+    );
+
+define global constant procedure pdorigin( procedure p );
+    pdorigin_table( p ).destpair
+enddefine;
+
+define updaterof pdorigin( file, linenum, procedure p );
+    conspair( file, linenum ) -> pdorigin_table( p )
+enddefine;
+
+endsection;