test.tcl

来自「多发法定阿凡阿道夫埃罚罚 埃担罚大多发叮罚罚多发」· TCL 代码 · 共 86 行

proc ShowExprProp {id} {
    global fp
    puts $fp "  <---- properties ----"
    puts $fp "  npiType=[npi_get $id -npiType]"
    puts $fp "  npiLineNo = [npi_get $id -npiLineNo]"
    if {[npi_get $id -npiType] == "npiConstant"} {
        puts $fp "  npiConstType=[npi_get $id -npiConstType]"
        puts $fp "  npiValue = [npi_get $id -npiValue]"
    } elseif {[npi_get $id -npiType] == "npiOperation"} {
        puts $fp "  npiOpType = [npi_get $id -npiOpType]"
    } else {
        puts $fp "  npiName = [npi_get $id -npiName]"
    }
    puts $fp "  >---- properties ----"
}
proc foreach_IterateHandle {iter_handle iter_type} {
    global fp
    set Object_Handle [npi_scan $iter_handle]
    puts $fp "    <---$iter_type--->"
    while {$Object_Handle != "NULL"} {
        puts $fp "    <---begin npi_scan \$iter_handle--->"
        puts $fp "    npiType = [npi_get $Object_Handle -npiType]"
        if {[npi_get $Object_Handle -npiType] == "npiConstant"} {
            puts $fp "    npiValue = [npi_get $Object_Handle -npiValue]"
        } else {
            puts $fp "    npiName = [npi_get $Object_Handle -npiName]"
        }
        puts $fp "    npiLineNo = [npi_get $Object_Handle -npiLineNo]"
        puts $fp "    <---end of npi_scan \$iter_handle--->"
        set Object_Handle  [npi_scan $iter_handle]
    }
    puts $fp "    <---end of $iter_type--->"
}

proc ShowHandleProp {Handle type} {
    global fp
    puts $fp "    <---$type --->"
    if {$Handle != "NULL"} {
        puts $fp "    npiType = [npi_get $Handle -npiType]"
        puts $fp "    npiName = [npi_get $Handle -npiName]"
        if {[npi_get $Handle -npiType] == "npiConstant"} {
            puts $fp "    npiValue = [npi_get $Handle -npiValue]"
        } else {
            puts $fp "    npiLineNo = [npi_get $Handle -npiLineNo]"
        }
    }
    puts $fp "    <---end of $type --->"
}

proc ShowExprRelationship {id} {
    global fp
    puts $fp "  <---relationship --->"
    if {[npi_get $id -npiType] == "npiOperation"} {
        set expr_iter [npi_iterate $id -npiType npiOperand]
        foreach_IterateHandle $expr_iter "npi_iterate \$id -npiType npiOperand"
    } elseif {[npi_get $id -npiType] == "npiPartSelect"} {
        set parent [npi_handle $id -npiType npiParent]
        ShowHandleProp $parent "npi_handle \$id -npiType npiParent"
        set Left [npi_handle $id -npiType npiLeftRange]
        ShowHandleProp $Left "npi_handle \$id -npiType npiLeftRange"
        set Right [npi_handle $id -npiType npiRightRange]
        ShowHandleProp $Right "npi_handle \$id -npiType npiRightRange"
    }
    puts $fp "  <---end of relationship --->"
}

proc ShowExprPropAndRelationship {} {
    global fp
    global g_Expression
    set var $g_Expression
    puts $fp "<---begin showing Expr information--->"
    #puts "var = $var [npi_get $var -npiType] [npi_get $var -npiLineNo]"
    ShowExprProp $var
    ShowExprRelationship $var
    puts $fp "<---end of showing Expr information--->"
}

set log_file [file join [file dirname [info script]] [file tail [info script]].out]
set fp [open $log_file w]
fconfigure $fp -buffering none

npi_register_cb -npiModuleBased Expression ShowExprPropAndRelationship
npi_traverse_model -npiModuleBased

close $fp