diff options
| author | Omar Rizwan <omar@omar.website> | 2023-09-15 19:03:21 +0000 |
|---|---|---|
| committer | Omar Rizwan <omar@omar.website> | 2023-09-15 19:03:21 +0000 |
| commit | 6aecdbf578bb9d143b19ca7b395f06af2ecdadb9 (patch) | |
| tree | b77bb47f4acb1e9d190e252ba5f57e3b0373f662 /lib | |
| parent | terminal: Fix(?) on Darwin (diff) | |
| download | folk-6aecdbf578bb9d143b19ca7b395f06af2ecdadb9.tar.gz folk-6aecdbf578bb9d143b19ca7b395f06af2ecdadb9.zip | |
c: Warn but don't break if we don't know how to emit a struct getter
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/c.tcl | 34 |
1 files changed, 19 insertions, 15 deletions
@@ -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 { |