diff --git a/README.txt b/README.txt index c5d53de842..c0d56dfa09 100755 --- a/README.txt +++ b/README.txt @@ -59,10 +59,10 @@ On Unix, Factor can either run a graphical user interface using X11, or a terminal listener. For X11 support, you need recent development libraries for libc, -Pango, X11, OpenGL and GLUT. On a Debian-derived Linux distribution +Pango, X11, and OpenGL. On a Debian-derived Linux distribution (like Ubuntu), you can use the following line to grab everything: - sudo apt-get install libc6-dev libpango-1.0-dev libx11-dev glutg3-dev + sudo apt-get install libc6-dev libpango-1.0-dev libx11-dev If your DISPLAY environment variable is set, the UI will start automatically: diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor index fcc5abf1cf..56bac7efcd 100644 --- a/basis/db/tester/tester.factor +++ b/basis/db/tester/tester.factor @@ -3,7 +3,7 @@ USING: concurrency.combinators db.pools db.sqlite db.tuples db.types kernel math random threads tools.test db sequences io prettyprint db.postgresql db.sqlite accessors io.files.temp -namespaces fry system ; +namespaces fry system math.parser ; IN: db.tester : postgresql-test-db ( -- postgresql-db ) @@ -56,6 +56,10 @@ test-2 "TEST2" { { "z" "Z" { VARCHAR 256 } +not-null+ } } define-persistent +: test-1-tuple ( -- tuple ) + f 100 random 100 random 100 random [ number>string ] tri@ + test-1 boa ; + : db-tester ( test-db -- ) [ [ @@ -67,8 +71,7 @@ test-2 "TEST2" { drop 10 [ dup [ - f 100 random 100 random 100 random test-1 boa - insert-tuple yield + test-1-tuple insert-tuple yield ] with-db ] times ] with parallel-each @@ -84,8 +87,7 @@ test-2 "TEST2" { [ 10 [ 10 [ - f 100 random 100 random 100 random test-1 boa - insert-tuple yield + test-1-tuple insert-tuple yield ] times ] parallel-each ] with-pooled-db diff --git a/basis/editors/emacs/authors.txt b/basis/editors/emacs/authors.txt index 6cfd5da273..07c1c4a765 100644 --- a/basis/editors/emacs/authors.txt +++ b/basis/editors/emacs/authors.txt @@ -1 +1,2 @@ Eduardo Cavazos +Doug Coleman diff --git a/basis/editors/emacs/emacs-docs.factor b/basis/editors/emacs/emacs-docs.factor index f55068e143..adf6d8a7b7 100644 --- a/basis/editors/emacs/emacs-docs.factor +++ b/basis/editors/emacs/emacs-docs.factor @@ -2,10 +2,23 @@ USING: help help.syntax help.markup ; IN: editors.emacs ARTICLE: "editors.emacs" "Integration with Emacs" -"Put this in your " { $snippet ".emacs" } " file:" +"Full Emacs integration with Factor requires the use of two executable files -- " { $snippet "emacs" } " and " { $snippet "emacsclient" } ", which act as a client/server pair. To start the server, run the " { $snippet "emacs" } " binary and run " { $snippet "M-x server-start" } " or start " { $snippet "emacs" } " with the following line in your " { $snippet ".emacs" } " file:" { $code "(server-start)" } +"On Windows, if you install Emacs to " { $snippet "Program Files" } " or " { $snippet "Program Files(x86)" } ", Factor will automatically detect the path to " { $snippet "emacsclient.exe" } ". On Unix systems, make sure that " { $snippet "emacsclient" } " is in your path. To set the path manually, use the following snippet:" +{ $code "USE: edtiors.emacs" + "\"/my/crazy/bin/emacsclient\" emacsclient-path set-global" +} + "If you would like a new window to open when you ask Factor to edit an object, put this in your " { $snippet ".emacs" } " file:" { $code "(setq server-window 'switch-to-buffer-other-frame)" } -{ $see-also "editor" } ; -ABOUT: "editors.emacs" \ No newline at end of file +"To quickly scaffold a " { $snippet ".emacs" } " file, run the following code:" +{ $code "USE: tools.scaffold" + "scaffold-emacs" +} + +{ $see-also "editor" } + +; + +ABOUT: "editors.emacs" diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index 366bc53104..31fcaf114e 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -11,7 +11,10 @@ M: object default-emacsclient ( -- path ) "emacsclient" ; : emacsclient ( file line -- ) [ - { [ emacsclient-path get ] [ default-emacsclient ] } 0|| , + { + [ emacsclient-path get-global ] + [ default-emacsclient dup emacsclient-path set-global ] + } 0|| , "--no-wait" , number>string "+" prepend , , diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 38d8ec957e..236da09489 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -83,15 +83,15 @@ ERROR: file-not-found ; ] with-directory ; inline : directory-size ( path -- n ) - 0 swap t [ file-info size-on-disk>> + ] each-file ; + 0 swap t [ link-info size-on-disk>> + ] each-file ; -: path>sizes ( path -- assoc ) +: directory-usage ( path -- assoc ) [ [ [ name>> dup ] [ directory? ] bi [ directory-size ] [ - file-info size-on-disk>> + link-info size-on-disk>> ] if ] { } map>assoc ] with-qualified-directory-entries sort-values ; diff --git a/basis/io/encodings/8-bit/8-bit-tests.factor b/basis/io/encodings/8-bit/8-bit-tests.factor index 8b18e2a9af..55b9c44934 100644 --- a/basis/io/encodings/8-bit/8-bit-tests.factor +++ b/basis/io/encodings/8-bit/8-bit-tests.factor @@ -4,11 +4,11 @@ IN: io.encodings.8-bit.tests [ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" latin1 encode ] unit-test [ { 256 } >string latin1 encode ] must-fail -[ B{ 255 } ] [ { 255 } latin1 encode ] unit-test +[ B{ 255 } ] [ { 255 } >string latin1 encode ] unit-test [ "bar" ] [ "bar" latin1 decode ] unit-test -[ { CHAR: b 233 CHAR: r } ] [ { CHAR: b 233 CHAR: r } latin1 decode >array ] unit-test -[ { HEX: fffd HEX: 20AC } ] [ { HEX: 81 HEX: 80 } windows-1252 decode >array ] unit-test +[ { CHAR: b 233 CHAR: r } ] [ B{ CHAR: b 233 CHAR: r } latin1 decode >array ] unit-test +[ { HEX: fffd HEX: 20AC } ] [ B{ HEX: 81 HEX: 80 } windows-1252 decode >array ] unit-test [ t ] [ \ latin1 8-bit-encoding? ] unit-test [ "bar" ] [ "bar" \ latin1 decode ] unit-test diff --git a/basis/io/encodings/ascii/ascii-tests.factor b/basis/io/encodings/ascii/ascii-tests.factor index 4f6d28835a..fcd549d31f 100644 --- a/basis/io/encodings/ascii/ascii-tests.factor +++ b/basis/io/encodings/ascii/ascii-tests.factor @@ -3,7 +3,7 @@ IN: io.encodings.ascii.tests [ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" ascii encode ] unit-test [ { 128 } >string ascii encode ] must-fail -[ B{ 127 } ] [ { 127 } ascii encode ] unit-test +[ B{ 127 } ] [ { 127 } >string ascii encode ] unit-test [ "bar" ] [ "bar" ascii decode ] unit-test -[ { CHAR: b HEX: fffd CHAR: r } ] [ { CHAR: b 233 CHAR: r } ascii decode >array ] unit-test +[ { CHAR: b HEX: fffd CHAR: r } ] [ B{ CHAR: b 233 CHAR: r } ascii decode >array ] unit-test diff --git a/basis/io/encodings/gb18030/gb18030-tests.factor b/basis/io/encodings/gb18030/gb18030-tests.factor index 20ea522a4d..da44d1cf9a 100644 --- a/basis/io/encodings/gb18030/gb18030-tests.factor +++ b/basis/io/encodings/gb18030/gb18030-tests.factor @@ -6,7 +6,7 @@ IN: io.encodings.gb18030.tests [ "hello" ] [ "hello" gb18030 encode >string ] unit-test [ "hello" ] [ "hello" gb18030 decode ] unit-test [ B{ HEX: A1 HEX: A4 HEX: 81 HEX: 30 HEX: 86 HEX: 30 } ] -[ B{ HEX: B7 HEX: B8 } gb18030 encode ] unit-test +[ B{ HEX: B7 HEX: B8 } >string gb18030 encode ] unit-test [ { HEX: B7 HEX: B8 } ] [ B{ HEX: A1 HEX: A4 HEX: 81 HEX: 30 HEX: 86 HEX: 30 } gb18030 decode >array ] unit-test [ { HEX: B7 CHAR: replacement-character } ] @@ -18,9 +18,9 @@ IN: io.encodings.gb18030.tests [ { HEX: B7 } ] [ B{ HEX: A1 HEX: A4 } gb18030 decode >array ] unit-test [ { CHAR: replacement-character } ] -[ B{ HEX: A1 } gb18030 decode >array ] unit-test +[ B{ HEX: A1 } >string gb18030 decode >array ] unit-test [ { HEX: 44D7 HEX: 464B } ] [ B{ HEX: 82 HEX: 33 HEX: A3 HEX: 39 HEX: 82 HEX: 33 HEX: C9 HEX: 31 } gb18030 decode >array ] unit-test [ { HEX: 82 HEX: 33 HEX: A3 HEX: 39 HEX: 82 HEX: 33 HEX: C9 HEX: 31 } ] -[ { HEX: 44D7 HEX: 464B } gb18030 encode >array ] unit-test +[ { HEX: 44D7 HEX: 464B } >string gb18030 encode >array ] unit-test diff --git a/basis/io/encodings/utf16/utf16-tests.factor b/basis/io/encodings/utf16/utf16-tests.factor index 230612cc77..e16c1f822e 100644 --- a/basis/io/encodings/utf16/utf16-tests.factor +++ b/basis/io/encodings/utf16/utf16-tests.factor @@ -1,25 +1,25 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel tools.test io.encodings.utf16 arrays sbufs -io.streams.byte-array sequences io.encodings io +io.streams.byte-array sequences io.encodings io strings io.encodings.string alien.c-types alien.strings accessors classes ; IN: io.encodings.utf16.tests -[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode >array ] unit-test -[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode >array ] unit-test +[ { CHAR: x } ] [ B{ 0 CHAR: x } utf16be decode >array ] unit-test +[ { HEX: 1D11E } ] [ B{ HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ BIN: 11011111 CHAR: q } utf16be decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode >array ] unit-test -[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode >array ] unit-test +[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } >string utf16be encode >array ] unit-test -[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode >array ] unit-test -[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode >array ] unit-test +[ { CHAR: x } ] [ B{ CHAR: x 0 } utf16le decode >array ] unit-test +[ { 119070 } ] [ B{ HEX: 34 HEX: D8 HEX: 1E HEX: DD } >string utf16le decode >array ] unit-test +[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } >string utf16le decode >array ] unit-test +[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } >string utf16le decode >array ] unit-test -[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode >array ] unit-test +[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } >string utf16le encode >array ] unit-test -[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode >array ] unit-test -[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test +[ { CHAR: x } ] [ B{ HEX: ff HEX: fe CHAR: x 0 } utf16 decode >array ] unit-test +[ { CHAR: x } ] [ B{ HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test -[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test +[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } >string utf16 encode >array ] unit-test diff --git a/basis/io/encodings/utf32/utf32-tests.factor b/basis/io/encodings/utf32/utf32-tests.factor index be1111e242..2a80e47c7b 100644 --- a/basis/io/encodings/utf32/utf32-tests.factor +++ b/basis/io/encodings/utf32/utf32-tests.factor @@ -1,30 +1,30 @@ ! Copyright (C) 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel tools.test io.encodings.utf32 arrays sbufs -io.streams.byte-array sequences io.encodings io +io.streams.byte-array sequences io.encodings io strings io.encodings.string alien.c-types alien.strings accessors classes ; IN: io.encodings.utf32.tests -[ { CHAR: x } ] [ { 0 0 0 CHAR: x } utf32be decode >array ] unit-test -[ { HEX: 1D11E } ] [ { 0 1 HEX: D1 HEX: 1E } utf32be decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { 0 1 HEX: D1 } utf32be decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { 0 1 } utf32be decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { 0 } utf32be decode >array ] unit-test +[ { CHAR: x } ] [ B{ 0 0 0 CHAR: x } utf32be decode >array ] unit-test +[ { HEX: 1D11E } ] [ B{ 0 1 HEX: D1 HEX: 1E } utf32be decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ 0 1 HEX: D1 } utf32be decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ 0 1 } utf32be decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ 0 } utf32be decode >array ] unit-test [ { } ] [ { } utf32be decode >array ] unit-test -[ { 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } utf32be encode >array ] unit-test +[ { 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } >string utf32be encode >array ] unit-test -[ { CHAR: x } ] [ { CHAR: x 0 0 0 } utf32le decode >array ] unit-test -[ { HEX: 1d11e } ] [ { HEX: 1e HEX: d1 1 0 } utf32le decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { HEX: 1e HEX: d1 1 } utf32le decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { HEX: 1e HEX: d1 } utf32le decode >array ] unit-test -[ { CHAR: replacement-character } ] [ { HEX: 1e } utf32le decode >array ] unit-test +[ { CHAR: x } ] [ B{ CHAR: x 0 0 0 } utf32le decode >array ] unit-test +[ { HEX: 1d11e } ] [ B{ HEX: 1e HEX: d1 1 0 } utf32le decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ HEX: 1e HEX: d1 1 } utf32le decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ HEX: 1e HEX: d1 } utf32le decode >array ] unit-test +[ { CHAR: replacement-character } ] [ B{ HEX: 1e } utf32le decode >array ] unit-test [ { } ] [ { } utf32le decode >array ] unit-test -[ { 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } utf32le encode >array ] unit-test +[ { 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32le encode >array ] unit-test -[ { CHAR: x } ] [ { HEX: ff HEX: fe 0 0 CHAR: x 0 0 0 } utf32 decode >array ] unit-test -[ { CHAR: x } ] [ { 0 0 HEX: fe HEX: ff 0 0 0 CHAR: x } utf32 decode >array ] unit-test +[ { CHAR: x } ] [ B{ HEX: ff HEX: fe 0 0 CHAR: x 0 0 0 } utf32 decode >array ] unit-test +[ { CHAR: x } ] [ B{ 0 0 HEX: fe HEX: ff 0 0 0 CHAR: x } utf32 decode >array ] unit-test -[ { HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } utf32 encode >array ] unit-test +[ { HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32 encode >array ] unit-test diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index 11fa3130d1..80f4b74ac8 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -63,6 +63,8 @@ M: unix link-info ( path -- info ) M: unix new-file-info ( -- class ) unix-file-info new ; +CONSTANT: standard-unix-block-size 512 + M: unix stat>file-info ( stat -- file-info ) [ new-file-info ] dip { @@ -80,7 +82,7 @@ M: unix stat>file-info ( stat -- file-info ) [ stat-st_rdev >>rdev ] [ stat-st_blocks >>blocks ] [ stat-st_blksize >>blocksize ] - [ drop dup [ blocks>> ] [ blocksize>> ] bi * >>size-on-disk ] + [ drop dup blocks>> standard-unix-block-size * >>size-on-disk ] } cleave ; : n>file-type ( n -- type ) diff --git a/basis/io/files/windows/nt/nt.factor b/basis/io/files/windows/nt/nt.factor index 9e449982fb..afc81c784c 100755 --- a/basis/io/files/windows/nt/nt.factor +++ b/basis/io/files/windows/nt/nt.factor @@ -4,7 +4,7 @@ io.backend.windows io.files.windows io.encodings.utf16n windows windows.kernel32 kernel libc math threads system environment alien.c-types alien.arrays alien.strings sequences combinators combinators.short-circuit ascii splitting alien strings assocs -namespaces make accessors tr windows.time ; +namespaces make accessors tr windows.time windows.shell32 ; IN: io.files.windows.nt M: winnt cwd @@ -58,4 +58,9 @@ M: winnt open-append [ dup windows-file-size ] [ drop 0 ] recover [ (open-append) ] dip >>ptr ; -M: winnt home "USERPROFILE" os-env ; +M: winnt home + { + [ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ] + [ "USERPROFILE" os-env ] + [ my-documents ] + } 0|| ; diff --git a/basis/io/streams/byte-array/byte-array-tests.factor b/basis/io/streams/byte-array/byte-array-tests.factor index 44290bfb47..3cf52c6a78 100644 --- a/basis/io/streams/byte-array/byte-array-tests.factor +++ b/basis/io/streams/byte-array/byte-array-tests.factor @@ -1,11 +1,11 @@ USING: tools.test io.streams.byte-array io.encodings.binary io.encodings.utf8 io kernel arrays strings namespaces ; -[ B{ 1 2 3 } ] [ binary [ { 1 2 3 } write ] with-byte-writer ] unit-test +[ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test [ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test [ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ] -[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } utf8 [ write ] with-byte-writer ] unit-test +[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } >string utf8 [ write ] with-byte-writer ] unit-test [ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 contents dup >array swap string? ] unit-test [ B{ 121 120 } 0 ] [ diff --git a/basis/io/streams/string/string.factor b/basis/io/streams/string/string.factor index a0087a70ee..85cb3022f5 100644 --- a/basis/io/streams/string/string.factor +++ b/basis/io/streams/string/string.factor @@ -33,5 +33,6 @@ M: sbuf stream-element-type drop +character+ ; 512 ; : with-string-writer ( quot -- str ) - swap [ output-stream get ] compose with-output-stream* - >string ; inline \ No newline at end of file + [ + swap with-output-stream* + ] keep >string ; inline \ No newline at end of file diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index bfba9ea28a..83457defa5 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -1,12 +1,12 @@ -! Copyright (C) 2007, 2008 Elie CHAFTARI, Dirk Vleugels, +! Copyright (C) 2007, 2009 Elie CHAFTARI, Dirk Vleugels, ! Slava Pestov, Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays namespaces make io io.encodings.string io.encodings.utf8 -io.encodings.iana io.timeouts io.sockets io.sockets.secure -io.encodings.ascii kernel logging sequences combinators splitting -assocs strings math.order math.parser random system calendar summary -calendar.format accessors sets hashtables base64 debugger classes -prettyprint io.crlf words ; +USING: arrays namespaces make io io.encodings io.encodings.string +io.encodings.utf8 io.encodings.iana io.encodings.binary +io.encodings.ascii io.timeouts io.sockets io.sockets.secure io.crlf +kernel logging sequences combinators splitting assocs strings +math.order math.parser random system calendar summary calendar.format +accessors sets hashtables base64 debugger classes prettyprint words ; IN: smtp SYMBOL: smtp-domain @@ -88,8 +88,9 @@ M: message-contains-dot summary ( obj -- string ) [ message-contains-dot ] when ; : send-body ( email -- ) - [ body>> ] [ encoding>> ] bi encode - >base64-lines write crlf + binary encode-output + [ body>> ] [ encoding>> ] bi encode >base64-lines write + ascii encode-output crlf "." command ; : quit ( -- ) diff --git a/basis/tools/profiler/profiler-docs.factor b/basis/tools/profiler/profiler-docs.factor index a786cdfef1..baecbd71c1 100644 --- a/basis/tools/profiler/profiler-docs.factor +++ b/basis/tools/profiler/profiler-docs.factor @@ -23,7 +23,7 @@ $nl { $subsection vocabs-profile. } { $subsection method-profile. } { $subsection "profiler-limitations" } -{ $see-also "ui-profiler" } ; +{ $see-also "ui.tools.profiler" } ; ABOUT: "profiling" diff --git a/build-support/factor.sh b/build-support/factor.sh index 53aab9ad04..3ece72306a 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -22,6 +22,13 @@ test_program_installed() { return 1; } +exit_script() { + if [[ $FIND_MAKE_TARGET -eq true ]] ; then + echo $MAKE_TARGET; + fi + exit $1 +} + ensure_program_installed() { installed=0; for i in $* ; @@ -43,7 +50,7 @@ ensure_program_installed() { $ECHO -n "any of [ $* ]" fi $ECHO " and try again." - exit 1 + exit_script 1; fi } @@ -51,7 +58,7 @@ check_ret() { RET=$? if [[ $RET -ne 0 ]] ; then $ECHO $1 failed - exit 2 + exit_script 2 fi } @@ -62,7 +69,7 @@ check_gcc_version() { if [[ $GCC_VERSION == *3.3.* ]] ; then $ECHO "You have a known buggy version of gcc (3.3)" $ECHO "Install gcc 3.4 or higher and try again." - exit 3 + exit_script 3 elif [[ $GCC_VERSION == *4.3.* ]] ; then MAKE_OPTS="$MAKE_OPTS SITE_CFLAGS=-fno-forward-propagate" fi @@ -154,7 +161,7 @@ check_factor_exists() { if [[ -d "factor" ]] ; then $ECHO "A directory called 'factor' already exists." $ECHO "Rename or delete it and try again." - exit 4 + exit_script 4 fi } @@ -279,7 +286,7 @@ check_os_arch_word() { $ECHO "OS, ARCH, or WORD is empty. Please report this." echo $MAKE_TARGET - exit 5 + exit_script 5 fi } @@ -385,7 +392,7 @@ check_makefile_exists() { echo "You are likely in the wrong directory." echo "Run this script from your factor directory:" echo " ./build-support/factor.sh" - exit 6 + exit_script 6 fi } @@ -536,6 +543,6 @@ case "$1" in bootstrap) get_config_info; bootstrap ;; report) find_build_info ;; net-bootstrap) get_config_info; update_boot_images; bootstrap ;; - make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;; + make-target) FIND_MAKE_TARGET=true; ECHO=false; find_build_info; exit_script ;; *) usage ;; esac diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor index 6cd3ee8033..088131acf9 100755 --- a/core/io/encodings/utf8/utf8-tests.factor +++ b/core/io/encodings/utf8/utf8-tests.factor @@ -6,7 +6,7 @@ IN: io.encodings.utf8.tests utf8 decode >array ; : encode-utf8-w/stream ( array -- newarray ) - utf8 encode >array ; + >string utf8 encode >array ; [ { CHAR: replacement-character } ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 11111111 } decode-utf8-w/stream ] unit-test diff --git a/extra/sandbox/authors.txt b/extra/sandbox/authors.txt new file mode 100644 index 0000000000..f97e1bfbf9 --- /dev/null +++ b/extra/sandbox/authors.txt @@ -0,0 +1 @@ +Maxim Savchenko diff --git a/extra/sandbox/sandbox-tests.factor b/extra/sandbox/sandbox-tests.factor new file mode 100644 index 0000000000..5d0496e77b --- /dev/null +++ b/extra/sandbox/sandbox-tests.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2009 Maxim Savchenko +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel accessors continuations lexer vocabs vocabs.parser + combinators.short-circuit sandbox tools.test ; + +IN: sandbox.tests + +<< "sandbox.syntax" load-vocab drop >> +USE: sandbox.syntax.private + +: run-script ( x lines -- y ) + H{ { "kernel" "kernel" } { "math" "math" } { "sequences" "sequences" } } + parse-sandbox call( x -- x! ) ; + +[ 120 ] +[ + 5 + { + "! Simple factorial example" + "APPLYING: kernel math sequences ;" + "1 swap [ 1+ * ] each" + } run-script +] unit-test + +[ + 5 + { + "! Jailbreak attempt with USE:" + "USE: io" + "\"Hello world!\" print" + } run-script +] +[ + { + [ lexer-error? ] + [ error>> condition? ] + [ error>> error>> no-word-error? ] + [ error>> error>> name>> "USE:" = ] + } 1&& +] must-fail-with + +[ + 5 + { + "! Jailbreak attempt with unauthorized APPLY:" + "APPLY: io" + "\"Hello world!\" print" + } run-script +] +[ + { + [ lexer-error? ] + [ error>> sandbox-error? ] + [ error>> vocab>> "io" = ] + } 1&& +] must-fail-with diff --git a/extra/sandbox/sandbox.factor b/extra/sandbox/sandbox.factor new file mode 100644 index 0000000000..097a7c8d8a --- /dev/null +++ b/extra/sandbox/sandbox.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2009 Maxim Savchenko. +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel sequences vectors assocs namespaces parser lexer vocabs + combinators.short-circuit vocabs.parser ; + +IN: sandbox + +SYMBOL: whitelist + +: with-sandbox-vocabs ( quot -- ) + "sandbox.syntax" load-vocab vocab-words 1vector + use [ auto-use? off call ] with-variable ; inline + +: parse-sandbox ( lines assoc -- quot ) + whitelist [ [ parse-lines ] with-sandbox-vocabs ] with-variable ; + +: reveal-in ( name -- ) + [ { [ search ] [ no-word ] } 1|| ] keep current-vocab vocab-words set-at ; + +SYNTAX: REVEAL: scan reveal-in ; + +SYNTAX: REVEALING: ";" parse-tokens [ reveal-in ] each ; diff --git a/extra/sandbox/summary.txt b/extra/sandbox/summary.txt new file mode 100644 index 0000000000..3ca1e25684 --- /dev/null +++ b/extra/sandbox/summary.txt @@ -0,0 +1 @@ +Basic sandboxing diff --git a/extra/sandbox/syntax/syntax.factor b/extra/sandbox/syntax/syntax.factor new file mode 100644 index 0000000000..2ff5f070c7 --- /dev/null +++ b/extra/sandbox/syntax/syntax.factor @@ -0,0 +1,26 @@ +! Copyright (C) 2009 Maxim Savchenko. +! See http://factorcode.org/license.txt for BSD license. + +USING: kernel sequences assocs namespaces lexer vocabs.parser sandbox ; +IN: sandbox.syntax + + + +SYNTAX: APPLY: scan sandbox-use+ ; + +SYNTAX: APPLYING: ";" parse-tokens [ sandbox-use+ ] each ; + +REVEALING: + ! #! + HEX: OCT: BIN: f t CHAR: " + [ { T{ + ] } ; + +REVEAL: ; diff --git a/extra/sequence-parser/sequence-parser-tests.factor b/extra/sequence-parser/sequence-parser-tests.factor index 3b2fcad5eb..da097f4c00 100644 --- a/extra/sequence-parser/sequence-parser-tests.factor +++ b/extra/sequence-parser/sequence-parser-tests.factor @@ -1,4 +1,5 @@ -USING: tools.test sequence-parser ascii kernel accessors ; +USING: tools.test sequence-parser unicode.categories kernel +accessors ; IN: sequence-parser.tests [ "hello" ] @@ -189,3 +190,15 @@ IN: sequence-parser.tests [ "123u" ] [ "123u" take-c-integer ] unit-test + +[ 36 ] +[ + " //jofiejoe\n //eoieow\n/*asdf*/\n " + skip-whitespace/comments n>> +] unit-test + +[ f ] +[ "\n" take-integer ] unit-test + +[ "\n" ] [ "\n" [ ] take-while ] unit-test +[ f ] [ "\n" [ not ] take-while ] unit-test diff --git a/extra/sequence-parser/sequence-parser.factor b/extra/sequence-parser/sequence-parser.factor index 4f57a7ccae..4cc10fd5fd 100644 --- a/extra/sequence-parser/sequence-parser.factor +++ b/extra/sequence-parser/sequence-parser.factor @@ -52,7 +52,7 @@ TUPLE: sequence-parser sequence n ; ] [ [ drop n>> ] [ skip-until ] - [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq + [ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq f like ] if ; inline : take-while ( sequence-parser quot: ( obj -- ? ) -- sequence/f ) @@ -104,6 +104,45 @@ TUPLE: sequence-parser sequence n ; : skip-whitespace ( sequence-parser -- sequence-parser ) [ [ current blank? not ] take-until drop ] keep ; +: skip-whitespace-eol ( sequence-parser -- sequence-parser ) + [ [ current " \t\r" member? not ] take-until drop ] keep ; + +: take-c-comment ( sequence-parser -- seq/f ) + [ + dup "/*" take-sequence [ + "*/" take-until-sequence* + ] [ + drop f + ] if + ] with-sequence-parser ; + +: take-c++-comment ( sequence-parser -- seq/f ) + [ + dup "//" take-sequence [ + [ + [ + { [ current CHAR: \n = ] [ sequence-parse-end? ] } 1|| + ] take-until + ] [ + advance drop + ] bi + ] [ + drop f + ] if + ] with-sequence-parser ; + +: skip-whitespace/comments ( sequence-parser -- sequence-parser ) + skip-whitespace-eol + { + { [ dup take-c-comment ] [ skip-whitespace/comments ] } + { [ dup take-c++-comment ] [ skip-whitespace/comments ] } + [ ] + } cond ; + +: take-define-identifier ( sequence-parser -- string ) + skip-whitespace/comments + [ current { [ blank? ] [ CHAR: ( = ] } 1|| ] take-until ; + : take-rest-slice ( sequence-parser -- sequence/f ) [ sequence>> ] [ n>> ] bi 2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline @@ -157,30 +196,6 @@ TUPLE: sequence-parser sequence n ; sequence-parser [ n + ] change-n drop ] if ; -: take-c-comment ( sequence-parser -- seq/f ) - [ - dup "/*" take-sequence [ - "*/" take-until-sequence* - ] [ - drop f - ] if - ] with-sequence-parser ; - -: take-c++-comment ( sequence-parser -- seq/f ) - [ - dup "//" take-sequence [ - [ - [ - { [ current CHAR: \n = ] [ sequence-parse-end? ] } 1|| - ] take-until - ] [ - advance drop - ] bi - ] [ - drop f - ] if - ] with-sequence-parser ; - : c-identifier-begin? ( ch -- ? ) CHAR: a CHAR: z [a,b] CHAR: A CHAR: Z [a,b] @@ -192,29 +207,30 @@ TUPLE: sequence-parser sequence n ; CHAR: 0 CHAR: 9 [a,b] { CHAR: _ } 4 nappend member? ; -: take-c-identifier ( state-parser -- string/f ) - [ - dup current c-identifier-begin? [ - [ current c-identifier-ch? ] take-while - ] [ - drop f - ] if - ] with-sequence-parser ; +: (take-c-identifier) ( sequence-parser -- string/f ) + dup current c-identifier-begin? [ + [ current c-identifier-ch? ] take-while + ] [ + drop f + ] if ; + +: take-c-identifier ( sequence-parser -- string/f ) + [ (take-c-identifier) ] with-sequence-parser ; << "length" [ length ] define-sorting >> : sort-tokens ( seq -- seq' ) { length>=< <=> } sort-by ; -: take-first-matching ( state-parser seq -- seq ) +: take-first-matching ( sequence-parser seq -- seq ) swap '[ _ [ swap take-sequence ] with-sequence-parser ] find nip ; -: take-longest ( state-parser seq -- seq ) +: take-longest ( sequence-parser seq -- seq ) sort-tokens take-first-matching ; -: take-c-integer ( state-parser -- string/f ) +: take-c-integer ( sequence-parser -- string/f ) [ dup take-integer [ swap @@ -225,5 +241,19 @@ TUPLE: sequence-parser sequence n ; ] if* ] with-sequence-parser ; +CONSTANT: c-punctuators + { + "[" "]" "(" ")" "{" "}" "." "->" + "++" "--" "&" "*" "+" "-" "~" "!" + "/" "%" "<<" ">>" "<" ">" "<=" ">=" "==" "!=" "^" "|" "&&" "||" + "?" ":" ";" "..." + "=" "*=" "/=" "%=" "+=" "-=" "<<=" ">>=" "&=" "^=" "|=" + "," "#" "##" + "<:" ":>" "<%" "%>" "%:" "%:%:" + } + +: take-c-punctuator ( sequence-parser -- string/f ) + c-punctuators take-longest ; + : write-full ( sequence-parser -- ) sequence>> write ; : write-rest ( sequence-parser -- ) take-rest write ;