aboutsummaryrefslogtreecommitdiff
path: root/gnu/packages/marst.scm
blob: 9b4db8be635c2faff72c76fcfff45556c6669bb4 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
;;; GNU Guix --- Functional package management for GNU
;;; Copyright 2016 John Darrington <jmd@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages marst)
  #:use-module (guix packages)
  #:use-module (guix licenses)
  #:use-module (guix download)
  #:use-module (gnu packages compression)
  #:use-module (guix build-system gnu))

(define-public marst
  (package
    (name "marst")
    (version "2.7")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "mirror://gnu/" name "/" name "-" version
             ".tar.gz"))
       (sha256
        (base32 "0l6swjy8fjrqw89ghc1vvakg21jmpfkpsw92yssrzkg3rg8vkrry"))))
    (build-system gnu-build-system)
    (home-page "https://www.gnu.org/software/marst/")
    (synopsis "Algol-to-C translator")
    (description
     "GNU MARST is an Algol-to-C translator.  The package consists of the
translator itself, a library that contains the necessary Algol 60 procedures,
and a converter that converts existing Algol 60 programs from other
representations to the MARST representation.")
    (license gpl3+)))
pleted (list (build "foo.drv" "x86_64-linux" #:log-file "foo.log"))) (downloads-completed (list (download "baz" "http://example.org/baz" #:size 500 #:transferred 500 #:start 'now #:end 'now) (download "bar" "http://example.org/bar" #:size 999 #:transferred 999 #:start 'now #:end 'now))))) ;; Below we omit 'substituter-started' events and the like. (let ((port get-status (build-event-output-port (lambda (event status) (compute-status event status #:current-time (const 'now)))))) (display "@ build-started foo.drv - x86_64-linux foo.log\n" port) (display "@ download-started bar http://example.org/bar 999\n" port) (display "various\nthings\nget\nwritten\n" port) (display "@ download-progress baz http://example.org/baz 500 42\n" port) (let ((first (get-status))) (display "@ build-succeeded foo.drv\n" port) (display "@ download-succeeded bar http://example.org/bar 999\n" port) (display "Almost done!\n" port) (display "@ substituter-succeeded baz\n" port) (list first (get-status))))) (test-equal "build-output-port, UTF-8" '((build-log #f "lambda is λ!\n")) (let ((port get-status (build-event-output-port cons '())) (bv (string->utf8 "lambda is λ!\n"))) (put-bytevector port bv) (force-output port) (get-status))) (test-equal "build-output-port, daemon messages with LF" '((build-log #f "updating substitutes... 0%\r") (build-log #f "updating substitutes... 50%\r") (build-log #f "updating substitutes... 100%\r")) (let ((port get-status (build-event-output-port cons '()))) (for-each (lambda (suffix) (let ((bv (string->utf8 (string-append "updating substitutes... " suffix "\r")))) (put-bytevector port bv) (force-output port))) '("0%" "50%" "100%")) (reverse (get-status)))) (test-equal "current-build-output-port, UTF-8 + garbage" ;; What about a mixture of UTF-8 + garbage? (let ((replacement "�")) `((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n")))) (let ((port get-status (build-event-output-port cons '()))) (display "garbage: " port) (put-bytevector port #vu8(128)) (put-bytevector port (string->utf8 "lambda: λ\n")) (force-output port) (get-status))) (test-equal "compute-status, multiplexed build output" (list (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121))) (downloading (list (download "bar" "http://example.org/bar" #:size 999 #:start 'now)))) (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121))) (downloading (list (download "bar" "http://example.org/bar" #:size 999 #:transferred 42 #:start 'now)))) (build-status ;; "bar" is now only listed as a download. (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121))) (downloads-completed (list (download "bar" "http://example.org/bar" #:size 999 #:transferred 999 #:start 'now #:end 'now))))) (let ((port get-status (build-event-output-port (lambda (event status) (compute-status event status #:current-time (const 'now) #:derivation-path->output-path (match-lambda ("bar.drv" "bar"))))))) (display "@ build-started foo.drv - x86_64-linux 121\n" port) (display "@ build-started bar.drv - armhf-linux bar.log 144\n" port) (display "@ build-log 121 6\nHello!" port) (display "@ build-log 144 50 @ download-started bar http://example.org/bar 999\n" port) (let ((first (get-status))) (display "@ build-log 121 30\n@ build-started FAKE!.drv 555\n") (display "@ build-log 144 54 @ download-progress bar http://example.org/bar 999 42\n" port) (let ((second (get-status))) (display "@ download-succeeded bar http://example.org/bar 999\n" port) (display "@ build-succeeded foo.drv\n" port) (display "@ build-succeeded bar.drv\n" port) (list first second (get-status)))))) (test-equal "compute-status, build completion" (list (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121)))) (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121 #:completion 0.)))) (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121 #:completion 50.)))) (build-status (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121 #:completion 100.))))) (let ((port get-status (build-event-output-port (lambda (event status) (compute-status event status #:current-time (const 'now)))))) (display "@ build-started foo.drv - x86_64-linux 121\n" port) (display "@ build-log 121 6\nHello!" port) (let ((first (get-status))) (display "@ build-log 121 20\n[ 0/100] building X\n" port) (display "@ build-log 121 6\nHello!" port) (let ((second (get-status))) (display "@ build-log 121 20\n[50/100] building Y\n" port) (display "@ build-log 121 6\nHello!" port) (let ((third (get-status))) (display "@ build-log 121 21\n[100/100] building Z\n" port) (display "@ build-log 121 6\nHello!" port) (display "@ build-succeeded foo.drv\n" port) (list first second third (get-status))))))) (test-equal "compute-status, build phase" (list (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121 #:phase 'configure)))) (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121 #:phase 'configure #:completion 50.)))) (build-status (building (list (build "foo.drv" "x86_64-linux" #:id 121 #:phase 'install)))) (build-status (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121 #:phase 'install))))) (let ((port get-status (build-event-output-port (lambda (event status) (compute-status event status #:current-time (const 'now)))))) (display "@ build-started foo.drv - x86_64-linux 121\n" port) (display "@ build-log 121 27\nstarting phase `configure'\n" port) (display "@ build-log 121 6\nabcde!" port) (let ((first (get-status))) (display "@ build-log 121 20\n[50/100] building Y\n" port) (display "@ build-log 121 6\nfghik!" port) (let ((second (get-status))) (display "@ build-log 121 21\n[100/100] building Z\n" port) (display "@ build-log 121 25\nstarting phase `install'\n" port) (display "@ build-log 121 6\nlmnop!" port) (let ((third (get-status))) (display "@ build-succeeded foo.drv\n" port) (list first second third (get-status))))))) (test-end "status")