diff options
| -rw-r--r-- | gnu-system.am | 1 | ||||
| -rw-r--r-- | gnu/packages/patches/hop-bigloo-4.0b.patch | 122 | ||||
| -rw-r--r-- | gnu/packages/scheme.scm | 6 |
3 files changed, 128 insertions, 1 deletions
diff --git a/gnu-system.am b/gnu-system.am index 920e1383f7..2600858fe0 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -207,6 +207,7 @@ dist_patch_DATA = \ gnu/packages/patches/guile-default-utf8.patch \ gnu/packages/patches/guile-linux-syscalls.patch \ gnu/packages/patches/guile-relocatable.patch \ + gnu/packages/patches/hop-bigloo-4.0b.patch \ gnu/packages/patches/libevent-dns-tests.patch \ gnu/packages/patches/libtool-skip-tests.patch \ gnu/packages/patches/m4-gets-undeclared.patch \ diff --git a/gnu/packages/patches/hop-bigloo-4.0b.patch b/gnu/packages/patches/hop-bigloo-4.0b.patch new file mode 100644 index 0000000000..312bfdd117 --- /dev/null +++ b/gnu/packages/patches/hop-bigloo-4.0b.patch @@ -0,0 +1,122 @@ +Bigloo 4.0b removes `xml-attribute-encode', which leads to a build failure +in Hop. + +This patch allows Hop to be compiled with Bigloo 4.0b. + + +changeset: 3327:3515f7f1aef2 +branch: 2.4.x +user: Manuel Serrano <Manuel.Serrano@inria.fr> +date: Wed Jul 31 12:41:10 2013 +0200 +summary: Fix serialization bug + +diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/js_comp.scm +--- a/runtime/js_comp.scm Fri Jul 19 08:28:13 2013 +0200 ++++ b/runtime/js_comp.scm Wed Jul 31 12:41:10 2013 +0200 +@@ -143,10 +143,17 @@ + (display "{ " op) + (display-seq fields op + (lambda (f op) ++ (let ((iv (class-field-info f))) + (display "'" op) + (display (class-field-name f) op) + (display "': " op) +- (compile ((class-field-accessor f) obj) op))) ++ (cond ++ ((and (pair? iv) (memq :client iv)) ++ => ++ (lambda (x) ++ (compile (when (pair? (cdr x)) (cadr x)) op))) ++ (else ++ (compile ((class-field-accessor f) obj) op)))))) + (display "}" op)) + + (let ((klass (object-class obj))) +diff -r 7244c4d30ad4 -r 3515f7f1aef2 runtime/xml.scm +--- a/runtime/xml.scm Fri Jul 19 08:28:13 2013 +0200 ++++ b/runtime/xml.scm Wed Jul 31 12:41:10 2013 +0200 +@@ -55,6 +55,7 @@ + (generic xml-write-attribute ::obj ::obj ::output-port ::xml-backend) + (generic xml-write-expression ::obj ::output-port) + (xml-write-attributes ::pair-nil ::output-port ::xml-backend) ++ (xml-attribute-encode obj) + + (xml->string ::obj ::xml-backend) + +@@ -613,6 +614,52 @@ + (display ">" p)))) + + ;*---------------------------------------------------------------------*/ ++;* xml-attribute-encode ... */ ++;*---------------------------------------------------------------------*/ ++(define (xml-attribute-encode obj) ++ (if (not (string? obj)) ++ obj ++ (let ((ol (string-length obj))) ++ (define (count str ol) ++ (let loop ((i 0) ++ (j 0)) ++ (if (=fx i ol) ++ j ++ (let ((c (string-ref str i))) ++ ;; attribute values should escape &#... ++ (if (or (char=? c #\') (char=? c #\&)) ++ (loop (+fx i 1) (+fx j 5)) ++ (loop (+fx i 1) (+fx j 1))))))) ++ (define (encode str ol nl) ++ (if (=fx nl ol) ++ obj ++ (let ((nstr (make-string nl))) ++ (let loop ((i 0) ++ (j 0)) ++ (if (=fx j nl) ++ nstr ++ (let ((c (string-ref str i))) ++ (case c ++ ((#\') ++ (string-set! nstr j #\&) ++ (string-set! nstr (+fx j 1) #\#) ++ (string-set! nstr (+fx j 2) #\3) ++ (string-set! nstr (+fx j 3) #\9) ++ (string-set! nstr (+fx j 4) #\;) ++ (loop (+fx i 1) (+fx j 5))) ++ ((#\&) ++ (string-set! nstr j #\&) ++ (string-set! nstr (+fx j 1) #\#) ++ (string-set! nstr (+fx j 2) #\3) ++ (string-set! nstr (+fx j 3) #\8) ++ (string-set! nstr (+fx j 4) #\;) ++ (loop (+fx i 1) (+fx j 5))) ++ (else ++ (string-set! nstr j c) ++ (loop (+fx i 1) (+fx j 1)))))))))) ++ (encode obj ol (count obj ol))))) ++ ++;*---------------------------------------------------------------------*/ + ;* xml-write-attributes ... */ + ;*---------------------------------------------------------------------*/ + (define (xml-write-attributes attr p backend) +diff -r 7244c4d30ad4 -r 3515f7f1aef2 share/hop-serialize.js +--- a/share/hop-serialize.js Fri Jul 19 08:28:13 2013 +0200 ++++ b/share/hop-serialize.js Wed Jul 31 12:41:10 2013 +0200 +@@ -942,7 +942,7 @@ + case 0x2e /* . */: return null; + case 0x3c /* < */: return read_cnst(); + case 0x22 /* " */: return read_string( s ); +- case 0x25 /* " */: return decodeURIComponent( read_string( s ) ); ++ case 0x25 /* % */: return decodeURIComponent( read_string( s ) ); + case 0x55 /* U */: return read_string( s ); + case 0x5b /* [ */: return read_vector( read_size( s ) ); + case 0x28 /* ( */: return read_list( read_size( s ) ); +diff -r 7244c4d30ad4 -r 3515f7f1aef2 src/main.scm +--- a/src/main.scm Fri Jul 19 08:28:13 2013 +0200 ++++ b/src/main.scm Wed Jul 31 12:41:10 2013 +0200 +@@ -59,8 +59,6 @@ + (for-each register-srfi! (cons 'hop-server (hop-srfis))) + ;; set the library load path + (bigloo-library-path-set! (hop-library-path)) +- ;; define the Hop macros +- (hop-install-expanders!) + ;; setup the hop readers + (bigloo-load-reader-set! hop-read) + (bigloo-load-module-set! diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index eb339d7236..43853fa08c 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -251,6 +251,7 @@ between Scheme and C# programs.") "\\.so$"))))) %standard-phases)) #:tests? #f ; no test suite + #:patches (list (assoc-ref %build-inputs "patch/bigloo-4.0b")) #:modules ((guix build gnu-build-system) (guix build utils) (ice-9 popen) @@ -259,7 +260,10 @@ between Scheme and C# programs.") (srfi srfi-1)))) (inputs `(("bigloo" ,bigloo) ("which" ,which) - ("patchelf" ,patchelf))) + ("patchelf" ,patchelf) + + ("patch/bigloo-4.0b" + ,(search-patch "hop-bigloo-4.0b.patch")))) (home-page "http://hop.inria.fr/") (synopsis "A multi-tier programming language for the Web 2.0") (description |