;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018, 2019 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 vulkan)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build-system cmake)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system meson)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages bison)
  #:use-module (gnu packages check)
  #:use-module (gnu packages cmake)
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages gl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages wine)
  #:use-module (gnu packages xorg))

(define-public spirv-headers
  (package
    (name "spirv-headers")
    (version "1.3.7")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/KhronosGroup/SPIRV-Headers")
             (c<pre>
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Jakob L. Kreuze &lt;zerodaysfordays@sdf.org&gt;
;;; Copyright © 2020 Danny Milosavljevic &lt;dannym@scratchpost.org&gt;
;;; Copyright © 2020, 2021 Brice Waegeneire &lt;brice@waegenei.re&gt;
;;; Copyright © 2021 raid5atemyhomework &lt;raid5atemyhomework@protonmail.com&gt;
;;;
;;; 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 &lt;http://www.gnu.org/licenses/&gt;.

(define-module (gnu tests linux-modules)
  #:use-module (gnu packages linux)
  #:use-module (gnu services)
  #:use-module (gnu services linux)
  #:use-module (gnu system)
  #:use-module (gnu system vm)
  #:use-module (gnu tests)
  #:use-module (guix derivations)
  #:use-module (guix gexp)
  #:use-module (guix modules)
  #:use-module (guix packages)
  #:use-module (guix monads)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:export (%test-loadable-kernel-modules-0
            %test-loadable-kernel-modules-1
            %test-loadable-kernel-modules-2
            %test-loadable-kernel-modules-service-0
            %test-loadable-kernel-modules-service-1
            %test-loadable-kernel-modules-service-2))

;;; Commentary:
;;;
;;; Test &lt;operating-system&gt; kernel-loadable-modules.
;;;
;;; Code:

(define* (modules-loaded?-program os modules)
  &quot;Return an executable store item that, upon being evaluated, will verify
that MODULES are actually loaded.&quot;
  (program-file
   &quot;verify-kernel-modules-loaded.scm&quot;
   #~(begin
     (use-modules (ice-9 rdelim)
                  (ice-9 popen)
                  (srfi srfi-1)
                  (srfi srfi-13))
     (let* ((port (open-input-pipe (string-append #$kmod &quot;/bin/lsmod&quot;)))
            (lines (string-split (read-string port) #\newline))
            (separators (char-set #\space #\tab))
            (modules (map (lambda (line)
                            (string-take line
                                         (or (string-index line separators)
                                             0)))
                          lines))
            (status (close-pipe port)))
       (and (= status 0)
            (and-map (lambda (module)
                       (member module modules string=?))
                     &apos;#$modules))))))

(define* (run-loadable-kernel-modules-test-base base-os module-names)
  &quot;Run a test of BASE-OS, verifying that MODULE-NAMES are loaded in memory.&quot;
  (define os
    (marionette-operating-system
     base-os
     #:imported-modules &apos;((guix combinators))))

  (define vm (virtual-machine os))

  (define (test script)
    (with-imported-modules &apos;((gnu build marionette))
      #~(begin
          (use-modules (gnu build marionette)
                       (srfi srfi-64))

          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin &quot;loadable-kernel-modules&quot;)
          (test-assert &quot;script successfully evaluated&quot;
            (marionette-eval
             &apos;(primitive-load #$script)
             marionette))
          (test-end))))

  (gexp-&gt;derivation &quot;loadable-kernel-modules&quot;
                    (test (modules-loaded?-program os module-names))))

(define* (run-loadable-kernel-modules-test module-packages module-names)
  &quot;Run a test of an OS having MODULE-PACKAGES, and verify that MODULE-NAMES
are loaded in memory.&quot;
  (run-loadable-kernel-modules-test-base
    (operating-system
      (inherit (simple-operating-system))
      (services (cons (service kernel-module-loader-service-type module-names)
                      (operating-system-user-services
                       (simple-operating-system))))
      (kernel-loadable-modules module-packages))
    module-names))

(define* (run-loadable-kernel-modules-service-test module-packages module-names)
  &quot;Run a test of an OS having MODULE-PACKAGES, which are loaded by creating a
service that extends LINUXL-LOADABLE-MODULE-SERVICE-TYPE. Then verify that
MODULE-NAMES are loaded in memory.&quot;
  (run-loadable-kernel-modules-test-base
    (operating-system
      (inherit (simple-operating-system))
      (services (cons* (simple-service &apos;installing-module
                                       linux-loadable-module-service-type
                                       module-packages)
                       (service kernel-module-loader-service-type module-names)
                       (operating-system-user-services
                        (simple-operating-system)))))
    module-names))

(define %test-loadable-kernel-modules-0
  (system-test
   (name &quot;loadable-kernel-modules-0&quot;)
   (description &quot;Tests loadable kernel modules facility of &lt;operating-system&gt;
with no extra modules.&quot;)
   (value (run-loadable-kernel-modules-test &apos;() &apos;()))))

(define %test-loadable-kernel-modules-1
  (system-test
   (name &quot;loadable-kernel-modules-1&quot;)
   (description &quot;Tests loadable kernel modules facility of &lt;operating-system&gt;
with one extra module.&quot;)
   (value (run-loadable-kernel-modules-test
           (list ddcci-driver-linux)
           &apos;(&quot;ddcci&quot;)))))

(define %test-loadable-kernel-modules-2
  (system-test
   (name &quot;loadable-kernel-modules-2&quot;)
   (description &quot;Tests loadable kernel modules facility of &lt;operating-system&gt;
with two extra modules.&quot;)
   (value (run-loadable-kernel-modules-test
           (list acpi-call-linux-module
                 (package
                   (inherit ddcci-driver-linux)
                   (arguments
                    `(#:linux #f
                      ,@(strip-keyword-arguments &apos;(#:linux)
                                                 (package-arguments
                                                  ddcci-driver-linux))))))
           &apos;(&quot;acpi_call&quot; &quot;ddcci&quot;)))))

(define %test-loadable-kernel-modules-service-0
  (system-test
   (name &quot;loadable-kernel-modules-service-0&quot;)
   (description &quot;Tests loadable kernel modules extensible service with no
extra modules.&quot;)
   (value (run-loadable-kernel-modules-service-test &apos;() &apos;()))))

(define %test-loadable-kernel-modules-service-1
  (system-test
   (name &quot;loadable-kernel-modules-service-1&quot;)
   (description &quot;Tests loadable kernel modules extensible service with one
extra module.&quot;)
   (value (run-loadable-kernel-modules-service-test
           (list ddcci-driver-linux)
           &apos;(&quot;ddcci&quot;)))))

(define %test-loadable-kernel-modules-service-2
  (system-test
   (name &quot;loadable-kernel-modules-service-2&quot;)
   (description &quot;Tests loadable kernel modules extensible service with two
extra modules.&quot;)
   (value (run-loadable-kernel-modules-service-test
           (list acpi-call-linux-module
                 (package
                   (inherit ddcci-driver-linux)
                   (arguments
                    `(#:linux #f
                      ,@(strip-keyword-arguments &apos;(#:linux)
                                                 (package-arguments
                                                  ddcci-driver-linux))))))
           &apos;(&quot;acpi_call&quot; &quot;ddcci&quot;)))))
</pre>
</div></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
         ; No tests.
       #:configure-flags (list (string-append "-DGLSLANG_INSTALL_DIR="
                               (assoc-ref %build-inputs "glslang")))))
    (home-page
     "https://github.com/KhronosGroup/Vulkan-Tools")
    (synopsis "Tools and utilities for Vulkan")
    (description
     "Vulkan-Tools provides tools and utilities that can assist development by
enabling developers to verify their applications correct use of the Vulkan
API.")
    (license (list license:asl2.0)))) ;LICENSE.txt

(define-public shaderc
  (package
    (name "shaderc")
    (version "2019.0")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/google/shaderc")
             (commit (string-append "v" version))))
       (file-name (git-file-name name version))
       (sha256
        (base32
         "1l5mmyxhzsbp0a6y2d86i8jmf46c6bjgjkdgkr5l8hmhflmm7gi2"))))
    (build-system meson-build-system)
    (arguments
     `(#:tests? #f ; FIXME: Tests fail.
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               ;; Remove various lines and touch build-version.inc or
               ;; configuring won't work.
               (invoke "touch" "glslc/src/build-version.inc")
               (substitute* "CMakeLists.txt" (("..PYTHON_EXE..*") ""))
               (substitute* "CMakeLists.txt"
                 ((".*update_build_version.py..*") ""))
               (substitute* "CMakeLists.txt"
                 ((".*add_custom_target.build-version.*") ""))
               (substitute* "CMakeLists.txt"
                 ((".*spirv-tools_SOURCE_DIR.*glslang_SOURCE_DIR.*")
                  ""))
               (substitute* "CMakeLists.txt"
                 ((".*Update build-version.inc.*") ""))
               (substitute* "CMakeLists.txt" ((".*--check.*") ""))
               (substitute* "glslc/src/main.cc" ((".*build-version.inc.*")
                                                 "\"1\""))
               (invoke "cmake" "-GNinja" "-DCMAKE_BUILD_TYPE=Release"
                       "-DSHADERC_SKIP_TESTS=ON"
                       "-DCMAKE_INSTALL_LIBDIR=lib"
                       (string-append "-DCMAKE_INSTALL_PREFIX="
                                      out)))))
         (add-after 'unpack 'unpack-sources
           (lambda* (#:key inputs #:allow-other-keys)
             (let ((spirv-tools-source (assoc-ref inputs "spirv-tools-source"))
                   (spirv-headers-source (assoc-ref inputs "spirv-headers-source"))
                   (glslang-source (assoc-ref inputs "glslang-source")))
               (copy-recursively spirv-tools-source "third_party/spirv-tools")
               (copy-recursively spirv-headers-source
                                 (string-append "third_party/spirv-tools"
                                                "/external/spirv-headers"))
               (copy-recursively glslang-source "third_party/glslang")
               #t))))))
    (inputs
     `(("googletest" ,googletest)
       ("python" ,python)))
    (native-inputs
     `(("cmake" ,cmake-minimal)
       ("glslang-source" ,(package-source glslang))
       ("pkg-config" ,pkg-config)
       ("spirv-headers-source" ,(package-source spirv-headers))
       ("spirv-tools-source" ,(package-source spirv-tools))))
    (home-page "https://github.com/google/shaderc")
    (synopsis "Tools for shader compilation")
    (description "Shaderc is a collection of tools, libraries, and tests for
shader compilation.")
    (license license:asl2.0)))

(define-public vkd3d
  (let ((commit "ecda316ef54d70bf1b3e860755241bb75873e53f")) ; Release 1.1.
    (package
     (name "vkd3d")
     (version "1.1")
     (source
      (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://source.winehq.org/git/vkd3d.git")
             (commit commit)))
       (sha256
        (base32
         "05a28kspy8gzng181w28zjqdb3pj2ss83b0lwnppxbcdzsz7rvrf"))
       (file-name (string-append name "-" version "-checkout"))))
     (build-system gnu-build-system)
     (arguments
      `(#:configure-flags '("--with-spirv-tools")))
     (native-inputs
      `(("autoconf" ,autoconf)
        ("automake" ,automake)
        ("gettext" ,gnu-gettext)
        ("libtool" ,libtool)
        ("pkg-config" ,pkg-config)))
     (inputs
      `(("libx11" ,libx11)
        ("libxcb" ,libxcb)
        ("spirv-headers" ,spirv-headers)
        ("spirv-tools" ,spirv-tools)
        ("vulkan-headers" ,vulkan-headers)
        ("vulkan-loader" ,vulkan-loader)
        ("wine-minimal" ,wine-minimal) ; Needed for 'widl'.
        ("xcb-util" ,xcb-util)
        ("xcb-util-keysyms" ,xcb-util-keysyms)
        ("xcb-util-wm" ,xcb-util-wm)))
     (home-page "https://source.winehq.org/git/vkd3d.git/")
     (synopsis "Direct3D 12 to Vulkan translation library")
     (description "vkd3d is a library for translating Direct3D 12 to Vulkan.")
     (license license:lgpl2.1))))