From 6af1b3f9b55e95bfee051d73bdbb2257875d97bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 30 Oct 2023 00:16:53 +0100 Subject: Add tests for module introspection. --- tests/unit/module-introspection/all-modules.scm | 93 +++++++++++++++++++++++++ tests/unit/module-introspection/module-uses.scm | 68 ++++++++++++++++++ tests/unit/module-introspection/static-util.scm | 15 ++++ 3 files changed, 176 insertions(+) create mode 100644 tests/unit/module-introspection/all-modules.scm create mode 100644 tests/unit/module-introspection/module-uses.scm create mode 100644 tests/unit/module-introspection/static-util.scm (limited to 'tests/unit/module-introspection') diff --git a/tests/unit/module-introspection/all-modules.scm b/tests/unit/module-introspection/all-modules.scm new file mode 100644 index 00000000..da59c77c --- /dev/null +++ b/tests/unit/module-introspection/all-modules.scm @@ -0,0 +1,93 @@ +(define-module (test module-introspection all-modules) + :use-module (srfi srfi-1) + :use-module (srfi srfi-64) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module ((hnh util) :select (sort*)) + :use-module (hnh module-introspection all-modules)) + + +(test-group "fs-find" + (for-each (lambda (reference entry) + (test-equal "Filename" (list-ref reference 1) (list-ref entry 0)) + (test-group "Stat data" + (test-assert (vector? (list-ref entry 1))) + (test-equal 18 (vector-length (list-ref entry 1)))) + (test-equal "File type" (list-ref reference 0) (list-ref entry 2)) + ) + '((directory "tests/test-module-tree") + (regular "tests/test-module-tree/README.md") + (directory "tests/test-module-tree/a") + (regular "tests/test-module-tree/a.scm") + (regular "tests/test-module-tree/a/b.scm") + (regular "tests/test-module-tree/a/c.scm") + (regular "tests/test-module-tree/b.scm")) + (sort* + (fs-find "tests/test-module-tree") + string< car))) + + + +(test-equal "all-files" + '("tests/test-module-tree/README.md" + "tests/test-module-tree/a.scm" + "tests/test-module-tree/a/b.scm" + "tests/test-module-tree/a/c.scm" + "tests/test-module-tree/b.scm") + (sort* + (all-files-under-directory "tests/test-module-tree" + "") + string<)) + +(test-equal "all SCM files" + '("tests/test-module-tree/a.scm" + "tests/test-module-tree/a/b.scm" + "tests/test-module-tree/a/c.scm" + "tests/test-module-tree/b.scm") + (sort* + (all-files-under-directory "tests/test-module-tree" + ".scm") + string<)) + + +;; module-file-mapping +;; all-files-and-modules-under-directory + +(test-equal "all SCM files and modules" + '(("tests/test-module-tree/a.scm" (a)) + ("tests/test-module-tree/a/b.scm" (a b)) + ("tests/test-module-tree/a/c.scm" #f) + ("tests/test-module-tree/b.scm" (b))) + (sort* + (all-files-and-modules-under-directory "tests/test-module-tree") + string< car)) + +(test-group "all-modules-under-directory" + (let ((files modules + (all-modules-under-directory + "tests/test-module-tree"))) + (test-equal "Files" + '("tests/test-module-tree/a.scm" + "tests/test-module-tree/a/b.scm" + "tests/test-module-tree/a/c.scm" + "tests/test-module-tree/b.scm") + (sort* files string<)) + (test-equal "Modules" + '((a) (b) (a b)) + (sort modules + (lambda (a b) + (cond ((< (length a) (length b)) #t) + ((> (length a) (length b)) #f) + (else (stringstring a)) + (string-concatenate (map symbol->string b)))))))))) +(test-equal "Files" + '(((a) . "tests/test-module-tree/a.scm") + ((a b) . "tests/test-module-tree/a/b.scm") + ((b) . "tests/test-module-tree/b.scm")) + (sort* + (module-file-mapping "tests/test-module-tree") + string< cdr)) + +'((hnh module-introspection all-modules)) + diff --git a/tests/unit/module-introspection/module-uses.scm b/tests/unit/module-introspection/module-uses.scm new file mode 100644 index 00000000..f460f9dc --- /dev/null +++ b/tests/unit/module-introspection/module-uses.scm @@ -0,0 +1,68 @@ +(define-module (test module-introspection module-uses) + :use-module (srfi srfi-1) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module ((hnh util) :select (sort*)) + :use-module (hnh module-introspection module-uses)) + + +(test-equal "Basic example" + '(((srfi srfi-1) hide: () autoload: #f) + ((not-a-real-module) select: (x) hide: () autoload: #f)) + (module-uses* + '((define-module (test-module) + :use-module (srfi srfi-1)) + + (@ (not-a-real-module) x)))) + +(test-equal "Multiple imports of same module" + '(((xdg basedir) hide: () autoload: #f) + ((xdg basedir) select: (config-home) hide: () autoload: #f)) + (module-uses* + '((use-modules + ((xdg basedir))) + (@ (xdg basedir) config-home)))) + +(test-equal "Multiple imports of same thing + alternative keyword" + '(((xdg basedir) hide: () prefix: xdg- autoload: #f) + ((xdg basedir) select: (config-home) hide: () autoload: #f)) + (module-uses* + '((define-module (test) + ;; Prefix written as keyword, to test that normalization + :use-module ((xdg basedir) #:prefix xdg-)) + (@ (xdg basedir) config-home)))) + +(test-equal "Autoload + import private" + '(((mod-1) select: (x) hide: () autoload: #t) + ((mod-2) select: (z) hide: () autoload: #f)) + (module-uses* + '((define-module (test) + :autoload (mod-1) (x)) + (@@ (mod-2) z)))) + +(test-equal ":version on define-module, along with \"weird\" symbols" + '(((tt) select: (y) hide: () version: (0 1) autoload: #f)) + (module-uses* + '((define-module (test) + :version (1 1) + :use-module ((tt) :select (y) :version (0 1)))))) + +(test-error 'wrong-type-arg + (module-uses* + '((use-modules x)))) + +(test-error 'wrong-type-arg + (module-uses* + '((use-modules (x :select (y)))))) + +(test-error 'wrong-type-arg + (module-uses* + '((use-modules ((x) (y)))))) + +(test-error 'wrong-type-arg + (module-uses* + '((use-modules ((x) 1 (y)))))) + +'((hnh module-introspection module-uses)) diff --git a/tests/unit/module-introspection/static-util.scm b/tests/unit/module-introspection/static-util.scm new file mode 100644 index 00000000..f9b7e17e --- /dev/null +++ b/tests/unit/module-introspection/static-util.scm @@ -0,0 +1,15 @@ +(define-module (test module-introspection static-util) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (hnh module-introspection static-util)) + +(test-equal "All forms" + '((define (f x) + (* x 2)) + (define-module (a) + :use-module (srfi srfi-1) + :export (f))) + (call-with-input-file "tests/test-module-tree/a.scm" get-forms)) + + +'((hnh module-introspection static-util)) -- cgit v1.2.3