gnu/packages/ada.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org>
   3 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
   4 ;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu packages ada)
  22   #:use-module ((guix licenses) #:prefix license:)
  23   #:use-module (guix build-system gnu)
  24   #:use-module (guix build-system python)
  25   #:use-module (guix packages)
  26   #:use-module (guix download)
  27   #:use-module (guix git-download)
  28   #:use-module (gnu packages)
  29   #:use-module (gnu packages base)
  30   #:use-module (gnu packages check)
  31   #:use-module (gnu packages compression)
  32   #:use-module (gnu packages python)
  33   #:use-module (gnu packages python-xyz)
  34   #:use-module (ice-9 match))
  35
  36 (define-public ada/ed
  37   (package
  38     (name "ada-ed")
  39     (version "1.11.2")
  40     (source
  41      (origin
  42        (method git-fetch)
  43        (uri (git-reference
  44              ;; The HOME-PAGE sources, mirrored by one of the original authors.
  45              (url "https://github.com/daveshields/AdaEd")
  46              (commit "57daecfb7ccadfd9aaf13b4d54f51065affbe599")))
  47        (sha256
  48         (base32 "1k97a8nqsvbsadizrmhhypcx758sxqkai8wq3ckk853qxvzaasd8"))
  49        (file-name (git-file-name name version))))
  50     (build-system gnu-build-system)
  51     (supported-systems (list "i686-linux" "x86_64-linux"
  52                              "armhf-linux" "aarch64-linux"
  53                              "powerpc-linux"))
  54     (outputs (list "out" "debug"))
  55     (arguments
  56      `(#:system
  57        ,@(match (%current-system)
  58            ;; This package predates 64-bit PCs: a ‘64-bit’ adaexec segfaults.
  59            ;; Force a 32-bit build targeting a similar architecture.
  60            ("aarch64-linux"
  61             `("armhf-linux"))
  62            ("x86_64-linux"
  63             `("i686-linux"))
  64            (_
  65             (list (%current-system))))
  66        #:make-flags
  67        (let ((out (assoc-ref %outputs "out")))
  68          (list (string-append
  69                 "CFLAGS=-g"             ; compile with :debug symbols
  70                 " -DOP_SYS='\"GNU\"'"   ; sic; quoting gets mangled somewhere
  71                 " -DSYSTEM_V"           ; closest to modern GNU
  72                 " -DWORDSIZE32"
  73                 " -DALIGN4")            ; suffices on both x86 and ARM
  74                "LFLAGS="                ; don't link against -lg
  75                (string-append "BINDIR=" out "/bin")
  76                (string-append "LIBDIR=" out "/lib")
  77                (string-append "MANDIR=" out "/share/man")))
  78        #:modules ((guix build gnu-build-system)
  79                   (guix build utils)
  80                   (srfi srfi-26))
  81        #:phases
  82        (modify-phases %standard-phases
  83          (add-after 'unpack 'patch-sources
  84            (lambda _
  85              ;; Rename the custom (and incompatible) getline() implementation.
  86              (substitute* "adalex.c"
  87                (("getline") "adaed_getline"))
  88              ;; Work around ‘error: initializer element is not constant’ by not
  89              ;; initialising MSGFILE.
  90              (substitute* "vars.ch"
  91                (("INIT\\(stdout\\)") ""))
  92              #t))
  93          (delete 'configure)            ; no configure script
  94          (add-before 'build 'find-build-scripts
  95            (lambda _
  96              (setenv "PATH" (string-append ".:" (getenv "PATH")))
  97              #t))
  98          (add-after 'build 'build-predef
  99            (lambda* (#:key make-flags #:allow-other-keys)
 100              ;; These aren't otherwise compiled until the ‘install’ phase.
 101              (apply invoke "make" "predef" make-flags)
 102              #t))
 103          (delete 'check)                ; no test suite; run our own below
 104          (add-before 'install 'create-output-directories
 105            (lambda* (#:key outputs #:allow-other-keys)
 106              (let ((out (assoc-ref outputs "out")))
 107                (mkdir-p (string-append out "/share/man/manl"))
 108                #t)))
 109          (add-after 'install 'check
 110            ;; Run most of the included demos as our own ‘test suite’.
 111            (lambda* (#:key outputs tests? #:allow-other-keys)
 112              (let ((out (assoc-ref outputs "out")))
 113                (when tests?
 114                  (setenv "ADAED" (string-append out "/lib"))
 115                  (setenv "PATH" (string-append out "/bin:" (getenv "PATH")))
 116                  (with-directory-excursion "demos" ; won't run outside of it
 117                    (for-each
 118                     delete-file
 119                     '("runc"   ; ‘invalid data. Please make it a positive no.’
 120                       "rund"   ; deadlocks by design
 121                       "rune"   ; ‘dining2.ada: No such file or directory’
 122                       "rung")) ; ‘mathlib cannot be used as a library’ (!)
 123                    (for-each (lambda (script)
 124                                (format #t "\n=== Invoking ~a ===\n" script)
 125                                (invoke script))
 126                              (find-files "." "^run")))))))
 127          (add-after 'install 'clean-up-output
 128            (lambda* (#:key outputs #:allow-other-keys)
 129              (let ((out (assoc-ref outputs "out")))
 130                (with-directory-excursion out
 131                  ;; These needn't be executable.
 132                  (for-each (cut chmod <> #o644)
 133                            (append (find-files "lib" "\\....$")
 134                                    (find-files "share" ".")))
 135                  #t)))))))
 136     (native-inputs
 137      (list sed))
 138     (home-page (string-append "https://web.archive.org/web/20140902150609/"
 139                               "http://www2.informatik.uni-stuttgart.de/iste/ps/"
 140                               "ada-software/html/dos_ada.html"))
 141     (synopsis "Ada 83 interpreter")
 142     (description "Ada/Ed is a translator-interpreter for Ada 83.  It's intended
 143 primarily as a teaching tool and lacks the capacity, performance, and robustness
 144 of other contemporary or modern-day Ada compilers.
 145
 146 Ada/Ed was the first Ada compiler to pass the @acronym{ACVC, Ada Compiler
 147 Validation Suite} version 1.7 but fails many newer tests and is not a validated
 148 Ada system.  Being an interpreter, it does not implement most representation
 149 clauses, and thus does not support systems programming close to the machine
 150 level.")
 151     (license license:gpl2+)))