scheme-gnunet/tests/config-expand.scm

;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021 Maxime Devos
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet 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
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL3.0-or-later

(use-modules (gnu gnunet config parser)
	     (gnu gnunet config expand)
	     (srfi srfi-64))

(define (region=? line1 start1 end1
		  line2 start2 end2)
  (string=? (substring/shared line1 start1 end1)
	    (substring/shared line2 start2 end2)))

(define (query/not line start end)
  (error "this test should not call the query procedure"))

(define (region=?/not line1 start1 end1
		      line2 start2 end2)
  (error "this test should not call the region=? procedure"))

;; § Literals
(test-equal "literal"
  "text"
  (expand->string query/not region=?/not "text"
		  (list (make-literal-position 0 4))))

(test-equal "part of literal (1)"
  "text"
  (expand->string query/not region=?/not "some text"
		  (list (make-literal-position 5 9))))

(test-equal "part of literal (2)"
  "some"
  (expand->string query/not region=?/not "some text"
		  (list (make-literal-position 0 4))))

(test-equal "quotes are not removed"
  "'text'"
  (expand->string query/not region=?/not "'text'"
		  (list (make-literal-position 0 6))))

(test-equal "zero literals"
  ""
  (expand->string query/not region=?/not 'anything '()))

(test-equal "two overlapping literals"
  "spoon"
  (expand->string query/not region=?/not "spon"
		  (list (make-literal-position 0 3)
			(make-literal-position 2 4))))
;; § Variable references
(define (alist->query alist)
  (lambda (line start end)
    (let ((entry (assoc (substring line start end) alist)))
      (if entry
	  (apply values (cdr entry))
	  (error "this variable was not meant to be encountered"
		 line start end)))))

(test-equal "variable reference ($)"
  "iable"
  (expand->string (alist->query `(("var" "variable"
				   (,(make-literal-position 3 8)))))
		  region=?/not "$var"
		  (list (make-$-position 1 4))))

(test-equal "variable reference (${})"
  "iable"
  (expand->string (alist->query `(("var" "variable"
				   (,(make-literal-position 3 8)))))
		  region=?/not "${var}"
		  (list (#{make-${}-position}# 2 5))))

(test-equal "variable reference (${:-})"
  "iable"
  (expand->string (alist->query `(("var" "variable"
				   (,(make-literal-position 3 8)))))
		  region=?/not "${var:-default}"
		  (list (#{make-${:-}-position}# 2 5 7 14 '()))))

;; This is the expander, not the parser.
(test-equal "expander does not care about delimiters ($)"
  "iable"
  (expand->string (alist->query `(("#@}!/" "variable"
				   (,(make-literal-position 3 8)))))
		  region=?/not "${pre}#@}!/${post}"
		  (list (make-$-position 6 11))))

(test-equal "expander does not care about delimiters (${})"
  "iable"
  (expand->string (alist->query `(("#@}!/" "variable"
				   (,(make-literal-position 3 8)))))
		  region=?/not "${pre}#@}!/${post}"
		  (list (#{make-${}-position}# 6 11))))

(test-equal "expander does not care about delimiters (${:-})"
  "iable"
  (expand->string (alist->query `(("#@}!/" "variable"
				   (,(make-literal-position 3 8)))))
		  region=?/not "${pre}#@}!/${post}"
		  (list (#{make-${:-}-position}# 6 11 13 15 '()))))

(test-equal "undefined variable -> default (${:-})"
  "default"
  (expand->string (alist->query '(("var")))
		  region=?/not "var  default"
		  (list (#{make-${:-}-position}# 0 3 5 12
			 (list (make-literal-position 5 12))))))

(test-equal "undefined variable -> default (${:-}, recursive)"
  "default"
  (expand->string (alist->query `(("var")
				  ("var2" "default"
				   (,(make-literal-position 0 7)))))
		  region=?/not "var  var2"
		  (list (#{make-${:-}-position}# 0 3 5 9
			 (list (make-$-position 5 9))))))

;; § Exceptions (undefined variable)
;;
;; Convert the exception into a S-expression
;; to be able to compare results with @code{equal?}.
(define (expand->string/catch query region=? line expo-list)
  (with-exception-handler
      (lambda (e)
	(cond ((undefined-variable-error? e)
	       `(undefined-variable-error
		 (line ,(undefined-variable-line e))
		 (start ,(undefined-variable-start e))
		 (end ,(undefined-variable-end e))))
	      ((expansion-loop-error? e)
	       `(expansion-loop-error
		 (visited . ,(expansion-loop-error-visited e))))
	      (#t (error "what is this madness"))))
    (lambda ()
      (expand->string query region=? line expo-list))
    #:unwind? #t
    #:unwind-for-type &expansion-error))

(test-equal "undefined variable -> exception ($)"
  `(undefined-variable-error
    (line "var")
    (start 0)
    (end 3))
  (expand->string/catch (alist->query '(("var")))
			region=?/not "var"
			(list (make-$-position 0 3))))

(test-equal "undefined variable -> exception (${})"
  `(undefined-variable-error
    (line "var")
    (start 0)
    (end 3))
  (expand->string/catch (alist->query '(("var")))
			region=?/not "var"
			(list (#{make-${}-position}# 0 3))))

;; Like @code{region=?}, but #(line start end) must be in @var{acceptable}.
(define (region=?/restricted . acceptable)
  (lambda (line1 start1 end1 line2 start2 end2)
    (unless (and (member (vector line1 start1 end1) acceptable)
		 (member (vector line2 start2 end2) acceptable))
      (error "where did this variable reference come from?"
	     (vector line1 start1 end1)
	     (vector line2 start2 end2)))
    (region=? line1 start1 end1 line2 start2 end2)))

(test-equal "undefined variable (nested) -> exception ($, correct line)"
  `(undefined-variable-error
    (line "var1 = $var2")
    (start 8)
    (end 12))
  (expand->string/catch (alist->query `(("var1" "var1 = $var2"
					 (,(make-$-position 8 12)))
					("var2")))
			(region=?/restricted
			 #("$var1" 1 5)
			 #("var1 = $var2" 8 12))
			"$var1"
			(list (make-$-position 1 5))))

(test-equal "undefined variable (nested) -> exception (${}, correct line)"
  `(undefined-variable-error
    (line "var1 = ${var2}")
    (start 9)
    (end 13))
  (expand->string/catch (alist->query `(("var1" "var1 = ${var2}"
					 (,(#{make-${}-position}# 9 13)))
					("var2")))
			(region=?/restricted
			 #("$var1" 1 5)
			 #("var1 = ${var2}" 9 13))
			"$var1"
			(list (make-$-position 1 5))))

;; § Exceptions (loops)

;; Verify the line number information and verify the loopiness is
;; visible in the ‘visited’ list.

(test-equal "loop ($, $)"
  `(expansion-loop-error
    (visited #("var = the $variable" 11 19)
	     #("variable = $var" 12 15)
	     #("$variable" 1 9)))
  (expand->string/catch (alist->query `(("variable"
					 "variable = $var"
					 (,(make-$-position 12 15)))
					("var"
					 "var = the $variable"
					 (,(make-$-position 11 19)))))
			(region=?/restricted
			 #("variable = $var" 12 15)
			 #("var = the $variable" 11 19)
			 #("$variable" 1 9))
			"$variable"
			(list (make-$-position 1 9))))

(test-equal "loop (${}, ${})"
  `(expansion-loop-error
    (visited #("variable = ${var}" 13 16)
	     #("var = the ${variable}" 12 20)
	     #("$var" 1 4)))
  (expand->string/catch (alist->query `(("variable"
					 "variable = ${var}"
					 (,(#{make-${}-position}# 13 16)))
					("var"
					 "var = the ${variable}"
					 (,(#{make-${}-position}# 12 20)))))
			(region=?/restricted
			 #("variable = ${var}" 13 16)
			 #("var = the ${variable}" 12 20)
			 #("$var" 1 4))
			"$var"
			(list (#{make-$-position}# 1 4))))


(test-equal "loop (${:-}, ${:-})"
  `(expansion-loop-error
    (visited #("variable = ${var:-}" 13 16)
	     #("var = the ${variable:-}" 12 20)
	     #("$var" 1 4)))
  (expand->string/catch
   (alist->query `(("variable"
		    "variable = ${var:-}"
		    (,(#{make-${:-}-position}# 13 16 18 18 '())))
		   ("var"
		    "var = the ${variable:-}"
		    (,(#{make-${:-}-position}# 12 20 22 22 '())))))
   (region=?/restricted
    #("variable = ${var:-}" 13 16)
    #("var = the ${variable:-}" 12 20)
    #("$var" 1 4))
   "$var"
   (list (make-$-position 1 4))))

(test-equal "${:-} with default --> no visited entry"
  `(expansion-loop-error
    (visited #("var = $var" 7 10)
	     #("${does-not-exist:-$var}" 19 22)))
  (expand->string/catch
   (alist->query `(("var" "var = $var"
		    (,(make-$-position 7 10)))
		   ("does-not-exist")))
   (region=?/restricted
    #("var = $var" 7 10)
    #("${does-not-exist:-$var}" 19 22))
   "${does-not-exist:-$var}"
   (list (#{make-${:-}-position}# 2 16 18 22
	  (list (make-$-position 19 22))))))

;; This should _not_ lead to an &expansion-loop-error.
(test-equal "variable expanded multiple times"
  "example example"
  (expand->string/catch
   (alist->query `(("var" "example"
		    (,(make-literal-position 0 7)))))
   region=?/not
   "var "
   (list (make-$-position 0 3)
	 (make-literal-position 3 4)
	 (make-$-position 0 3))))