Commit 38dfa894 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

revamped checkargs error handling

parent b32382fb

Util.pm

+19 −12
Original line number Diff line number Diff line
@@ -21,6 +21,19 @@ BEGIN { 
                    );

}



sub caller_name {

        my ($level) = @_;

        my (undef, undef, undef, $name) = caller($level + 1);

        $name =~ s/.*B//;

        return $name;

}



sub arg_type_error {

        my ($argno, $type, $arg) = @_;

        return error("argument %d to builtin function %s is not a %s: %s",

                     $argno, caller_name(2), $type, $arg);

}



# check arguments; descriptor is string "xxx:xx" with mandatory args

# before the :, then optional args; x is:

#  e: any expression
@@ -34,7 +47,6 @@ BEGIN { 
#  R: rest of the arglist converted to array

sub checkargs {

        my ($arglist, $descriptor) = @_;

        my (undef, undef, undef, $function_name) = caller(1);

        my @result = ();

        my $argno = 0;

        my $optional = 0;
@@ -56,7 +68,7 @@ sub checkargs { 
                        next;

                }

                return error("too few arguments to function %s: %s",

                             $function_name, $argno)

                             caller_name(1), $argno)

                    unless $optional || consp($arglist);

                my $arg;

                ($arg, $arglist) = cxr($arglist);
@@ -75,24 +87,19 @@ sub checkargs { 
                } elsif ($desc eq 'S') {

                        $arg = &$Princs($arg);

                } elsif ($desc eq 'y') {

                        error("argument %d to function %s not a symbol: %s",

                              $argno, $function_name, $arg)

                        arg_type_error($argno, "symbol", $arg)

                            unless symbolp($arg);

                } elsif ($desc eq 'p') {

                        error("argument %d to function %s not a pair: %s",

                              $argno, $function_name, $arg)

                        arg_type_error($argno, "pair", $arg)

                            unless consp($arg);

                } elsif ($desc eq 'l') {

                        error("argument %d to function %s not a list: %s",

                              $argno, $function_name, $arg)

                        arg_type_error($argno, "list", $arg)

                            unless listp($arg);

                } elsif ($desc eq 'n') {

                        error("argument %d to function %s not a number: %s",

                              $argno, $function_name, $arg)

                        arg_type_error($argno, "number", $arg)

                            unless numberp($arg);

                } elsif ($desc eq 's') {

                        error("argument %d to function %s not a string: %s",

                              $argno, $function_name, $arg)

                        arg_type_error($argno, "string", $arg)

                            unless stringp($arg);

                } else {

                        error("internal error, unknown arg descriptor %s",