steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler, alien: fix some duplication in ERROR: definitions. hope this doesnt trigger more failing builds than it fixed...

db4
Doug Coleman 2015-08-12 13:58:38 -05:00
parent e4f5035257
commit e3ddd337e0
3 changed files with 10 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
basis/alien/libraries/libraries.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff. ! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.strings assocs io.backend USING: accessors alien alien.strings assocs compiler.errors
kernel namespaces destructors sequences strings io.backend kernel namespaces destructors sequences strings
system io.pathnames fry combinators vocabs ; system io.pathnames fry combinators vocabs ;
IN: alien.libraries IN: alien.libraries
@ -27,8 +27,6 @@ TUPLE: library { path string } dll dlerror { abi abi initial: cdecl } ;
C: <library> library C: <library> library
ERROR: no-library name ;
: lookup-library ( name -- library ) libraries get at ; : lookup-library ( name -- library ) libraries get at ;
: open-dll ( path -- dll dll-error/f ) : open-dll ( path -- dll dll-error/f )
@ -80,8 +78,6 @@ M: library dispose dll>> [ dispose ] when* ;
: library-abi ( library -- abi ) : library-abi ( library -- abi )
lookup-library [ abi>> ] [ cdecl ] if* ; lookup-library [ abi>> ] [ cdecl ] if* ;
ERROR: no-such-symbol name library ;
: address-of ( name library -- value ) : address-of ( name library -- value )
2dup load-library dlsym-raw [ 2nip ] [ no-such-symbol ] if* ; 2dup load-library dlsym-raw [ 2nip ] [ no-such-symbol ] if* ;
@ -92,7 +88,7 @@ deploy-libraries [ V{ } clone ] initialize
: deploy-library ( name -- ) : deploy-library ( name -- )
dup libraries get key? dup libraries get key?
[ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ] [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
[ no-library ] if ; [ "deploy-library failure" no-such-library ] if ;
HOOK: >deployed-library-path os ( path -- path' ) HOOK: >deployed-library-path os ( path -- path' )

4
basis/compiler/errors/errors.factor
View File

@ -57,13 +57,13 @@ T{ error-type-holder
{ fatal? f } { fatal? f }
} define-error-type } define-error-type
TUPLE: no-such-library name message ; ERROR: no-such-library name message ;
M: no-such-library summary drop "Library not found" ; M: no-such-library summary drop "Library not found" ;
: no-such-library-error ( name message word -- ) \ no-such-library set-linkage-error ; : no-such-library-error ( name message word -- ) \ no-such-library set-linkage-error ;
TUPLE: no-such-symbol name message ; ERROR: no-such-symbol name message ;
M: no-such-symbol summary drop "Symbol not found" ; M: no-such-symbol summary drop "Symbol not found" ;

13
basis/compiler/tests/linkage-errors.factor
View File

@ -13,12 +13,12 @@ FUNCTION: void this_does_not_exist ( )
= =
] must-fail-with ] must-fail-with
[ T{ no-such-symbol { name "this_does_not_exist" } } ] { t } [
[
\ this_does_not_exist linkage-errors get at error>> \ this_does_not_exist linkage-errors get at error>>
[ no-such-symbol? ] [ name>> "this_does_not_exist" = ] bi and
! We don't care about the error message from dlerror, just ! We don't care about the error message from dlerror, just
! wipe it out ! wipe it out
clone f >>message ! clone f >>message
] unit-test ] unit-test
<< "no_such_library" "no_such_library" cdecl add-library >> << "no_such_library" "no_such_library" cdecl add-library >>
@ -38,10 +38,7 @@ FUNCTION: void no_such_function ( )
= =
] must-fail-with ] must-fail-with
[ T{ no-such-library { name "no_such_library" } } ] { t } [
[
\ no_such_function linkage-errors get at error>> \ no_such_function linkage-errors get at error>>
! We don't care about the error message from dlerror, just [ no-such-library? ] [ name>> "no_such_library" = ] bi and
! wipe it out
clone f >>message
] unit-test ] unit-test