tests/yanglint/common.tcl

# @brief Common functions and variables for yanglint-interactive and yanglint-non-interactive.
#
# The script requires variables:
# ::env(TESTS_DIR) - Main test directory. Must be set if the script is run via ctest.
#
# The script sets the variables:
# ::env(TESTS_DIR) - Main test directory. It is set by default if not defined.
# ::env(YANG_MODULES_DIR) - Directory of YANG modules.
# TUT_PATH - Assumed absolute path to the directory in which the TUT is located.
# TUT_NAME - TUT name (without path).
# ::tcltest::testConstraint ctest - A tcltest variable that is set to true if the script is run via ctest. Causes tests
#   to be a skipped.

package require tcltest
namespace import ::tcltest::test ::tcltest::cleanupTests

# Set directory paths for testing yanglint.
if { ![info exists ::env(TESTS_DIR)] } {
    # the script is not run via 'ctest' so paths must be set
    set ::env(TESTS_DIR) "../"
    set ::env(YANG_MODULES_DIR) "../modules"
    set TUT_PATH "../../../build"
    ::tcltest::testConstraint ctest false
} else {
    # cmake (ctest) already sets ::env variables
    set TUT_PATH $::env(YANGLINT)
    ::tcltest::testConstraint ctest true
}

set TUT_NAME "yanglint"

# The script continues by defining functions specific to the yanglint tool.

namespace eval uti {
    namespace export *
}

# Iterate through the items in the list 'lst' and return a new list where
# the items will have the form: <prefix><item><suffix>.
# Parameter 'index' determines at which index it will start wrapping.
# Parameter 'step' specifies how far the iterator must move to wrap the next item.
proc uti::wrap_list_items {lst {prefix ""} {suffix ""} {index 0} {step 1}} {
    # counter to track when to insert wrapper
    set cnt $step
    set len [llength $lst]

    if {$index > 0} {
        # copy list from interval <0;$index)
        set ret [lrange $lst 0 [expr {$index - 1}]]
    } else {
        set ret {}
    }

    for {set i $index} {$i < $len} {incr i} {
        incr cnt
        set item [lindex $lst $i]
        if {$cnt >= $step} {
            # insert wrapper for item
            set cnt 0
            lappend ret [string cat $prefix $item $suffix]
        } else {
            # just copy item
            lappend ret $item
        }
    }

    return $ret
}

# Wrap list items with xml tags.
# The element format is: <tag>value</tag>
# Parameter 'values' is list of values.
# Parameter 'tag' is the name of the searched tag.
proc uti::wrap_to_xml {values tag {index 0} {step 1}} {
    return [wrap_list_items $values "<$tag>" "</$tag>" $index $step]
}

# Wrap list items with json attributes.
# The pair format is: "attribute": "value"
# Parameter 'values' is list of values.
# Parameter 'attribute' is the name of the searched attribute.
proc uti::wrap_to_json {values attribute {index 0} {step 1}} {
    return [wrap_list_items $values "\"$attribute\": \"" "\"" $index $step]
}

# Convert list to a regex (which is just a string) so that 'delim' is between items,
# 'begin' is at the beginning of the expression and 'end' is at the end.
proc uti::list_to_regex {lst {delim ".*"} {begin ".*"} {end ".*"}} {
    return [string cat $begin [join $lst $delim] $end]
}

# Merge two lists into one such that the nth items are merged into one separated by a delimiter.
# Returns a list that is the same length as 'lst1' and 'lst2'
proc uti::blend_lists {lst1 lst2 {delim ".*"}} {
    return [lmap a $lst1 b $lst2 {string cat $a $delim $b}]
}

# Create regex to find xml elements.
# The element format is: <tag>value</tag>
# Parameter 'values' is list of values.
# Parameter 'tag' is the name of the searched tag.
# The resulting expression looks like: ".*<tag>value1</tag>.*<tag>value2</tag>.*..."
proc uti::regex_xml_elements {values tag} {
    return [list_to_regex [wrap_to_xml $values $tag]]
}

# Create regex to find json pairs.
# The pair format is: "attribute": "value"
# Parameter 'values' is list of values.
# Parameter 'attribute' is the name of the searched attribute.
# The resulting expression looks like: ".*\"attribute\": \"value1\".*\"attribute\": \"value2\".*..."
proc uti::regex_json_pairs {values attribute} {
    return [list_to_regex [wrap_to_json $values $attribute]]
}