From 6aecdbf578bb9d143b19ca7b395f06af2ecdadb9 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 15 Sep 2023 15:03:21 -0400 Subject: c: Warn but don't break if we don't know how to emit a struct getter --- lib/c.tcl | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) (limited to 'lib') diff --git a/lib/c.tcl b/lib/c.tcl index a277db87..c26c0940 100644 --- a/lib/c.tcl +++ b/lib/c.tcl @@ -325,26 +325,30 @@ namespace eval c { set ns [uplevel {namespace current}]::$type namespace eval $ns {} foreach {fieldtype fieldname} $fields { - if {$fieldtype ne "Tcl_Obj*" && - [regexp {([^\[]+)(?:\[(\d*)\]|\*)$} $fieldtype -> basefieldtype arraylen]} { - if {$basefieldtype eq "char"} { - proc ${ns}::$fieldname {Tcl_Interp* interp Tcl_Obj* obj} char* { - __ENSURE_OK(Tcl_ConvertToType(interp, obj, &$[set type]_ObjType)); - return (($type *)obj->internalRep.ptrAndLongRep.ptr)->$fieldname; + try { + if {$fieldtype ne "Tcl_Obj*" && + [regexp {([^\[]+)(?:\[(\d*)\]|\*)$} $fieldtype -> basefieldtype arraylen]} { + if {$basefieldtype eq "char"} { + proc ${ns}::$fieldname {Tcl_Interp* interp Tcl_Obj* obj} char* { + __ENSURE_OK(Tcl_ConvertToType(interp, obj, &$[set type]_ObjType)); + return (($type *)obj->internalRep.ptrAndLongRep.ptr)->$fieldname; + } + } else { + # If fieldtype is a pointer or an array, + # then make a getter that takes an index. + proc ${ns}::$fieldname {Tcl_Interp* interp Tcl_Obj* obj int idx} $basefieldtype { + __ENSURE_OK(Tcl_ConvertToType(interp, obj, &$[set type]_ObjType)); + return (($type *)obj->internalRep.ptrAndLongRep.ptr)->$fieldname[idx]; + } } } else { - # If fieldtype is a pointer or an array, - # then make a getter that takes an index. - proc ${ns}::$fieldname {Tcl_Interp* interp Tcl_Obj* obj int idx} $basefieldtype { + proc ${ns}::$fieldname {Tcl_Interp* interp Tcl_Obj* obj} $fieldtype { __ENSURE_OK(Tcl_ConvertToType(interp, obj, &$[set type]_ObjType)); - return (($type *)obj->internalRep.ptrAndLongRep.ptr)->$fieldname[idx]; + return (($type *)obj->internalRep.ptrAndLongRep.ptr)->$fieldname; } } - } else { - proc ${ns}::$fieldname {Tcl_Interp* interp Tcl_Obj* obj} $fieldtype { - __ENSURE_OK(Tcl_ConvertToType(interp, obj, &$[set type]_ObjType)); - return (($type *)obj->internalRep.ptrAndLongRep.ptr)->$fieldname; - } + } on error e { + puts stderr "Warning: Unable to generate getter for `$type $fieldname`: $e" } } namespace eval $ns { -- cgit v1.2.3