mirror of git://git.gnupg.org/gnupg.git
gpgscm: Fix property lists.
* tests/gpgscm/opdefines.h (put, get): Check arguments. Also rename to 'set-symbol-property' and 'symbol-property', the names used by Guile, because put and get are too unspecific. * tests/gpgscm/scheme.c (hasprop): Only symbols have property lists. (get_property): New function. (set_property): Likewise. (opexe_4): Use the new functions. Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
parent
7b4e2ea274
commit
d8df804272
|
@ -146,8 +146,8 @@
|
||||||
_OP_DEF(opexe_4, "list*", 1, INF_ARG, TST_NONE, OP_LIST_STAR )
|
_OP_DEF(opexe_4, "list*", 1, INF_ARG, TST_NONE, OP_LIST_STAR )
|
||||||
_OP_DEF(opexe_4, "append", 0, INF_ARG, TST_NONE, OP_APPEND )
|
_OP_DEF(opexe_4, "append", 0, INF_ARG, TST_NONE, OP_APPEND )
|
||||||
#if USE_PLIST
|
#if USE_PLIST
|
||||||
_OP_DEF(opexe_4, "put", 3, 3, TST_NONE, OP_PUT )
|
_OP_DEF(opexe_4, "set-symbol-property!", 3, 3, TST_SYMBOL TST_SYMBOL TST_ANY, OP_SET_SYMBOL_PROPERTY )
|
||||||
_OP_DEF(opexe_4, "get", 2, 2, TST_NONE, OP_GET )
|
_OP_DEF(opexe_4, "symbol-property", 2, 2, TST_SYMBOL TST_SYMBOL, OP_SYMBOL_PROPERTY )
|
||||||
#endif
|
#endif
|
||||||
_OP_DEF(opexe_4, "quit", 0, 1, TST_NUMBER, OP_QUIT )
|
_OP_DEF(opexe_4, "quit", 0, 1, TST_NUMBER, OP_QUIT )
|
||||||
_OP_DEF(opexe_4, "gc", 0, 0, 0, OP_GC )
|
_OP_DEF(opexe_4, "gc", 0, 0, 0, OP_GC )
|
||||||
|
|
|
@ -250,7 +250,7 @@ INTERFACE pointer set_cdr(pointer p, pointer q) { return cdr(p)=q; }
|
||||||
INTERFACE INLINE int is_symbol(pointer p) { return (type(p)==T_SYMBOL); }
|
INTERFACE INLINE int is_symbol(pointer p) { return (type(p)==T_SYMBOL); }
|
||||||
INTERFACE INLINE char *symname(pointer p) { return strvalue(car(p)); }
|
INTERFACE INLINE char *symname(pointer p) { return strvalue(car(p)); }
|
||||||
#if USE_PLIST
|
#if USE_PLIST
|
||||||
SCHEME_EXPORT INLINE int hasprop(pointer p) { return (typeflag(p)&T_SYMBOL); }
|
SCHEME_EXPORT INLINE int hasprop(pointer p) { return (is_symbol(p)); }
|
||||||
#define symprop(p) cdr(p)
|
#define symprop(p) cdr(p)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -3380,6 +3380,52 @@ static pointer opexe_1(scheme *sc, enum scheme_opcodes op) {
|
||||||
return sc->T;
|
return sc->T;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#if USE_PLIST
|
||||||
|
static pointer
|
||||||
|
get_property(scheme *sc, pointer obj, pointer key)
|
||||||
|
{
|
||||||
|
pointer x;
|
||||||
|
|
||||||
|
assert (is_symbol(obj));
|
||||||
|
assert (is_symbol(key));
|
||||||
|
|
||||||
|
for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
|
||||||
|
if (caar(x) == key)
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (x != sc->NIL)
|
||||||
|
return cdar(x);
|
||||||
|
|
||||||
|
return sc->NIL;
|
||||||
|
}
|
||||||
|
|
||||||
|
static pointer
|
||||||
|
set_property(scheme *sc, pointer obj, pointer key, pointer value)
|
||||||
|
{
|
||||||
|
#define set_property_allocates 2
|
||||||
|
pointer x;
|
||||||
|
|
||||||
|
assert (is_symbol(obj));
|
||||||
|
assert (is_symbol(key));
|
||||||
|
|
||||||
|
for (x = symprop(obj); x != sc->NIL; x = cdr(x)) {
|
||||||
|
if (caar(x) == key)
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (x != sc->NIL)
|
||||||
|
cdar(x) = value;
|
||||||
|
else {
|
||||||
|
gc_disable(sc, gc_reservations(set_property));
|
||||||
|
symprop(obj) = cons(sc, cons(sc, key, value), symprop(obj));
|
||||||
|
gc_enable(sc);
|
||||||
|
}
|
||||||
|
|
||||||
|
return sc->T;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
|
static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
|
||||||
pointer x;
|
pointer x;
|
||||||
num v;
|
num v;
|
||||||
|
@ -4127,36 +4173,14 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
|
||||||
s_return(sc, reverse_in_place(sc, car(y), x));
|
s_return(sc, reverse_in_place(sc, car(y), x));
|
||||||
|
|
||||||
#if USE_PLIST
|
#if USE_PLIST
|
||||||
CASE(OP_PUT): /* put */
|
CASE(OP_SET_SYMBOL_PROPERTY): /* set-symbol-property! */
|
||||||
if (!hasprop(car(sc->args)) || !hasprop(cadr(sc->args))) {
|
gc_disable(sc, gc_reservations(set_property));
|
||||||
Error_0(sc,"illegal use of put");
|
s_return_enable_gc(sc,
|
||||||
}
|
set_property(sc, car(sc->args),
|
||||||
for (x = symprop(car(sc->args)), y = cadr(sc->args); x != sc->NIL; x = cdr(x)) {
|
cadr(sc->args), caddr(sc->args)));
|
||||||
if (caar(x) == y) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (x != sc->NIL)
|
|
||||||
cdar(x) = caddr(sc->args);
|
|
||||||
else
|
|
||||||
symprop(car(sc->args)) = cons(sc, cons(sc, y, caddr(sc->args)),
|
|
||||||
symprop(car(sc->args)));
|
|
||||||
s_return(sc,sc->T);
|
|
||||||
|
|
||||||
CASE(OP_GET): /* get */
|
CASE(OP_SYMBOL_PROPERTY): /* symbol-property */
|
||||||
if (!hasprop(car(sc->args)) || !hasprop(cadr(sc->args))) {
|
s_return(sc, get_property(sc, car(sc->args), cadr(sc->args)));
|
||||||
Error_0(sc,"illegal use of get");
|
|
||||||
}
|
|
||||||
for (x = symprop(car(sc->args)), y = cadr(sc->args); x != sc->NIL; x = cdr(x)) {
|
|
||||||
if (caar(x) == y) {
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (x != sc->NIL) {
|
|
||||||
s_return(sc,cdar(x));
|
|
||||||
} else {
|
|
||||||
s_return(sc,sc->NIL);
|
|
||||||
}
|
|
||||||
#endif /* USE_PLIST */
|
#endif /* USE_PLIST */
|
||||||
CASE(OP_QUIT): /* quit */
|
CASE(OP_QUIT): /* quit */
|
||||||
if(is_pair(sc->args)) {
|
if(is_pair(sc->args)) {
|
||||||
|
|
Loading…
Reference in New Issue