security-and-privacy/gnupg
security-and-privacy
/
gnupg
mirror of git://git.gnupg.org/gnupg.git
1
0
Fork 0
Code Releases Activity

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:
Justus Winter 2016-11-17 18:03:22 +01:00
parent 7b4e2ea274
commit d8df804272
2 changed files with 56 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
tests/gpgscm/opdefines.h
View File

@ -146,8 +146,8 @@
_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 )
#if USE_PLIST
_OP_DEF(opexe_4, "put", 3, 3, TST_NONE, OP_PUT )
_OP_DEF(opexe_4, "get", 2, 2, TST_NONE, OP_GET )
_OP_DEF(opexe_4, "set-symbol-property!", 3, 3, TST_SYMBOL TST_SYMBOL TST_ANY, OP_SET_SYMBOL_PROPERTY )
_OP_DEF(opexe_4, "symbol-property", 2, 2, TST_SYMBOL TST_SYMBOL, OP_SYMBOL_PROPERTY )
#endif
_OP_DEF(opexe_4, "quit", 0, 1, TST_NUMBER, OP_QUIT )
_OP_DEF(opexe_4, "gc", 0, 0, 0, OP_GC )

84
tests/gpgscm/scheme.c
View File

@ -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 char *symname(pointer p) { return strvalue(car(p)); }
#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)
#endif
@ -3380,6 +3380,52 @@ static pointer opexe_1(scheme *sc, enum scheme_opcodes op) {
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) {
pointer x;
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));
#if USE_PLIST
CASE(OP_PUT): /* put */
if (!hasprop(car(sc->args)) || !hasprop(cadr(sc->args))) {
Error_0(sc,"illegal use of put");
}
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)
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_SET_SYMBOL_PROPERTY): /* set-symbol-property! */
gc_disable(sc, gc_reservations(set_property));
s_return_enable_gc(sc,
set_property(sc, car(sc->args),
cadr(sc->args), caddr(sc->args)));
CASE(OP_GET): /* get */
if (!hasprop(car(sc->args)) || !hasprop(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);
}
CASE(OP_SYMBOL_PROPERTY): /* symbol-property */
s_return(sc, get_property(sc, car(sc->args), cadr(sc->args)));
#endif /* USE_PLIST */
CASE(OP_QUIT): /* quit */
if(is_pair(sc->args)) {