diff --git a/pkgs/racket-test-core/tests/racket/struct.rktl b/pkgs/racket-test-core/tests/racket/struct.rktl index 2843124994..a59500e8b3 100644 --- a/pkgs/racket-test-core/tests/racket/struct.rktl +++ b/pkgs/racket-test-core/tests/racket/struct.rktl @@ -751,6 +751,23 @@ (test 10 a-x (make-b 10 20 30)) (test 100 a-x (make-c 100 200 300 400))) +;; ------------------------------------------------------------ +;; struct->vector on non `struct?` + +(test #f struct? void) +(test #f struct? (procedure-rename void 'still-void)) +(test #f struct? (procedure-reduce-arity void 1)) +(test #f struct? (cons 1 2)) +(test #f struct? (box 1)) +(test #f struct? (vector 1 2 3)) + +(test '#(struct:procedure ...) struct->vector void) +(test '#(struct:procedure ...) struct->vector (procedure-rename void 'still-void)) +(test '#(struct:procedure ...) struct->vector (procedure-reduce-arity void 1)) +(test '#(struct:pair ...) struct->vector (cons 1 2)) +(test '#(struct:box ...) struct->vector (box 1)) +(test '#(struct:vector ...) struct->vector (vector 1 2 3)) + ;; ------------------------------------------------------------ ;; Prefab diff --git a/racket/src/racket/src/fun.c b/racket/src/racket/src/fun.c index 7d4efb4093..a3326c8b3b 100644 --- a/racket/src/racket/src/fun.c +++ b/racket/src/racket/src/fun.c @@ -2813,7 +2813,7 @@ void scheme_init_reduced_proc_struct(Scheme_Startup_Env *env) while (insp->superior->superior) { insp = insp->superior; } - scheme_reduced_procedure_struct = scheme_make_struct_type2(NULL, + scheme_reduced_procedure_struct = scheme_make_struct_type2(scheme_intern_symbol("procedure"), NULL, (Scheme_Object *)insp, 4, 0, diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c index e26c941b64..b6bff883c4 100644 --- a/racket/src/racket/src/struct.c +++ b/racket/src/racket/src/struct.c @@ -4739,14 +4739,14 @@ Scheme_Struct_Type *scheme_make_prefab_struct_type_raw(Scheme_Object *base, return struct_type; } -static Scheme_Struct_Type *scheme_make_prefab_struct_type(Scheme_Object *base, +static Scheme_Struct_Type *scheme_make_prefab_struct_type(Scheme_Object *name, Scheme_Object *parent, int num_fields, int num_uninit_fields, Scheme_Object *uninit_val, char *immutable_array) { - return scheme_make_prefab_struct_type_raw(base, + return scheme_make_prefab_struct_type_raw(name, parent, num_fields, num_uninit_fields, @@ -4754,7 +4754,7 @@ static Scheme_Struct_Type *scheme_make_prefab_struct_type(Scheme_Object *base, immutable_array); } -static Scheme_Object *_make_struct_type(Scheme_Object *base, +static Scheme_Object *_make_struct_type(Scheme_Object *name, Scheme_Object *parent, Scheme_Object *inspector, int num_fields, @@ -4790,7 +4790,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base, struct_type->parent_types[j] = parent_type->parent_types[j]; } - struct_type->name = base; + struct_type->name = name; struct_type->nonfail_constructor = (parent_type ? parent_type->nonfail_constructor : 1); struct_type->num_slots = num_fields + num_uninit_fields + (parent_type ? parent_type->num_slots : 0); @@ -5075,7 +5075,7 @@ static Scheme_Object *_make_struct_type(Scheme_Object *base, return (Scheme_Object *)struct_type; } -Scheme_Object *scheme_make_struct_type(Scheme_Object *base, +Scheme_Object *scheme_make_struct_type(Scheme_Object *name, Scheme_Object *parent, Scheme_Object *inspector, int num_fields, int num_uninit, @@ -5083,7 +5083,7 @@ Scheme_Object *scheme_make_struct_type(Scheme_Object *base, Scheme_Object *properties, Scheme_Object *guard) { - return _make_struct_type(base, + return _make_struct_type(name, parent, inspector, num_fields, num_uninit, uninit_val, properties, @@ -5091,7 +5091,7 @@ Scheme_Object *scheme_make_struct_type(Scheme_Object *base, guard); } -Scheme_Object *scheme_make_struct_type2(Scheme_Object *base, +Scheme_Object *scheme_make_struct_type2(Scheme_Object *name, Scheme_Object *parent, Scheme_Object *inspector, int num_fields, int num_uninit, @@ -5101,7 +5101,7 @@ Scheme_Object *scheme_make_struct_type2(Scheme_Object *base, char *immutable_array, Scheme_Object *guard) { - return _make_struct_type(base, + return _make_struct_type(name, parent, inspector, num_fields, num_uninit, uninit_val, properties, @@ -5109,14 +5109,14 @@ Scheme_Object *scheme_make_struct_type2(Scheme_Object *base, guard); } -Scheme_Object *scheme_make_struct_type_from_string(const char *base, +Scheme_Object *scheme_make_struct_type_from_string(const char *name, Scheme_Object *parent, int num_fields, Scheme_Object *props, Scheme_Object *guard, int immutable) { - Scheme_Object *basesym, *r; + Scheme_Object *namesym, *r; char *immutable_array = NULL; if (immutable) { @@ -5124,9 +5124,9 @@ Scheme_Object *scheme_make_struct_type_from_string(const char *base, memset(immutable_array, 1, num_fields); } - basesym = scheme_intern_exact_symbol(base, strlen(base)); + namesym = scheme_intern_exact_symbol(name, strlen(name)); - r = _make_struct_type(basesym, + r = _make_struct_type(namesym, parent, scheme_false, num_fields, 0, NULL, props, diff --git a/racket/src/racket/src/type.c b/racket/src/racket/src/type.c index 08e4165461..5415917a38 100644 --- a/racket/src/racket/src/type.c +++ b/racket/src/racket/src/type.c @@ -112,8 +112,8 @@ scheme_init_type () set_name(scheme_eval_waiting_type, ""); set_name(scheme_void_type, ""); - set_name(scheme_prim_type, ""); - set_name(scheme_closed_prim_type, ""); + set_name(scheme_prim_type, ""); + set_name(scheme_closed_prim_type, ""); set_name(scheme_closure_type, ""); set_name(scheme_native_closure_type, ""); set_name(scheme_cont_type, "");