From mboxrd@z Thu Jan 1 00:00:00 1970 From: Danny Milosavljevic Subject: bug#34531: Guix profile fails on Overdrive 1000 Date: Wed, 20 Feb 2019 23:08:57 +0100 Message-ID: <20190220230857.2282d9b1@scratchpost.org> References: <20190218200552.GB1881@jurong> <87mumsom9l.fsf@fastmail.com> <20190219082728.GA5650@jurong> <87lg2bvrne.fsf@elephly.net> <20190219161954.47234638@scratchpost.org> <20190220115136.422bdf5b@scratchpost.org> <87va1eu1gp.fsf@elephly.net> <20190220142634.56868dba@scratchpost.org> <87k1hutpvw.fsf@elephly.net> <20190220172603.1a675f61@scratchpost.org> <87a7iq5gh8.fsf@elephly.net> Mime-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha256; boundary="Sig_/lR._XZIHMBGvr_bjxHS5M=g"; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([209.51.188.92]:57737) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gwa45-0005LR-6W for bug-guix@gnu.org; Wed, 20 Feb 2019 17:10:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gwa43-0002lC-Qs for bug-guix@gnu.org; Wed, 20 Feb 2019 17:10:05 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:57938) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gwa42-0002gG-Ha for bug-guix@gnu.org; Wed, 20 Feb 2019 17:10:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1gwa42-0001qk-40 for bug-guix@gnu.org; Wed, 20 Feb 2019 17:10:02 -0500 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <87a7iq5gh8.fsf@elephly.net> List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 34531@debbugs.gnu.org --Sig_/lR._XZIHMBGvr_bjxHS5M=g Content-Type: multipart/mixed; boundary="MP_/VP48/+qdshZALJq3nKstA.L" --MP_/VP48/+qdshZALJq3nKstA.L Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: quoted-printable Content-Disposition: inline First somewhat working version attached... It finds 1387 tests in 328 suites. The original finds 2611 tests in 349 suites. That's because skip-comments is somehow broken. An example where it has an error very early is tests/core/futils.c : (use-modules (ice-9 ftw)) (use-modules (ice-9 regex)) (use-modules (ice-9 getopt-long)) (use-modules (ice-9 rdelim)) (use-modules (ice-9 match)) (use-modules (ice-9 textual-ports)) (use-modules (srfi srfi-1)) (define fname "test/core/futils.c") (define s (call-with-input-file fname get-string-all)) (define (replace needle replacement haystack) "Replace all occurences of NEEDLE in HAYSTACK by REPLACEMENT. NEEDLE is a regular expression." (regexp-substitute/global #f needle haystack 'pre replacement 'post)) (define (skip-comments text) (replace (string-append "//[^\n]*?|" "/[*].*?[*]/|" "'([.]|[^'])*?'|" "\"([.]|[^\"])*?\"") "" text)) (write (skip-comments s)) ; very short, for some reason --MP_/VP48/+qdshZALJq3nKstA.L Content-Type: text/x-scheme Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename=generate.scm ;; -*- geiser-scheme-implementation: guile -*- ;;; Implementation: Danny Milosavljevic ;;; Based on: Implementation in Python by Vicent Marti. ;;; License: ISC, like the original generate.py in clar. (use-modules (ice-9 ftw)) (use-modules (ice-9 regex)) (use-modules (ice-9 getopt-long)) (use-modules (ice-9 rdelim)) (use-modules (ice-9 match)) (use-modules (ice-9 textual-ports)) (use-modules (srfi srfi-1)) (define (render-callback cb) (if cb (string-append " { \"" (assoc-ref cb "short-name") "\", &" (assoc-ref cb "symbol") " }") " { NULL, NULL }")) (define (rxegexp-substitute/global flags port regexp string . items) ;; If `port' is #f, send output to a string. (if (not port) (call-with-output-string (lambda (p) (apply regexp-substitute/global flags p regexp string items))) ;; Walk the set of non-overlapping, maximal matches. (let next-match ((matches (list-matches regexp string flags)) (start 0)) (if (null? matches) (display (substring string start) port) (let ((m (car matches))) ;; Process all of the items for this match. Don't use ;; for-each, because we need to make sure 'post at the ;; end of the item list is a tail call. (let next-item ((items items)) (define (do-item item) (cond ((string? item) (display item port)) ((integer? item) (display (match:substring m item) por= t)) ((procedure? item) (display (item m) port)) ((eq? item 'pre) (display (substring string start (match:start m)) port)) ((eq? item 'post) (next-match (cdr matches) (match:end m))) (else (error 'wrong-type-arg item)))) (if (pair? items) (if (null? (cdr items)) (do-item (car items)) ; This is a tail call. (begin (do-item (car items)) ; This is not. (next-item (cdr items))))))))))) (define (replace needle replacement haystack) "Replace all occurences of NEEDLE in HAYSTACK by REPLACEMENT. NEEDLE is a regular expression." (regexp-substitute/global #f needle haystack 'pre replacement 'post)) (define (skip-comments text) (replace (string-append "//[^\n]*?|" "/[*].*?[*]/|" "'([.]|[^'])*?'|" "\"([.]|[^\"])*?\"") "" text)) (define (maybe-only items) (match items ((a) a) (_ #f))) (define (Module name path excludes) (write name) (write path) (newline) (let* ((clean-name (replace "_" "::" name)) (enabled (not (any (lambda (exclude) (string-prefix? exclude clean-name)) excludes)))) (define (parse contents) (define (cons-match match prev) (cons `(("declaration" . ,(match:substring match 1)) ("symbol" . ,(match:substring match 2)) ("short-name" . ,(match:substring match 3))) prev)) (let* ((contents (skip-comments contents)) (entries (fold-matches (make-regexp (string-append "^(void\\s+(test_" name "__(\\w+))\\s*\\(\\s*vo= id\\s*\\))\\s*\\{") regexp/newline) contents '() cons-match)) (callbacks (filter (lambda (entry) (match (assoc-ref entry "short-name") ("initialize" #f) ("cleanup" #f) (_ #t))) entries))) (write callbacks) (newline) (if (> (length callbacks) 0) `(("name" . ,name) ("enabled" . ,(if enabled "1" "0")) ("clean-name" . ,clean-name) ("initialize" . ,(maybe-only (filter-map (lambda (entry) (match (assoc-ref ent= ry "short-name") ("initialize" entry) (_ #f))) entries))) ("cleanup" . ,(maybe-only (filter-map (lambda (entry) (match (assoc-ref entry = "short-name") ("cleanup" entry) (_ #f))) entries))) ("callbacks" . ,callbacks)) #f))) (define (refresh path) (and (file-exists? path) (parse (call-with-input-file path get-string-all)))) (refresh path))) (define (generate-TestSuite path output excludes) (define (load) (define enter? (const #t)) (define (leaf file stat result) (let* ((module-root (string-drop (dirname file) (string-length path))) (module-root (filter-map (match-lambda ("" #f) (a a)) (string-split module-root #\/)))) (define (make-module path) (let* ((name (string-join (append module-root (list (string-d= rop-right (basename path) (string-length ".c")))) "_")) (name (replace "-" "_" name))) (Module name path excludes))) (if (string-suffix? ".c" file) (let ((module (make-module file))) (if module (cons module result) result)) result))) (define (down dir stat result) result) (define (up file state result) result) (define skip (const #f)) (define error (const #f)) ; FIXME (file-system-fold enter? leaf down up skip error '() path)) (define (CallbacksTemplate module) (string-append "static const struct clar_func _clar_cb_" (assoc-ref module "name") "[] =3D {\n" (string-join (map render-callback (assoc-ref module "callbacks")) ",\n") "\n};\n")) (define (DeclarationTemplate module) (string-append (string-join (map (lambda (cb) (string-append "extern " (assoc-ref cb "decl= aration") ";")) (assoc-ref module "callbacks")) "\n") "\n" (if (assoc-ref module "initialize") (string-append "extern " (assoc-ref (assoc-ref mod= ule "initialize") "declaration") ";\n") "") (if (assoc-ref module "cleanup") (string-append "extern " (assoc-ref (assoc-ref mod= ule "cleanup") "declaration") ";\n") ""))) (define (InfoTemplate module) (string-append " { \"" (assoc-ref module "clean-name") "\", " (render-callback (assoc-ref module "initialize")) ", " (render-callback (assoc-ref module "cleanup")) ", _clar_cb_" (assoc-ref module "name") ", " (number->string (length (assoc-ref module "callbacks"))) ", " (assoc-ref module "enabled") " }")) (define (Write data) (define (name< module-a module-b) (stringstring (suite-count))) (callback-count-str (number->string (callback-count)))) (display-x "static const size_t _clar_suite_count =3D ") (display-x suite-count-str) (display-x ";\n") (display-x "static const size_t _clar_callback_count =3D ") (display-x callback-count-str) (display-x ";\n") (display (string-append "Written `clar.suite` (" callback-count-str " tests in " suite-count-str " suites)")) (newline)) #t) (call-with-output-file (string-append output "/clar.suite") Write)) ;;; main (define (main) (define option-spec '((force (single-char #\f) (value #f)) (exclude (single-char #\x) (value #t)) (output (single-char #\o) (value #t)) (help (single-char #\h) (value #f)))) (define options (getopt-long (command-line) option-spec #:stop-at-first-n= on-option #t)) (define args (reverse (option-ref options '() '()))) (when (> (length args) 1) (display "More than one path given\n") (exit 1)) (if (< (length args) 1) (set! args '("."))) (let* ((path (car args)) (output (option-ref options 'output path)) (excluded (filter-map (match-lambda (('exclude . value) value) (_ #f)) options))) (generate-TestSuite path output excluded))) (main) --MP_/VP48/+qdshZALJq3nKstA.L-- --Sig_/lR._XZIHMBGvr_bjxHS5M=g Content-Type: application/pgp-signature Content-Description: OpenPGP digital signature -----BEGIN PGP SIGNATURE----- iQEzBAEBCAAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAlxtz/kACgkQ5xo1VCww uqU1swf+Nx7zNqgtixg3I8YGIHyHJ0Ve1sUMOgoSDgQu/cyAZkVyeWefozSTen5P 3DS4IoYTbjg4FnZkqtX5udW80H6iyoxA82AxkXN9CT9nEXMDlLjwvxZzY8pUxIUp KO5VCSAsNuj9LTfu/RC2gtGdzuw+h2QTejlhEYu7eiBtA8eih3WYu975ZtjdZyaO J6xwmzpQauB6VlUmgn7TmUTm3jKkR2KlKGa5v26pZfb6eYQKv6sJSXt5FZkElfOz +AU4KnTlqKuu03TmBtoUyBRQ0tL0GCwJHP5fbuW/Dq/PNoGE3WPViEgf4K6hGjuJ bXDtpJm3e+l74rCco1FkR9W6iQr20A== =1MH8 -----END PGP SIGNATURE----- --Sig_/lR._XZIHMBGvr_bjxHS5M=g--