fix some tests broken by the prepend change.
parent
915176822b
commit
180ad0aabf
|
@ -144,8 +144,8 @@ redirects ;
|
||||||
pick header>> set-at ;
|
pick header>> set-at ;
|
||||||
|
|
||||||
: set-basic-auth ( request username password -- request )
|
: set-basic-auth ( request username password -- request )
|
||||||
":" glue >base64 "Basic " prepend "Authorization" set-header ;
|
":" glue >base64 "Basic " "" prepend-as "Authorization" set-header ;
|
||||||
|
|
||||||
: <request> ( -- request )
|
: <request> ( -- request )
|
||||||
request new
|
request new
|
||||||
"1.1" >>version
|
"1.1" >>version
|
||||||
|
|
|
@ -153,18 +153,18 @@ SYMBOL: end
|
||||||
GENERIC: >ber ( obj -- byte-array )
|
GENERIC: >ber ( obj -- byte-array )
|
||||||
M: fixnum >ber ( n -- byte-array )
|
M: fixnum >ber ( n -- byte-array )
|
||||||
>128-ber dup length 2 swap 2array
|
>128-ber dup length 2 swap 2array
|
||||||
"cc" pack-native prepend ;
|
"cc" pack-native B{ } prepend-as ;
|
||||||
|
|
||||||
: >ber-enumerated ( n -- byte-array )
|
: >ber-enumerated ( n -- byte-array )
|
||||||
>128-ber >byte-array dup length 10 swap 2array
|
>128-ber dup length 10 swap 2array
|
||||||
"CC" pack-native prepend ;
|
"CC" pack-native B{ } prepend-as ;
|
||||||
|
|
||||||
: >ber-length-encoding ( n -- byte-array )
|
: >ber-length-encoding ( n -- byte-array )
|
||||||
dup 127 <= [
|
dup 127 <= [
|
||||||
1array "C" pack-be
|
1array "C" pack-be
|
||||||
] [
|
] [
|
||||||
1array "I" pack-be 0 swap remove dup length
|
1array "I" pack-be 0 swap remove dup length
|
||||||
0x80 + 1array "C" pack-be prepend
|
0x80 + 1array "C" pack-be B{ } prepend-as
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
! =========================================================
|
! =========================================================
|
||||||
|
@ -172,11 +172,11 @@ M: fixnum >ber ( n -- byte-array )
|
||||||
! =========================================================
|
! =========================================================
|
||||||
|
|
||||||
M: bignum >ber ( n -- byte-array )
|
M: bignum >ber ( n -- byte-array )
|
||||||
>128-ber >byte-array dup length
|
>128-ber dup length
|
||||||
dup 126 > [
|
dup 126 > [
|
||||||
"range error in bignum" throw
|
"range error in bignum" throw
|
||||||
] [
|
] [
|
||||||
2 swap 2array "CC" pack-native prepend
|
2 swap 2array "CC" pack-native B{ } prepend-as
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
! =========================================================
|
! =========================================================
|
||||||
|
|
|
@ -216,8 +216,8 @@ M: uniform-tuple (bind-uniforms)
|
||||||
dup texture-uniform = [ drop 1 ] [ "uniform-tuple-texture-units" word-prop 0 or ] if ;
|
dup texture-uniform = [ drop 1 ] [ "uniform-tuple-texture-units" word-prop 0 or ] if ;
|
||||||
|
|
||||||
: all-uniform-tuple-slots ( class -- slots )
|
: all-uniform-tuple-slots ( class -- slots )
|
||||||
dup "uniform-tuple-slots" word-prop
|
dup "uniform-tuple-slots" word-prop
|
||||||
[ swap superclass all-uniform-tuple-slots prepend ] [ drop { } ] if* ;
|
[ [ superclass all-uniform-tuple-slots ] dip append ] [ drop { } ] if* ;
|
||||||
|
|
||||||
DEFER: uniform-texture-accessors
|
DEFER: uniform-texture-accessors
|
||||||
|
|
||||||
|
@ -464,7 +464,7 @@ DEFER: [bind-uniform-tuple]
|
||||||
quot-prefix prepend
|
quot-prefix prepend
|
||||||
] 2map :> ( texture-unit' value-cleave )
|
] 2map :> ( texture-unit' value-cleave )
|
||||||
|
|
||||||
texture-unit'
|
texture-unit'
|
||||||
value>>-quot { value-cleave 2cleave } append ;
|
value>>-quot { value-cleave 2cleave } append ;
|
||||||
|
|
||||||
:: [bind-uniform] ( texture-unit uniform prefix -- texture-unit' quot )
|
:: [bind-uniform] ( texture-unit uniform prefix -- texture-unit' quot )
|
||||||
|
|
|
@ -8,7 +8,7 @@ combinators.short-circuit literals splitting ;
|
||||||
IN: mason.report
|
IN: mason.report
|
||||||
|
|
||||||
: git-link ( id -- link )
|
: git-link ( id -- link )
|
||||||
[ "http://github.com/slavapestov/factor/commit/" prepend ] keep
|
[ "http://github.com/slavapestov/factor/commit/" "" prepend-as ] keep
|
||||||
[XML <a href=<->><-></a> XML] ;
|
[XML <a href=<->><-></a> XML] ;
|
||||||
|
|
||||||
: common-report ( -- xml )
|
: common-report ( -- xml )
|
||||||
|
@ -44,7 +44,7 @@ IN: mason.report
|
||||||
[
|
[
|
||||||
error [ error. ] with-string-writer :> error
|
error [ error. ] with-string-writer :> error
|
||||||
file utf8 400 file-tail :> output
|
file utf8 400 file-tail :> output
|
||||||
|
|
||||||
[XML
|
[XML
|
||||||
<h2><-what-></h2>
|
<h2><-what-></h2>
|
||||||
Build output:
|
Build output:
|
||||||
|
@ -118,7 +118,7 @@ IN: mason.report
|
||||||
test-all-vocabs-file
|
test-all-vocabs-file
|
||||||
test-all-errors-file
|
test-all-errors-file
|
||||||
error-dump
|
error-dump
|
||||||
|
|
||||||
"Help lint failures"
|
"Help lint failures"
|
||||||
help-lint-vocabs-file
|
help-lint-vocabs-file
|
||||||
help-lint-errors-file
|
help-lint-errors-file
|
||||||
|
@ -143,4 +143,4 @@ IN: mason.report
|
||||||
} [ eval-file empty? ] all? ;
|
} [ eval-file empty? ] all? ;
|
||||||
|
|
||||||
: success ( -- status )
|
: success ( -- status )
|
||||||
successful-report build-clean? status-clean status-dirty ? ;
|
successful-report build-clean? status-clean status-dirty ? ;
|
||||||
|
|
Loading…
Reference in New Issue