From 70573c01f07b1aecd9abe14fd44b0cd87f00a141 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 6 Apr 2008 14:33:01 -0500 Subject: [PATCH 1/9] comment out compiler error --- extra/db/mysql/lib/lib.factor | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/extra/db/mysql/lib/lib.factor b/extra/db/mysql/lib/lib.factor index 59d1b6ff3d..ca912f200d 100644 --- a/extra/db/mysql/lib/lib.factor +++ b/extra/db/mysql/lib/lib.factor @@ -18,16 +18,16 @@ TUPLE: mysql-result-set ; : mysql-error ( mysql -- ) [ mysql_error throw ] when* ; -: mysql-connect ( mysql-connection -- ) - new-mysql over set-mysql-db-handle - dup { - mysql-db-handle - mysql-db-host - mysql-db-user - mysql-db-password - mysql-db-db - mysql-db-port - } get-slots f 0 mysql_real_connect mysql-error ; +! : mysql-connect ( mysql-connection -- ) + ! new-mysql over set-mysql-db-handle + ! dup { + ! mysql-db-handle + ! mysql-db-host + ! mysql-db-user + ! mysql-db-password + ! mysql-db-db + ! mysql-db-port + ! } get-slots f 0 mysql_real_connect mysql-error ; ! ========================================================= ! Low level mysql utility definitions From ddb1749c57743c25d7667c9484fa854ee98abf50 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 6 Apr 2008 21:07:21 -0500 Subject: [PATCH 2/9] ERROR: should be inside the IN: --- extra/opengl/gl/extensions/extensions.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/opengl/gl/extensions/extensions.factor b/extra/opengl/gl/extensions/extensions.factor index b8ac396c2f..20929fb410 100644 --- a/extra/opengl/gl/extensions/extensions.factor +++ b/extra/opengl/gl/extensions/extensions.factor @@ -1,6 +1,7 @@ USING: alien alien.syntax combinators kernel parser sequences system words namespaces hashtables init math arrays assocs continuations ; +IN: opengl.gl.extensions ERROR: unknown-gl-platform ; << { @@ -9,7 +10,6 @@ ERROR: unknown-gl-platform ; { [ os unix? ] [ "opengl.gl.unix" ] } { [ t ] [ unknown-gl-platform ] } } cond use+ >> -IN: opengl.gl.extensions SYMBOL: +gl-function-number-counter+ SYMBOL: +gl-function-pointers+ From b1b889d8994e96968a47c5f93642fc76b6eb9864 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 7 Apr 2008 15:30:06 -0500 Subject: [PATCH 3/9] add some acl constants --- extra/windows/advapi32/advapi32.factor | 195 ++++++++++++++++--------- 1 file changed, 129 insertions(+), 66 deletions(-) diff --git a/extra/windows/advapi32/advapi32.factor b/extra/windows/advapi32/advapi32.factor index 28091d3d9d..0d2f164c8d 100644 --- a/extra/windows/advapi32/advapi32.factor +++ b/extra/windows/advapi32/advapi32.factor @@ -61,6 +61,133 @@ LIBRARY: advapi32 : CRYPT_MACHINE_KEYSET HEX: 20 ; inline : CRYPT_SILENT HEX: 40 ; inline +C-STRUCT: ACL + { "BYTE" "AclRevision" } + { "BYTE" "Sbz1" } + { "WORD" "AclSize" } + { "WORD" "AceCount" } + { "WORD" "Sbz2" } ; + +TYPEDEF: ACL* PACL + +: ACCESS_ALLOWED_ACE_TYPE 0 ; inline +: ACCESS_DENIED_ACE_TYPE 1 ; inline +: SYSTEM_AUDIT_ACE_TYPE 2 ; inline +: SYSTEM_ALARM_ACE_TYPE 3 ; inline + +: OBJECT_INHERIT_ACE HEX: 1 ; inline +: CONTAINER_INHERIT_ACE HEX: 2 ; inline +: NO_PROPAGATE_INHERIT_ACE HEX: 4 ; inline +: INHERIT_ONLY_ACE HEX: 8 ; inline +: VALID_INHERIT_FLAGS HEX: f ; inline + +C-STRUCT: ACE_HEADER + { "BYTE" "AceType" } + { "BYTE" "AceFlags" } + { "WORD" "AceSize" } ; + +TYPEDEF: ACE_HEADER* PACE_HEADER + +C-STRUCT: ACCESS_ALLOWED_ACE + { "ACE_HEADER" "Header" } + { "DWORD" "Mask" } + { "DWORD" "SidStart" } ; + +TYPEDEF: ACCESS_ALLOWED_ACE* PACCESS_ALLOWED_ACE + +C-STRUCT: ACCESS_DENIED_ACE + { "ACE_HEADER" "Header" } + { "DWORD" "Mask" } + { "DWORD" "SidStart" } ; +TYPEDEF: ACCESS_DENIED_ACE* PACCESS_DENIED_ACE + + +C-STRUCT: SYSTEM_AUDIT_ACE + { "ACE_HEADER" "Header" } + { "DWORD" "Mask" } + { "DWORD" "SidStart" } ; + +TYPEDEF: SYSTEM_AUDIT_ACE* PSYSTEM_AUDIT_ACE + +C-STRUCT: SYSTEM_ALARM_ACE + { "ACE_HEADER" "Header" } + { "DWORD" "Mask" } + { "DWORD" "SidStart" } ; + +TYPEDEF: SYSTEM_ALARM_ACE* PSYSTEM_ALARM_ACE + +C-STRUCT: ACCESS_ALLOWED_CALLBACK_ACE + { "ACE_HEADER" "Header" } + { "DWORD" "Mask" } + { "DWORD" "SidStart" } ; + +TYPEDEF: ACCESS_ALLOWED_CALLBACK_ACE* PACCESS_ALLOWED_CALLBACK_ACE + + +! typedef enum _TOKEN_INFORMATION_CLASS { +: TokenUser 1 ; inline +: TokenGroups 2 ; inline +: TokenPrivileges 3 ; inline +: TokenOwner 4 ; inline +: TokenPrimaryGroup 5 ; inline +: TokenDefaultDacl 6 ; inline +: TokenSource 7 ; inline +: TokenType 8 ; inline +: TokenImpersonationLevel 9 ; inline +: TokenStatistics 10 ; inline +: TokenRestrictedSids 11 ; inline +: TokenSessionId 12 ; inline +: TokenGroupsAndPrivileges 13 ; inline +: TokenSessionReference 14 ; inline +: TokenSandBoxInert 15 ; inline +! } TOKEN_INFORMATION_CLASS; + +: DELETE HEX: 00010000 ; inline +: READ_CONTROL HEX: 00020000 ; inline +: WRITE_DAC HEX: 00040000 ; inline +: WRITE_OWNER HEX: 00080000 ; inline +: SYNCHRONIZE HEX: 00100000 ; inline +: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline + +: STANDARD_RIGHTS_READ READ_CONTROL ; inline +: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline +: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline + +: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline +: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline +: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline +: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline +: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline +: TOKEN_DUPLICATE HEX: 0002 ; inline +: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline +: TOKEN_IMPERSONATE HEX: 0004 ; inline +: TOKEN_QUERY HEX: 0008 ; inline +: TOKEN_QUERY_SOURCE HEX: 0010 ; inline +: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline +: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ; + +: TOKEN_WRITE + { + STANDARD_RIGHTS_WRITE + TOKEN_ADJUST_PRIVILEGES + TOKEN_ADJUST_GROUPS + TOKEN_ADJUST_DEFAULT + } flags ; foldable + +: TOKEN_ALL_ACCESS + { + STANDARD_RIGHTS_REQUIRED + TOKEN_ASSIGN_PRIMARY + TOKEN_DUPLICATE + TOKEN_IMPERSONATE + TOKEN_QUERY + TOKEN_QUERY_SOURCE + TOKEN_ADJUST_PRIVILEGES + TOKEN_ADJUST_GROUPS + TOKEN_ADJUST_SESSIONID + TOKEN_ADJUST_DEFAULT + } flags ; foldable + ! : I_ScGetCurrentGroupStateW ; ! : A_SHAFinal ; @@ -85,7 +212,7 @@ LIBRARY: advapi32 ! : AddAccessDeniedAce ; ! : AddAccessDeniedAceEx ; ! : AddAccessDeniedObjectAce ; -! : AddAce ; +FUNCTION: BOOL AddAce ( PACL pAcl, DWORD dwAceRevision, DWORD dwStartingAceIndex, LPVOID pAceList, DWORD nAceListLength ) ; ! : AddAuditAccessAce ; ! : AddAuditAccessAceEx ; ! : AddAuditAccessObjectAce ; @@ -382,7 +509,7 @@ FUNCTION: BOOL GetUserNameW ( LPCTSTR lpBuffer, LPDWORD lpnSize ) ; ! : ImpersonateLoggedOnUser ; ! : ImpersonateNamedPipeClient ; ! : ImpersonateSelf ; -! : InitializeAcl ; +FUNCTION: BOOL InitializeAcl ( PACL pAcl, DWORD nAclLength, DWORD dwAclRevision ) ; ! : InitializeSecurityDescriptor ; ! : InitializeSid ; ! : InitiateSystemShutdownA ; @@ -508,70 +635,6 @@ FUNCTION: BOOL LookupPrivilegeValueW ( LPCTSTR lpSystemName, ! : OpenEventLogA ; ! : OpenEventLogW ; -! typedef enum _TOKEN_INFORMATION_CLASS { -: TokenUser 1 ; -: TokenGroups 2 ; -: TokenPrivileges 3 ; -: TokenOwner 4 ; -: TokenPrimaryGroup 5 ; -: TokenDefaultDacl 6 ; -: TokenSource 7 ; -: TokenType 8 ; -: TokenImpersonationLevel 9 ; -: TokenStatistics 10 ; -: TokenRestrictedSids 11 ; -: TokenSessionId 12 ; -: TokenGroupsAndPrivileges 13 ; -: TokenSessionReference 14 ; -: TokenSandBoxInert 15 ; -! } TOKEN_INFORMATION_CLASS; - -: DELETE HEX: 00010000 ; inline -: READ_CONTROL HEX: 00020000 ; inline -: WRITE_DAC HEX: 00040000 ; inline -: WRITE_OWNER HEX: 00080000 ; inline -: SYNCHRONIZE HEX: 00100000 ; inline -: STANDARD_RIGHTS_REQUIRED HEX: 000f0000 ; inline - -: STANDARD_RIGHTS_READ READ_CONTROL ; inline -: STANDARD_RIGHTS_WRITE READ_CONTROL ; inline -: STANDARD_RIGHTS_EXECUTE READ_CONTROL ; inline - -: TOKEN_TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline -: TOKEN_ADJUST_GROUPS HEX: 0040 ; inline -: TOKEN_ADJUST_PRIVILEGES HEX: 0020 ; inline -: TOKEN_ADJUST_SESSIONID HEX: 0100 ; inline -: TOKEN_ASSIGN_PRIMARY HEX: 0001 ; inline -: TOKEN_DUPLICATE HEX: 0002 ; inline -: TOKEN_EXECUTE STANDARD_RIGHTS_EXECUTE ; inline -: TOKEN_IMPERSONATE HEX: 0004 ; inline -: TOKEN_QUERY HEX: 0008 ; inline -: TOKEN_QUERY_SOURCE HEX: 0010 ; inline -: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline -: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ; - -: TOKEN_WRITE - { - STANDARD_RIGHTS_WRITE - TOKEN_ADJUST_PRIVILEGES - TOKEN_ADJUST_GROUPS - TOKEN_ADJUST_DEFAULT - } flags ; foldable - -: TOKEN_ALL_ACCESS - { - STANDARD_RIGHTS_REQUIRED - TOKEN_ASSIGN_PRIMARY - TOKEN_DUPLICATE - TOKEN_IMPERSONATE - TOKEN_QUERY - TOKEN_QUERY_SOURCE - TOKEN_ADJUST_PRIVILEGES - TOKEN_ADJUST_GROUPS - TOKEN_ADJUST_SESSIONID - TOKEN_ADJUST_DEFAULT - } flags ; foldable - FUNCTION: BOOL OpenProcessToken ( HANDLE ProcessHandle, DWORD DesiredAccess, PHANDLE TokenHandle ) ; From 56ff4530ff9b34fcc15050fd8af66b71e751b572 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 7 Apr 2008 19:28:54 -0500 Subject: [PATCH 4/9] fix blum-blum-shub --- .../blum-blum-shub-tests.factor | 28 +++++++++++++++++++ .../blum-blum-shub/blum-blum-shub.factor | 24 ++++++---------- 2 files changed, 36 insertions(+), 16 deletions(-) create mode 100644 extra/random/blum-blum-shub/blum-blum-shub-tests.factor diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor new file mode 100644 index 0000000000..a92f256eeb --- /dev/null +++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor @@ -0,0 +1,28 @@ +USING: kernel math tools.test namespaces random +random.blum-blum-shub ; +IN: blum-blum-shub.tests + +[ 887708070 ] [ + T{ blum-blum-shub f 590695557939 811977232793 } random-32* +] unit-test + + +[ 887708070 ] [ + T{ blum-blum-shub f 590695557939 811977232793 } [ + 32 random-bits + ] with-random +] unit-test + +[ 5726770047455156646 ] [ + T{ blum-blum-shub f 590695557939 811977232793 } [ + 64 random-bits + ] with-random +] unit-test + +[ 3716213681 ] +[ + 100 T{ blum-blum-shub f 200352954495 846054538649 } tuck [ + random-32* drop + ] curry times + random-32* +] unit-test diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor index 017ef402c0..5644cf6d08 100755 --- a/extra/random/blum-blum-shub/blum-blum-shub.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub.factor @@ -3,34 +3,26 @@ math.miller-rabin combinators.lib math.functions accessors random ; IN: random.blum-blum-shub -! TODO: take (log log M) bits instead of 1 bit -! Blum Blum Shub, M = pq +! Blum Blum Shub, n = pq, x_i+1 = x_i ^ 2 mod n +! return low bit of x+1 TUPLE: blum-blum-shub x n ; -C: blum-blum-shub + ( numbits -- blum-blum-shub ) - #! returns a Blum-Blum-Shub tuple generate-bbs-primes * [ find-relative-prime ] keep blum-blum-shub construct-boa ; -! 256 make-bbs blum-blum-shub set-global - : next-bbs-bit ( bbs -- bit ) - #! x = x^2 mod n, return low bit of calculated x - [ [ x>> 2 ] [ n>> ] bi ^mod ] - [ [ >>x ] keep x>> 1 bitand ] bi ; + [ [ x>> 2 ] [ n>> ] bi ^mod ] keep + over >>x drop 1 bitand ; -IN: crypto -! : random ( n -- n ) - ! ! #! Cryptographically secure random number using Blum-Blum-Shub 256 - ! [ log2 1+ random-bits ] keep dupd >= [ -1 shift ] when ; +PRIVATE> M: blum-blum-shub random-32* ( bbs -- r ) - ; + 0 32 rot + [ next-bbs-bit swap 1 shift bitor ] curry times ; From f0ae86b884efe75ab55d3f6e8524a019bafd80ac Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 7 Apr 2008 19:30:02 -0500 Subject: [PATCH 5/9] remove outdated file --- extra/crypto/test/blum-blum-shub.factor | 5 ----- 1 file changed, 5 deletions(-) delete mode 100644 extra/crypto/test/blum-blum-shub.factor diff --git a/extra/crypto/test/blum-blum-shub.factor b/extra/crypto/test/blum-blum-shub.factor deleted file mode 100644 index b1b6034373..0000000000 --- a/extra/crypto/test/blum-blum-shub.factor +++ /dev/null @@ -1,5 +0,0 @@ -USING: kernel math test namespaces crypto crypto-internals ; - -[ 6 ] [ 5 T{ bbs f 590695557939 811977232793 } random-bbs-bits* ] unit-test -[ 792723710536787233474130382522 ] [ 100 T{ bbs f 200352954495 846054538649 } [ random-bbs-bits* drop ] 2keep random-bbs-bits* ] unit-test - From 2a85901ccaa040bf0481108c43b12f22e4192dd7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 10 Apr 2008 19:35:06 -0500 Subject: [PATCH 6/9] add some windows messages --- extra/windows/messages/messages.factor | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/extra/windows/messages/messages.factor b/extra/windows/messages/messages.factor index 733071d197..3b0db96d63 100644 --- a/extra/windows/messages/messages.factor +++ b/extra/windows/messages/messages.factor @@ -1001,3 +1001,25 @@ windows-messages set-global : LM_GETIDEALHEIGHT WM_USER HEX: 0301 + ; inline : LM_SETITEM WM_USER HEX: 0302 + ; inline : LM_GETITEM WM_USER HEX: 0303 + ; inline + + +: WA_INACTIVE 0 ; inline +: WA_ACTIVE 1 ; inline +: WA_CLICKACTIVE 2 ; inline + +: SC_SIZE HEX: f000 ; inline +: SC_MOVE HEX: f010 ; inline +: SC_MINIMIZE HEX: f020 ; inline +: SC_MAXIMIZE HEX: f030 ; inline +: SC_NEXTWINDOW HEX: f040 ; inline +: SC_PREVWINDOW HEX: f050 ; inline +: SC_CLOSE HEX: f060 ; inline +: SC_VSCROLL HEX: f070 ; inline +: SC_HSCROLL HEX: f080 ; inline +: SC_MOUSEMENU HEX: f090 ; inline +: SC_KEYMENU HEX: f100 ; inline +: SC_ARRANGE HEX: f110 ; inline +: SC_RESTORE HEX: f120 ; inline +: SC_TASKLIST HEX: f130 ; inline +: SC_SCREENSAVE HEX: f140 ; inline +: SC_HOTKEY HEX: f150 ; inline From 2cefe124d6c9c05b2b2dea665e7609ed63b85b3a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 10 Apr 2008 21:17:23 -0500 Subject: [PATCH 7/9] try not to render to factor windows when they're minimized --- extra/ui/windows/windows.factor | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index e0c9f24122..0adfc676f8 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -7,7 +7,7 @@ vectors words windows.kernel32 windows.gdi32 windows.user32 windows.opengl32 windows.messages windows.types windows.nt windows threads libc combinators continuations command-line shuffle opengl ui.render unicode.case ascii math.bitfields -locals symbols ; +locals symbols accessors ; IN: ui.windows SINGLETON: windows-ui-backend @@ -203,8 +203,18 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ; wParam keystroke>gesture hWnd window-focus send-gesture drop ; +: set-window-active ( hwnd uMsg wParam lParam ? -- n ) + >r 4dup r> 2nip nip + swap window set-world-active? DefWindowProc ; + : handle-wm-syscommand ( hWnd uMsg wParam lParam -- n ) - dup alpha? [ 4drop 0 ] [ DefWindowProc ] if ; + { + { [ over SC_MINIMIZE = ] [ f set-window-active ] } + { [ over SC_RESTORE = ] [ t set-window-active ] } + { [ over SC_MAXIMIZE = ] [ t set-window-active ] } + { [ dup alpha? ] [ 4drop 0 ] } + { [ t ] [ DefWindowProc ] } + } cond ; : cleanup-window ( handle -- ) dup win-title [ free ] when* From a1b050fd88f5b3d3ba0a5b031dd1156d318e5b6a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 10 Apr 2008 21:49:08 -0500 Subject: [PATCH 8/9] Fix interactor --- .../tools/interactor/interactor-tests.factor | 25 ++++++++++++++++++- extra/ui/tools/interactor/interactor.factor | 4 ++- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/extra/ui/tools/interactor/interactor-tests.factor b/extra/ui/tools/interactor/interactor-tests.factor index fe0a654217..94953f9c72 100755 --- a/extra/ui/tools/interactor/interactor-tests.factor +++ b/extra/ui/tools/interactor/interactor-tests.factor @@ -1,4 +1,27 @@ IN: ui.tools.interactor.tests -USING: ui.tools.interactor tools.test ; +USING: ui.tools.interactor ui.gadgets.panes namespaces +ui.gadgets.editors concurrency.promises threads listener +tools.test kernel calendar ; \ must-infer + +[ ] [ "interactor" set ] unit-test + +[ ] [ "[ 1 2 3" "interactor" get set-editor-string ] unit-test + +[ ] [ "promise" set ] unit-test + +[ + "interactor" get stream-read-quot "promise" get fulfill +] "Interactor test" spawn drop + +! This should not throw an exception +[ ] [ "interactor" get evaluate-input ] unit-test + +[ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test + +[ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test + +[ ] [ "interactor" get evaluate-input ] unit-test + +[ [ [ 1 2 3 ] ] ] [ "promise" get 5 seconds ?promise-timeout ] unit-test diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor index 8232094e76..86ba51df95 100755 --- a/extra/ui/tools/interactor/interactor.factor +++ b/extra/ui/tools/interactor/interactor.factor @@ -138,7 +138,9 @@ M: interactor stream-read-partial drop parse-lines-interactive ] [ 2nip - dup delegate unexpected-eof? [ drop f ] when + dup parse-error? [ + dup error>> unexpected-eof? [ drop f ] when + ] when ] recover ; : handle-interactive ( lines interactor -- quot/f ? ) From 039c344e8745bc0f1a5afb975c0c57eb14eb1ea8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 10 Apr 2008 22:02:23 -0500 Subject: [PATCH 9/9] Fix unit test failure on BSD --- extra/tools/vocabs/vocabs-tests.factor | 8 ++++++++ extra/tools/vocabs/vocabs.factor | 6 +++--- 2 files changed, 11 insertions(+), 3 deletions(-) create mode 100644 extra/tools/vocabs/vocabs-tests.factor diff --git a/extra/tools/vocabs/vocabs-tests.factor b/extra/tools/vocabs/vocabs-tests.factor new file mode 100644 index 0000000000..ae74d516e4 --- /dev/null +++ b/extra/tools/vocabs/vocabs-tests.factor @@ -0,0 +1,8 @@ +IN: tools.vocabs.tests +USING: tools.test tools.vocabs namespaces continuations ; + +[ ] [ + changed-vocabs get-global + f changed-vocabs set-global + [ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup +] unit-test diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index 211b396c50..371bbc7813 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -76,11 +76,11 @@ SYMBOL: changed-vocabs [ f changed-vocabs set-global ] "tools.vocabs" add-init-hook : changed-vocab ( vocab -- ) - dup vocab - [ dup changed-vocabs get-global set-at ] [ drop ] if ; + dup vocab changed-vocabs get and + [ dup changed-vocabs get set-at ] [ drop ] if ; : unchanged-vocab ( vocab -- ) - changed-vocabs get-global delete-at ; + changed-vocabs get delete-at ; : unchanged-vocabs ( vocabs -- ) [ unchanged-vocab ] each ;