From e056e339328ef93a04191080708784419c9bfebf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Aur=C3=A9lien=20Buchet?= Date: Thu, 16 Oct 2025 15:15:27 +0200 Subject: [PATCH 1/3] Legacy fixes --- skill/autoloaded/docgen.scm | 29 +++++++++++++++++++++-------- skill/autoloaded/lint.scm | 10 ++++++++++ skill/legacy.scm | 4 ++-- skill/sharp.scm | 12 +++++++++++- spec/skill_sharp_spec.sh | 1 + tcl/tcp_server.tcl | 2 +- test/autoloaded/docgen_test.scm | 4 ++-- test/legacy_test.scm | 2 +- 8 files changed, 49 insertions(+), 15 deletions(-) diff --git a/skill/autoloaded/docgen.scm b/skill/autoloaded/docgen.scm index 4830eac..d4e1814 100644 --- a/skill/autoloaded/docgen.scm +++ b/skill/autoloaded/docgen.scm @@ -253,7 +253,10 @@ ));let ;when (fprintf port ")") ;; Print output when defined - (when (memq '@output (get name '?)) (fprintf port " => %s" (@pretty_print (get name '@output) t))) + (when (and (memq '@output (get name '?)) + (neq (get name '@output) '__undefined__) + ) + (fprintf port " => %s" (@pretty_print (get name '@output) t))) (getOutstring port) ));with ;fun @@ -285,7 +288,11 @@ ;; Print info, warn and error messages when expected (letseq ( ( assertion (car assertions) ) ( input assertion->body_quoted ) - ( output (car assertion->body_result) ) + ;; Support skipped assertions + ( output (if (neq '\*slotUnbound\* assertion->body_result) + (car assertion->body_result) + assertion->body_expected + ) ) ( info (@nonblankstring? assertion->info_expected ) ) ( warn (@nonblankstring? assertion->warn_expected ) ) ( error (@nonblankstring? assertion->error_expected) ) @@ -305,7 +312,9 @@ (fprintf port ";%s>%s\n" color prefix (escape (clean_at_sign line))) ));when ;foreach );foreach - (fprintf port ";> %s\n" (escape (clean_at_sign (@pretty_print output )))) + (unless error + (fprintf port ";> %s\n" (escape (clean_at_sign (@pretty_print output )))) + ) (when (cdr assertions) (newline port)) ));let ;foreach (fprintf port "") @@ -315,9 +324,10 @@ (@fun @docgen ( @key - ( files ?type ( string ... ) ) - ( init ?type string ?def (or (getShellEnvVar "SKILL_SHARP_INIT_COMMAND" ) "") ) - ( before ?type string ?def (or (getShellEnvVar "SKILL_SHARP_BEFORE_COMMAND") "") ) + ( source_files ?type ( string ... ) ) + ( test_files ?type ( string ... )|nil ?def nil ) + ( init ?type string ?def (or (getShellEnvVar "SKILL_SHARP_INIT_COMMAND" ) "") ) + ( before ?type string ?def (or (getShellEnvVar "SKILL_SHARP_BEFORE_COMMAND") "") ) ( track_source ?type t|nil ?def (equal "TRUE" (getShellEnvVar "SKILL_SHARP_TRACK_SOURCE")) @@ -335,13 +345,16 @@ Print associated documentation (as .fnd file content) to stdout." ?out t|nil ?global t (destructuringBind ( functions _variables _scheme _classes @optional _symbols ) - (@globals ?files files ?before (@str "(progn nil (inSkill (sklint)) {before})") ?init init) + (@globals ?files source_files ?before (@str "(progn nil (inSkill (sklint)) {before})") ?init init) ;; Load all files containing tests (@letf ( ( (status keepNLInString ) t ) ( (status saveInlineDoc ) t ) ( (getShellEnvVar "SKILL_SHARP_RUN_TEST") "TRUE" ) ) - (foreach file files (@load file ?no_reload t)) + (foreach files (list source_files test_files) + (foreach file files + (@load file ?no_reload t ?fun 'loadi) + )) ) ;; Filter and sort functions (setq functions (setof function functions (and (getd function) (nequal "_" (substring function 1 1))))) diff --git a/skill/autoloaded/lint.scm b/skill/autoloaded/lint.scm index ff047cc..2bae987 100644 --- a/skill/autoloaded/lint.scm +++ b/skill/autoloaded/lint.scm @@ -372,6 +372,16 @@ NAME is the message reference." (unless (equal "NO_LINT" (nth 1 sexp)) (apply '_\@lint_default_rule sexp args)) )) +;; ------------------------------------------------------- +;; `muffleWarnings` +;; ------------------------------------------------------- + +(_\@lint_rule + ?functions '( muffleWarnings ) + ?control t + ?rule_fun '_\@lint_default_rule + ) + ;; ------------------------------------------------------- ;; `if`, `when`, `unless` ;; ------------------------------------------------------- diff --git a/skill/legacy.scm b/skill/legacy.scm index 2e97bbc..97d4ec5 100644 --- a/skill/legacy.scm +++ b/skill/legacy.scm @@ -33,14 +33,14 @@ Warnings catched during evaluation can be fetched using `getMuffleWarnings'." ;; Split warnings (@letf ( ( (rexMagic) nil ) ) - (rexCompile "*WARNING*") + (rexCompile "*WARNING* ") (setq str (rexReplace str "¶" 0)) ) (setq warnings ;; Remove added warning in case it was printed before being catched (foreach mapcon _warnings (parseString str "¶") (unless (and (not (cdr _warnings)) (blankstrp (car _warnings))) - (list (strcat "*WARNING*" (car _warnings))) + (list (car _warnings)) )) ) );when diff --git a/skill/sharp.scm b/skill/sharp.scm index 5f6016a..b9da428 100755 --- a/skill/sharp.scm +++ b/skill/sharp.scm @@ -145,7 +145,17 @@ (lambda ( @rest args ) (@debug "Running Docgen on {args}") (@setf (@woport) (@stderr)) - (@exit (if (@docgen ?files (@skill_files args)) 0 1)) + (let ( ( source_files nil ) + ( test_files nil ) + ) + ;; Segregate source and test files according to _test suffix + (foreach file (@skill_files args) + (if (pcreMatchp "_test\\.(ils?|scm)$" file) + (push file test_files) + (push file source_files) + )) + (@exit (if (@docgen ?source_files source_files ?test_files test_files) 0 1)) + ) )) ;; ------------------------------------------------------- diff --git a/spec/skill_sharp_spec.sh b/spec/skill_sharp_spec.sh index a404257..0c8b477 100644 --- a/spec/skill_sharp_spec.sh +++ b/spec/skill_sharp_spec.sh @@ -108,6 +108,7 @@ End It 'generates documentation' When run env SKILL_SHARP_TRACK_SOURCE=TRUE \ + SKILL_SHARP_GLOBALS_LOAD=TRUE \ bash -c 'mkdir -p ./doc/finder/SKILL/SKILL#/ && ./bin/sharp docgen ./skill/loader.scm ./test > "./doc/finder/SKILL/SKILL#/sharp.fnd"' The file './doc/finder/SKILL/SKILL#/sharp.fnd' should be exist The stdout should be blank diff --git a/tcl/tcp_server.tcl b/tcl/tcp_server.tcl index ba95e86..9011265 100755 --- a/tcl/tcp_server.tcl +++ b/tcl/tcp_server.tcl @@ -36,7 +36,7 @@ proc random_string {} { #exec openssl rand -base64 12 | tr , - set charset "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#%^-_=:." set charset [string map {"," ""} $charset] - set password "" + set password "P" for {set i 0} {$i < 16} {incr i} { append password [string index $charset [expr {int(rand() * [string length $charset])}]] } diff --git a/test/autoloaded/docgen_test.scm b/test/autoloaded/docgen_test.scm index db4b9ae..78996a5 100644 --- a/test/autoloaded/docgen_test.scm +++ b/test/autoloaded/docgen_test.scm @@ -14,9 +14,9 @@ ?doc "Run `@docgen` on known files." (@assertion - (@docgen ?files (list (@realpath "$SKILL_SHARP_ROOT/metatest/globals/functions.ils"))) + (@docgen ?source_files (list (@realpath "$SKILL_SHARP_ROOT/metatest/docgen/defun_without_argument.il"))) ?out t - ?info "( \"nonlocal\"\n \"nonlocal()\"\n \"Missing documentation for function `nonlocal'.\"\n )" + ?info "( \"no_args\"\n \"no_args()\"\n \"This is a simple function without argument.\nIt always return 12.\"\n )" ) ) diff --git a/test/legacy_test.scm b/test/legacy_test.scm index 2128593..e8ffb97 100644 --- a/test/legacy_test.scm +++ b/test/legacy_test.scm @@ -16,7 +16,7 @@ (@assertion (progn (muffleWarnings (warn "reported warning")) (getMuffleWarnings)) - ?out '("*WARNING* reported warning") + ?out '("reported warning") ) ) From 18ab57ce5410c6bf9ee195274c1bd1ffd71e6614 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Aur=C3=A9lien=20Buchet?= Date: Thu, 16 Oct 2025 15:52:10 +0200 Subject: [PATCH 2/3] fix hardcoded value --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 5e83db7..775897b 100644 --- a/Makefile +++ b/Makefile @@ -126,7 +126,7 @@ bash: container .PHONY: shell shell: container ## Run SKILL interpreter in Shell mode. ifeq ($(OS_NAME),Linux) - @/skill#/bin/shell + @$$SKILL_SHARP_ROOT/bin/shell #@rlwrap docker exec -it rocky8-skill /skill#/bin/shell else @make container From cff9acff9e62e2e72bbf953bc6703aa2004b1110 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Aur=C3=A9lien=20Buchet?= Date: Thu, 16 Oct 2025 15:53:17 +0200 Subject: [PATCH 3/3] add function to return project version --- skill/sharp.scm | 2 +- skill/utils.scm | 31 ++++++++++++++++++++++++++++++ test/utils_test.scm | 46 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 78 insertions(+), 1 deletion(-) diff --git a/skill/sharp.scm b/skill/sharp.scm index b9da428..e8fee4e 100755 --- a/skill/sharp.scm +++ b/skill/sharp.scm @@ -28,7 +28,7 @@ ;; ======================================================= (@script_set_description "Run SKILL Sharp comamnds." ) -(@script_set_version "0.0.0" ) +(@script_set_version (@skill_sharp) ) (@script_add_argument ?name "command" diff --git a/skill/utils.scm b/skill/utils.scm index 8a97edb..2d9de15 100644 --- a/skill/utils.scm +++ b/skill/utils.scm @@ -244,6 +244,13 @@ If NUM is negative, STR is right-padded instead." ; str ; ) +(@fun @pascal_case + ( ( str ?type string ) + ) + ?doc "Return STR in Pascal-Case. (i.e. first letter is upper-case, rest is lower-case." + (strcat (upperCase (substring str 1 1)) (lowerCase (substring str 2))) + ) + ;; ======================================================= ;; Numbers ;; ======================================================= @@ -649,5 +656,29 @@ If END is not provided, END defaults to BEG minus 1 and BEG defaults to 0." );closure +;; ======================================================= +;; Return SKILL# Version +;; ======================================================= + +(@fun @skill_sharp + ( @key + ( min_version ?type string|nil ?def nil ) + ) + ?doc "Return current SKILL# version. +If MIN_VERSION is provided, then assert that current version is equal or higher. + +This is intended to be used as following in SKILL# dependent files: +`(assert (and (isCallable '@skill_sharp) (@skill_sharp ?min_version \"0.0.0\")) + \"SKILL# version 0.0.0 or higher is required\")`" + (letseq ( ( file (@realpath "$SKILL_SHARP_ROOT/VERSION") ) + ( version (if (isFile file) (@read_file file) "0.0.0") ) + ) + (if (stringp min_version) + (@assert (not (@alphalessp version min_version)) + "@skill_sharp - Minimum required version [{min_version}] is higher than current one [{version}].") + version + ) + ));let ;fun + ;*/ diff --git a/test/utils_test.scm b/test/utils_test.scm index 6f44160..1cfcc0e 100644 --- a/test/utils_test.scm +++ b/test/utils_test.scm @@ -532,6 +532,27 @@ Kevin layouter\n\ ) +(@test + ?fun '@pascal_case + ?doc "`@pascal_case' works with different strings." + + (@assertion + (@pascal_case "Example message.") + ?out "Example message." + ) + + (@assertion + (@pascal_case "name") + ?out "Name" + ) + + (@assertion + (@pascal_case "several Words") + ?out "Several words" + ) + + ) + ; (@test ; ?fun '@escape_chars ; (@assertion @@ -1129,3 +1150,28 @@ Kevin layouter\n\ ) +;; ======================================================= +;; SKILL# Version +;; ======================================================= + +(@test + ?fun '@skill_sharp + ?doc "Make sure `@skill_sharp` returns current version." + + (@assertion + (pcreMatchp "[0-9]+\\.[0-9]+\\.[0-9]+" (@skill_sharp)) + ?out t + ) + + (@assertion + (@skill_sharp ?min_version "0.0.0") + ?out nil + ) + + (@assertion + (@skill_sharp ?min_version "666.0.0") + ?error "@skill_sharp - Minimum required version [666.0.0] is higher than current one" + ) + ) + +