add saved-errno setter variant

This makes it easier to create mock foreign functions
(or wrap existing ones) for testing.
This commit is contained in:
Ryan Culpepper 2016-02-19 16:30:28 -05:00
parent f2bef56a2e
commit 2cc4b66184
3 changed files with 32 additions and 9 deletions

View File

@ -26,11 +26,16 @@ internal representation of @racket[vec].}
Returns a pointer to an array of @racket[_double] values, which is the Returns a pointer to an array of @racket[_double] values, which is the
internal representation of @racket[flvec].} internal representation of @racket[flvec].}
@defproc[(saved-errno) exact-integer?]{ @defproc*[([(saved-errno) exact-integer?]
[(saved-errno [new-value exact-integer?]) void?])]{
Returns the value most recently saved (in the current thread) after a Returns or sets the error code saved for the current Racket
foreign call with a non-@racket[#f] @racket[#:save-errno] option (see thread. The saved error code is set after a foreign call with a
@racket[_fun] and @racket[_cprocedure]).} non-@racket[#f] @racket[#:save-errno] option (see @racket[_fun] and
@racket[_cprocedure]), but it can also be set explicitly (for example,
to create mock foreign functions for testing).
@history[#:changed "6.4.0.9"]{Added the one-argument variant.}}
@defproc[(lookup-errno [sym (or/c 'EINTR 'EEXIST 'EAGAIN)]) @defproc[(lookup-errno [sym (or/c 'EINTR 'EEXIST 'EAGAIN)])
exact-integer?]{ exact-integer?]{

View File

@ -4290,7 +4290,16 @@ static void save_errno_values(int kind)
static Scheme_Object *foreign_saved_errno(int argc, Scheme_Object *argv[]) static Scheme_Object *foreign_saved_errno(int argc, Scheme_Object *argv[])
{ {
Scheme_Thread *p = scheme_current_thread; Scheme_Thread *p = scheme_current_thread;
if (argc == 0) {
return scheme_make_integer_value(p->saved_errno); return scheme_make_integer_value(p->saved_errno);
} else {
intptr_t v;
if (!scheme_get_int_val(argv[0], &v)) {
wrong_intptr(MYNAME, 0, argc, argv);
}
p->saved_errno = v;
return scheme_void;
}
} }
#undef MYNAME #undef MYNAME
@ -4552,7 +4561,7 @@ void scheme_init_foreign(Scheme_Env *env)
scheme_add_global_constant("ffi-callback", scheme_add_global_constant("ffi-callback",
scheme_make_noncm_prim(foreign_ffi_callback, "ffi-callback", 3, 6), menv); scheme_make_noncm_prim(foreign_ffi_callback, "ffi-callback", 3, 6), menv);
scheme_add_global_constant("saved-errno", scheme_add_global_constant("saved-errno",
scheme_make_immed_prim(foreign_saved_errno, "saved-errno", 0, 0), menv); scheme_make_immed_prim(foreign_saved_errno, "saved-errno", 0, 1), menv);
scheme_add_global_constant("lookup-errno", scheme_add_global_constant("lookup-errno",
scheme_make_immed_prim(foreign_lookup_errno, "lookup-errno", 1, 1), menv); scheme_make_immed_prim(foreign_lookup_errno, "lookup-errno", 1, 1), menv);
scheme_add_global_constant("make-stubborn-will-executor", scheme_add_global_constant("make-stubborn-will-executor",
@ -4923,7 +4932,7 @@ void scheme_init_foreign(Scheme_Env *env)
scheme_add_global_constant("ffi-callback", scheme_add_global_constant("ffi-callback",
scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-callback", 3, 6), menv); scheme_make_noncm_prim((Scheme_Prim *)unimplemented, "ffi-callback", 3, 6), menv);
scheme_add_global_constant("saved-errno", scheme_add_global_constant("saved-errno",
scheme_make_immed_prim((Scheme_Prim *)unimplemented, "saved-errno", 0, 0), menv); scheme_make_immed_prim((Scheme_Prim *)unimplemented, "saved-errno", 0, 1), menv);
scheme_add_global_constant("lookup-errno", scheme_add_global_constant("lookup-errno",
scheme_make_immed_prim((Scheme_Prim *)unimplemented, "lookup-errno", 1, 1), menv); scheme_make_immed_prim((Scheme_Prim *)unimplemented, "lookup-errno", 1, 1), menv);
scheme_add_global_constant("make-stubborn-will-executor", scheme_add_global_constant("make-stubborn-will-executor",

View File

@ -3441,9 +3441,18 @@ static void save_errno_values(int kind)
p->saved_errno = errno; p->saved_errno = errno;
} }
@cdefine[saved-errno 0 #:kind immed]{ @cdefine[saved-errno 0 1 #:kind immed]{
Scheme_Thread *p = scheme_current_thread; Scheme_Thread *p = scheme_current_thread;
if (argc == 0) {
return scheme_make_integer_value(p->saved_errno); return scheme_make_integer_value(p->saved_errno);
} else {
intptr_t v;
if (!scheme_get_int_val(argv[0], &v)) {
wrong_intptr(MYNAME, 0, argc, argv);
}
p->saved_errno = v;
return scheme_void;
}
} }
@cdefine[lookup-errno 1 #:kind immed]{ @cdefine[lookup-errno 1 #:kind immed]{