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

gpgscm: Improve error reporting. 

* tests/gpgscm/init.scm (throw'): Guard against 'args' being atomic.
* tests/gpgscm/scheme.c (Eval_Cycle): Remove any superfluous colons in
error messages.

Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
Justus Winter 2017-06-19 16:13:24 +02:00
parent b766d3d103
commit 4c8be58fd4
No known key found for this signature in database
GPG Key ID: DD1A52F9DA8C9020
2 changed files with 27 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
tests/gpgscm/init.scm
View File

@ -615,7 +615,7 @@
(display message) (display message)
(when (and args (not (null? args))) (when (and args (not (null? args)))
(display ": ") (display ": ")
(if (string? (car args)) (if (and (pair? args) (string? (car args)))
(begin (display (car args)) (begin (display (car args))
(unless (null? (cdr args)) (unless (null? (cdr args))
(newline) (newline)

50
tests/gpgscm/scheme.c
View File

@ -3565,7 +3565,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
if (x != sc->NIL) { if (x != sc->NIL) {
s_return(sc,slot_value_in_env(x)); s_return(sc,slot_value_in_env(x));
} else { } else {
Error_1(sc,"eval: unbound variable:", sc->code); Error_1(sc, "eval: unbound variable", sc->code);
} }
} else if (is_pair(sc->code)) { } else if (is_pair(sc->code)) {
if (is_syntax(x = car(sc->code))) { /* SYNTAX */ if (is_syntax(x = car(sc->code))) { /* SYNTAX */
@ -3677,7 +3677,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
for (x = car(closure_code(sc->code)), y = sc->args; for (x = car(closure_code(sc->code)), y = sc->args;
is_pair(x); x = cdr(x), y = cdr(y)) { is_pair(x); x = cdr(x), y = cdr(y)) {
if (y == sc->NIL) { if (y == sc->NIL) {
Error_1(sc, "not enough arguments, missing:", x); Error_1(sc, "not enough arguments, missing", x);
} else if (is_symbol(car(x))) { } else if (is_symbol(car(x))) {
new_slot_in_env(sc, car(x), car(y)); new_slot_in_env(sc, car(x), car(y));
} else { } else {
@ -3692,7 +3692,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
} else if (is_symbol(x)) } else if (is_symbol(x))
new_slot_in_env(sc, x, y); new_slot_in_env(sc, x, y);
else { else {
Error_1(sc,"syntax error in closure: not a symbol:", x); Error_1(sc, "syntax error in closure: not a symbol", x);
} }
sc->code = cdr(closure_code(sc->code)); sc->code = cdr(closure_code(sc->code));
sc->args = sc->NIL; sc->args = sc->NIL;
@ -3805,7 +3805,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
set_slot_in_env(sc, y, sc->value); set_slot_in_env(sc, y, sc->value);
s_return(sc,sc->value); s_return(sc,sc->value);
} else { } else {
Error_1(sc,"set!: unbound variable:", sc->code); Error_1(sc, "set!: unbound variable", sc->code);
} }
@ -3855,7 +3855,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
if (is_pair(sc->code)) { /* continue */ if (is_pair(sc->code)) { /* continue */
if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) { if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) {
gc_enable(sc); gc_enable(sc);
Error_1(sc, "Bad syntax of binding spec in let :", Error_1(sc, "Bad syntax of binding spec in let",
car(sc->code)); car(sc->code));
} }
s_save(sc,OP_LET1, sc->args, cdr(sc->code)); s_save(sc,OP_LET1, sc->args, cdr(sc->code));
@ -3881,9 +3881,9 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
if (is_symbol(car(sc->code))) { /* named let */ if (is_symbol(car(sc->code))) { /* named let */
for (x = cadr(sc->code), sc->args = sc->NIL; x != sc->NIL; x = cdr(x)) { for (x = cadr(sc->code), sc->args = sc->NIL; x != sc->NIL; x = cdr(x)) {
if (!is_pair(x)) if (!is_pair(x))
Error_1(sc, "Bad syntax of binding in let :", x); Error_1(sc, "Bad syntax of binding in let", x);
if (!is_list(sc, car(x))) if (!is_list(sc, car(x)))
Error_1(sc, "Bad syntax of binding in let :", car(x)); Error_1(sc, "Bad syntax of binding in let", car(x));
gc_disable(sc, 1); gc_disable(sc, 1);
sc->args = cons(sc, caar(x), sc->args); sc->args = cons(sc, caar(x), sc->args);
gc_enable(sc); gc_enable(sc);
@ -3907,7 +3907,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
s_thread_to(sc,OP_BEGIN); s_thread_to(sc,OP_BEGIN);
} }
if(!is_pair(car(sc->code)) || !is_pair(caar(sc->code)) || !is_pair(cdaar(sc->code))) { if(!is_pair(car(sc->code)) || !is_pair(caar(sc->code)) || !is_pair(cdaar(sc->code))) {
Error_1(sc,"Bad syntax of binding spec in let* :",car(sc->code)); Error_1(sc, "Bad syntax of binding spec in let*", car(sc->code));
} }
s_save(sc,OP_LET1AST, cdr(sc->code), car(sc->code)); s_save(sc,OP_LET1AST, cdr(sc->code), car(sc->code));
sc->code = cadaar(sc->code); sc->code = cadaar(sc->code);
@ -3946,7 +3946,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
gc_enable(sc); gc_enable(sc);
if (is_pair(sc->code)) { /* continue */ if (is_pair(sc->code)) { /* continue */
if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) { if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) {
Error_1(sc, "Bad syntax of binding spec in letrec :", Error_1(sc, "Bad syntax of binding spec in letrec",
car(sc->code)); car(sc->code));
} }
s_save(sc,OP_LET1REC, sc->args, cdr(sc->code)); s_save(sc,OP_LET1REC, sc->args, cdr(sc->code));
@ -4165,7 +4165,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
} else if(modf(rvalue_unchecked(x),&dd)==0.0) { } else if(modf(rvalue_unchecked(x),&dd)==0.0) {
s_return(sc,mk_integer(sc,ivalue(x))); s_return(sc,mk_integer(sc,ivalue(x)));
} else { } else {
Error_1(sc,"inexact->exact: not integral:",x); Error_1(sc, "inexact->exact: not integral", x);
} }
CASE(OP_EXP): CASE(OP_EXP):
@ -4425,7 +4425,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
} }
} }
if (pf < 0) { if (pf < 0) {
Error_1(sc, "string->atom: bad base:", cadr(sc->args)); Error_1(sc, "string->atom: bad base", cadr(sc->args));
} else if(*s=='#') /* no use of base! */ { } else if(*s=='#') /* no use of base! */ {
s_return(sc, mk_sharp_const(sc, s+1)); s_return(sc, mk_sharp_const(sc, s+1));
} else { } else {
@ -4466,7 +4466,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
} }
} }
if (pf < 0) { if (pf < 0) {
Error_1(sc, "atom->string: bad base:", cadr(sc->args)); Error_1(sc, "atom->string: bad base", cadr(sc->args));
} else if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) { } else if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) {
char *p; char *p;
int len; int len;
@ -4474,7 +4474,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
gc_disable(sc, 1); gc_disable(sc, 1);
s_return_enable_gc(sc, mk_counted_string(sc, p, len)); s_return_enable_gc(sc, mk_counted_string(sc, p, len));
} else { } else {
Error_1(sc, "atom->string: not an atom:", x); Error_1(sc, "atom->string: not an atom", x);
} }
} }
@ -4504,7 +4504,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
index=ivalue(cadr(sc->args)); index=ivalue(cadr(sc->args));
if(index>=strlength(car(sc->args))) { if(index>=strlength(car(sc->args))) {
Error_1(sc,"string-ref: out of bounds:",cadr(sc->args)); Error_1(sc, "string-ref: out of bounds", cadr(sc->args));
} }
gc_disable(sc, 1); gc_disable(sc, 1);
@ -4518,13 +4518,14 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
int c; int c;
if(is_immutable(car(sc->args))) { if(is_immutable(car(sc->args))) {
Error_1(sc,"string-set!: unable to alter immutable string:",car(sc->args)); Error_1(sc, "string-set!: unable to alter immutable string",
car(sc->args));
} }
str=strvalue(car(sc->args)); str=strvalue(car(sc->args));
index=ivalue(cadr(sc->args)); index=ivalue(cadr(sc->args));
if(index>=strlength(car(sc->args))) { if(index>=strlength(car(sc->args))) {
Error_1(sc,"string-set!: out of bounds:",cadr(sc->args)); Error_1(sc, "string-set!: out of bounds", cadr(sc->args));
} }
c=charvalue(caddr(sc->args)); c=charvalue(caddr(sc->args));
@ -4563,13 +4564,13 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
index0=ivalue(cadr(sc->args)); index0=ivalue(cadr(sc->args));
if(index0>strlength(car(sc->args))) { if(index0>strlength(car(sc->args))) {
Error_1(sc,"substring: start out of bounds:",cadr(sc->args)); Error_1(sc, "substring: start out of bounds", cadr(sc->args));
} }
if(cddr(sc->args)!=sc->NIL) { if(cddr(sc->args)!=sc->NIL) {
index1=ivalue(caddr(sc->args)); index1=ivalue(caddr(sc->args));
if(index1>strlength(car(sc->args)) || index1<index0) { if(index1>strlength(car(sc->args)) || index1<index0) {
Error_1(sc,"substring: end out of bounds:",caddr(sc->args)); Error_1(sc, "substring: end out of bounds", caddr(sc->args));
} }
} else { } else {
index1=strlength(car(sc->args)); index1=strlength(car(sc->args));
@ -4584,7 +4585,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
pointer vec; pointer vec;
int len=list_length(sc,sc->args); int len=list_length(sc,sc->args);
if(len<0) { if(len<0) {
Error_1(sc,"vector: not a proper list:",sc->args); Error_1(sc, "vector: not a proper list", sc->args);
} }
vec=mk_vector(sc,len); vec=mk_vector(sc,len);
if(sc->no_memory) { s_return(sc, sc->sink); } if(sc->no_memory) { s_return(sc, sc->sink); }
@ -4622,7 +4623,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
index=ivalue(cadr(sc->args)); index=ivalue(cadr(sc->args));
if(index >= vector_length(car(sc->args))) { if(index >= vector_length(car(sc->args))) {
Error_1(sc,"vector-ref: out of bounds:",cadr(sc->args)); Error_1(sc, "vector-ref: out of bounds", cadr(sc->args));
} }
s_return(sc,vector_elem(car(sc->args),index)); s_return(sc,vector_elem(car(sc->args),index));
@ -4632,12 +4633,13 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
int index; int index;
if(is_immutable(car(sc->args))) { if(is_immutable(car(sc->args))) {
Error_1(sc,"vector-set!: unable to alter immutable vector:",car(sc->args)); Error_1(sc, "vector-set!: unable to alter immutable vector",
car(sc->args));
} }
index=ivalue(cadr(sc->args)); index=ivalue(cadr(sc->args));
if(index >= vector_length(car(sc->args))) { if(index >= vector_length(car(sc->args))) {
Error_1(sc,"vector-set!: out of bounds:",cadr(sc->args)); Error_1(sc, "vector-set!: out of bounds", cadr(sc->args));
} }
set_vector_elem(car(sc->args),index,caddr(sc->args)); set_vector_elem(car(sc->args),index,caddr(sc->args));
@ -4980,7 +4982,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
s_thread_to(sc,OP_READ_INTERNAL); s_thread_to(sc,OP_READ_INTERNAL);
} }
if(!is_inport(car(sc->args))) { if(!is_inport(car(sc->args))) {
Error_1(sc,"read: not an input port:",car(sc->args)); Error_1(sc, "read: not an input port", car(sc->args));
} }
if(car(sc->args)==sc->inport) { if(car(sc->args)==sc->inport) {
s_thread_to(sc,OP_READ_INTERNAL); s_thread_to(sc,OP_READ_INTERNAL);
@ -5258,7 +5260,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
CASE(OP_LIST_LENGTH): { /* length */ /* a.k */ CASE(OP_LIST_LENGTH): { /* length */ /* a.k */
long l = list_length(sc, car(sc->args)); long l = list_length(sc, car(sc->args));
if(l<0) { if(l<0) {
Error_1(sc,"length: not a list:",car(sc->args)); Error_1(sc, "length: not a list", car(sc->args));
} }
gc_disable(sc, 1); gc_disable(sc, 1);
s_return_enable_gc(sc, mk_integer(sc, l)); s_return_enable_gc(sc, mk_integer(sc, l));