From: Danny Milosavljevic <dannym@scratchpost.org>
To: 34531@debbugs.gnu.org
Subject: bug#34531: Guix profile fails on Overdrive 1000
Date: Wed, 20 Feb 2019 23:28:33 +0100 [thread overview]
Message-ID: <20190220232833.3a437681@scratchpost.org> (raw)
In-Reply-To: <20190220230857.2282d9b1@scratchpost.org>
[-- Attachment #1.1: Type: text/plain, Size: 645 bytes --]
On Wed, 20 Feb 2019 23:08:57 +0100
Danny Milosavljevic <dannym@scratchpost.org> wrote:
> 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.
Another example is tests/repo/pathspec.c where the vast majority of the file is missing.
In any case, leaving the call of skip-comments off, it finds 2611 tests in 349 suites (see attachment).
So either we find the problem in skip-comments, or we leave it off. In both cases, this can be used in order to generate the test metadata for libgit2 now.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: generate.scm --]
[-- Type: text/x-scheme, Size: 10721 bytes --]
;; -*- geiser-scheme-implementation: guile -*-
;;; Implementation: Danny Milosavljevic <dannym@scratchpost.org>
;;; 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) port))
((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* ((contents2 (skip-comments contents))
(entries (fold-matches (make-regexp
(string-append "^(void\\s+(test_"
name
"__(\\w+))\\s*\\(\\s*void\\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 entry "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-drop-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") "[] = {\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 "declaration")
";"))
(assoc-ref module "callbacks"))
"\n")
"\n"
(if (assoc-ref module "initialize")
(string-append "extern " (assoc-ref (assoc-ref module "initialize") "declaration") ";\n")
"")
(if (assoc-ref module "cleanup")
(string-append "extern " (assoc-ref (assoc-ref module "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)
(string<? (assoc-ref module-a "name")
(assoc-ref module-b "name")))
(define modules (sort (load) name<))
(define (suite-count)
(length modules))
(define (callback-count)
(fold + 0 (map (lambda (entry)
(length (assoc-ref entry "callbacks")))
modules)))
(define (display-x value)
(display value data))
(for-each (compose display-x DeclarationTemplate) modules)
(for-each (compose display-x CallbacksTemplate) modules)
(display-x "static struct clar_suite _clar_suites[] = {")
(display-x (string-join (map InfoTemplate modules) ","))
(display-x "\n};\n")
(let ((suite-count-str (number->string (suite-count)))
(callback-count-str (number->string (callback-count))))
(display-x "static const size_t _clar_suite_count = ")
(display-x suite-count-str)
(display-x ";\n")
(display-x "static const size_t _clar_callback_count = ")
(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-non-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)
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
next prev parent reply other threads:[~2019-02-20 22:29 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-02-18 20:05 bug#34531: Guix profile fails on Overdrive 1000 Andreas Enge
2019-02-18 20:49 ` Marius Bakke
2019-02-19 8:27 ` Andreas Enge
2019-02-19 13:23 ` Ricardo Wurmus
2019-02-19 15:19 ` Danny Milosavljevic
2019-02-20 10:51 ` Danny Milosavljevic
2019-02-20 11:46 ` Ricardo Wurmus
2019-02-20 13:26 ` Danny Milosavljevic
2019-02-20 15:56 ` Ricardo Wurmus
2019-02-20 16:26 ` Danny Milosavljevic
2019-02-20 20:53 ` Ricardo Wurmus
2019-02-20 22:08 ` Danny Milosavljevic
2019-02-20 22:28 ` Danny Milosavljevic [this message]
2019-02-23 11:20 ` Ricardo Wurmus
2019-02-24 10:40 ` Danny Milosavljevic
2019-02-24 11:45 ` Ricardo Wurmus
2019-02-24 12:12 ` Danny Milosavljevic
2019-02-26 21:07 ` Ricardo Wurmus
2019-02-20 13:28 ` Danny Milosavljevic
2019-02-19 15:35 ` Andreas Enge
2019-02-19 15:40 ` Danny Milosavljevic
2019-04-04 11:28 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190220232833.3a437681@scratchpost.org \
--to=dannym@scratchpost.org \
--cc=34531@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.