aPiecek | 266ca76 | 2023-03-22 15:04:59 +0100 | [diff] [blame^] | 1 | package require tcltest |
| 2 | namespace import ::tcltest::test ::tcltest::cleanupTests |
| 3 | |
| 4 | if { ![info exists ::env(TESTS_DIR)] } { |
| 5 | # the script is not run via 'ctest' so paths must be set |
| 6 | set ::env(TESTS_DIR) "../" |
| 7 | set ::env(YANG_MODULES_DIR) "../modules" |
| 8 | set ::env(YANGLINT) "../../../../build/yanglint" |
| 9 | } |
| 10 | |
| 11 | # prompt of error message |
| 12 | set error_prompt ">>>" |
| 13 | # the beginning of error message |
| 14 | set error_head "$error_prompt Check-failed" |
| 15 | |
| 16 | namespace eval uti { |
| 17 | namespace export * |
| 18 | } |
| 19 | |
| 20 | # Iterate through the items in the list 'lst' and return a new list where |
| 21 | # the items will have the form: <prefix><item><suffix>. |
| 22 | # Parameter 'index' determines at which index it will start wrapping. |
| 23 | # Parameter 'step' specifies how far the iterator must move to wrap the next item. |
| 24 | proc uti::wrap_list_items {lst {prefix ""} {suffix ""} {index 0} {step 1}} { |
| 25 | # counter to track when to insert wrapper |
| 26 | set cnt $step |
| 27 | set len [llength $lst] |
| 28 | |
| 29 | if {$index > 0} { |
| 30 | # copy list from interval <0;$index) |
| 31 | set ret [lrange $lst 0 [expr {$index - 1}]] |
| 32 | } else { |
| 33 | set ret {} |
| 34 | } |
| 35 | |
| 36 | for {set i $index} {$i < $len} {incr i} { |
| 37 | incr cnt |
| 38 | set item [lindex $lst $i] |
| 39 | if {$cnt >= $step} { |
| 40 | # insert wrapper for item |
| 41 | set cnt 0 |
| 42 | lappend ret [string cat $prefix $item $suffix] |
| 43 | } else { |
| 44 | # just copy item |
| 45 | lappend ret $item |
| 46 | } |
| 47 | } |
| 48 | |
| 49 | return $ret |
| 50 | } |
| 51 | |
| 52 | # Wrap list items with xml tags. |
| 53 | # The element format is: <tag>value</tag> |
| 54 | # Parameter 'values' is list of values. |
| 55 | # Parameter 'tag' is the name of the searched tag. |
| 56 | proc uti::wrap_to_xml {values tag {index 0} {step 1}} { |
| 57 | return [wrap_list_items $values "<$tag>" "</$tag>" $index $step] |
| 58 | } |
| 59 | |
| 60 | # Wrap list items with json attributes. |
| 61 | # The pair format is: "attribute": "value" |
| 62 | # Parameter 'values' is list of values. |
| 63 | # Parameter 'attribute' is the name of the searched attribute. |
| 64 | proc uti::wrap_to_json {values attribute {index 0} {step 1}} { |
| 65 | return [wrap_list_items $values "\"$attribute\": \"" "\"" $index $step] |
| 66 | } |
| 67 | |
| 68 | # Convert list to a regex (which is just a string) so that 'delim' is between items, |
| 69 | # 'begin' is at the beginning of the expression and 'end' is at the end. |
| 70 | proc uti::list_to_regex {lst {delim ".*"} {begin ".*"} {end ".*"}} { |
| 71 | return [string cat $begin [join $lst $delim] $end] |
| 72 | } |
| 73 | |
| 74 | # Merge two lists into one such that the nth items are merged into one separated by a delimiter. |
| 75 | # Returns a list that is the same length as 'lst1' and 'lst2' |
| 76 | proc uti::blend_lists {lst1 lst2 {delim ".*"}} { |
| 77 | return [lmap a $lst1 b $lst2 {string cat $a $delim $b}] |
| 78 | } |
| 79 | |
| 80 | # Create regex to find xml elements. |
| 81 | # The element format is: <tag>value</tag> |
| 82 | # Parameter 'values' is list of values. |
| 83 | # Parameter 'tag' is the name of the searched tag. |
| 84 | # The resulting expression looks like: ".*<tag>value1</tag>.*<tag>value2</tag>.*..." |
| 85 | proc uti::regex_xml_elements {values tag} { |
| 86 | return [list_to_regex [wrap_to_xml $values $tag]] |
| 87 | } |
| 88 | |
| 89 | # Create regex to find json pairs. |
| 90 | # The pair format is: "attribute": "value" |
| 91 | # Parameter 'values' is list of values. |
| 92 | # Parameter 'attribute' is the name of the searched attribute. |
| 93 | # The resulting expression looks like: ".*\"attribute\": \"value1\".*\"attribute\": \"value2\".*..." |
| 94 | proc uti::regex_json_pairs {values attribute} { |
| 95 | return [list_to_regex [wrap_to_json $values $attribute]] |
| 96 | } |