Merge pull request #12 from nineties/minor_fixes

Minor fixes

.github/workflows/benchmark.yaml

@@ -11,7 +11,7 @@ jobs:
     - name: take benchmarks
       run: |
         mkdir -p document
-        ./benchmark/gendoc.sh | tee document/Benchmarks.md
+        ./benchmark/gendoc.sh ${{ github.event.issue.number }} | tee document/Benchmarks.md
     - name: upload to wiki
       uses: SwiftDocOrg/github-wiki-publish-action@v1
       with:

Makefile

@@ -14,6 +14,9 @@ python: others/planck.py
 	cp others/planck.py planck
 	chmod +x planck
 
-.PHONY: clean
+.PHONY: clean test
 clean:
 	rm -f planck
+
+test: planck bootstrap.fs runtests.fs
+	./planck < bootstrap.fs runtests.fs

benchmark/gendoc.sh

@@ -1,5 +1,6 @@
 #!/bin/bash
 
+COMMIT="$1"
 TARGETS="i386-linux-handwritten c python"
 TIMEFORMAT='%U'
 CPU_MODEL=`cat /proc/cpuinfo | grep -m1 'model name' | cut -d: -f2 | sed "s/^ *//g"`
@@ -35,6 +36,7 @@ function generate-table {
 
 echo "# Environment"
 echo
+echo "- Commit: $COMMIT"
 echo "- $CPU_MODEL"
 echo "- $MEM_SIZE"
 echo "- $UNAME"

bootstrap.fs

@@ -1907,6 +1907,10 @@ variable inputstreams
 
 stdin_ push-inputstream
 
+: sourcefilename ( -- c-addr )
+    inputstreams @ input>file @ file>name
+;
+
 \ Replacing parser functions using input stream.
 
 variable source-buffer BUFSIZE allot
@@ -2594,7 +2598,7 @@ need-defined (read)
         insn:docol insn:exit insn:lit insn:litstring insn:branch insn:0branch
 
         words id. name>string name>link
-        include included source >in
+        include included source >in sourcefilename
         next-arg shift-args arg argv argc version runtime copyright
 
         [if] [unless] [else] [then] defined? private{ }private export

runtests.fs

@@ -10,12 +10,10 @@ include lib/tester.fs
 
 include test/core.fs
 include test/utilities.fs
-include test/errorreport.fs
 include test/coreexttest.fs
 
 include test/export.fs
 include lib/array.fs
 include lib/bitscan.fs
 
-report-errors
 report-and-exit

test/core.fs

@@ -809,6 +809,9 @@ skip T{ bl gs3 drop -> 0 }T            \ blank line return zero-length string
 \ T{ gs4 123 456
 \ -> }T
 
+testing sourcefilename
+T{ sourcefilename s" test/core.fs" streq -> <true> }T
+
 \ ------------------------------------------------------------------------
 testing <# # #s #> hold sign base >number hex decimal
 

test/coreexttest.fs

@@ -684,7 +684,6 @@ skip T{ : SSQ9  s\" 11 : SSQ10 S\\\" \\x32\\x32\" evaluate ; SSQ10 33" evaluate
 skip T{ SSQ9 -> 11 22 33 }T
 
 \ -----------------------------------------------------------------------------
-core-ext-errors set-error-count
 
 cr .( End of Core Extension word tests) cr
 

test/errorreport.fs

@@ -1,78 +0,0 @@
-\ planckforth -
-\ Copyright (C) 2021 nineties
-
-\ test/tester.fs and test codes are base on
-\ https://github.com/gerryjackson/forth2012-test-suite
-
-decimal
-
-variable total-errors
-
-: error-count  ( "name" n1 -- n2 )  \ n2 = n1 + 1cell
-   create  dup , cell+
-   does>  ( -- offset ) @     \ offset in address units
-;
-
-0     \ Offset into errors[] array
-error-count core-errors          error-count core-ext-errors
-error-count double-errors        error-count exception-errors
-error-count facility-errors      error-count file-errors
-error-count locals-errors        error-count memory-errors
-error-count searchorder-errors   error-count string-errors
-error-count tools-errors         error-count block-errors
-create errors[] dup allot constant #error-counts
-
-\ set-error-count called at the end of each test file with its own offset into
-\ the errors[] array. #error is in files tester.fr and ttester.fs
-
-: set-error-count  ( offset -- )
-   #error @ swap errors[] + !
-   #error @ total-errors +!
-   0 #error !
-;
-
-: init-errors  ( -- )
-   errors[] #error-counts over + swap do -1 i ! 1 cells +loop
-   0 total-errors !
-   core-errors set-error-count
-;
-
-init-errors
-
-\ Report summary of errors
-
-25 constant margin
-
-: show-error-line  ( n caddr -- )
-   cr dup strlen swap type margin - abs >r
-   dup -1 = if drop r> 1- spaces ." -" else
-   r> .r then
-;
-
-: show-error-count  ( caddr offset -- )
-   errors[] + @ swap show-error-line
-;
-
-: hline  ( -- )  cr ." ---------------------------"  ;
-
-: report-errors
-   hline
-   cr 8 spaces ." Error Report"
-   cr ." Word Set" 13 spaces ." Errors"
-   hline
-   s" Core" core-errors show-error-count
-   s" Core extension" core-ext-errors show-error-count
-   s" Block" block-errors show-error-count
-   s" Double number" double-errors show-error-count
-   s" Exception" exception-errors show-error-count
-   s" Facility" facility-errors show-error-count
-   s" File-access" file-errors show-error-count
-   s" Locals"    locals-errors show-error-count
-   s" Memory-allocation" memory-errors show-error-count
-   s" Programming-tools" tools-errors show-error-count
-   s" Search-order" searchorder-errors show-error-count
-   s" String" string-errors show-error-count
-   hline
-   total-errors @ s" Total" show-error-line
-   hline cr cr
-;