From 434086ade8007521f1a7492f7db8eadf887040c9 Mon Sep 17 00:00:00 2001 From: Pavel Kulyov Date: Mon, 21 Sep 2026 22:24:47 +0300 Subject: [PATCH] tests: add docstring cases --- tests/codegen.scm | 31 ++++++++++++++- tests/modules/greet.sex | 5 ++- tests/semen.scm | 85 +++++++++++++++++++++++++++++++++++------ 3 files changed, 107 insertions(+), 14 deletions(-) diff --git a/tests/codegen.scm b/tests/codegen.scm index 1f60903..2b94fe4 100644 --- a/tests/codegen.scm +++ b/tests/codegen.scm @@ -230,4 +230,33 @@ compiles." (test-assert "grouping sublist still accepted" (emits? (in-fn "(var s (* (const struct suc)) 0)") "const struct suc * s")) (test-assert "flat chain still accepted" - (emits? (in-fn "(var q (* * const char) 0)") "const char * * q")))) + (emits? (in-fn "(var q (* * const char) 0)") "const char * * q"))) + + ;; A string as the first body form (or after the name of a struct, + ;; union or enum) is a docstring: it becomes a comment immediately + ;; before the declaration, not a statement inside it. + (test-group "docstrings" + (test-assert "appears before the function" + (emits? "(fn greet ((name (* char))) void \"Greet NAME.\" (printf \"hi\" name))" + "/* Greet NAME. */")) + (test-assert "and not inside the body as a statement" + (not (emits? "(fn greet ((name (* char))) void \"Greet NAME.\" (printf \"hi\" name))" + "\"Greet NAME.\""))) + (test-assert "multiline keeps its paragraphs" + (emits? "(pub fn main () int \"Entry point.\n\nARGC and ARGV.\" (return 0))" + "Entry point.")) + (test-assert "and the second paragraph too" + (emits? "(pub fn main () int \"Entry point.\n\nARGC and ARGV.\" (return 0))" + "ARGC and ARGV.")) + (test-assert "a prototype with only a docstring stays a prototype" + (emits? "(fn helper ((a int)) int \"Forward.\")" + "helper (int a);")) + (test-assert "a string after the first statement is left alone" + (emits? "(fn f () void (g) \"not a docstring\")" + "\"not a docstring\"")) + (test-assert "a struct docstring sits above the struct" + (emits? "(struct point \"A 2D point.\" ((x int) (y int)))" + "/* A 2D point. */")) + (test-assert "and an enum docstring too" + (emits? "(enum color \"RGB.\" (red green blue))" + "/* RGB. */")))) diff --git a/tests/modules/greet.sex b/tests/modules/greet.sex index 887b295..96e36ff 100644 --- a/tests/modules/greet.sex +++ b/tests/modules/greet.sex @@ -9,7 +9,9 @@ (pub var greet-count int 0) -(pub struct greeting ((text (* const char)) (times int))) +(pub struct greeting + "A greeting to print." + ((text (* const char)) (times int))) (pub enum mood (cheerful grumpy)) @@ -24,6 +26,7 @@ `(printf "%s " ,(symbol->string name)))))) (pub fn greet ((name (* const char))) void + "Print a greeting for NAME." (++ greet-count) (printf "hello, %s\n" name)) diff --git a/tests/semen.scm b/tests/semen.scm index b5c4465..3235477 100644 --- a/tests/semen.scm +++ b/tests/semen.scm @@ -1,30 +1,35 @@ (import srfi-69 - semen) + semen + types) (define print-str-fn - '(fn void print-str ((string s)) + '(fn print-str ((s string)) void (printf "%s" s))) (define sum-fn - '(pub fn float sum ((int a) (int b)) - (return (cast float (+ a b))))) + '(pub fn sum ((a int) (b int)) float + (return (cast (+ a b) float)))) (test-group "semen" (test-assert (sex-fn? print-str-fn)) (test #f (sex-fn-public? print-str-fn)) (test 'void (sex-fn-return-type print-str-fn)) (test 'print-str (sex-fn-name print-str-fn)) - (test '((string s)) (sex-fn-arglist print-str-fn)) - (test '(fn void print-str ((string s))) (sex-fn-prototype print-str-fn)) + (test '((s string)) (sex-fn-arglist print-str-fn)) + (test '(fn print-str ((s string)) void) (sex-fn-prototype print-str-fn)) (test '((printf "%s" s)) (sex-fn-body print-str-fn)) (test-assert (sex-fn? sum-fn)) (test #t (sex-fn-public? sum-fn)) (test 'float (sex-fn-return-type sum-fn)) (test 'sum (sex-fn-name sum-fn)) - (test '((int a) (int b)) (sex-fn-arglist sum-fn)) - (test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn)) - (test '((return (cast float (+ a b)))) (sex-fn-body sum-fn)) + (test '((a int) (b int)) (sex-fn-arglist sum-fn)) + (test '(pub fn sum ((a int) (b int)) float) (sex-fn-prototype sum-fn)) + (test '((return (cast (+ a b) float))) (sex-fn-body sum-fn)) + + (test-assert (sex-fn? '(extern fn foo () void))) + (test 'foo (sex-fn-name '(extern fn foo () void))) + (test #f (sex-fn? '(struct point ((x int))))) (let ((sex-code '((defmacro (sum-var name a b c) @@ -49,9 +54,65 @@ '((defmacro (x10 a) `(* 10 ,a)) - (fn void foo ((int a) (int b)) + (fn foo ((a int) (b int)) void (return (+ a (x10 b))))))) - (test '((fn void foo ((int a) (int b)) + (test '((fn foo ((a int) (b int)) void (return (+ a (* 10 b))))) - (semen-process sex-code-macro)))) + (semen-process sex-code-macro))) + +;;; Docstrings are lifted out as comment forms sitting before the +;;; declaration. A string later in a body is left alone. + + (test '((comment "Greet NAME.") + (fn greet ((name (* char))) void + (printf "Hello %s!\n" name))) + (semen-process + '((fn greet ((name (* char))) void + "Greet NAME." + (printf "Hello %s!\n" name))))) + + (test '((comment "Public entry.") + (pub fn main () int + (return 0))) + (semen-process + '((pub fn main () int + "Public entry." + (return 0))))) + + ;; A prototype whose only "body" is a docstring stays a prototype + (test '((comment "Forward.") + (fn helper ((a int)) int)) + (semen-process + '((fn helper ((a int)) int + "Forward.")))) + + (test '((fn f () void (g) "not a docstring")) + (semen-process + '((fn f () void (g) "not a docstring")))) + + ;; `;' comments before the string are skipped when looking for it, + ;; and stay in the body + (test '((comment "Kept.") + (fn f () void (comment " note") (g))) + (semen-process + '((fn f () void (comment " note") "Kept." (g))))) + + (test '((comment "A 2D point.") + (struct t-doc-pt ((x int) (y int)))) + (semen-process + '((struct t-doc-pt "A 2D point." ((x int) (y int)))))) + + (test '((x int) (y int)) + (get-fields 't-doc-pt)) + + (test '((comment "RGB.") + (enum t-doc-color (red green blue))) + (semen-process + '((enum t-doc-color "RGB." (red green blue))))) + + (test '((comment "Either.") + (union t-doc-val ((i int) (f float)))) + (semen-process + '((union t-doc-val "Either." ((i int) (f float)))))) +)