Add function for creating an 'environ'

* geesh/environment.scm (environment->environ): New function.
* tests/environment.scm: Test it.

geesh/environment.scm

@@ -23,7 +23,8 @@
             make-environment
             environment?
             var-ref
-            set-var!))
+            set-var!
+            environment->environ))
 
 ;;; Commentary:
 ;;;
@@ -51,3 +52,19 @@
   (set-environment-vars! env (acons name val
                                     (environment-vars env))))
 
+(define* (environment->environ env #:optional (bindings '()))
+  "Convert the environment variables from @var{env} into a list of
+@code{\"name=value\"} strings (an @dfn{environ}).  If @var{bindings}
+is set to a list of pairs of strings, those name-value pairs take
+precedence over the ones in @var{env}."
+  (let loop ((env-vars (append bindings (environment-vars env)))
+             (acc '())
+             (seen '()))
+    (match env-vars
+      (((name . value) . rest)
+       (if (member name seen)
+           (loop rest acc seen)
+           (loop rest
+                 (cons (string-append name "=" value) acc)
+                 (cons name seen))))
+      (() acc))))

tests/environment.scm

@@ -18,6 +18,7 @@
 
 (define-module (test-environment)
   #:use-module (geesh environment)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
   #:use-module (tests automake))
 
@@ -55,4 +56,51 @@
   (let ((env (make-environment '())))
     (var-ref env "FOO")))
 
+;;;
+;;; Making an 'environ'.
+;;;
+
+(define (subset? lst1 lst2)
+  "Test if @var{lst1} is a subset of @var{lst2}."
+  (every (lambda (x) (member x lst2)) lst1))
+
+(define (set=? lst1 lst2)
+  "Test if @var{lst1} is @code{equal?} to @var{lst2} without respect
+to order."
+  (and (subset? lst1 lst2)
+       (subset? lst2 lst1)))
+
+(test-equal "Creates environ from empty environment"
+  '()
+  (let ((env (make-environment '())))
+    (environment->environ env)))
+
+(test-assert "Creates environ from environment"
+  (let* ((env (make-environment '(("FOO" . "abc")
+                                  ("BAR" . "def"))))
+         (environ (environment->environ env)))
+    (set=? environ '("FOO=abc" "BAR=def"))))
+
+(test-assert "Creates environ from empty environment and bindings"
+  (let* ((env (make-environment '()))
+         (bindings '(("FOO" . "abc")
+                     ("BAR" . "def")))
+         (environ (environment->environ env bindings)))
+    (set=? environ '("FOO=abc" "BAR=def"))))
+
+(test-assert "Creates environ from environment and bindings"
+  (let* ((env (make-environment '(("FOO" . "abc")
+                                  ("BAZ" . "ghi"))))
+         (bindings '(("BAR" . "def")
+                     ("QUUX" . "jkl")))
+         (environ (environment->environ env bindings)))
+    (set=? environ '("FOO=abc" "BAR=def" "BAZ=ghi" "QUUX=jkl"))))
+
+(test-assert "Bindings override environment when creating an environ"
+  (let* ((env (make-environment '(("FOO" . "abc")
+                                  ("BAR" . "def"))))
+         (bindings '(("FOO" . "ghi")))
+         (environ (environment->environ env bindings)))
+    (set=? environ '("FOO=ghi" "BAR=def"))))
+
 (test-end)