repair chaperone handling in current-command-line-arguments
This commit is contained in:
parent
af1b96849c
commit
23ec573e51
|
@ -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)
|
||||||
|
|
|
@ -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);
|
||||||
|
|
||||||
|
|
|
@ -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);
|
||||||
|
|
Loading…
Reference in New Issue
Block a user