repair chaperone handling in current-command-line-arguments

This commit is contained in:
Matthew Flatt 2015-04-06 12:44:47 -05:00
parent af1b96849c
commit 23ec573e51
3 changed files with 20 additions and 9 deletions

View File

@ -2042,6 +2042,16 @@
(regexp-match #rx"struct-type-property-accessor-procedure[?]" (regexp-match #rx"struct-type-property-accessor-procedure[?]"
(exn-message x)))))) (exn-message x))))))
;; ----------------------------------------
;; Make sure that `current-command-line-arguments` works with chaperones:
(test "b"
'current-command-line-arguments
(parameterize ([current-command-line-arguments
(chaperone-vector (vector "a" "b" "c")
(lambda (b i v) v) (lambda (b i v) v))])
(vector-ref (current-command-line-arguments) 1)))
;; ---------------------------------------- ;; ----------------------------------------
(report-errs) (report-errs)

View File

@ -1018,6 +1018,8 @@ typedef struct Scheme_Chaperone {
|| (SCHEME_NP_CHAPERONEP(obj) \ || (SCHEME_NP_CHAPERONEP(obj) \
&& SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(obj)))) && SCHEME_CONTINUATION_MARK_KEYP(SCHEME_CHAPERONE_VAL(obj))))
#define SCHEME_CHAPERONE_VEC_SIZE(obj) (SCHEME_NP_CHAPERONEP(obj) ? SCHEME_VEC_SIZE(SCHEME_CHAPERONE_VAL(obj)) : SCHEME_VEC_SIZE(obj))
Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i); Scheme_Object *scheme_chaperone_vector_ref(Scheme_Object *o, int i);
void scheme_chaperone_vector_set(Scheme_Object *o, int i, Scheme_Object *v); void scheme_chaperone_vector_set(Scheme_Object *o, int i, Scheme_Object *v);

View File

@ -1080,7 +1080,7 @@ void scheme_get_substring_indices(const char *name, Scheme_Object *str,
intptr_t start, finish; intptr_t start, finish;
if (SCHEME_CHAPERONE_VECTORP(str)) if (SCHEME_CHAPERONE_VECTORP(str))
len = SCHEME_VEC_SIZE(str); len = SCHEME_CHAPERONE_VEC_SIZE(str);
else if (SCHEME_CHAR_STRINGP(str)) else if (SCHEME_CHAR_STRINGP(str))
len = SCHEME_CHAR_STRTAG_VAL(str); len = SCHEME_CHAR_STRTAG_VAL(str);
else else
@ -2850,23 +2850,22 @@ static Scheme_Object *ok_cmdline(int argc, Scheme_Object **argv)
{ {
if (SCHEME_CHAPERONE_VECTORP(argv[0])) { if (SCHEME_CHAPERONE_VECTORP(argv[0])) {
Scheme_Object *vec = argv[0], *vec2, *str; Scheme_Object *vec = argv[0], *vec2, *str;
int i, size = SCHEME_VEC_SIZE(vec); int i, size = SCHEME_CHAPERONE_VEC_SIZE(vec);
if (!size) if (!size)
return vec; return vec;
for (i = 0; i < size; i++) {
if (!SCHEME_CHAR_STRINGP(SCHEME_VEC_ELS(vec)[i]))
return NULL;
}
/* Make sure vector and strings are immutable: */ /* Make sure vector and strings are immutable: */
vec2 = scheme_make_vector(size, NULL); vec2 = scheme_make_vector(size, NULL);
if (size) if (size)
SCHEME_SET_VECTOR_IMMUTABLE(vec2); SCHEME_SET_VECTOR_IMMUTABLE(vec2);
for (i = 0; i < size; i++) { for (i = 0; i < size; i++) {
str = SCHEME_VEC_ELS(vec)[i]; if (SCHEME_VECTORP(vec))
str = SCHEME_VEC_ELS(vec)[i];
else
str = scheme_chaperone_vector_ref(vec, i);
if (!SCHEME_CHAR_STRINGP(str))
return NULL;
if (!SCHEME_IMMUTABLE_CHAR_STRINGP(str)) { if (!SCHEME_IMMUTABLE_CHAR_STRINGP(str)) {
str = scheme_make_sized_char_string(SCHEME_CHAR_STR_VAL(str), SCHEME_CHAR_STRLEN_VAL(str), 0); str = scheme_make_sized_char_string(SCHEME_CHAR_STR_VAL(str), SCHEME_CHAR_STRLEN_VAL(str), 0);
SCHEME_SET_CHAR_STRING_IMMUTABLE(str); SCHEME_SET_CHAR_STRING_IMMUTABLE(str);