Test non-object arguments for undef
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/dfc084ea Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/dfc084ea Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/dfc084ea Branch: refs/heads/master Commit: dfc084ea926ff9ba3da1330313dc270b14c24192 Parents: da15a25 Author: Nick Wellnhofer <wellnho...@aevum.de> Authored: Tue Dec 1 13:39:26 2015 +0100 Committer: Nick Wellnhofer <wellnho...@aevum.de> Committed: Tue Dec 1 16:06:03 2015 +0100 ---------------------------------------------------------------------- compiler/src/CFCPerlConstructor.c | 1 + compiler/src/CFCPerlMethod.c | 4 +++- compiler/src/CFCPerlSub.c | 39 +++++++++++++++++++++++----------- runtime/perl/xs/XSBind.c | 8 +++++-- runtime/perl/xs/XSBind.h | 6 ++++++ 5 files changed, 43 insertions(+), 15 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/dfc084ea/compiler/src/CFCPerlConstructor.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlConstructor.c b/compiler/src/CFCPerlConstructor.c index 68f20e1..c0c3a89 100644 --- a/compiler/src/CFCPerlConstructor.c +++ b/compiler/src/CFCPerlConstructor.c @@ -146,6 +146,7 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { " dXSARGS;\n" "%s" // param_specs "%s" // locs_decl + " SV *sv;\n" "%s" // arg_decls " %s retval;\n" "\n" http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/dfc084ea/compiler/src/CFCPerlMethod.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c index 6c77e60..911d51d 100644 --- a/compiler/src/CFCPerlMethod.c +++ b/compiler/src/CFCPerlMethod.c @@ -264,6 +264,7 @@ S_xsub_def_labeled_params(CFCPerlMethod *self, CFCClass *klass) { " dXSARGS;\n" "%s" // param_specs " int32_t locations[%d];\n" + " SV *sv;\n" "%s" // arg_decls " %s method;\n" "%s" @@ -355,7 +356,8 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { "XS(%s);\n" "XS(%s) {\n" " dXSARGS;\n" - "%s" + " SV *sv;\n" + "%s" // arg_decls " %s method;\n" "%s" "\n" http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/dfc084ea/compiler/src/CFCPerlSub.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlSub.c b/compiler/src/CFCPerlSub.c index 6942abc..fb50975 100644 --- a/compiler/src/CFCPerlSub.c +++ b/compiler/src/CFCPerlSub.c @@ -182,35 +182,50 @@ S_arg_assignment(CFCVariable *var, const char *val, CFCType *var_type = CFCVariable_get_type(var); char *statement = NULL; - char perl_stack_var[40]; - sprintf(perl_stack_var, "ST(%s)", stack_location); - char *conversion = CFCPerlTypeMap_from_perl(var_type, perl_stack_var, - var_name); + char *conversion = CFCPerlTypeMap_from_perl(var_type, "sv", var_name); if (!conversion) { const char *type_c = CFCType_to_c(var_type); CFCUtil_die("Can't map type '%s'", type_c); } + if (val) { if (CFCType_is_object(var_type)) { - char pattern[] = " arg_%s = %s < items ? %s : %s;\n"; + const char pattern[] = " arg_%s = %s < items ? %s : %s;\n"; statement = CFCUtil_sprintf(pattern, var_name, stack_location, conversion, val); } else { - char pattern[] = - " arg_%s = %s < items && XSBind_sv_defined(aTHX_ %s)\n" + const char pattern[] = + " arg_%s = %s < items && XSBind_sv_defined(aTHX_ sv)\n" " ? %s : %s;\n"; statement = CFCUtil_sprintf(pattern, var_name, stack_location, - perl_stack_var, conversion, val); + conversion, val); } } else { - const char pattern[] = " arg_%s = %s;\n"; - statement = CFCUtil_sprintf(pattern, var_name, conversion); + if (CFCType_is_object(var_type)) { + const char pattern[] = " arg_%s = %s;\n"; + statement = CFCUtil_sprintf(pattern, var_name, conversion); + } + else { + const char pattern[] = + " if (!XSBind_sv_defined(aTHX_ sv)) {\n" + " XSBind_undef_arg_error(aTHX_ \"%s\");\n" + " }\n" + " arg_%s = %s;\n"; + statement = CFCUtil_sprintf(pattern, var_name, var_name, + conversion); + } } - FREEMEM(conversion); - return statement; + const char pattern[] = + " sv = ST(%s);\n" + "%s"; + char *retval = CFCUtil_sprintf(pattern, stack_location, statement); + + FREEMEM(conversion); + FREEMEM(statement); + return retval; } CFCParamList* http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/dfc084ea/runtime/perl/xs/XSBind.c ---------------------------------------------------------------------- diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c index 6175c46..314387b 100644 --- a/runtime/perl/xs/XSBind.c +++ b/runtime/perl/xs/XSBind.c @@ -391,8 +391,7 @@ XSBind_arg_to_cfish(pTHX_ SV *value, const char *label, cfish_Class *klass, } if (!obj) { - THROW(CFISH_ERR, "'%s' must not be undef", label); - CFISH_UNREACHABLE_RETURN(cfish_Obj*); + XSBind_undef_arg_error(aTHX_ label); } return obj; @@ -417,6 +416,11 @@ XSBind_invalid_args_error(pTHX_ CV *cv, const char *param_list) { THROW(CFISH_ERR, "Usage: %s(%s)", GvNAME(CvGV(cv)), param_list); } +void +XSBind_undef_arg_error(pTHX_ const char *label) { + THROW(CFISH_ERR, "'%s' must not be undef", label); +} + /*************************************************************************** * The routines below are declared within the Clownfish core but left * unimplemented and must be defined for each host language. http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/dfc084ea/runtime/perl/xs/XSBind.h ---------------------------------------------------------------------- diff --git a/runtime/perl/xs/XSBind.h b/runtime/perl/xs/XSBind.h index 7c5a9cc..fd9f4a2 100644 --- a/runtime/perl/xs/XSBind.h +++ b/runtime/perl/xs/XSBind.h @@ -202,6 +202,11 @@ cfish_XSBind_arg_to_cfish_nullable(pTHX_ SV *value, const char *label, CFISH_VISIBLE void cfish_XSBind_invalid_args_error(pTHX_ CV *cv, const char *param_list); +/** Throw an error because of an undefined argument. + */ +CFISH_VISIBLE void +cfish_XSBind_undef_arg_error(pTHX_ const char *label); + #define XSBIND_PARAM(key, required) \ { key, (int16_t)sizeof("" key) - 1, (char)required } @@ -228,6 +233,7 @@ cfish_XSBind_invalid_args_error(pTHX_ CV *cv, const char *param_list); #define XSBind_arg_to_cfish cfish_XSBind_arg_to_cfish #define XSBind_arg_to_cfish_nullable cfish_XSBind_arg_to_cfish_nullable #define XSBind_invalid_args_error cfish_XSBind_invalid_args_error +#define XSBind_undef_arg_error cfish_XSBind_undef_arg_error /* Strip the prefix from some common ClownFish symbols where we know there's * no conflict with Perl. It's a little inconsistent to do this rather than
