From daa951cb00526fa4946a30ae4e459516871cbb86 Mon Sep 17 00:00:00 2001 From: Alexander Vynnyk Date: Mon, 6 Feb 2017 10:48:02 +0200 Subject: [PATCH 1/2] Make skeleton definition in defproject more universal. Skeleton plugin refactoring --- TODO.md | 3 - share/hits/clean.hit | 10 +- share/hits/deploy-local.hit | 67 +++--- .../generic/make-binary/src/make-binary.lisp | 3 +- src/core/jabs-depmanager/jabs-depmanager.lisp | 45 +++- src/core/jabs-operations/jabs-operations.lisp | 21 ++ src/core/jabs-skeleton/jabs-skeleton.lisp | 193 +++++++++++------- src/core/jabs-test/jabs-test.lisp | 28 ++- src/jabs-plugin.lisp | 6 + 9 files changed, 245 insertions(+), 131 deletions(-) diff --git a/TODO.md b/TODO.md index 56bb610..7f036aa 100644 --- a/TODO.md +++ b/TODO.md @@ -13,11 +13,8 @@ * realise round list view for projects * remove `*jabs-verbose*`, `*jabs-quiet*` and `*jabs-debug*` variables as deprecated * make automatic detection, which project should be launched -* check for multiple directories to load libs/plugins/skeletons/bouts/rounds/hits etc * make possibility to add absolute pathnames to skeleton definition -* make skeleton definition in project regular (now: `:skeleton (:default)` ) * add CLI option additional-plugins -* implement multiple directories support for plugins/bouts/rounds/hits/skelethons ## Plugins: * Core: diff --git a/share/hits/clean.hit b/share/hits/clean.hit index 6b5d95b..8d2550b 100644 --- a/share/hits/clean.hit +++ b/share/hits/clean.hit @@ -1,8 +1,6 @@ ;; -*- mode: lisp -*- + (clean :depends-on () - (let ((target-dir - (or - (try (get-skeleton-target (find-skeleton (project-slot-value *jabs-current-project* 'skeleton)))) - (try (get-skeleton-target (find-skeleton (car (project-slot-value *jabs-current-project* 'skeleton)))))))) - (when target-dir - (os-rm target-dir :recursive t)))) + (let ((target-dir (try (get-skeleton-target (find-project-skeleton *jabs-current-project*))))) + (when target-dir + (os-rm target-dir :recursive t)))) diff --git a/share/hits/deploy-local.hit b/share/hits/deploy-local.hit index 95c3c5d..bdc4245 100644 --- a/share/hits/deploy-local.hit +++ b/share/hits/deploy-local.hit @@ -1,32 +1,39 @@ ;; -*- mode: lisp -*- (deploy-local :depends-on () - (let* ((current-skeleton (or (try (find-skeleton (car (project-slot-value *jabs-current-project* 'skeleton)))) - (try (find-skeleton (project-slot-value *jabs-current-project* 'skeleton))))) - (target-dir (when current-skeleton (pathname-as-directory (parse-namestring (get-skeleton-target current-skeleton))))) - ;; - (src-dir (try (get-skeleton-src current-skeleton))) - (bin-dir (try (get-skeleton-bin current-skeleton))) - (doc-dir (try (get-skeleton-doc current-skeleton))) - (share-dir (try (get-skeleton-share current-skeleton))) - (test-dir (try (get-skeleton-test current-skeleton))) - (contrib-dir (try (get-skeleton-contrib current-skeleton))) - (conf-dir (try (get-skeleton-conf current-skeleton))) - (script-dir (try (get-skeleton-script current-skeleton))) - (readme-file (try (get-skeleton-readme-file current-skeleton))) - (license-file (try (get-skeleton-license-file current-skeleton))) - (install-file (try (get-skeleton-install-file current-skeleton))) - ;; - ) - (when (not target-dir) - (jlog:crit "Target directory for skeleton ``~a'', project ``~a'' is not set. Can not deploy locally" - (get-skeleton-name current-skeleton) - (get-project-name *jabs-current-project*))) - ;; - (dolist (dir (list src-dir bin-dir doc-dir test-dir contrib-dir script-dir share-dir conf-dir)) - (let ((dst-dir (when dir (pathname-as-directory (or (try (parse-namestring dir)) - (try (parse-namestring (car dir)))))))) - (when dst-dir - (os-cp dst-dir (merge-pathnames dst-dir target-dir) :recursive t :force t)))) - (dolist (file (list readme-file license-file install-file)) - (when (and file (file-exists-p file)) - (os-cp file (merge-pathnames file target-dir) :recursive t :force t))))) + (let* ((current-skeleton (find-project-skeleton *jabs-current-project*)) + (target-dir (try + (pathname-as-directory + (parse-namestring + (get-skeleton-target current-skeleton))))) + ;; + (src-dir (try (get-skeleton-src current-skeleton))) + (bin-dir (try (get-skeleton-bin current-skeleton))) + (doc-dir (try (get-skeleton-doc current-skeleton))) + (share-dir (try (get-skeleton-share current-skeleton))) + (test-dir (try (get-skeleton-test current-skeleton))) + (contrib-dir (try (get-skeleton-contrib current-skeleton))) + (conf-dir (try (get-skeleton-conf current-skeleton))) + (script-dir (try (get-skeleton-script current-skeleton))) + (readme-file (try (get-skeleton-readme-file current-skeleton))) + (license-file (try (get-skeleton-license-file current-skeleton))) + (install-file (try (get-skeleton-install-file current-skeleton))) + ;; + ) + (if (not target-dir) + (jlog:wrn "Target directory for skeleton ``~a'', project ``~a'' is not set. Can not deploy locally. Skipping" + (get-skeleton-name current-skeleton) + (get-project-name *jabs-current-project*)) + ;; + (progn + (dolist (dir (list src-dir bin-dir doc-dir test-dir contrib-dir + script-dir share-dir conf-dir)) + (let ((dst-dir (when dir (pathname-as-directory + (or (try (parse-namestring dir)) + (try (parse-namestring (car dir)))))))) + ;; (jlog:crit "AAAA ~a" dst-dir) + (when dst-dir + (jlog:info "Deploying ``~a'' to ``~a''" dst-dir target-dir) + (os-cp dst-dir (merge-pathnames dst-dir target-dir) :recursive t :force t)))) + (dolist (file (list readme-file license-file install-file)) + (when (and file (file-exists-p file)) + (os-cp file (merge-pathnames file target-dir) :recursive t :force t))))))) diff --git a/share/plugins/generic/make-binary/src/make-binary.lisp b/share/plugins/generic/make-binary/src/make-binary.lisp index 6b1deb6..c6a7058 100644 --- a/share/plugins/generic/make-binary/src/make-binary.lisp +++ b/share/plugins/generic/make-binary/src/make-binary.lisp @@ -27,8 +27,7 @@ (pathname-as-directory (parse-namestring (get-skeleton-bin - (find-skeleton - (car (jabs:project-slot-value *jabs-current-project* 'jabs::skeleton)))))) + (find-project-skeleton *jabs-current-project*)))) ""))) ;; (when (not function) diff --git a/src/core/jabs-depmanager/jabs-depmanager.lisp b/src/core/jabs-depmanager/jabs-depmanager.lisp index 280e2d4..38d44c8 100644 --- a/src/core/jabs-depmanager/jabs-depmanager.lisp +++ b/src/core/jabs-depmanager/jabs-depmanager.lisp @@ -68,11 +68,13 @@ Created for ASDF compatability" (add-hook *post-init-hook* #'map-global-projects-to-files) (add-hook *post-init-hook* #'map-global-systems-to-files) +(defgeneric get-project-projects-map (project) + ) + (defmethod get-project-projects-map ((project project)) "Get project names mapped to files for only for given project w\o global map" - (let* ((skel-name (or (car (try (slot-value project 'skeleton))) - *jabs-default-skeleton-name*)) + (let* ((skel-name (get-project-skeleton-name project)) (skel (or (find-skeleton skel-name) (and @@ -95,11 +97,13 @@ w\o global map" (cons lib (cons contrib opt))) hash)) +(defgeneric get-project-systems-map (project) + ) + (defmethod get-project-systems-map ((project project)) "Get asdf system names mapped to files for only for given project w\o global map. For ASDF back compatability" - (let* ((skel-name (or (car (try (slot-value project 'skeleton))) - *jabs-default-skeleton-name*)) + (let* ((skel-name (get-project-skeleton-name project)) (skel (or (find-skeleton skel-name) (and @@ -122,19 +126,31 @@ w\o global map. For ASDF back compatability" (cons lib (cons contrib opt))) hash)) +(defgeneric get-project-depends-on (project) + ) + (defmethod get-project-depends-on ((project project)) (try (slot-value project 'depends-on))) +(defgeneric dependency-project-reachable-locally-p (name project) + ) + (defmethod dependency-project-reachable-locally-p (name (project project)) (check-type name keyword) (or (gethash name (get-project-projects-map project)) (gethash name *jabs-global-projects-map*))) +(defgeneric dependency-system-reachable-locally-p (name project) + ) + (defmethod dependency-system-reachable-locally-p (name (project project)) (check-type name keyword) (or (gethash name (get-project-systems-map project)) (gethash name *jabs-global-systems-map*))) +(defgeneric find-project-dependency-force-locally (name project) + ) + (defmethod find-project-dependency-force-locally (name (project project)) "Like ``find-project'', but tries to load local project or system file, than retry to find project" @@ -166,24 +182,36 @@ system file, than retry to find project" found-project-file-asd)) found-project))))) +(defgeneric dependency-project-reachable-remotely-p (name project) + ) + (defmethod dependency-project-reachable-remotely-p (name (project project)) "Check if project can be reachable in all accessible plugins" (let ((plugins (filter-project-plugins-by-type project :repository))) (plugins-api-call-to-true :find-repository-project plugins name))) +(defgeneric find-project-dependencies-remotely (name project) + ) + (defmethod find-project-dependencies-remotely (name (project project)) "Check if project can be reachable in all accessible plugins" (let ((plugins (filter-project-plugins-by-type project :repository))) (plugins-api-call-to-true :repository-project-dependencies plugins name))) +(defgeneric load-project-remote-dependency (name project) + ) + (defmethod load-project-remote-dependency (name (project project)) "Check if project can be reachable in all accessible plugins" (let ((plugins (filter-project-plugins-by-type project :repository))) (plugins-api-call-to-true :load-repository-project plugins name))) +(defgeneric dependency-project-reachable-p (name project) + ) + (defmethod dependency-project-reachable-p (name (project project)) (or (dependency-project-reachable-locally-p name project) (dependency-system-reachable-locally-p name project) @@ -191,6 +219,9 @@ system file, than retry to find project" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric make-project-depencencies-list (project) + ) + (defmethod make-project-depencencies-list ((project project)) "Make full list of project dependencies (recursively)" (labels @@ -212,11 +243,17 @@ system file, than retry to find project" (remove (get-project-name project) (reverse (remove-duplicates (reverse (make-deps-list (get-project-name project)))))))) +(defgeneric load-project-local-dependency (name project) + ) + (defmethod load-project-local-dependency (name (project project)) (jlog:dbg "Loading project ``~a'' as dependency for project ``~a''" name (get-project-name project)) (and (find-project-dependency-force-locally name project) (asdf:operate 'asdf:load-op name))) +(defgeneric load-project-dependencies (project) + ) + (defmethod load-project-dependencies ((project project)) (dolist (v (make-project-depencencies-list project)) (or diff --git a/src/core/jabs-operations/jabs-operations.lisp b/src/core/jabs-operations/jabs-operations.lisp index 4cdadc9..7100852 100644 --- a/src/core/jabs-operations/jabs-operations.lisp +++ b/src/core/jabs-operations/jabs-operations.lisp @@ -10,26 +10,47 @@ (in-package :jabs) +(defgeneric load-op (project &optional source-force) + ) + (defmethod load-op ((project project) &optional source-force) (if source-force (asdf:operate 'asdf:load-source-op (get-project-name project)) (asdf:operate 'asdf:load-op (get-project-name project)))) +(defgeneric load-dependencies-op (project) + ) + (defmethod load-dependencies-op ((project project)) (load-project-dependencies project)) +(defgeneric compile-op (project) + ) + (defmethod compile-op ((project project)) (asdf:operate 'asdf:compile-op (get-project-name project))) +(defgeneric test-op (project) + ) + (defmethod test-op ((project project)) (run-tests project)) +(defgeneric lib-op (project) + ) + (defmethod lib-op ((project project)) (jlog:err "lib-op Not implemented")) +(defgeneric link-op (project) + ) + (defmethod link-op ((project project)) (jlog:err "link-op Not implemented")) +(defgeneric prepare-op (project) + ) + (defmethod prepare-op ((project project)) (jlog:err "prepare-source-op Not implemented")) diff --git a/src/core/jabs-skeleton/jabs-skeleton.lisp b/src/core/jabs-skeleton/jabs-skeleton.lisp index 5c8bfa2..8fb84fb 100644 --- a/src/core/jabs-skeleton/jabs-skeleton.lisp +++ b/src/core/jabs-skeleton/jabs-skeleton.lisp @@ -28,7 +28,7 @@ get-skeleton-template get-skeleton-opt get-skeleton-tmp - get-skeleton-target + get-skeleton-target get-skeleton-readme-file get-skeleton-license-file get-skeleton-install-file @@ -64,19 +64,17 @@ (cache :accessor get-skeleton-cache :initarg :cache) (log :accessor get-skeleton-log :initarg :log) (template :accessor get-skeleton-template :initarg :template) - (opt :accessor get-skeleton-opt :initarg :opt) ;; other optional directories, not /opt :) + ;; other optional directories, not /opt :) + (opt :accessor get-skeleton-opt :initarg :opt) (tmp :accessor get-skeleton-tmp :initarg :tmp) (target :accessor get-skeleton-target :initarg :target) (readme-file :accessor get-skeleton-readme-file :initarg :readme-file) (license-file :accessor get-skeleton-license-file :initarg :license-file) (install-file :accessor get-skeleton-install-file :initarg :install-file))) -(defun find-skeleton (name) - (check-type name keyword) - (gethash name *jabs-skeleton-registry*)) - +;;;; functions (defun skeletondir-p (dir) - "Skelethon directory record must be a string, or list + "Skeleton directory record must be a string, or list in format (\"dirname\" 755 :required) @@ -84,6 +82,8 @@ or (\"dirname\" :optional) or (\"dirname\" 511) +or + \"dirname\" It`s optional by default " @@ -107,7 +107,7 @@ It`s optional by default t))) (defun listskeletondirs-p (dirs) - "Skelethon can take list of optional directories, which are + "Skeleton can take list of optional directories, which are not included to main schema (like socket or dev dir etc)" (cond ((null dirs) t) ((atom dirs) nil) @@ -159,7 +159,7 @@ not included to main schema (like socket or dev dir etc)" :readme-file readme-file :license-file license-file :install-file install-file)) - (jlog:info "Skelethon ``~a'' registered" name)) + (jlog:info "Skeleton ``~a'' registered" name)) (defmacro defskeleton (name &body options) `(apply 'register-skeleton ,(tosymbol name) ',options)) @@ -190,9 +190,9 @@ not included to main schema (like socket or dev dir etc)" (or (eq (nth 1 dir) :required) (eq (nth 2 dir) :required))) (not (null force))) - (let* ((path-dir (pathname-as-directory (parse-namestring (car dir)))) + (let* ((path-dir (pathname-as-directory (parse-namestring (or (try (car dir)) dir)))) (path-prefix (if (stringp prefix) (pathname-as-directory (parse-namestring prefix)) prefix)) - (mode (when (integerp (nth 1 dir)) (nth 1 dir))) + (mode (when (and (listp dir) (integerp (nth 1 dir))) (nth 1 dir))) list (full-dir-path (merge-pathnames path-dir path-prefix))) ;; @@ -257,47 +257,42 @@ not included to main schema (like socket or dev dir etc)" ;; (initialize-skeleton (find-skeleton :test)) +(defun find-skeleton-file (name) + (check-type name (or string symbol)) + (let ((skeleton-name (string-downcase (princ-to-string name))) + (skeleton-dirs)) + (dolist (dirs *jabs-skeleton-directories*) + (dolist (dir (directory + (merge-pathnames + (make-pathname :name skeleton-name :type *jabs-skeleton-template-type*) + dirs))) + (push dir skeleton-dirs))) + (car skeleton-dirs))) + (defun parse-skeleton-from-file (file) (check-type file (or string pathname)) (let* ((content (car (os-cat file :list))) (skeleton-name (tosymbol (car content))) (skeleton-body (cdr content))) ;; - (jlog:dbg "Processing skeleton file ``~a''" file) + (jlog:info "Processing skeleton file ``~a''" file) (eval (cons 'defskeleton (cons skeleton-name skeleton-body))))) -(defun parse-skeleton-inline (name skeleton) - (check-type name symbol) - (check-type skeleton list) - (eval (cons 'defskeleton (cons name skeleton)))) - -(defmacro make-get-project-smth-dir (dir) ;; TODO: rewrite w/o get-project-skeleton - `(progn - (defgeneric ,(intern (string-upcase (concatenate 'string "project-" dir "-dir"))) (project)) - (defmethod ,(intern (string-upcase (concatenate 'string "project-" dir "-dir"))) ((project project)) - (let ((dir (parse-namestring - (,(intern (string-upcase (concatenate 'string "get-skeleton-" dir))) - (find-skeleton - (or - (try (slot-value project 'skeleton)) - (list *jabs-default-skeleton-name*)) - )))) - (project-pathname (get-project-pathname project)) - (workdir (os-pwd))) - (cond ((eq :absolute (car (pathname-directory dir))) dir) - ((eq :absolute (car (pathname-directory project-pathname))) - (merge-pathnames dir project-pathname)) - (t (merge-n-directories workdir project-pathname dir))))))) - -(dolist (d (list "src" "bin" "lib" "doc" "share" "test" "contrib" "conf" "public" "cache" "script" "log" "template" "opt" "tmp")) - (eval `(make-get-project-smth-dir ,d))) - -;; TODO: skeleton:create-from-project -;; TODO: show list of skeletons - -;; TODO: +add project name to skeleton dirs -;; TODO: +add package naming convension -;; TODO: +add build.jab sample for all skeletons +(defun find-skeleton (name) + (check-type name keyword) + (let ((maybe-skeleton + (gethash name *jabs-skeleton-registry*))) + (cond ((null maybe-skeleton) + (jlog:dbg "Skeleton ``~a'' not found in registry. Trying to load from file" + name) + ;; + (let ((maybe-skeleton-file (find-skeleton-file name))) + (if maybe-skeleton-file + (progn + (parse-skeleton-from-file maybe-skeleton-file) + (gethash name *jabs-skeleton-registry*)) + (jlog:err "Can not find skeleton ``~a''" name)))) + (t maybe-skeleton)))) (defun process-skeleton (skeleton-params) "process skeleton" @@ -317,21 +312,9 @@ not included to main schema (like socket or dev dir etc)" (if skeleton-force (jlog:dbg "Processing skeleton ``~a'' for project ``~a'' FORCE" skeleton-name project-name) (jlog:dbg "Processing skeleton ``~a'' for project ``~a''" skeleton-name project-name)) - (setf skeleton-name (tosymbol (gensym "SKELETHON-"))) + (setf skeleton-name (tosymbol (gensym "SKELETON-"))) (initialize-skeleton skeleton-obj :force skeleton-force))) -(defun find-skeleton-file (name) - (check-type name (or string symbol)) - (let ((skeleton-name (string-downcase (princ-to-string name))) - (skeleton-dirs)) - (dolist (dirs *jabs-skeleton-directories*) - (dolist (dir (directory - (merge-pathnames - (make-pathname :name skeleton-name :type *jabs-skeleton-template-type*) - dirs))) - (push dir skeleton-dirs))) - (car skeleton-dirs))) - (defun load-skeleton (skeleton) (let ((skeleton-name (if (listp skeleton) (car skeleton) skeleton))) (when (and (not (find-skeleton skeleton-name)) (or (atom skeleton) (null (cdr skeleton)) (eq (cdr skeleton) :force))) @@ -341,29 +324,34 @@ not included to main schema (like socket or dev dir etc)" (parse-skeleton-from-file file-to-load) (jlog:crit "There is no file for skeleton ``~a''" skeleton-name)))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;; -;;;; extending defproject syntax -(bind-project-symbol - :skeleton - #'(lambda (x) - (declare (ignore x)))) +(defgeneric get-project-skeleton-name (project) + ) + +(defmethod get-project-skeleton-name ((project project)) + (let ((maybe-skeleton-name (try (slot-value project 'skeleton)))) + (cond ((null maybe-skeleton-name) + (jlog:dbg "No skeleton defined for project ``~a''. Falling back to default name" + (get-project-name project)) + (tokeyword *jabs-default-skeleton-name*)) + ((listp maybe-skeleton-name) + (tokeyword (car maybe-skeleton-name))) + (t (tokeyword maybe-skeleton-name))))) + +(defgeneric project-skeleton-force-p (project) + ) + +(defmethod project-skeleton-force-p ((project project)) + "Check if project skeleton required to be initialized with all directories" + (try (member :force (slot-value project 'skeleton)))) -(defgeneric get-project-skelethon (project) +(defgeneric find-project-skeleton (project) ) -(defmethod get-project-skelethon ((project project)) - (let* ((skelethon (project-slot-value project 'skelethon)) - (skelethon-name (or (try (tokeyword skelethon)) - (try (tokeyword (car skelethon)))))) - (when (null skelethon-name) - (jlog:wrn "No skeletons defined in project ``~a''. Using default skelethon ``~a''" (get-project-name project) *jabs-default-skeleton-name*) - (setf skelethon-name *jabs-default-skeleton-name*)) - (or - (find-skeleton skelethon-name) - (and - (load-skeleton skelethon-name) - (find-skeleton skelethon-name))))) +(defmethod find-project-skeleton ((project project)) + "Try to find project skeleton. Use default, if not defined" + (find-skeleton (get-project-skeleton-name project))) (defgeneric load-project-skeleton (project) ) @@ -380,9 +368,58 @@ not included to main schema (like socket or dev dir etc)" (defmethod process-project-skeleton ((project project)) (let ((skeleton (or - (try (slot-value project 'skeleton)) - (list *jabs-default-skeleton-name*)))) + (try (slot-value project 'skeleton)) + (list *jabs-default-skeleton-name*)))) (process-skeleton skeleton))) +;;;;;;;;;; + +(defmacro make-get-project-smth-dir (dir) + `(progn + (defgeneric ,(concat-symbols :jabs "project-" dir "-dir") (project)) + (defmethod ,(concat-symbols :jabs "project-" dir "-dir") ((project project)) + (let ((dir (parse-namestring + (,(concat-symbols :jabs "get-skeleton-" dir) + (find-skeleton (get-project-skeleton-name project))))) + (project-pathname (get-project-pathname project)) + (workdir (os-pwd))) + (cond ((eq :absolute (car (pathname-directory dir))) dir) + ((eq :absolute (car (pathname-directory project-pathname))) + (merge-pathnames dir project-pathname)) + (t (merge-n-directories workdir project-pathname dir))))))) + +(dolist (d (list + "src" + "bin" + "lib" + "doc" + "share" + "test" + "contrib" + "conf" + "public" + "script" + "cache" + "log" + "template" + "opt" + "tmp" + "target" + )) + (eval `(make-get-project-smth-dir ,d))) + +;; TODO: skeleton:create-from-project +;; TODO: show list of skeletons + +;; TODO: +add project name to skeleton dirs +;; TODO: +add package naming convension +;; TODO: +add build.jab sample for all skeletons +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;; extending defproject syntax +(bind-project-symbol + :skeleton + #'(lambda (x) + (declare (ignore x)))) ;;;; adding define-project-hook to load skeleton (add-hook *define-project-hook* #'load-project-skeleton) diff --git a/src/core/jabs-test/jabs-test.lisp b/src/core/jabs-test/jabs-test.lisp index c55154b..221cb6a 100644 --- a/src/core/jabs-test/jabs-test.lisp +++ b/src/core/jabs-test/jabs-test.lisp @@ -69,6 +69,9 @@ (defmacro filter-project-test-plugins (project) `(filter-project-plugins-by-type ,project :test)) +(defgeneric get-project-test-files (project plugin) + ) + (defmethod get-project-test-files ((project project) (plugin plugin)) "Parse modeline with test-engine: ex: ;;; -*- TestEngine: fiveam; -*- @@ -77,15 +80,12 @@ The logic is: if you don't have modeline, than all of your test files acceptable. Else, you should mark, what test engine do you use " - (let* ((skeleton (find-skeleton - (or (try (car (project-slot-value project 'skeleton))) - (try (project-slot-value project 'skeleton)) - *jabs-default-skeleton-name*))) + (let* ((skeleton (find-project-skeleton project)) (skeleton-test-dir (pathname-as-directory - (parse-namestring - (or (try (car (get-skeleton-test skeleton))) - (try (get-skeleton-test skeleton)) - "")))) + (parse-namestring + (or (try (car (get-skeleton-test skeleton))) + (try (get-skeleton-test skeleton)) + "")))) (project-pathname (pathname-as-directory (parse-namestring (or (project-slot-value project 'pathname) ""))))) @@ -116,22 +116,34 @@ Else, you should mark, what test engine do you use ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defgeneric run-single-test-with-plugins (name project) + ) + (defmethod run-single-test-with-plugins (name (project project)) (let ((plugins (filter-project-test-plugins project))) (plugins-api-call-to-true :run-single-test plugins name))) +(defgeneric run-single-suite-with-plugins (name project) + ) + (defmethod run-single-suite-with-plugins (name (project project)) (let ((plugins (filter-project-test-plugins project))) (plugins-api-call-to-true :run-single-suite plugins name))) +(defgeneric run-all-tests-with-plugins (project) + ) + (defmethod run-all-tests-with-plugins ((project project)) (let ((plugins (filter-project-test-plugins project))) (plugins-api-call-to-true :run-all-tests plugins))) ;; defun register-test-report-format +(defgeneric run-tests (project) + ) + (defmethod run-tests ((project project)) "Run tests, according to preconfiguration" (when (and diff --git a/src/jabs-plugin.lisp b/src/jabs-plugin.lisp index 423b09b..515447d 100644 --- a/src/jabs-plugin.lisp +++ b/src/jabs-plugin.lisp @@ -133,6 +133,9 @@ by many projects w/o requirement to set it as plugin in (jlog:info "Plugin ``~a'', type ``~a'' registered" plugin-id (get-plugin-type plugin)) t)))))) +(defgeneric share-plugin (plugin) + ) + (defmethod share-plugin ((plugin plugin)) "Add plugin to shared plugins" (push (concatenate-symbol *jabs-universal-delimiter* @@ -239,6 +242,9 @@ by many projects w/o requirement to set it as plugin in ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; LIB +(defgeneric filter-project-plugins-by-type (project type) + ) + (defmethod filter-project-plugins-by-type ((project project) type) "Get plugin names list of same type plugins from project and shared plugins" (check-type type keyword) -- GitLab From 178f1666c9a11ac9a9d31ca7561269bedffca346 Mon Sep 17 00:00:00 2001 From: Alexander Vynnyk Date: Mon, 6 Feb 2017 11:12:08 +0200 Subject: [PATCH 2/2] update doc --- doc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc b/doc index 66ea4a6..95da36d 160000 --- a/doc +++ b/doc @@ -1 +1 @@ -Subproject commit 66ea4a6b7df97fb745e50aa443d084040edd1487 +Subproject commit 95da36dee5faabbea9038301496ba6f274c36781 -- GitLab