Quality Assurance, Audit and Tags #14

Merged
kreyren merged 11 commits from QAaudit into central 2022-09-03 10:35:10 +02:00
17 changed files with 262 additions and 252 deletions
Showing only changes of commit 66772f99e8 - Show all commits

3
pmake

@ -1,3 +0,0 @@
#!/usr/bin/env sh
exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@"
!#

20
pman Executable file

@ -0,0 +1,20 @@
#!/usr/bin/env sh
# shellcheck shell=sh # Written to comply with IEEE Std 1003.1-2017 (POSIX)
# The Project Manager ("pman") -- GNU Guile-based solution for project management
# Copyright (C) 2022 Jacob Hrbek <kreyren@rixotstudio.cz>
#
# This file is Free/Libre Open-Source Software; you may copy, redistribute and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 2 of the License, or (at your option) any later version.
# This file is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public license along with this project. If not, see <http://www.gnu.org/licenses>
#
# This file incorporates work covered by the following copyright and permission notice:
#
# Copyright (C) 2017-2021 Mike Gran <spk121@yahoo.com>
#
# Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@"
!#

@ -20,11 +20,10 @@
;;; Commentary: ;;; Commentary:
;;; ;;;
;;; Backend for the `pmake` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual <https://www.gnu.org/software/guile/manual/html_node/getopt_002dlong.html>. ;;; Backend for the `pman` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual <https://www.gnu.org/software/guile/manual/html_node/getopt_002dlong.html>.
;;; ;;;
;;; Code: ;;; Code:
;; FIXME-QA(Krey): Is this even needed?
;; Declare exit codes ;; Declare exit codes
(define EXIT_SUCCESS 0) (define EXIT_SUCCESS 0)
(define EXIT_NOT_UP_TO_DATE 1) (define EXIT_NOT_UP_TO_DATE 1)

@ -16,13 +16,11 @@
(define-module (potato builtins) (define-module (potato builtins)
#:export (builtin-makevars #:export (builtin-makevars))
; builtin-rules
))
;;; Commentary: ;;; Commentary:
;;; ;;;
;;; Declaration of the built-in functionality such as variables and helper rules ;;; Dedicated to the declaration of built-in functionality such as variables, rules, tasks, etc..
;;; ;;;
;;; Code: ;;; Code:
@ -43,43 +41,4 @@
("GUILD" . "guild") ("GUILD" . "guild")
("GFLAGS" . "-W2"))) ("GFLAGS" . "-W2")))
;; FIXME(Krey): This was commented out by the original author and it's use needs to be abstracted and re-implemented
#;(define builtin-rules
`((".c"
""
(,~ ,($ CC) ,($ CFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<))
(".f"
""
(,~ ,($ FC) ,($ FFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<))
(".sh"
""
(,~ "cp" ,$< ,$@)
(,~ "chmod a+x" ,$@))
(".c"
".o"
(,~ ,($ CC) ,($ CFLAGS) -c ,$<))
(".f"
".o"
(,~ ,($ FC) ,($ FFLAGS) -c ,$<))
(".y"
".o"
(,~ ,($ YACC) ,($ YFLAGS) ,$<))
(".l"
".o"
(,~ ,($ LEX) ,($ LFLAGS) ,$<)
(,~ ,($ CC) ,($ CFLAGS) "-c" lex.yy.c)
"rm -f lex.yy.c"
(,~ "mv lex.yy.o" ,$@))
(".y"
".c"
(,~ ,($ YACC) ,($ YFLAGS) ,$<)
(,~ "mv y.tab.c" ,$@))
(".l"
".c"
(,~ ,($ LEX) ,($ LDFLAGS) ,$<)
("mv lex.yy.c" ,$@))
(".scm"
".go"
(,~ ,($ GUILD) "compile" ,($ GFLAGS) ,$<))))
;;; builtins.scm ends here ;;; builtins.scm ends here

@ -14,7 +14,7 @@
;;; ;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE
-(define-module (potato exceptions) (define-module (potato exceptions)
#:use-module (ice-9 exceptions) #:use-module (ice-9 exceptions)
#:export (bad-key-type #:export (bad-key-type
bad-value-type bad-value-type
@ -22,30 +22,44 @@
invalid-macro invalid-macro
not-a-regular-file not-a-regular-file
not-a-procedure not-a-procedure
no-read-access-to-file no-read-access-to-file))
))
;;; Commentary:
;;;
;;; Dedicated to handling 'exceptions' as in termination of the program
;;;
;;; Code:
;; FIXME-QA(Krey): This code is using 'bad' which is hard to understand without context, thus should be changed on 'unexpected'
(define (make-bad-key-type origin irritants) (define (make-bad-key-type origin irritants)
"Exception used when bad key is parsed to 'make' functionality"
(make-exception (make-exception
(make-programming-error) (make-programming-error)
(make-exception-with-origin origin) (make-exception-with-origin origin)
;; FIXME-TRANSLATE(Krey)
(make-exception-with-message "Wrong type for key. Expecting string or procedure.") (make-exception-with-message "Wrong type for key. Expecting string or procedure.")
(make-exception-with-irritants irritants))) (make-exception-with-irritants irritants)))
(define (bad-key-type origin irritant) (define (bad-key-type origin irritant)
"Generic exception for unexpected key"
(raise-exception (make-bad-key-type origin irritant))) (raise-exception (make-bad-key-type origin irritant)))
(define (make-bad-value-type origin irritants) (define (make-bad-value-type origin irritants)
"Exception for unexpected value in the 'make' functionality"
(make-exception (make-exception
(make-programming-error) (make-programming-error)
(make-exception-with-origin origin) (make-exception-with-origin origin)
;; FIXME-TRANSLATE(Krey)
(make-exception-with-message "Wrong type for value. Expecting string or procedure.") (make-exception-with-message "Wrong type for value. Expecting string or procedure.")
(make-exception-with-irritants irritants))) (make-exception-with-irritants irritants)))
(define (bad-value-type origin irritant) (define (bad-value-type origin irritant)
"Generic exception for unexpected value"
(raise-exception (make-bad-value-type origin irritant))) (raise-exception (make-bad-value-type origin irritant)))
(define (make-bad-proc-output origin irritants) (define (make-bad-proc-output origin irritants)
"Exception for unexpected process output in 'make' functionality"
(make-exception (make-exception
(make-programming-error) (make-programming-error)
(make-exception-with-origin origin) (make-exception-with-origin origin)
@ -53,9 +67,11 @@
(make-exception-with-irritants irritants))) (make-exception-with-irritants irritants)))
(define (bad-proc-output origin irritant) (define (bad-proc-output origin irritant)
"Generic exception for unexpected process output"
(raise-exception (make-bad-proc-output origin irritant))) (raise-exception (make-bad-proc-output origin irritant)))
(define (make-invalid-macro origin irritants) (define (make-invalid-macro origin irritants)
"Exception for invalid macro in 'make' functionality"
(make-exception (make-exception
(make-programming-error) (make-programming-error)
(make-exception-with-origin origin) (make-exception-with-origin origin)
@ -63,9 +79,11 @@
(make-exception-with-irritants irritants))) (make-exception-with-irritants irritants)))
(define (invalid-macro origin irritant) (define (invalid-macro origin irritant)
"Generic exception for invalid macro"
(raise-exception (make-invalid-macro origin irritant))) (raise-exception (make-invalid-macro origin irritant)))
(define (make-not-a-regular-file origin irritants) (define (make-not-a-regular-file origin irritants)
"Exception for not regular file in 'make' functionality"
(make-exception (make-exception
(make-programming-error) (make-programming-error)
(make-exception-with-origin origin) (make-exception-with-origin origin)
@ -73,9 +91,11 @@
(make-exception-with-irritants irritants))) (make-exception-with-irritants irritants)))
(define (not-a-regular-file origin irritant) (define (not-a-regular-file origin irritant)
"Generic exception for when regular file is not parsed"
(raise-exception (make-not-a-regular-file origin irritant))) (raise-exception (make-not-a-regular-file origin irritant)))
(define (make-not-a-procedure origin irritants) (define (make-not-a-procedure origin irritants)
"Exception for when regular file is not parsed in the 'make' functionality"
(make-exception (make-exception
(make-programming-error) (make-programming-error)
(make-exception-with-origin origin) (make-exception-with-origin origin)
@ -83,9 +103,11 @@
(make-exception-with-irritants irritants))) (make-exception-with-irritants irritants)))
(define (not-a-procedure origin irritant) (define (not-a-procedure origin irritant)
"Generic exception for when procedure is not parsed"
(raise-exception (make-not-a-procedure origin irritant))) (raise-exception (make-not-a-procedure origin irritant)))
(define (make-no-read-access-to-file origin irritants) (define (make-no-read-access-to-file origin irritants)
"Exception for when we don't have the expected read access to the file in 'make' functionality"
(make-exception (make-exception
(make-programming-error) (make-programming-error)
(make-exception-with-origin origin) (make-exception-with-origin origin)
@ -93,4 +115,7 @@
(make-exception-with-irritants irritants))) (make-exception-with-irritants irritants)))
(define (no-read-access-to-file origin irritant) (define (no-read-access-to-file origin irritant)
"Generic exception for when we don't have the excepted read access to the file"
(raise-exception (make-no-read-access-to-file origin irritant))) (raise-exception (make-no-read-access-to-file origin irritant)))
;;; exceptions.scm end here

@ -29,7 +29,6 @@
#:re-export (%suffix-rules #:re-export (%suffix-rules
lazy-assign ?= lazy-assign ?=
assign := assign :=
;; WTF(Krey): Why is the 'Q' here?
reference $ Q reference $ Q
reference-func $$ reference-func $$
target-rule : target-rule :
@ -47,26 +46,21 @@
;;; Commentary: ;;; Commentary:
;;; ;;;
;;; TBD ;;; Entry file to the project, designed for handling the functionality
;;; ;;;
;;; Code: ;;; Code:
;; FIXME-QA(Krey): This file includes debugging utilities that should be exported into a standalone library to make this software more maintainable
;; FIXME-QA(Krey): Needs refactor
;; FIXME-QA(Krey): Why is this here?
;; Project version ;; Project version
(define %version "1.0") (define %version "1.0")
;; WTF(Krey) ;; WTF(Krey)
(define %debug-argv0 #f) (define %debug-argv0 #f)
;; WTF(Krey): Was commented out by the original author.. no idea why ;; FIXME-DOCS(Krey): Lacks context
;; #:re-export (
;; lazy-assign ?=
;; assign :=
;; ref $
;; target-rule :
;; suffix-rule ->
;; compose ~
;; ))
;;; Asynchronous events. ;;; Asynchronous events.
;;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target ;;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target
;;; unless that target is a directory or the target is a prerequisite ;;; unless that target is a directory or the target is a prerequisite
@ -88,27 +82,31 @@
;;; If the -t option was specified, make shall write to standard ;;; If the -t option was specified, make shall write to standard
;;; output a message for each file that was touched. ;;; output a message for each file that was touched.
;;; Output handlers
;;; These handlers are designed to be used for debug management
;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose ;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose
(define %verbosity 2) (define %verbosity 2)
;; WTF(Krey) ;; WTF(Krey): Option to set verbose output and %verbosity defining the "deepness" of output?
(define %opt-verbose #f) (define %opt-verbose #f)
;; WTF(Krey) ;; WTF(Krey): Option to ignore errors?
(define %opt-ignore-errors #f) (define %opt-ignore-errors #f)
;; WTF(Krey) ;; WTF(Krey): Option to continue on errors?
(define %opt-continue-on-error #f) (define %opt-continue-on-error #f)
;; WTF(Krey) ;; WTF(Krey): Generic definition of targets for appending?
(define %targets '()) (define %targets '())
;; WTF(Krey) ;; WTF(Krey): No idea
(define %initialized #f) (define %initialized #f)
;; Output handlers
(define (critical spec . args) (define (critical spec . args)
"Output to handle 'cricital' output messages"
(apply format (append (list #t spec) args))) (apply format (append (list #t spec) args)))
;; FIXME-QA(Krey): The 'print' is too generic, should we rename it? ;; FIXME-QA(Krey): The 'print' is too generic, should we rename it?
(define (print spec . args) (define (print spec . args)
"Output to handle printing of output. Only works when verbosity is set to 2 and higher"
(when (>= %verbosity 2) (when (>= %verbosity 2)
(apply format (append (list #t spec) args)))) (apply format (append (list #t spec) args))))
(define (debug spec . args) (define (debug spec . args)
"Output to handle level 3 debug messages"
(when (>= %verbosity 3) (when (>= %verbosity 3)
(apply format (append (list #t spec) args)))) (apply format (append (list #t spec) args))))
@ -127,6 +125,7 @@
;; FIXME-QA(Krey): This is calling `format` multiple times to print one line which is resource inefficient ;; FIXME-QA(Krey): This is calling `format` multiple times to print one line which is resource inefficient
(define (display-help-and-exit argv0) (define (display-help-and-exit argv0)
"Function used to output help message and exit"
(format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0) (format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0)
(format #t " -h, --help print help and exit~%") (format #t " -h, --help print help and exit~%")
(format #t " -v, --version print version and exit~%") (format #t " -v, --version print version and exit~%")
@ -148,11 +147,11 @@
(format #t " ASCII only output and no colors~%") (format #t " ASCII only output and no colors~%")
(format #t " -S, --strict~%") (format #t " -S, --strict~%")
(format #t " causes some behaviours to throw errors~%") (format #t " causes some behaviours to throw errors~%")
;; FIXME-QA(Krey): 'exit'? It should be using 'throw'
(exit 0)) (exit 0))
;; FIXME-QA(Krey): Why is this accepting input?
(define (display-version-and-exit argv0) (define (display-version-and-exit argv0)
"Procedure to output the project version and exit" "Function to output the project version and exit"
(format #t "~a~%" argv0) (format #t "~a~%" argv0)
(format #t " using potato make~a~%" %version) (format #t " using potato make~a~%" %version)
(exit 0)) (exit 0))
@ -173,8 +172,7 @@ of pairs of KEY VAL"
lst)) lst))
(define (parse-targets lst) (define (parse-targets lst)
"Search the list for strings that don't have equals signs, and "Search the list for strings that don't have equals signs, and return them in a list."
return them in a list."
(filter-map (filter-map
(lambda (str) (lambda (str)
(if (string-index str #\=) (if (string-index str #\=)
@ -184,13 +182,7 @@ return them in a list."
(define* (initialize #:optional (define* (initialize #:optional
(arguments #f)) (arguments #f))
"Set up the options, rules, and makevars. If ARGUMENTS "Set up the options, rules, and makevars. If ARGUMENTS is not set, it will use options, makevars, and targets as specified by the command line. If it is set, it is expected to be a list of strings that are command-line arguments." ;; If left unset, assume user want all the command line arguments.
is not set, it will use options, makevars, and targets as
specified by the command line. If it is set, it is
expected to be a list of strings that are command-line
arguments."
;; If left unset, assume user want all the command line arguments.
(when (not arguments) (when (not arguments)
(set! arguments (command-line))) (set! arguments (command-line)))
;; If the user has set it to '(), expecting a null environment, add ;; If the user has set it to '(), expecting a null environment, add
@ -284,9 +276,7 @@ arguments."
%opt-no-execution %opt-no-execution
%verbosity %verbosity
%opt-ascii) %opt-ascii)
(set! %initialized #t) (set! %initialized #t) %targets)))
%targets
)))
(define* (execute #:key (targets '())) (define* (execute #:key (targets '()))
"This function runs build actions. TARGETS, if provided, is a list "This function runs build actions. TARGETS, if provided, is a list

@ -27,34 +27,54 @@
assign := assign :=
reference $ Q reference $ Q
reference-func $$ reference-func $$
dump-makevars dump-makevars))
))
;;; Commentary:
;;;
;;; Used to handle the 'makevars' functionality meaning assigning and managing environmental variables into variables used by guile
;;;
;;; Code:
;; Defines the priority level
;; There are five priority levels ;; There are five priority levels
;; 1. defined - in the script itself ;; 1. defined - in the script itself
;; 2. command-line ;; 2. command-line
;; 3. makeflags - in the MAKEFLAGS environment variable ;; 3. makeflags - in the MAKEFLAGS environment variable
;; 4. env - specified in the environment ;; 4. env - specified in the environment
;; 5. built-in - one of the built-in macros ;; 5. built-in - one of the built-in macros
;;
;; The lower priority level always win, unless the '-e' flag was set ;; The lower priority level always win, unless the '-e' flag was set
;; If the '-e' flag is set level 1 doesn't override level 3 and 4. ;; If the '-e' flag is set level 1 doesn't override level 3 and 4.
(define %level-name '("unknown"
"script"
"command-line"
"makeflags"
"environment"
"built-in"))
(define %level-name '("unknown" "script" "command-line" "makeflags" "environment" "built-in")) ;; WTF(Krey): No fucking idea.. something with ASCII? If ASCII is supported?
(define %ascii? #f) (define %ascii? #f)
;; WTF(Krey)
(define %makevars (make-hash-table)) (define %makevars (make-hash-table))
;; WTF(Krey)
(define %elevate-environment? #f) (define %elevate-environment? #f)
;; WTF(Krey)
(define %strict #f) (define %strict #f)
;; WTF(Krey)
(define %verbose? #t) (define %verbose? #t)
;; WTF(Krey)
(define (debug spec . args) (define (debug spec . args)
"Output to handle debugging messages"
(when %verbose? (when %verbose?
(apply format (append (list #t spec) args)))) (apply format (append (list #t spec) args))))
(define (split-at-equals str) (define (split-at-equals str)
"Splits the string at the first equals sign, ignoring "Splits the string at the first equals sign, ignoring later equals signs."
later equals signs."
(let ((idx (string-index str #\=))) (let ((idx (string-index str #\=)))
(if (and idx (> idx 0)) (if (and idx (> idx 0))
(cons (substring str 0 idx) (cons (substring str 0 idx)
@ -100,8 +120,7 @@ priority."
*unspecified*) *unspecified*)
(define (makevars-add-keyvals keyvals) (define (makevars-add-keyvals keyvals)
"Adds any suitable macros passed in from the command line, which "Adds any suitable macros passed in from the command line, which here are expected to be a list of key / val string pairs."
here are expected to be a list of key / val string pairs."
(for-each (for-each
(lambda (entry) (lambda (entry)
(let ((key (car entry)) (let ((key (car entry))
@ -112,8 +131,7 @@ here are expected to be a list of key / val string pairs."
keyvals)) keyvals))
(define (makevars-add-makeflags) (define (makevars-add-makeflags)
"Adds any suitable environment variables found in the MAKEFLAGS "Adds any suitable environment variables found in the MAKEFLAGS environment variable to the macro store"
environment variable to the macro store"
(let ((makeflags (getenv "MAKEFLAGS"))) (let ((makeflags (getenv "MAKEFLAGS")))
(when makeflags (when makeflags
(for-each (for-each
@ -128,8 +146,7 @@ environment variable to the macro store"
(string-split makeflags #\space))))) (string-split makeflags #\space)))))
(define (makevars-add-environment) (define (makevars-add-environment)
"Adds any suitable environment variables to the macro store, but not "Adds any suitable environment variables to the macro store, but not the value of MAKEFLAGS or SHELL."
the value of MAKEFLAGS or SHELL."
(for-each (for-each
(lambda (entry) (lambda (entry)
(let* ((keyval (split-at-equals entry)) (let* ((keyval (split-at-equals entry))
@ -147,6 +164,7 @@ the value of MAKEFLAGS or SHELL."
(makevars-set (car keyval) (cdr keyval) 5)) (makevars-set (car keyval) (cdr keyval) 5))
builtin-makevars)) builtin-makevars))
;; FIXME-DOCS(Krey)
(define (print-makevar key) (define (print-makevar key)
(let ((val (hash-ref %makevars key))) (let ((val (hash-ref %makevars key)))
(let ((keyval-string (let ((keyval-string
@ -240,6 +258,7 @@ the value of MAKEFLAGS or SHELL."
(newline))))) (newline)))))
keyvals)))) keyvals))))
;; FIXME-DOCS(Krey)
(define (initialize-makevars keyvals (define (initialize-makevars keyvals
environment? environment?
elevate-environment? elevate-environment?

1
src/zz-README.org Normal file

@ -0,0 +1 @@
Source code of the project