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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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/44] 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;

From 3d4904f8f0885fe5fe8cbbc053cecd1bbe345e8a Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 7 Sep 2021 23:13:41 +0100
Subject: [PATCH 33/44] Added utilities

---
 base/pop/getpoploglib/auto/frozval_names.p | 58 ++++++++++++++++++++++
 base/pop/getpoploglib/auto/pop11_comp_N.p  | 52 +++++++++++++++++++
 2 files changed, 110 insertions(+)
 create mode 100644 base/pop/getpoploglib/auto/frozval_names.p
 create mode 100644 base/pop/getpoploglib/auto/pop11_comp_N.p

diff --git a/base/pop/getpoploglib/auto/frozval_names.p b/base/pop/getpoploglib/auto/frozval_names.p
new file mode 100644
index 00000000..88436998
--- /dev/null
+++ b/base/pop/getpoploglib/auto/frozval_names.p
@@ -0,0 +1,58 @@
+section $-frozval_names => 
+    frozval_names 
+    frozval_stack_slot
+    frozval_closure_slot;
+
+constant procedure frozval_slot_table =
+    newanyproperty( [], 8, 1, 8, false, false, "tmpval", false, false );
+
+;;; Given a word and a 'bound' closure, returns the index of the word
+;;; when addressed using subscr_stack.
+define global constant procedure frozval_stack_slot( word, closure );
+    lvars slots = frozval_slot_table( closure );
+    if slots then
+        lvars i, item;
+        for item with_index i in_vector slots do
+            returnif( word == item )( datalength( closure ) - i + 1 )
+        endfor
+    endif;
+    mishap( 'Unrecognised slot name', [^word ^closure] )
+enddefine;
+
+;;; Given a word and a 'bound' closure, returns the index of the frozval.
+define global constant procedure frozval_closure_slot( word, closure );
+    lvars slots = frozval_slot_table( closure );
+    if slots then
+        lvars i, item;
+        for item with_index i in_vector slots do
+            returnif( word == item )( i )
+        endfor
+    endif;
+    mishap( 'Unrecognised slot name', [^word ^closure] )
+enddefine;
+
+
+define frozval_names( closure );
+    unless closure.isclosure do
+        mishap( 'Expecting closure', [^closure] )
+    endunless;
+    lvars slots = frozval_slot_table( closure );
+    if slots then
+        destvector( slots )
+    else
+        0
+    endif
+enddefine;
+
+define updaterof frozval_names( N, closure );
+    unless closure.isclosure do
+        mishap( 'Expecting closure', [^closure] )
+    endunless;
+    lvars slots = consvector( N );
+    if datalength( slots ) /== datalength( closure ) then
+        mishap( 'Mismatch in the number of names and the size of closure', [^N ^closure] )
+    endif;
+    slots -> frozval_slot_table( closure );
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/pop11_comp_N.p b/base/pop/getpoploglib/auto/pop11_comp_N.p
new file mode 100644
index 00000000..a946c67e
--- /dev/null
+++ b/base/pop/getpoploglib/auto/pop11_comp_N.p
@@ -0,0 +1,52 @@
+compile_mode :pop11 +strict;
+
+section;
+
+define lconstant check_0( before );
+    lvars after = stacklength();
+    unless after == before then
+        lvars k = after fi_- before;
+        if k < 0 then
+            mishap( 'Expression consumed values, zero stack change required', [] )
+        else
+            lvars results = conslist( k );
+            mishap( 'Expression returned too many results, exactly zero required', results );
+        endif
+    endunless;
+enddefine;
+
+define lconstant check_N( before, N );
+    lvars after = stacklength();
+    lvars k = after fi_- before;
+    unless k == N then
+        if k == 0 then
+            mishap( sprintf( 'Expression generated no results but %p required', [^N] ), [] );
+        elseif k < 0 then
+            mishap( sprintf('Expression consumed values instead of returning % result(s)', [^N] ), [] )
+        else
+            lvars results = conslist( k );
+            mishap( sprintf( 'Expression returned too many results, exactly %p required', [^N] ), results );
+        endif
+    endunless;
+enddefine;
+
+lconstant procedure check_1 = check_N(% 1 %);
+
+define global constant procedure pop11_comp_N( action, N );
+    dlocal pop_new_lvar_list;
+    lvars tmpvar = sysNEW_LVAR();
+    sysCALL( "stacklength" );
+    sysPOP( tmpvar );
+    action();
+    sysPUSH( tmpvar );
+    if N == 0 then
+        sysCALLQ( check_0 )
+    elseif N == 1 then
+        sysCALLQ( check_1 );
+    else
+        sysPUSHQ( N );
+        sysCALLQ( check_N );
+    endif
+enddefine;
+
+endsection;

From 8b19ba243ff3f35f84cf3cfc552d43c3e3e7f062 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 5 Mar 2022 22:10:35 +0000
Subject: [PATCH 34/44] Bring in restack from GOSPL plus 1 dependency
 read_variables

---
 base/pop/getpoploglib/auto/read_variables.p   |  29 ++
 base/pop/getpoploglib/auto/restack.p          | 274 ++++++++++++++++++
 base/pop/getpoploglib/help/read_variables     |   6 +
 base/pop/getpoploglib/help/restack            | 246 ++++++++++++++++
 .../unittests/read_variables.test.p           |  40 +++
 .../pop/getpoploglib/unittests/restack.test.p |  43 +++
 6 files changed, 638 insertions(+)
 create mode 100644 base/pop/getpoploglib/auto/read_variables.p
 create mode 100644 base/pop/getpoploglib/auto/restack.p
 create mode 100644 base/pop/getpoploglib/help/read_variables
 create mode 100644 base/pop/getpoploglib/help/restack
 create mode 100644 base/pop/getpoploglib/unittests/read_variables.test.p
 create mode 100644 base/pop/getpoploglib/unittests/restack.test.p

diff --git a/base/pop/getpoploglib/auto/read_variables.p b/base/pop/getpoploglib/auto/read_variables.p
new file mode 100644
index 00000000..4b30490f
--- /dev/null
+++ b/base/pop/getpoploglib/auto/read_variables.p
@@ -0,0 +1,29 @@
+compile_mode :pop11 +strict;
+
+section;
+
+;;; reads a (optionally comma separated) list of ordinary variables from
+;;; the input stream.
+define read_variables();
+    [%
+        repeat
+            quitif( proglist.null );
+            lvars item = proglist.hd;
+            quitunless( item.isword );
+            if item == "," then
+                readitem().erase;
+                nextloop;
+            endif;
+            lvars id = identprops( item );
+            quitunless(
+                id.isnumber or
+                id == "undef" or
+                id == "procedure" or
+                id == "macro"
+            );
+            readitem();
+        endrepeat
+    %]
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/restack.p b/base/pop/getpoploglib/auto/restack.p
new file mode 100644
index 00000000..fbc056bd
--- /dev/null
+++ b/base/pop/getpoploglib/auto/restack.p
@@ -0,0 +1,274 @@
+;;; Summary: syntax word for manipulating top items of stack
+
+compile_mode :pop11 +strict;
+
+section;
+
+define lconstant oops( i ); lvars i;
+    mishap( 'RESTACK: INTERNAL ERROR (please report)', [^i] )
+enddefine;
+
+define lconstant sanity_check( inputs, outputs ) -> ( arity, indexes );
+    lvars inputs, outputs, arity, indexes;
+    0 -> arity;
+    lvars i, t;
+    for i on inputs do
+        if lmember( dest( i ) ) do
+            mishap( 'RESTACK: input variable used twice', [% hd(i) %] )
+        else
+            arity + 1 -> arity;
+        endif
+    endfor;
+    [%
+        for i in outputs do
+            if lmember( i, inputs ) ->> t then
+                arity - length( t ) + 1
+            else
+                mishap( 'RESTACK: variable not in input list', [^i] )
+            endif
+        endfor;
+    %] -> indexes;
+enddefine;
+
+;;; A plan consists of a series of instructions of the form
+;;;     [POP n], [PUSH n], [PUSHS], [ERASE], [SWAP m n], [CHECK n]
+;;; These correspond to VM instructions, with the exception of [CHECK k]
+;;; whose role is to check there are at least k items on the stack.
+;;;
+define lconstant naive_plan( arity, indexes ); lvars arity, indexes;
+    [%
+        lvars i;
+        for i from arity by -1 to 1 do
+            [POP ^i]
+        endfor;
+        for i in indexes do
+            [PUSH ^i]
+        endfor;
+    %]
+enddefine;
+
+;;; This predicate is given a list of
+;;; instruction types "types" and a particular instruction "this_inst".
+;;; It checks whether or not the plan consists of a series of instructions
+;;; of those types & then this_inst.  The instructions after that don't
+;;; matter.
+;;;
+define lconstant up_to_inst( plan, this_inst, types );
+    lvars plan, types, this_inst;
+    lvars inst, count = 0;
+    for inst in plan do
+        if inst = this_inst then
+            return( count )
+        elseunless lmember( hd( inst ), types ) then
+            return( false )
+        endif;
+        count + 1 -> count;
+    endfor;
+    return( false )
+enddefine;
+
+;;; This is a little predicate on plans.  Does the plan consist of a series of
+;;; POP/ERASE instructions followed by a particular instruction?  It returns
+;;; either the number of PUSH/ERASE instructions or false.
+define lconstant pops_then_inst( plan, this_inst ); lvars plan, this_inst;
+    up_to_inst( plan, this_inst, [POP ERASE] )
+enddefine;
+
+;;; A similar predicate to the preceding.  This time, does the plan consist
+;;; of a series of SWAP instructions followed by a particular instruction?
+;;; It returns the number of SWAP instructions or false.
+define lconstant swaps_then_inst( plan, this_inst ); lvars plan, this_inst;
+    up_to_inst( plan, this_inst, [SWAP] )
+enddefine;
+
+;;; Is there a check that can be eliminated through stack counting?
+;;; We know there are at least K items on the stack.
+define find_check( plan, k ); lvars plan, k;
+    lvars n = 0;
+    lvars i;
+    for i in plan do
+        n + 1 -> n;
+        quitif( k <= 0 );
+        lvars type = i.hd;
+        if type == "ERASE" or type == "POP" then
+            k - 1 -> k
+        elseif type == "PUSHS" or type == "PUSH" then
+            k + 1 -> k
+        elseif type == "SWAP" then
+            ;;; Ignore this swap.
+        elseif type == "CHECK" then
+            return( n )
+        else
+            oops( i );
+        endif;
+    endfor;
+    return( false );
+enddefine;
+
+;;; Try to remove superfluous CHECK instructions by counting
+;;; the number of items guaranteed to be on the stack.  K is the
+;;; number guaranteed.
+;;;
+define lconstant cull_checks( plan ); lvars plan;
+
+    define lconstant decr( n ) -> n; lvars n;
+        n - 1 -> n;
+        if n < 0 then 0 -> n endif
+    enddefine;
+
+    lvars K = 0;
+    lvars inst;
+    for inst in plan do
+        lvars type = inst.hd;
+        if type == "ERASE" or type == "POP" then
+            decr( K ) -> K;
+        elseif type == "PUSHS" or type == "PUSH" then
+            K + 1 -> K;
+        elseif type == "SWAP" then
+            max( K, max( inst(2), inst(3) ) ) -> K;
+        elseif type == "CHECK" then
+            nextif( K >= 1 );
+            1 -> K;
+        else
+            oops( inst );
+        endif;
+        ;;; We push every instruction apart from that of CHECK.
+        ;;; CHECK will sometimes skip this by calling "nextif".
+        inst;
+    endfor;
+enddefine;
+
+;;; Peephole optimisation of restacking plan.  There are several different
+;;; kinds of simple improvement made in this routine.
+;;; 1.  Any POP n without a subsequent PUSH n becomes an ERASE
+;;; 2.  POP n & PUSH n without subsequent references to n --> [CHECK]
+;;; 3.  POP n & POP/ERASE ... & PUSH n without a subsequent reference to n
+;;;     improved into a SWAP.
+;;; 4.  POP n & SWAPS... & PUSH n --> +SWAPS... & POP n & PUSH n
+;;; 5.  (PUSHS | PUSH n) & ERASE --> ()
+;;; 6.  PUSH n & PUSH n ... --> PUSH n & PUSHS ...
+;;; 7.  SWAP a b & SWAP a b --> ()
+;;; 8.  CHECK & ( CHECK/PUSHS/ERASE/POP n/SWAP a b) --> ( ... )
+define lconstant improved( plan ); lvars plan, n;
+    until null( plan ) do
+        lvars inst = plan.dest -> plan;
+        lvars ( type, arg ) = inst.dest;
+        lvars next_inst = if plan.null then [DUMMY] else plan.hd endif;
+        lvars ( next_type, next_arg ) = next_inst.dest;
+        if type == "POP" then
+            lvars index = arg( 1 );
+            lvars push = [ PUSH ^index ];
+            if not( member( push, plan ) ) then
+                [ ERASE ]
+            elseif
+                next_inst = push and
+                ( null( plan ) or not( member( push, plan.tl ) ) )
+            then
+                plan.tl -> plan;
+                [CHECK]
+            elseif
+                next_inst /= push and
+                ( pops_then_inst( plan, push ) ->> n ) and
+                not( member( push, applynum( plan, tl, n+1 ) ) )
+            then
+                [SWAP 1 ^(n+1)];        ;;; insert swap
+                plan( n );              ;;; move last POP/ERASE to start
+                repeat n - 1 times
+                    plan.dest -> plan   ;;; remaining POP/ERASE
+                endrepeat;
+                plan.tl -> plan;        ;;; don't reuse last POP/ERASE
+                plan.tl -> plan;        ;;; dispose of PUSH
+            elseif
+                next_inst /= push and
+                ( swaps_then_inst( plan, push ) ->> n )
+            then
+                repeat n times
+                    lvars swap_inst = plan.dest -> plan;
+                    [SWAP % swap_inst(2)+1, swap_inst(3)+1 %]
+                endrepeat;
+                inst;
+            else
+                inst
+            endif
+        elseif type == "PUSH" or type == "PUSHS" then
+            if next_type == "ERASE" then
+                plan.tl -> plan
+            elseif type == "PUSH" and next_inst = inst then
+                inst;
+                while not(plan.null) and plan.hd = inst do
+                    [PUSHS];
+                    plan.tl -> plan;
+                endwhile;
+            else
+                inst
+            endif
+        elseif type == "SWAP" then
+            if inst = next_inst then
+                ;;; two swaps in a row ... do nothing.
+                plan.tl -> plan;
+            else
+                lvars n = find_check( plan, max( arg(1), arg(2) ) );
+                inst
+            endif
+        elseif type == "CHECK" then
+            if lmember( next_type, #_< [CHECK ERASE POP PUSHS SWAP] >_# ) then
+                /* nothing -- eliminate this instruction */
+            else
+                inst
+            endif
+        else
+            inst
+        endif
+    enduntil;
+enddefine;
+
+define lconstant optimise( plan ); lvars plan;
+    repeat
+        lvars i_plan = [% cull_checks( [% improved( plan ) %] ) %];
+        returnif( i_plan = plan )( plan );
+        i_plan -> plan;
+    endrepeat
+enddefine;
+
+define lconstant plant( plan ); lvars plan;
+    dlocal pop_new_lvar_list;
+
+    lvars table = [].newassoc;
+
+    define lconstant local( arg ); lvars arg;
+        lvars index = arg.hd;
+        table( index ) or
+        ( sysNEW_LVAR() ->> table( index ) )
+    enddefine;
+
+    lvars inst;
+    for inst in plan do
+        lvars ( type, arg ) = inst.dest;
+        if type == "POP" then
+            sysPOP( arg.local )
+        elseif type == "PUSH" then
+            sysPUSH( arg.local )
+        elseif type == "PUSHS" then
+            sysPUSHS( undef )
+        elseif type == "ERASE" then
+            sysERASE( undef )
+        elseif type == "SWAP" then
+            sysSWAP( arg.dl )
+        elseif type == "CHECK" then
+            sysPUSHS( undef );
+            sysERASE( undef )
+        else
+            oops( inst )
+        endif
+    endfor;
+enddefine;
+
+define syntax restack;
+    lvars inputs = read_variables();
+    pop11_need_nextreaditem( "->" ).erase;
+    lvars outputs = read_variables();
+    lvars ( arity, indexes ) = sanity_check( inputs, outputs );
+    naive_plan( arity, indexes ).optimise.plant;
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/help/read_variables b/base/pop/getpoploglib/help/read_variables
new file mode 100644
index 00000000..fc2b68df
--- /dev/null
+++ b/base/pop/getpoploglib/help/read_variables
@@ -0,0 +1,6 @@
+HELP READ_VARIABLES                             Steve Knight, Jan 1991
+
+read_variables() -> <L:word list>
+
+This routine reads a list of "ordinary" variables from the input stream,
+optionally separated by commas.  It stops when it reaches any syntax word.
diff --git a/base/pop/getpoploglib/help/restack b/base/pop/getpoploglib/help/restack
new file mode 100644
index 00000000..fdd3d4b3
--- /dev/null
+++ b/base/pop/getpoploglib/help/restack
@@ -0,0 +1,246 @@
+HELP RESTACK                                    Steve Knight, Jan 1991
+
+restack id ... -> id ... ;
+
+ -- General Description
+ -- Examples
+ -- The Idiom of Pure Stack Operations
+ -- Negative Examples
+ -- Positive Examples
+
+-- General Description ------------------------------------------------
+
+The purpose of the "restack" construct is to rearrange the topmost items on
+the stack.  For example, you can reverse the top three items on the stack by
+writing
+
+    restack x y z -> z y x;
+
+The syntax of restack is
+    restack <input words> -> <output words>
+where <input/output words> stands for a sequence of words optionally separated
+by commas.  All the output-words must appear in the input-words and no
+input-word can occur twice.
+
+The effect of a restack is equivalent to writing
+    procedure( <input words> ) -> ( <output words> );
+        lvars <input words>, <output words>;
+    endprocedure();
+But using -restack- is much more efficient as it plants in-line code.
+
+
+-- Examples -----------------------------------------------------------
+
+    1, 2, 3; restack a b c -> c a b =>
+    ** 3 1 2
+
+    ;;; You can use restack to check the number of items on the stack!
+    restack x -> x;  ;;; with nothing on the stack!
+    ;;; MISHAP - STE: STACK EMPTY (missing argument? missing result?)
+
+
+-- The Idiom of Pure Stack Operations ---------------------------------
+
+(This section provides some background on the idiom that restack is written
+to support.  It is not essential.)
+
+Most of the time in Pop11, you don't have to be particularly interested in the
+stack.  In fact, many programmers try to ignore the stack altogether.
+However, there are a number of interesting programming 'idioms' or techniques
+that are made possible by deliberately exploiting the fact that the stack is
+completely open to the programmer.
+
+A familiar idiom to Pop11 programmers is the use of the stack in combination
+with list or vector brackets.  For example, you might write the familiar
+"flatten" or "fringe" function (that constructs a list of all the elements in
+a tree, represented as a list of lists) like this
+
+    define flatten( tree ); lvars tree;
+        define lconstant walk_fringe( t ); lvars t;
+            if t.islist then
+                applist( t, walk_fringe )
+            else
+                t
+            endif
+        enddefine;
+        [% walk_fringe( tree ) %]
+    enddefine;
+
+But there are several other ideas in this area.  How can you sum the elements
+in a list?  Obviously you could write a "for" loop.  Try thinking about
+this!
+
+    applist( 0, [2 4 6], nonop + ) =>
+    ** 12
+
+One rich source of ideas is the programming language FORTH.  FORTH is a very
+low-level language which, like Pop11, has an 'open' stack.  Rather remarkably,
+FORTH procedures have no local variables(!!)  Instead, the FORTH programmer
+has to learn how to carefully manipulate the stack so that the values they
+want are always on top of the stack (and in the right order) when they are
+needed.
+
+To help them, the FORTH programmer has a number of simple stack manipulation
+routines.  The most frequently used ones are
+    dup     which duplicates the value on top         x -> x x
+    drop    which removes the topmost value           x ->
+    swap    which swaps the top two values            x y -> y x
+    rot     which rotates the top three stack values  x y z -> z x y
+    rot2    equal to two rot's                        x y z -> y z x
+    over    which copies the second value to the top  x y -> x y x
+Pop11 has the first two, which are "dup" and "erase" but not the other
+four.
+
+Now the lack of local variables is typically a "bad thing" -- at least
+from the viewpoint of conveniently writing programs.  However, when you
+get used to this way of writing routines, it is quite easy and SOMETIMES
+it is very elegant.  It is this idiom of pure stack-manipulation that
+restack helps you exploit on those occasions.
+
+
+-- Negative Examples --------------------------------------------------
+
+Just to get a flavour of this programming style, I've written a couple of
+functions in this style.  The first is the well-known factorial function and
+the second finds the roots of quadratic equations.  They aren't especially
+pretty to look at -- their purpose is only to get you thinking in pure-stack
+operations and to realise that it needs a different way of thinking.
+
+;;; remember, we're not allowed to use any local variables!
+define factorial();
+    ;;; we want to compare the top of the stack with 0.  However, we'll
+    ;;; need it later.  This means we must take a copy using dup.
+    if dup() = 0 then
+        ;;; in this case, we don't need the input value any more.  We
+        ;;; drop it, using erase, and then push 1 as the result.
+        erase(); 1
+    else
+        ;;; we've got the input value N on top of the stack.  We now
+        ;;; want to compute N * factorial( N - 1 ).  This is especially
+        ;;; easy.
+        dup() - 1;      ;;; leaves N; N-1 on the stack
+        factorial();    ;;; N; factorial( N - 1 )
+        *;              ;;; then multiply
+    endif
+enddefine;
+
+Here's an even more grotesque example - finding the roots of the quadratic
+equation a*x**2 + b*x +c = 0.  First, we write it out in ordinary Pop11 code.
+
+    define roots( a, b, c ); lvars a, b, c;
+        lvars base = sqrt( b ** 2 - 4 * a * c );
+        lvars denom = 2 * a;
+        (-b + base) / denom;
+        (-b - base) / denom;
+    enddefine;
+
+Here it is, rather perversely, done without any local variables.
+
+    define swap( a, b ) -> ( b, a ); lvars a, b; enddefine;
+    define rot( a, b, c ) -> ( c, a, b ); lvars a, b, c; enddefine;
+    define rot2( a, b, c ) -> ( b, c, a ); lvars a, b, c; enddefine;
+    define over( a, b ) -> ( a, b, a ); lvars a, b; enddefine;
+
+    define roots();
+        ;;; a, b, c on the stack
+        rot2() * 2;     ;;; b, c, denom
+        dup() * 2;      ;;; b, c, denom, 4*a
+        rot2();         ;;; b, denom, 4*a, c
+        *;              ;;; b, denom, 4*a*c
+        rot2();         ;;; denom, 4*a*c, b
+        negate();       ;;; denom, 4*a*c, -b
+        dup() * dup();  ;;; denom, 4*a*c, -b, b**2
+        rot2() -;       ;;; denom, -b, b**2 - 4*a*c
+        sqrt();         ;;; denom, -b, base
+        over(); over(); ;;; denom, -b, base, -b, base
+        +;              ;;; denom, -b, base, -b+base
+        rot() -;        ;;; denom, -b+base, -b-base
+        rot(); over();  ;;; -b-base, denom, -b+base, denom
+        /;              ;;; -b-base, denom, root1
+        rot() /;        ;;; root1; root2
+    enddefine;
+
+These examples show:
+    1.  writing such code requires thinking about programming
+        in a different way,
+    2.  you only need a handful of stack operators,
+    3.  pure stack operator code is not always appropriate!
+
+
+-- Positive Examples --------------------------------------------------
+
+Here are a few examples that illustrate pure stack operations more positively.
+They are all quite simple and use the stack operators very sparingly to create
+elegant solutions.
+
+The first example is strikingly elegant in its use of the stack.  Suppose
+you were asked to write a function to generate the first N fibonacci numbers
+as a list.  (These are the numbers in the series 1, 1, 2, 3, 5, 8, 13, ...
+where each number is the sum of the previous two.)  Almost everyone writes
+code looking like this -- for simplicity of presentation, I'll assume that
+N >= 2
+    define fibs( n ); lvars n;
+        lvars a = 1, b = 1;
+        [%
+            a; b;
+            repeat n-2 times
+                lvars c = a + b;
+                b -> a;
+                c -> b;
+                c;
+            endrepeat
+        %]
+    enddefine;
+However, all these variables simply get in the way.  The pure stack based
+approach brushes them aside!
+    define fibs( n ); lvars n;
+        [% 1; 1; repeat n-2 times over() + over() endrepeat %]
+    enddefine;
+
+
+The second example uses "swap" to create an elegant solution.  Suppose you had
+a list of vectors, and you wanted the third element from all these vectors
+    e.g.    index( [{a b c} {d e f} {g h i}] ) =>
+            ** [c f i]
+One might be tempted to write a "for" loop -- but that's the brute force
+approach.  You might write
+    maplist( L, procedure( v ); lvars v; v(3) endprocedure )
+but that's a rather bulky expression.  What you could try is pure stack
+manipulation
+    maplist( L, swap(% 3 %) <> apply )
+There are many examples of this kind, where the pure stack manipulation
+combines nicely with the use of functional programming.
+
+The third example also illustrates a similar use of "swap".  Our task is
+to "reverse" a list.
+    define reverse( L ); lvars L;
+        applist( [], L, swap <> conspair )
+    enddefine;
+
+
+-- The Idea Behind Restack --------------------------------------------
+
+The idea behind restack is simple.  Rather than provide a collection of
+operators, restack is a single syntax word that allows you to write any
+pure stack operation in a convenient fashion.  Because it is a syntax word
+it can generate efficient in-line code, too.
+
+It is not the sort of construct that's likely to find everyday use.  It is
+a flexible and efficient tool that helps provide the basis for a general
+stack use idiom.
+
+One good way of using -restack- would be to use it in combination with
+lib plant_in_line.  That way, you could define functions such as "over" 
+so that they plant in-line code when used in-line.
+
+uses plant_in_line;
+
+lvars macro over_pattern = [restack x y -> x y x];
+
+define constant procedure over() with_nargs 2;
+    over_pattern
+enddefine;
+
+sysplant(% nonmac over_pattern %) -> plant_in_line( over );
+
+-----------------------------------------------------------------------
diff --git a/base/pop/getpoploglib/unittests/read_variables.test.p b/base/pop/getpoploglib/unittests/read_variables.test.p
new file mode 100644
index 00000000..b35aa859
--- /dev/null
+++ b/base/pop/getpoploglib/unittests/read_variables.test.p
@@ -0,0 +1,40 @@
+compile_mode :pop11 +strict;
+
+section;
+
+define :unittest no_variables_to_termin();
+    dlocal proglist = [];
+    assert read_variables() == [];
+enddefine;
+
+define :unittest no_variables_to_semi();
+    dlocal proglist = [;];
+    assert read_variables() == [];
+enddefine;
+
+define :unittest no_variables_to_close_parenthesis();
+    dlocal proglist = [)];
+    assert read_variables() == [];
+enddefine;
+
+define :unittest one_variables_no_comma();
+    dlocal proglist = [x];
+    assert read_variables() = [x];
+enddefine;
+
+define :unittest one_variables_with_commas();
+    dlocal proglist = [,x,];
+    assert read_variables() = [x];
+enddefine;
+
+define :unittest two_variables_with_many_commas();
+    dlocal proglist = [,x,,,y];
+    assert read_variables() = [x y];
+enddefine;
+
+
+
+
+
+
+endsection;
diff --git a/base/pop/getpoploglib/unittests/restack.test.p b/base/pop/getpoploglib/unittests/restack.test.p
new file mode 100644
index 00000000..a9f10bab
--- /dev/null
+++ b/base/pop/getpoploglib/unittests/restack.test.p
@@ -0,0 +1,43 @@
+compile_mode :pop11 +strict;
+
+section;
+
+define :unittest do_nothing();
+    lvars zero = stacklength();
+    restack -> ;
+    assert stacklength() == zero;
+enddefine;
+
+define :unittest swap();
+    ( "foo", "bar" );
+    restack x y -> y x;
+    lvars z = () <> ();
+    assert "barfoo" == z;
+enddefine;
+
+define :unittest duplicate();
+    ( "foo", "bar" );
+    restack x y -> y y;
+    lvars z = () <> ();
+    assert "barbar" == z;
+enddefine;
+
+define :unittest shrink_stack();
+    lvars n = stacklength();
+    ( "foo", "bar" );
+    restack x y -> y;
+    lvars z = ();
+    assert "bar" == z;
+    assert stacklength() == n;
+enddefine;
+
+define :unittest grow_stack();
+    lvars n = stacklength();
+    ( "foo", "bar" );
+    restack x y -> x y x y;
+    lvars z = () <> () <> () <> ();
+    assert "foobarfoobar" == z;
+    assert stacklength() == n;
+enddefine;
+
+endsection;

From f93c2ae555315d58b3ed4793610ae8fc87c04de9 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 5 Sep 2021 17:59:00 +0100
Subject: [PATCH 35/44] Implementing lib dict Also named parameters
 experimental extension - work in progress A simple example of the Design A
 syntax

---
 base/pop/getpoploglib/auto/$.p                |  68 ++++++
 base/pop/getpoploglib/auto/destdict_keys.p    |  11 +
 base/pop/getpoploglib/auto/destdict_values.p  |  11 +
 base/pop/getpoploglib/auto/dollar_{.p         |  19 ++
 base/pop/getpoploglib/auto/frozval_slot.p     |   1 +
 .../auto/newdict_from_assoclist.p             |  21 ++
 .../auto/newdict_from_twinlists.p             |  22 ++
 base/pop/getpoploglib/auto/partapply_dict.p   |  12 ++
 base/pop/getpoploglib/examples/design_a.p     |  24 +++
 base/pop/getpoploglib/help/dict               |  11 +
 base/pop/getpoploglib/lib/dict.p              | 201 ++++++++++++++++++
 base/pop/getpoploglib/lib/named_arguments.p   | 125 +++++++++++
 12 files changed, 526 insertions(+)
 create mode 100644 base/pop/getpoploglib/auto/$.p
 create mode 100644 base/pop/getpoploglib/auto/destdict_keys.p
 create mode 100644 base/pop/getpoploglib/auto/destdict_values.p
 create mode 100644 base/pop/getpoploglib/auto/dollar_{.p
 create mode 100644 base/pop/getpoploglib/auto/frozval_slot.p
 create mode 100644 base/pop/getpoploglib/auto/newdict_from_assoclist.p
 create mode 100644 base/pop/getpoploglib/auto/newdict_from_twinlists.p
 create mode 100644 base/pop/getpoploglib/auto/partapply_dict.p
 create mode 100644 base/pop/getpoploglib/examples/design_a.p
 create mode 100644 base/pop/getpoploglib/help/dict
 create mode 100644 base/pop/getpoploglib/lib/dict.p
 create mode 100644 base/pop/getpoploglib/lib/named_arguments.p

diff --git a/base/pop/getpoploglib/auto/$.p b/base/pop/getpoploglib/auto/$.p
new file mode 100644
index 00000000..3b13fea2
--- /dev/null
+++ b/base/pop/getpoploglib/auto/$.p
@@ -0,0 +1,68 @@
+section dollar => $;
+
+;;; Initially tried with '$_' and hit a lot of problems with '$_{'.
+lconstant autoload_prefix = 'dollar_';
+lconstant autoload_class_suffix = '_key';
+
+;;; This procedure provides an extension mechanism for the $ITEM syntax.
+;;; It maps from 'items' from the Pop-11 itemizer (words, string, numbers)
+;;; or keys (word_key, string_key, number keys) into code-planting
+;;; procedures.
+
+define lconstant lookup( item );
+    if item.isword then
+        lvars w = consword( autoload_prefix <> item.word_string );
+        lvars wid = word_identifier( w, pop_section, true );
+        if wid then
+            wid.valof
+        else
+            [try to autoload ^w] =>
+            if sys_autoload( w ) then
+                [succeeded] =>
+                word_identifier( w, pop_section, true ).valof
+            else
+                false
+            endif
+        endif
+    else
+        lvars w = consword( autoload_prefix <> item.datakey.class_name.word_string <> autoload_class_suffix );
+        lvars wid = word_identifier( w, pop_section, true );
+        [try to autoload ^w] =>
+        if sys_autoload( w ) then
+            [ succeeded] =>
+            word_identifier( w, pop_section, true ).valof
+        else
+            false
+        endif;
+    endif
+enddefine;
+
+define lconstant is_viable_shell_variable( w );
+    returnif( w.datalength <= 0 )( false );
+    lvars w1 = subscrw( 1, w );
+    returnunless( w1.isalphacode or w1 == `_` )( false );
+    lvars i;
+    for i from 2 to w.datalength do
+        lvars ch = subscrw( i, w );
+        returnunless( ch.isalphacode or ch.isnumbercode or ch == `_` )( false )
+    endfor;
+    return( true )
+enddefine;
+
+define global syntax $ ;
+    lvars item = readitem();
+    if item.isword and item.is_viable_shell_variable then
+        sysPUSHQ( item.word_string );
+        sysCALL -> pop_expr_inst;
+        "systranslate" -> pop_expr_item;
+    else
+        lvars p = lookup( item );
+        if p then
+            p( item )
+        else
+            mishap( 'Unexpected item after $', [^item] )
+        endif
+    endif
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/destdict_keys.p b/base/pop/getpoploglib/auto/destdict_keys.p
new file mode 100644
index 00000000..c54d06c0
--- /dev/null
+++ b/base/pop/getpoploglib/auto/destdict_keys.p
@@ -0,0 +1,11 @@
+compile_mode :pop11 +strict;
+
+uses dict
+
+section $-dict => destdict_keys;
+
+define global constant procedure destdict_keys( dict );
+    dict.dict_keys.destvector
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/destdict_values.p b/base/pop/getpoploglib/auto/destdict_values.p
new file mode 100644
index 00000000..84dcb9ff
--- /dev/null
+++ b/base/pop/getpoploglib/auto/destdict_values.p
@@ -0,0 +1,11 @@
+compile_mode :pop11 +strict;
+
+uses dict
+
+section $-dict => destdict_values;
+
+define global constant procedure destdict_values( dict );
+    dict.dict_values.destvector
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/dollar_{.p b/base/pop/getpoploglib/auto/dollar_{.p
new file mode 100644
index 00000000..7314df69
--- /dev/null
+++ b/base/pop/getpoploglib/auto/dollar_{.p
@@ -0,0 +1,19 @@
+compile_mode :pop11 +strict;
+
+section;
+
+;;; Idiom for 'silently load a lib defining a class if not loaded already'.
+if identprops("dict_key") then
+    loadlib("dict")
+endif;
+
+;;;
+;;; Pop-11 really does not like the identifier dollar_{ so we need to force
+;;; the assignment with some low-level code.
+;;;
+ident_declare( "'dollar_{'", "syntax", 0 );
+procedure(word) with_props 'dollar_{';
+    $-dict$-compile_newdict_to( "}" ) -> _;
+endprocedure -> idval( identof( "'dollar_{'" ) );
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/frozval_slot.p b/base/pop/getpoploglib/auto/frozval_slot.p
new file mode 100644
index 00000000..2df739a8
--- /dev/null
+++ b/base/pop/getpoploglib/auto/frozval_slot.p
@@ -0,0 +1 @@
+uses-by_name frozval_names (frozval_slot);
diff --git a/base/pop/getpoploglib/auto/newdict_from_assoclist.p b/base/pop/getpoploglib/auto/newdict_from_assoclist.p
new file mode 100644
index 00000000..feb440a3
--- /dev/null
+++ b/base/pop/getpoploglib/auto/newdict_from_assoclist.p
@@ -0,0 +1,21 @@
+compile_mode :pop11 +strict;
+
+section;
+
+uses dict
+
+define global constant procedure newdict_from_assoclist( list );
+    lvars keys = [];
+    lvars values = {%
+        lvars p, n = 0;
+        for p in list do
+            n fi_+ 1 -> n;
+            lvars ( k, v ) = p.dest.hd;
+            conspair( conspair( k, n ), keys ) -> keys;
+            v ;;; put values in historical order into a vector.
+        endfor
+    %};
+    newdict_internal( keys, values )
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/newdict_from_twinlists.p b/base/pop/getpoploglib/auto/newdict_from_twinlists.p
new file mode 100644
index 00000000..489a7222
--- /dev/null
+++ b/base/pop/getpoploglib/auto/newdict_from_twinlists.p
@@ -0,0 +1,22 @@
+compile_mode :pop11 +strict;
+
+section;
+
+uses dict
+
+define global constant procedure newdict_from_twinlists( keys_list, values_list );
+    lvars keys = [];
+    lvars values = {%
+        lvars n = 0;
+        until keys_list.null or values_list.null do
+            n fi_+ 1 -> n;
+            lvars k = keys_list.fast_destpair -> keys_list;
+            lvars v = values_list.fast_destpair -> values_list;
+            conspair( conspair( k, n ), keys ) -> keys;
+            v ;;; put values in historical order into a vector.
+        enduntil
+    %};
+    newdict_internal( keys, values );
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/partapply_dict.p b/base/pop/getpoploglib/auto/partapply_dict.p
new file mode 100644
index 00000000..90345a59
--- /dev/null
+++ b/base/pop/getpoploglib/auto/partapply_dict.p
@@ -0,0 +1,12 @@
+compile_mode :pop11 +strict;
+
+section;
+
+uses dict
+
+define global constant procedure partapply_dict( procedure p, dict ) -> c;
+    consclosure( dict.destdict_values, p ) -> c;
+    dict.destdict_keys -> c.frozval_names;
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/examples/design_a.p b/base/pop/getpoploglib/examples/design_a.p
new file mode 100644
index 00000000..766935f5
--- /dev/null
+++ b/base/pop/getpoploglib/examples/design_a.p
@@ -0,0 +1,24 @@
+;;; Try the following code.
+
+with
+    sorted = false
+define demo( x, y ) -> list;
+    [%
+        lvars i;
+        for i in x do
+            if member( i, y ) then i endif
+        endfor
+    %] -> list;
+    if sorted then 
+        list.sort -> list
+    endif;
+enddefine;
+
+
+demo( [ 4 3 2 1 ], [3 6 4 8] ) =>
+
+with 
+    sorted = true
+do
+    demo( [ 4 3 2 1 ], [3 6 4 8] ) =>
+
diff --git a/base/pop/getpoploglib/help/dict b/base/pop/getpoploglib/help/dict
new file mode 100644
index 00000000..ce2b98f5
--- /dev/null
+++ b/base/pop/getpoploglib/help/dict
@@ -0,0 +1,11 @@
+HELP DICT                                         Stephen Leach Aug 2021
+
+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+<<<<<<<<<<<<<<<<<<<<<                             >>>>>>>>>>>>>>>>>>>>>>
+<<<<<<<<<<<<<<<<<<<<<           DICTS             >>>>>>>>>>>>>>>>>>>>>>
+<<<<<<<<<<<<<<<<<<<<<                             >>>>>>>>>>>>>>>>>>>>>>
+<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+newdict
+
++
diff --git a/base/pop/getpoploglib/lib/dict.p b/base/pop/getpoploglib/lib/dict.p
new file mode 100644
index 00000000..b5bc2ab4
--- /dev/null
+++ b/base/pop/getpoploglib/lib/dict.p
@@ -0,0 +1,201 @@
+compile_mode :pop11 +strict;
+ 
+section $-dict =>
+    dict_key isdict empty_dict dict_length is_empty_dict 
+    subscrdict appdict;
+
+#_IF not( isdefined( "dict_key" ) )
+
+constant ejection_threshold = 1024;
+
+define constant procedure clear_half( prop );
+    lvars clear_these = (
+        [% 
+            fast_appproperty( 
+                prop, 
+                procedure( k, v );
+                    if random(1.0) < 0.5 then k endif
+                endprocedure
+            ) 
+        %]
+    );
+    lvars k;
+    for k in clear_these do
+        fast_kill_prop_entry( k, prop ) -> _;
+    endfor;
+enddefine;
+
+;;; This table is used to ensure keysets are not usually duplicated.
+constant procedure dict_table =
+    newanyproperty(
+        [], 8, 1, 8,
+        nonop =, syshash, "tmpval",
+        false,
+        procedure( key, prop );
+            ;;; Have we grown too big?
+            if datalength( prop ) > ejection_threshold then
+                clear_half( prop )
+            endif;
+            key ->> prop( key );
+        endprocedure
+    );
+
+global constant dict_key = conskey( "dict", [ full full ] );
+global constant procedure isdict = dict_key.class_recognise;
+
+lconstant procedure consdict = dict_key.class_cons;
+
+;;; Not exported but retained for autoloading.
+constant procedure dict_keys = class_access( 1, dict_key );
+"dict_keys" -> dict_keys.pdprops;
+
+;;; Not exported but retained for autoloading.
+constant procedure dict_values = class_access( 2, dict_key );
+"dict_values" -> dict_values.pdprops;
+
+global constant empty_dict = consdict( {}.dup );
+
+define global constant procedure dict_length( dict );
+    dict.dict_values.datalength
+enddefine;
+
+define global constant procedure is_empty_dict( dict );
+    dict.dict_values.datalength == 0
+enddefine;
+
+define lconstant find( w, dict );
+    lvars lo = 1;
+    lvars hi = dict.dict_values.datalength;
+    repeat
+        if lo < hi then
+            lvars mid = ( lo fi_+ hi ) fi_>> 1;
+            lvars midkey = subscrv( mid, dict.dict_keys );
+            lvars cmp = alphabefore( w, midkey );
+            if cmp then
+                if cmp == 1 then
+                    return( mid )
+                else
+                    mid fi_- 1 -> hi;
+                endif
+            else
+                mid fi_+ 1 -> lo;
+            endif
+        elseif lo == hi and w == subscrv( lo, dict.dict_keys ) then
+            return( hi )
+        else
+            mishap( 'Trying to index dict with invalid', [ ^w ] )
+        endif
+    endrepeat
+enddefine;
+
+define global constant procedure subscrdict( w, dict );
+    subscrv( find( w, dict ), dict.dict_values )
+enddefine;
+
+define updaterof subscrdict( item, w, dict );
+    item -> subscrv( find( w, dict ), dict.dict_values )
+enddefine;
+
+subscrdict -> class_apply( dict_key );
+
+define global constant procedure appdict( dict, procedure p );
+    lvars i, n = dict.dict_length;
+    for i from 1 to n do
+        p(
+            fast_subscrv( i, dict.dict_keys ),
+            fast_subscrv( i, dict.dict_values )
+        )
+    endfor;
+enddefine;
+
+define prdict( dict );
+    pr( '${' );
+    unless dict.is_empty_dict do pr( ' ' ) endunless;
+    dlvars first = true;
+    appdict(
+        dict,
+        procedure( k, v );
+            unless first then
+                pr( ', ' )
+            endunless;
+            pr( k );
+            pr( '=' );
+            pr( v );
+            false -> first;
+        endprocedure
+    );
+    unless dict.is_empty_dict do pr( ' ' ) endunless;
+    pr( '}' );
+enddefine;
+
+prdict -> class_print( dict_key );
+
+;;;
+;;; This is a helper function for building dict objects. It takes a list
+;;; of unsorted pairs (key, position) and a vector of values and
+;;; _takes ownership of these_ i.e. no other references to these parameters
+;;; are usable after this function has run. This allows the values vector to
+;;; be sorted and the list of pairs to be returned to the heap.
+;;;
+;;; newdict_internal<T>: [ pair< word, int > ] * { T } -> dict< T >
+;;;
+define lconstant newdict_internal( key_index_list, values_vector );
+    nc_listsort(
+        key_index_list,
+        procedure( x, y ); alphabefore( x.front, y.front ) endprocedure
+    ) -> key_index_list;
+    lvars sorted_keys_vector = {% applist( key_index_list, front ) %};
+    lvars sorted_values_vector = fill(
+        lblock
+            lvars p;
+            for p in key_index_list do
+                subscrv( p.back, values_vector )
+            endfor
+        endlblock,
+        values_vector      ;;; !! reusing this vector !!
+    );
+    ;;; Now we can free up the working store.
+    while key_index_list.ispair do
+        ( key_index_list.sys_grbg_destpair -> key_index_list ).sys_grbg_destpair -> _ -> _;
+    endwhile;
+    ;;; And deliver the result.
+    consdict( sorted_keys_vector, sorted_values_vector )
+enddefine;
+
+;;; This is a non-exported helper function for writing syntax words.
+define compile_newdict_to( closing_keyword ) -> actual_closer;
+    dlocal pop_new_lvar_list;
+    lvars keys = [];
+    lvars n = 0;
+    lvars tmpvars = {%
+        until pop11_try_nextreaditem( closing_keyword ) ->> actual_closer do
+            while pop11_try_nextreaditem( "," ) do endwhile;
+            n + 1 -> n;
+            lvars k = readitem();                    ;;; TODO: must be a word
+            unless k.isword do
+                mishap( 'Expected word as dict key', [^k] )
+            endunless;
+            conspair( k, n ) :: keys -> keys;
+            pop11_need_nextreaditem( "=" ) -> _;
+            dlvars tmpvar = sysNEW_LVAR();
+            pop11_comp_N( procedure(); pop11_comp_expr(); sysPOP(tmpvar) endprocedure, 0 );
+            tmpvar
+        enduntil;
+    %};
+    nc_listsort(
+        keys,
+        procedure( x, y ); alphabefore( x.front, y.front ) endprocedure
+    ) -> keys;
+    sysPUSHQ( {% applist( keys, front ) %} );
+    lvars p;
+    for p in keys do
+        sysPUSH( subscrv( p.back, tmpvars ) )
+    endfor;
+    sysPUSHQ( tmpvars.datalength );
+    sysCALL( "consvector" );
+    sysCALLQ( consdict );
+enddefine;
+
+#_ENDIF
+
+endsection;
diff --git a/base/pop/getpoploglib/lib/named_arguments.p b/base/pop/getpoploglib/lib/named_arguments.p
new file mode 100644
index 00000000..5db0c050
--- /dev/null
+++ b/base/pop/getpoploglib/lib/named_arguments.p
@@ -0,0 +1,125 @@
+compile_mode :pop11 +strict;
+
+section;
+
+;;; WARNING!
+procedure();
+    dlocal cucharout = cucharerr;
+    pr( ';;; EXPERIMENTAL LIBRARY WARNING - named_arguments' )
+endprocedure();
+
+uses frozval_names;
+
+define recalculate_offsets( fn, data );
+    lvars ( detect_dirty, names, refs ) = data.explode;
+    until names.null do
+        lvars name = names.dest -> names;
+        lvars ref = refs.dest -> refs;
+        lvars index = frozval_slot( name, fn );
+        index -> cont( ref );
+    enduntil;
+    fn -> cont( detect_dirty );
+enddefine;
+
+define plant_replace_stack_values( fn_name, names, tmpvars, refs );
+
+    define lconstant update_stacked_values( fn_name, tmpvars, refs );
+        unless tmpvars.null do
+            lvars tmpvar = tmpvars.dest -> tmpvars;
+            lvars ref = refs.dest -> refs;
+            sysPUSH( tmpvar );
+            sysPUSHQ( ref );
+            sysCALL( "fast_cont" );
+            sysUCALL( "subscr_stack" );
+            update_stacked_values( fn_name, tmpvars, refs );
+        endunless
+    enddefine;
+
+    lvars detect_dirty = consref( false );
+    sysPUSHQ( detect_dirty );
+    sysCALL( "fast_cont" );
+    sysPUSH( fn_name );
+    sysCALL( "==" );
+    lvars label_update_stacked_values = sysNEW_LABEL();
+    sysIFSO( label_update_stacked_values );
+
+    sysPUSH( fn_name );
+    sysPUSHQ( {% detect_dirty, names, refs %} );
+    sysCALLQ( recalculate_offsets );
+
+    sysLABEL( label_update_stacked_values );
+    update_stacked_values( fn_name, tmpvars, refs );
+enddefine;
+
+define compile_with_define( bound_names, bound_tmpvars );
+    dlocal pop_new_lvar_list;
+    lvars fn_name = proglist.dest -> proglist;
+    [
+        define ^fn_name
+    %
+        pop11_need_nextitem( "(" );
+        until proglist.null or proglist.hd == ")" do
+            proglist.dest -> proglist;
+        enduntil;
+        lvars nm;
+        for nm in bound_names do
+            ",", nm
+        endfor;
+    % 
+        ^^proglist
+    ] -> proglist;
+    pop11_comp_expr();
+    sysPUSH( fn_name );
+    sysPUSH( "popstackmark" );
+    applist( bound_tmpvars, sysPUSH );
+    sysCALL( "sysconslist" );
+    sysCALL( "partapply" );
+    sysPOP( fn_name );
+    sysPUSHQ( bound_names );
+    sysCALL( "destlist" );
+    sysPUSH( fn_name );
+    sysUCALL( "frozval_names" );
+enddefine;
+
+define syntax with;
+    dlocal pop_new_lvar_list;
+    lvars bound_names = [];
+    lvars bound_tmpvars = [];
+    lvars bound_refs = [];
+    lvars token;
+    until pop11_try_nextreaditem( [do define] ) ->> token do
+        lvars name = readitem();    ;;; macro expansion not allowed.
+        unless name.isword do
+            mishap( 'Word expected', [^name] )
+        endunless;
+        pop11_need_nextitem( "=" ) -> _;
+        pop11_comp_expr();
+        lvars tmpvar = sysNEW_LVAR();
+        sysPOP( tmpvar );
+        pop11_try_nextreaditem( "," ) -> _;
+        tmpvar :: bound_tmpvars -> bound_tmpvars;
+        name :: bound_names -> bound_names;
+        consref( false ) :: bound_refs -> bound_refs;
+    enduntil;
+    if token == "do" then
+        lvars next = pop11_comp_prec_expr( 0, false );
+        lvars fn_name = sysNEW_LVAR();
+        sysPOP( fn_name );
+        if next /== "(" then
+            mishap( 'Missing (', [^next] )
+        endif;
+        pop11_comp_prec_expr( 241, false ) -> _;
+        sysPUSH( fn_name );
+        sysCALL( "explode" );
+        plant_replace_stack_values( fn_name, bound_names, bound_tmpvars, bound_refs );
+        sysPUSH( fn_name );
+        sysCALL( "pdpart" );
+        sysCALL( "fast_apply" );
+    elseif token == "define" then
+        compile_with_define( bound_names, bound_tmpvars )
+    else
+        mishap( 'Unexpected end of expression', [^token] )
+    endif
+enddefine;
+
+endsection;

From b06caccbdf825cdac69bbdee3dfdd0eae0fff751 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 5 Sep 2021 19:44:37 +0100
Subject: [PATCH 36/44] Adding some autoloadable functions

---
 base/pop/getpoploglib/auto/is_null_dict.p | 9 +++++++++
 base/pop/getpoploglib/auto/nulldict.p     | 7 +++++++
 base/pop/getpoploglib/lib/dict.p          | 8 +-------
 3 files changed, 17 insertions(+), 7 deletions(-)
 create mode 100644 base/pop/getpoploglib/auto/is_null_dict.p
 create mode 100644 base/pop/getpoploglib/auto/nulldict.p

diff --git a/base/pop/getpoploglib/auto/is_null_dict.p b/base/pop/getpoploglib/auto/is_null_dict.p
new file mode 100644
index 00000000..785701b3
--- /dev/null
+++ b/base/pop/getpoploglib/auto/is_null_dict.p
@@ -0,0 +1,9 @@
+compile :pop11 +strict;
+
+section $-dict => is_null_dict;
+
+define global constant procedure is_null_dict( dict );
+    dict.dict_values.datalength == 0
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/nulldict.p b/base/pop/getpoploglib/auto/nulldict.p
new file mode 100644
index 00000000..a7af46fc
--- /dev/null
+++ b/base/pop/getpoploglib/auto/nulldict.p
@@ -0,0 +1,7 @@
+compile_mode :pop11 +strict;
+
+section $-dict => nulldict;
+
+global constant nulldict = consdict( {}.dup );
+
+endsection;
diff --git a/base/pop/getpoploglib/lib/dict.p b/base/pop/getpoploglib/lib/dict.p
index b5bc2ab4..6985a0d3 100644
--- a/base/pop/getpoploglib/lib/dict.p
+++ b/base/pop/getpoploglib/lib/dict.p
@@ -1,7 +1,7 @@
 compile_mode :pop11 +strict;
  
 section $-dict =>
-    dict_key isdict empty_dict dict_length is_empty_dict 
+    dict_key isdict dict_length 
     subscrdict appdict;
 
 #_IF not( isdefined( "dict_key" ) )
@@ -53,16 +53,10 @@ constant procedure dict_keys = class_access( 1, dict_key );
 constant procedure dict_values = class_access( 2, dict_key );
 "dict_values" -> dict_values.pdprops;
 
-global constant empty_dict = consdict( {}.dup );
-
 define global constant procedure dict_length( dict );
     dict.dict_values.datalength
 enddefine;
 
-define global constant procedure is_empty_dict( dict );
-    dict.dict_values.datalength == 0
-enddefine;
-
 define lconstant find( w, dict );
     lvars lo = 1;
     lvars hi = dict.dict_values.datalength;

From 4dd476abdb106700c16d8250944e2abb102ab40d Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 5 Sep 2021 19:45:13 +0100
Subject: [PATCH 37/44] Work in progress

---
 base/pop/getpoploglib/help/dict | 51 +++++++++++++++++++++++++++++++--
 1 file changed, 48 insertions(+), 3 deletions(-)

diff --git a/base/pop/getpoploglib/help/dict b/base/pop/getpoploglib/help/dict
index ce2b98f5..43740020 100644
--- a/base/pop/getpoploglib/help/dict
+++ b/base/pop/getpoploglib/help/dict
@@ -1,4 +1,4 @@
-HELP DICT                                         Stephen Leach Aug 2021
+HELP DICT                                         Stephen Leach Sep 2021
 
 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 <<<<<<<<<<<<<<<<<<<<<                             >>>>>>>>>>>>>>>>>>>>>>
@@ -6,6 +6,51 @@ HELP DICT                                         Stephen Leach Aug 2021
 <<<<<<<<<<<<<<<<<<<<<                             >>>>>>>>>>>>>>>>>>>>>>
 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
-newdict
+--------------
+1  Recognisers
+--------------
+
+is_null_dict(dict) -> bool
+
+isdict(item) -> bool
+
+---------------
+2  Constructors
+---------------
+
+
+newdict_from_assoclist(assoc_list) -> dict
+
+newdict_from_twinlists(keys_list, values_list) -> dict
+
+
+ 
+------------
+3  Accessors
+------------
+
+dict_destkeys( dict ) -> ( key1, key2, ..., keyN, N )
+
+dist_destvalues( dict ) -> ( value1, value2, ..., valueN, N )
+
+subscrdict( key, dict ) -> item 
+dict -> subscrdict( key, dict )
+
+----------------
+4  Miscellaneous
+----------------
+
+appdict(dict, procedure )         
+        Applies the  procedure  p  to  each  entry  in  the  dict.  The
+        procedure p is applied as:
+ 
+            p(key, value)
+ 
+        for each key/value association in dict.
+
+dict_length(dict) -> N
+
+nulldict -> dict
+
+dict_key -> key
 
-+

From 98d372d28239a0f6c0345488f9a3931f03d7cd7c Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 5 Sep 2021 19:51:32 +0100
Subject: [PATCH 38/44] Help file for dict

---
 base/pop/getpoploglib/help/dict | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/base/pop/getpoploglib/help/dict b/base/pop/getpoploglib/help/dict
index 43740020..e30fd9a2 100644
--- a/base/pop/getpoploglib/help/dict
+++ b/base/pop/getpoploglib/help/dict
@@ -12,15 +12,17 @@ HELP DICT                                         Stephen Leach Sep 2021
 
 is_null_dict(dict) -> bool
 
+
 isdict(item) -> bool
+        Returns true if item is a dict, false otherwise.
 
 ---------------
 2  Constructors
 ---------------
 
-
 newdict_from_assoclist(assoc_list) -> dict
 
+
 newdict_from_twinlists(keys_list, values_list) -> dict
 
 
@@ -31,11 +33,14 @@ newdict_from_twinlists(keys_list, values_list) -> dict
 
 dict_destkeys( dict ) -> ( key1, key2, ..., keyN, N )
 
+
 dist_destvalues( dict ) -> ( value1, value2, ..., valueN, N )
 
+
 subscrdict( key, dict ) -> item 
 dict -> subscrdict( key, dict )
 
+
 ----------------
 4  Miscellaneous
 ----------------
@@ -48,9 +53,16 @@ appdict(dict, procedure )
  
         for each key/value association in dict.
 
+
 dict_length(dict) -> N
+        Returns the number N of key/values pairs in dict.
+
 
 nulldict -> dict
+        An instance of an empty dict object
+
 
 dict_key -> key
+        Constant holding key structure for dict
 
+--- Copyright (c) GetPoplog Sep 2021 -------------------------------------------
\ No newline at end of file

From 8eda01aac1d6746ade3ce3423888364fc8b1099b Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 5 Sep 2021 20:06:55 +0100
Subject: [PATCH 39/44] First draft of documentation of dict

---
 base/pop/getpoploglib/help/dict | 39 ++++++++++++++++++++++++++++-----
 1 file changed, 34 insertions(+), 5 deletions(-)

diff --git a/base/pop/getpoploglib/help/dict b/base/pop/getpoploglib/help/dict
index e30fd9a2..05d88cac 100644
--- a/base/pop/getpoploglib/help/dict
+++ b/base/pop/getpoploglib/help/dict
@@ -11,34 +11,58 @@ HELP DICT                                         Stephen Leach Sep 2021
 --------------
 
 is_null_dict(dict) -> bool
+        Returns true if dict is empty, false otherwise.
 
 
 isdict(item) -> bool
         Returns true if item is a dict, false otherwise.
 
+
 ---------------
 2  Constructors
 ---------------
 
 newdict_from_assoclist(assoc_list) -> dict
+        This constructs a dict from an assoc-list i.e. a list of key/values
+        which are themselves a list of length 2 (or more). e.g.
+
+                newdict_from_assoclist([[a 1] [b 2]])
+
+        will return a dict that maps the word "a" to 1 and "b" to 2.
 
 
 newdict_from_twinlists(keys_list, values_list) -> dict
+        This constructs a dict from two lists, being a list of keys and 
+        a parallel list of values. The lists are not required to be of equal 
+        length, the first N items are taken when N is the lesser of the 
+        two lengths. e.g.
+
+                newdict_from_twinlists([a b], [1 2])
+
+        will return a dict that maps the word "a" to 1 and "b" to 2.
 
 
- 
 ------------
 3  Accessors
 ------------
 
 dict_destkeys( dict ) -> ( key1, key2, ..., keyN, N )
+        This returns all the keys of a dict on the stack and a count of
+        the keys. The keys will be sorted in lexicographical order.
 
 
 dist_destvalues( dict ) -> ( value1, value2, ..., valueN, N )
+        This returns all the values of a dict on the stack and a count of
+        the values returned. The values are returned in the same order as
+        the keys.
 
 
-subscrdict( key, dict ) -> item 
-dict -> subscrdict( key, dict )
+dict( key ) -> value
+value -> dict(key)
+subscrdict(key, dict) -> value 
+value -> subscrdict(key, dict)
+        This returns or updates the value associated with the key in the
+        dict. subscrdict is the class_apply of the dict_key.
 
 
 ----------------
@@ -54,6 +78,10 @@ appdict(dict, procedure )
         for each key/value association in dict.
 
 
+dict_key -> key
+        Constant holding key structure for dict
+
+
 dict_length(dict) -> N
         Returns the number N of key/values pairs in dict.
 
@@ -62,7 +90,8 @@ nulldict -> dict
         An instance of an empty dict object
 
 
-dict_key -> key
-        Constant holding key structure for dict
+partapply_dict(procedure, dict) -> closure
+        Returns a closure with named frozval-slots. See HELP * PARTAPPLY_DICT.
+
 
 --- Copyright (c) GetPoplog Sep 2021 -------------------------------------------
\ No newline at end of file

From 784451f9b8e150294381bd6441f2a387d05853a9 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sun, 5 Sep 2021 22:11:10 +0100
Subject: [PATCH 40/44] Documenting dicts and adding support for named closures

---
 base/pop/getpoploglib/auto/$.p                |  2 --
 .../getpoploglib/auto/frozval_closure_slot.p  |  7 +++++
 base/pop/getpoploglib/auto/is_null_dict.p     |  9 ------
 base/pop/getpoploglib/auto/partapply_dict.p   |  2 +-
 .../getpoploglib/auto/partapply_override.p    | 30 +++++++++++++++++++
 base/pop/getpoploglib/help/dict               |  4 +++
 base/pop/getpoploglib/help/partapply_dict     | 30 +++++++++++++++++++
 base/pop/getpoploglib/help/partapply_override | 10 +++++++
 base/pop/getpoploglib/lib/dict.p              | 10 +++++--
 base/pop/getpoploglib/lib/named_arguments.p   |  4 +--
 10 files changed, 91 insertions(+), 17 deletions(-)
 create mode 100644 base/pop/getpoploglib/auto/frozval_closure_slot.p
 delete mode 100644 base/pop/getpoploglib/auto/is_null_dict.p
 create mode 100644 base/pop/getpoploglib/auto/partapply_override.p
 create mode 100644 base/pop/getpoploglib/help/partapply_dict
 create mode 100644 base/pop/getpoploglib/help/partapply_override

diff --git a/base/pop/getpoploglib/auto/$.p b/base/pop/getpoploglib/auto/$.p
index 3b13fea2..78af7477 100644
--- a/base/pop/getpoploglib/auto/$.p
+++ b/base/pop/getpoploglib/auto/$.p
@@ -16,9 +16,7 @@ define lconstant lookup( item );
         if wid then
             wid.valof
         else
-            [try to autoload ^w] =>
             if sys_autoload( w ) then
-                [succeeded] =>
                 word_identifier( w, pop_section, true ).valof
             else
                 false
diff --git a/base/pop/getpoploglib/auto/frozval_closure_slot.p b/base/pop/getpoploglib/auto/frozval_closure_slot.p
new file mode 100644
index 00000000..97a4beba
--- /dev/null
+++ b/base/pop/getpoploglib/auto/frozval_closure_slot.p
@@ -0,0 +1,7 @@
+compile_mode :pop11 +strict;
+
+section;
+
+uses frozval_names
+
+endsection;
diff --git a/base/pop/getpoploglib/auto/is_null_dict.p b/base/pop/getpoploglib/auto/is_null_dict.p
deleted file mode 100644
index 785701b3..00000000
--- a/base/pop/getpoploglib/auto/is_null_dict.p
+++ /dev/null
@@ -1,9 +0,0 @@
-compile :pop11 +strict;
-
-section $-dict => is_null_dict;
-
-define global constant procedure is_null_dict( dict );
-    dict.dict_values.datalength == 0
-enddefine;
-
-endsection;
diff --git a/base/pop/getpoploglib/auto/partapply_dict.p b/base/pop/getpoploglib/auto/partapply_dict.p
index 90345a59..b162a370 100644
--- a/base/pop/getpoploglib/auto/partapply_dict.p
+++ b/base/pop/getpoploglib/auto/partapply_dict.p
@@ -5,7 +5,7 @@ section;
 uses dict
 
 define global constant procedure partapply_dict( procedure p, dict ) -> c;
-    consclosure( dict.destdict_values, p ) -> c;
+    consclosure( p, dict.destdict_values ) -> c;
     dict.destdict_keys -> c.frozval_names;
 enddefine;
 
diff --git a/base/pop/getpoploglib/auto/partapply_override.p b/base/pop/getpoploglib/auto/partapply_override.p
new file mode 100644
index 00000000..f04a017b
--- /dev/null
+++ b/base/pop/getpoploglib/auto/partapply_override.p
@@ -0,0 +1,30 @@
+compile_mode :pop11 +strict;
+
+uses frozval_names
+uses dict
+
+section $-frozval_names => partapply_override;
+
+define partapply_override( procedure pdr, new_frozvals ) -> c;
+    dlvars c;
+    consclosure( pdr.pdpart, #| pdr.explode |#) -> c;
+    frozval_slot_table( pdr ) -> frozval_slot_table( c );
+    if new_frozvals.islist then
+        lvars i, n = 0;
+        for i in new_frozvals do
+            n fi_+ 1 -> n;
+            i -> frozval( n, c )
+        endfor;
+    elseif new_frozvals.isdict then
+        appdict( 
+            new_frozvals, 
+            procedure( k, v );
+                v -> frozval( frozval_closure_slot( k, c ), c )
+            endprocedure
+        ), 
+    else
+        mishap( 'Unexpected replacement frozen values', [^new_frozvals] )
+    endif
+enddefine;
+
+endsection;
diff --git a/base/pop/getpoploglib/help/dict b/base/pop/getpoploglib/help/dict
index 05d88cac..f3674552 100644
--- a/base/pop/getpoploglib/help/dict
+++ b/base/pop/getpoploglib/help/dict
@@ -93,5 +93,9 @@ nulldict -> dict
 partapply_dict(procedure, dict) -> closure
         Returns a closure with named frozval-slots. See HELP * PARTAPPLY_DICT.
 
+partapply_override(closure, list|dict) -> closure
+        Copies a closure and updates the frozvals from the list or dict.
+        See HELP * PARTAPPLY_OVERRIDE.
+
 
 --- Copyright (c) GetPoplog Sep 2021 -------------------------------------------
\ No newline at end of file
diff --git a/base/pop/getpoploglib/help/partapply_dict b/base/pop/getpoploglib/help/partapply_dict
new file mode 100644
index 00000000..566b6f04
--- /dev/null
+++ b/base/pop/getpoploglib/help/partapply_dict
@@ -0,0 +1,30 @@
+HELP PARTAPPLY_DICT                              Stephen Leach, Sep 2021
+
+    partapply_dict( <procedure>, <dict> ) -> closure
+
+This procedure produces a closure of an existing procedure (which may
+itself be a closure). It takes two arguments - a procedure and a dict;
+its result is a new procedure based upon the given procedure, but
+requiring fewer arguments, the rightmost of the arguments of the new
+procedure being supplied by the ordered values of the dict at the time
+PARTAPPLY_DICT is called. e.g.
+
+    vars Q =
+        partapply_dict(
+            procedure( x, a, b, c ) with_props quadratic;
+                ( a * x  + b ) * x + c
+            endprocedure,
+            ${ a = 1, b = 2, c = 1 }
+        );
+
+    Q( 4 ) =>
+    ** 25
+
+The closure will have N named frozen values, where N is the size of the dict.
+Named frozen values can be overridden (see HELP * PARTAPPLY_OVERRIDE)
+
+    vars R = partapply_override( Q, ${ b = 0, c = -4 } );
+    R( 4 ) =>
+    ** 12
+
+--- Copyright (c) GetPoplog Sep 2021 -------------------------------------------
\ No newline at end of file
diff --git a/base/pop/getpoploglib/help/partapply_override b/base/pop/getpoploglib/help/partapply_override
new file mode 100644
index 00000000..4f64f73f
--- /dev/null
+++ b/base/pop/getpoploglib/help/partapply_override
@@ -0,0 +1,10 @@
+HELP PARTAPPLY_OVERRIDE                          Stephen Leach, Sep 2021
+
+    partapply_override( <closure>, <args> ) -> closure
+
+This procedure takes a closure and creates a copy with updated frozvals. 
+The <args> may be a list or a dict. If args are a list of length N then
+the frozvals from 1 to N are replaced by the elements of args.
+
+If the args are a dict then the closure must have named frozvals and the
+dict is used to update the corresponding frozvals.
diff --git a/base/pop/getpoploglib/lib/dict.p b/base/pop/getpoploglib/lib/dict.p
index 6985a0d3..c7e42600 100644
--- a/base/pop/getpoploglib/lib/dict.p
+++ b/base/pop/getpoploglib/lib/dict.p
@@ -2,7 +2,7 @@ compile_mode :pop11 +strict;
  
 section $-dict =>
     dict_key isdict dict_length 
-    subscrdict appdict;
+    subscrdict appdict is_null_dict;
 
 #_IF not( isdefined( "dict_key" ) )
 
@@ -102,9 +102,13 @@ define global constant procedure appdict( dict, procedure p );
     endfor;
 enddefine;
 
+define global constant procedure is_null_dict( dict );
+    dict.dict_values.datalength == 0
+enddefine;
+
 define prdict( dict );
     pr( '${' );
-    unless dict.is_empty_dict do pr( ' ' ) endunless;
+    unless dict.is_null_dict do pr( ' ' ) endunless;
     dlvars first = true;
     appdict(
         dict,
@@ -118,7 +122,7 @@ define prdict( dict );
             false -> first;
         endprocedure
     );
-    unless dict.is_empty_dict do pr( ' ' ) endunless;
+    unless dict.is_null_dict do pr( ' ' ) endunless;
     pr( '}' );
 enddefine;
 
diff --git a/base/pop/getpoploglib/lib/named_arguments.p b/base/pop/getpoploglib/lib/named_arguments.p
index 5db0c050..079838b0 100644
--- a/base/pop/getpoploglib/lib/named_arguments.p
+++ b/base/pop/getpoploglib/lib/named_arguments.p
@@ -5,7 +5,7 @@ section;
 ;;; WARNING!
 procedure();
     dlocal cucharout = cucharerr;
-    pr( ';;; EXPERIMENTAL LIBRARY WARNING - named_arguments' )
+    npr( ';;; EXPERIMENTAL LIBRARY WARNING - named_arguments' )
 endprocedure();
 
 uses frozval_names;
@@ -15,7 +15,7 @@ define recalculate_offsets( fn, data );
     until names.null do
         lvars name = names.dest -> names;
         lvars ref = refs.dest -> refs;
-        lvars index = frozval_slot( name, fn );
+        lvars index = frozval_stack_slot( name, fn );
         index -> cont( ref );
     enduntil;
     fn -> cont( detect_dirty );

From bda516f496fc8909c6516666be4ad4dd426e2724 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 7 Sep 2021 22:52:55 +0100
Subject: [PATCH 41/44] Added concatenation of dictionaries

---
 base/pop/getpoploglib/auto/dict_concat.p | 58 ++++++++++++++++++++++++
 base/pop/getpoploglib/lib/dict.p         | 29 +++++++++---
 2 files changed, 80 insertions(+), 7 deletions(-)
 create mode 100644 base/pop/getpoploglib/auto/dict_concat.p

diff --git a/base/pop/getpoploglib/auto/dict_concat.p b/base/pop/getpoploglib/auto/dict_concat.p
new file mode 100644
index 00000000..3de1e3ec
--- /dev/null
+++ b/base/pop/getpoploglib/auto/dict_concat.p
@@ -0,0 +1,58 @@
+compile_mode :pop11 +strict;
+
+uses dict
+
+section $-dict => dict_concat;
+
+define global constant procedure dict_concat( d1, d2 );
+    lvars ( d1keys, d1values, d1length ) = d1.destdict.dup.datalength;
+    lvars ( d2keys, d2values, d2length ) = d2.destdict.dup.datalength;
+    lvars plist, d1i = 1, d2i = 1;
+    [%
+        repeat
+            if d1i > d1length then
+                ;;; Accept all of the remaining d2 items.
+                lvars i;
+                for i from d2i to d2length do
+                    conspair( 
+                        subscrv( i, d2keys ),
+                        subscrv( i, d2values )
+                    )
+                endfor;
+                quitloop
+            elseif d2i > d2length then
+                ;;; Accept all of the remaining d1 items. 
+                lvars i;
+                for i from d2i to d1length do
+                    conspair(
+                        subscrv( i, d1keys ),
+                        subscrv( i, d1values )
+                    )
+                endfor;
+                quitloop
+            endif;
+            lvars d1item = subscrv( d1i, d1keys );
+            lvars d2item = subscrv( d2i, d2keys );
+            lvars cmp = alphabefore( d1item, d2item );
+            if cmp == true then
+                conspair( d1item, subscrv( d1i, d1values ) );
+                d1i fi_+ 1 -> d1i;
+            elseif cmp == 1 then
+                conspair( d2item, subscrv( d2i, d2values ) );
+                d1i fi_+ 1 -> d1i;
+                d2i fi_+ 1 -> d2i;
+            else
+                conspair( d2item, subscrv( d2i, d2values ) );
+                d2i fi_+ 1 -> d2i;
+            endif
+        endrepeat
+    %] -> plist;
+    lvars keys = {% applist( plist, front ) %};
+    lvars values = {% applist( plist, back ) %};
+    while plist.ispair do
+        sys_grbg_destpair( sys_grbg_destpair( plist ) -> plist ) -> (_, _); 
+    endwhile;
+    consdict( keys.dict_table, values );
+enddefine;
+
+endsection;
\ No newline at end of file
diff --git a/base/pop/getpoploglib/lib/dict.p b/base/pop/getpoploglib/lib/dict.p
index c7e42600..423c736b 100644
--- a/base/pop/getpoploglib/lib/dict.p
+++ b/base/pop/getpoploglib/lib/dict.p
@@ -2,7 +2,7 @@ compile_mode :pop11 +strict;
  
 section $-dict =>
     dict_key isdict dict_length 
-    subscrdict appdict is_null_dict;
+    subscr_dict appdict is_null_dict;
 
 #_IF not( isdefined( "dict_key" ) )
 
@@ -29,7 +29,7 @@ enddefine;
 constant procedure dict_table =
     newanyproperty(
         [], 8, 1, 8,
-        nonop =, syshash, "tmpval",
+        syshash, nonop =, "tmpval",
         false,
         procedure( key, prop );
             ;;; Have we grown too big?
@@ -43,7 +43,8 @@ constant procedure dict_table =
 global constant dict_key = conskey( "dict", [ full full ] );
 global constant procedure isdict = dict_key.class_recognise;
 
-lconstant procedure consdict = dict_key.class_cons;
+constant procedure destdict = dict_key.class_dest;
+constant procedure consdict = dict_key.class_cons;
 
 ;;; Not exported but retained for autoloading.
 constant procedure dict_keys = class_access( 1, dict_key );
@@ -82,15 +83,15 @@ define lconstant find( w, dict );
     endrepeat
 enddefine;
 
-define global constant procedure subscrdict( w, dict );
+define global constant procedure subscr_dict( w, dict );
     subscrv( find( w, dict ), dict.dict_values )
 enddefine;
 
-define updaterof subscrdict( item, w, dict );
+define updaterof subscr_dict( item, w, dict );
     item -> subscrv( find( w, dict ), dict.dict_values )
 enddefine;
 
-subscrdict -> class_apply( dict_key );
+subscr_dict -> class_apply( dict_key );
 
 define global constant procedure appdict( dict, procedure p );
     lvars i, n = dict.dict_length;
@@ -128,6 +129,18 @@ enddefine;
 
 prdict -> class_print( dict_key );
 
+
+define lconstant procedure check_duplicates( key_index_list );
+    lvars tail;
+    for tail on key_index_list do
+        if fast_back( tail ).ispair then
+            if fast_front( fast_front( tail ) ) == fast_front( fast_front( fast_back( tail ) ) ) then
+                mishap( 'Trying to construct dict with non-unique key', [% front(front(tail)) %] )
+            endif
+        endif
+    endfor;
+enddefine;
+
 ;;;
 ;;; This is a helper function for building dict objects. It takes a list
 ;;; of unsorted pairs (key, position) and a vector of values and
@@ -142,6 +155,7 @@ define lconstant newdict_internal( key_index_list, values_vector );
         key_index_list,
         procedure( x, y ); alphabefore( x.front, y.front ) endprocedure
     ) -> key_index_list;
+    check_duplicates( key_index_list );
     lvars sorted_keys_vector = {% applist( key_index_list, front ) %};
     lvars sorted_values_vector = fill(
         lblock
@@ -157,7 +171,7 @@ define lconstant newdict_internal( key_index_list, values_vector );
         ( key_index_list.sys_grbg_destpair -> key_index_list ).sys_grbg_destpair -> _ -> _;
     endwhile;
     ;;; And deliver the result.
-    consdict( sorted_keys_vector, sorted_values_vector )
+    consdict( sorted_keys_vector.dict_table, sorted_values_vector )
 enddefine;
 
 ;;; This is a non-exported helper function for writing syntax words.
@@ -184,6 +198,7 @@ define compile_newdict_to( closing_keyword ) -> actual_closer;
         keys,
         procedure( x, y ); alphabefore( x.front, y.front ) endprocedure
     ) -> keys;
+    check_duplicates( keys );
     sysPUSHQ( {% applist( keys, front ) %} );
     lvars p;
     for p in keys do

From be56cb83fe9b944fe4179c0644ee8d5d451bf025 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Tue, 7 Sep 2021 23:09:50 +0100
Subject: [PATCH 42/44] Minor fix-ups for previous renaming

---
 base/pop/getpoploglib/auto/frozval_slot.p       | 1 -
 base/pop/getpoploglib/auto/frozval_stack_slot.p | 1 +
 2 files changed, 1 insertion(+), 1 deletion(-)
 delete mode 100644 base/pop/getpoploglib/auto/frozval_slot.p
 create mode 100644 base/pop/getpoploglib/auto/frozval_stack_slot.p

diff --git a/base/pop/getpoploglib/auto/frozval_slot.p b/base/pop/getpoploglib/auto/frozval_slot.p
deleted file mode 100644
index 2df739a8..00000000
--- a/base/pop/getpoploglib/auto/frozval_slot.p
+++ /dev/null
@@ -1 +0,0 @@
-uses-by_name frozval_names (frozval_slot);
diff --git a/base/pop/getpoploglib/auto/frozval_stack_slot.p b/base/pop/getpoploglib/auto/frozval_stack_slot.p
new file mode 100644
index 00000000..b75c032c
--- /dev/null
+++ b/base/pop/getpoploglib/auto/frozval_stack_slot.p
@@ -0,0 +1 @@
+uses-by_name frozval_names (frozval_stack_slot);

From 4fe2e4bc005016509ebe5ba31c16d9c533c84d57 Mon Sep 17 00:00:00 2001
From: Stephen Leach <sfkleach@gmail.com>
Date: Sat, 10 Aug 2024 21:53:57 +0100
Subject: [PATCH 43/44] Bug fix for autoloadable dict functions

---
 .../pop/getpoploglib/auto/newdict_from_assoclist.p |  2 +-
 .../pop/getpoploglib/auto/newdict_from_twinlists.p |  2 +-
 base/pop/getpoploglib/lib/dict.p                   | 14 +++++++-------
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/base/pop/getpoploglib/auto/newdict_from_assoclist.p b/base/pop/getpoploglib/auto/newdict_from_assoclist.p
index feb440a3..232433ee 100644
--- a/base/pop/getpoploglib/auto/newdict_from_assoclist.p
+++ b/base/pop/getpoploglib/auto/newdict_from_assoclist.p
@@ -1,6 +1,6 @@
 compile_mode :pop11 +strict;
 
-section;
+section $-dict => newdict_from_assoclist;
 
 uses dict
 
diff --git a/base/pop/getpoploglib/auto/newdict_from_twinlists.p b/base/pop/getpoploglib/auto/newdict_from_twinlists.p
index 489a7222..1fac043c 100644
--- a/base/pop/getpoploglib/auto/newdict_from_twinlists.p
+++ b/base/pop/getpoploglib/auto/newdict_from_twinlists.p
@@ -1,6 +1,6 @@
 compile_mode :pop11 +strict;
 
-section;
+section $-dict => newdict_from_twinlists;
 
 uses dict
 
diff --git a/base/pop/getpoploglib/lib/dict.p b/base/pop/getpoploglib/lib/dict.p
index 423c736b..4aff9ae3 100644
--- a/base/pop/getpoploglib/lib/dict.p
+++ b/base/pop/getpoploglib/lib/dict.p
@@ -1,7 +1,7 @@
 compile_mode :pop11 +strict;
- 
+
 section $-dict =>
-    dict_key isdict dict_length 
+    dict_key isdict dict_length
     subscr_dict appdict is_null_dict;
 
 #_IF not( isdefined( "dict_key" ) )
@@ -10,13 +10,13 @@ constant ejection_threshold = 1024;
 
 define constant procedure clear_half( prop );
     lvars clear_these = (
-        [% 
-            fast_appproperty( 
-                prop, 
+        [%
+            fast_appproperty(
+                prop,
                 procedure( k, v );
                     if random(1.0) < 0.5 then k endif
                 endprocedure
-            ) 
+            )
         %]
     );
     lvars k;
@@ -150,7 +150,7 @@ enddefine;
 ;;;
 ;;; newdict_internal<T>: [ pair< word, int > ] * { T } -> dict< T >
 ;;;
-define lconstant newdict_internal( key_index_list, values_vector );
+define constant newdict_internal( key_index_list, values_vector );
     nc_listsort(
         key_index_list,
         procedure( x, y ); alphabefore( x.front, y.front ) endprocedure

From 15a262ba5b81410982868ff0f3c3dfd7ca7dba90 Mon Sep 17 00:00:00 2001
From: CircleCI <circleci@example.com>
Date: Sat, 10 Aug 2024 20:56:24 +0000
Subject: [PATCH 44/44] [skip ci] Update corepop results

---
 corepops/README.md | 30 +++++++++++++++---------------
 1 file changed, 15 insertions(+), 15 deletions(-)

diff --git a/corepops/README.md b/corepops/README.md
index 9154a6e6..f8c70f28 100644
--- a/corepops/README.md
+++ b/corepops/README.md
@@ -54,21 +54,21 @@ For example, `010-05_11_12-2021_07_07.corepop` has:
 | linux/x86_64/020-05_08_00-2021_06_24.corepop | fedora | 32 | :x: | 127 | <details><summary>details</summary><pre>/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: error while loading shared libraries: libncurses.so.5: cannot open shared object file: No such file or directory<br></pre></details> |
 | linux/x86_64/020-05_08_00-2021_06_24.corepop | centos | 8 | :x: | 127 | <details><summary>details</summary><pre>/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: error while loading shared libraries: libncurses.so.5: cannot open shared object file: No such file or directory<br></pre></details> |
 | linux/x86_64/020-05_08_00-2021_06_24.corepop | centos | 7 | :x: | 1 | <details><summary>details</summary><pre>/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: /lib64/libtinfo.so.5: no version information available (required by /corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop)<br>/corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop: /lib64/libm.so.6: version `GLIBC_2.29' not found (required by /corepops/linux/x86_64/020-05_08_00-2021_06_24.corepop)<br></pre></details> |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 21.04 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 20.04 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 18.04 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 16.04 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | archlinux | latest | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | unstable-slim | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | testing-slim | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | stable-slim | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldstable-slim | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldoldstable | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 34 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 33 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 32 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 8 | :heavy_check_mark: | 0 |  |
-| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 7 | :heavy_check_mark: | 0 |  |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 21.04 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 20.04 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 18.04 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | ubuntu | 16.04 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | archlinux | latest | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | unstable-slim | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | testing-slim | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | stable-slim | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldstable-slim | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | debian | oldoldstable | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 34 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 33 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | fedora | 32 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 8 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
+| linux/x86_64/030-05_04_00-2020_08_22.corepop | centos | 7 | :x: | 1 | <details><summary>details</summary><pre><br><<<<<<< Access Violation: PC = 00000000007AB250, Addr = 00000000007AB250,<br>	Code = 2 >>>>>>><br><br><br>;;; MISHAP - serr: MEMORY ACCESS VIOLATION (attempt to alter non-writeable<br>;;; 	system structure?)<br>;;; PRINT DOING<br>;;; DOING    :  null nextitem <br></pre></details> |
 | linux/x86_64/040-05_08_00-2021_07_30.corepop | ubuntu | 21.04 | :x: | 127 | <details><summary>details</summary><pre>/corepops/linux/x86_64/040-05_08_00-2021_07_30.corepop: error while loading shared libraries: libXt.so.6: cannot open shared object file: No such file or directory<br></pre></details> |
 | linux/x86_64/040-05_08_00-2021_07_30.corepop | ubuntu | 20.04 | :x: | 127 | <details><summary>details</summary><pre>/corepops/linux/x86_64/040-05_08_00-2021_07_30.corepop: error while loading shared libraries: libXt.so.6: cannot open shared object file: No such file or directory<br></pre></details> |
 | linux/x86_64/040-05_08_00-2021_07_30.corepop | ubuntu | 18.04 | :x: | 127 | <details><summary>details</summary><pre>/corepops/linux/x86_64/040-05_08_00-2021_07_30.corepop: error while loading shared libraries: libXt.so.6: cannot open shared object file: No such file or directory<br></pre></details> |