fix some tests broken by the prepend change.

db4
John Benediktsson 2012-05-29 16:58:58 -07:00
parent 915176822b
commit 180ad0aabf
4 changed files with 15 additions and 15 deletions

View File

@ -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

View File

@ -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 ;
! ========================================================= ! =========================================================

View File

@ -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 )

View File

@ -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 ? ;