tools/lint/tests/expect/common.exp - github/CESNET/libyang - Gitiles

 # detect the path to the yanglint binary
 if { [info exists ::env(YANGLINT)] } {
     set yanglint "$env(YANGLINT)"
 } else {
     set yanglint "../../../../build/yanglint"
 }

 # detect the path to the examples
 if { [info exists ::env(CURRENT_SOURCE_DIR)] } {
     set yang_models "$env(CURRENT_SOURCE_DIR)/tests/models"
 } else {
     set yang_models "../models"
 }

 # set the variable used to print the error message
 if { ![info exists error_verbose] } {
     set error_verbose 1
 }

 # prompt of yanglint
 set prompt "> "
 # prompt of error message
 set error_prompt ">>>"
 # the beginning of error message
 set error_head "$error_prompt Check-failed"
 # set the timeout to 1 second
 set timeout 1

 # detection on eof and timeout will be on every expect command
 expect_after {
     eof {
         global error_head
         send_error "\n$error_head unexpected termination.\n"
         exit 1
     } timeout {
         global error_head
         send_error "\n$error_head timeout.\n"
         exit 1
     }
 }

 # Internal function. Print error message and exit script with an error return value.
 proc check_failed {pattern output} {
     global error_verbose
     global error_prompt
     global error_head

     set frame [info frame 1]
     set line [dict get $frame line]
     set file [lindex [split [dict get $frame file] /] end]
     switch $error_verbose {
         0 {}
         1 { send_error "\n$error_head in $file on line $line\n" }
         2 { send_error "\n$error_head in $file on line $line, output is:\n$output\n" }
         3 {
             send_error "\n$error_head in $file on line $line, expecting:\n$pattern\n"
             send_error "$error_prompt but the output is:\n$output\n"
         }
         default { send_error "\n$error_head unrecognized entry \"$error_verbose\" in error_verbose variable.\n" }
     }
     close
     wait
     exit 1
 }

 # 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 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 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 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 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 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 regex_xml_contains_elements {values tag} {
     return [list_to_regex [wrap_list_items $values "<$tag>" "</$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 regex_json_contains_pairs {values attribute} {
     return [list_to_regex [wrap_list_items $values "\"$attribute\": \"" "\""]]
 }

 # skip no dir and/or no history warnings and prompt
 proc skip_warnings {} {
     global prompt
     expect -re "(YANGLINT.*)*$prompt" {}
 }

 # Send command 'cmd' to the process, then check output string by 'pattern'.
 # The parameter 'pattern' should not contain prompt.
 # If 'pattern' is not specified, only the prompt assumed afterwards.
 # Parameter 'opt' can contain:
 #   -ex     has a similar meaning to the expect command. The 'pattern' parameter is used as a simple string
 #           for exact matching of the output. So 'pattern' is not a regular expression but some characters
 #           must still be escaped, eg ][.
 proc command {cmd {pattern ""} {opt ""}} {
     global prompt

     send -- "${cmd}\r"
     expect "${cmd}\r\n"

     if { $pattern eq "" } {
         # command without output
         expect $prompt
         return
     }

     # definition of an expression that matches failure
     set failure_pattern "(.*)\r\n${prompt}$"

     if { $opt eq "" } {
         # check output by regular expression
         expect {
             -re "^${pattern}\r\n${prompt}$" {}
             -indices -re $failure_pattern {
                 # Pattern does not match the output. Print error and exit the script.
                 check_failed $pattern $expect_out(1,string)
             }
         }
     } elseif { $opt eq "-ex" } {
         # check output by exact matching
         expect {
             -ex "${pattern}\r\n${prompt}" {}
             -indices -re $failure_pattern {
                 # Pattern does not match the output. Print error and exit the script.
                 check_failed $pattern $expect_out(1,string)
             }
         }
     } else {
         global error_head
         send_error "\n$error_head unrecognized value of parameter 'opt'.\n"
         exit 1
     }
 }

 # whatever is written is sent, output is ignored and then another prompt is expected
 proc next_prompt {} {
     global prompt

     send "\r"
     expect -re "$prompt$"
 }

 # send a completion request and check if the anchored regex output matches
 proc expect_completion {input output} {
     global prompt

     send -- "${input}\t"
     # expecting echoing input, output and 10 terminal control characters
     expect -re "^${input}\r> ${output}.*\r.*$"
 }

 # send a completion request and check if the anchored regex hint options match
 proc expect_hint {input prev_input hints} {
     set output {}
     foreach i $hints {
         # each element might have some number of spaces and CRLF around it
         append output "${i} *(?:\\r\\n)?"
     }

     send -- "${input}\t"
     # expecting the hints, previous input from which the hints were generated
     # and some number of terminal control characters
     expect -re "^\r\n${output}\r> ${prev_input}.*\r.*$"
 }

 # send 'exit' and wait for eof
 proc send_exit {} {
     send "exit\r"
     expect eof
 }
	# detect the path to the yanglint binary
	if { [info exists ::env(YANGLINT)] } {
	set yanglint "$env(YANGLINT)"
	} else {
	set yanglint "../../../../build/yanglint"
	}

	# detect the path to the examples
	if { [info exists ::env(CURRENT_SOURCE_DIR)] } {
	set yang_models "$env(CURRENT_SOURCE_DIR)/tests/models"
	} else {
	set yang_models "../models"
	}

	# set the variable used to print the error message
	if { ![info exists error_verbose] } {
	set error_verbose 1
	}

	# prompt of yanglint
	set prompt "> "
	# prompt of error message
	set error_prompt ">>>"
	# the beginning of error message
	set error_head "$error_prompt Check-failed"
	# set the timeout to 1 second
	set timeout 1

	# detection on eof and timeout will be on every expect command
	expect_after {
	eof {
	global error_head
	send_error "\n$error_head unexpected termination.\n"
	exit 1
	} timeout {
	global error_head
	send_error "\n$error_head timeout.\n"
	exit 1
	}
	}

	# Internal function. Print error message and exit script with an error return value.
	proc check_failed {pattern output} {
	global error_verbose
	global error_prompt
	global error_head

	set frame [info frame 1]
	set line [dict get $frame line]
	set file [lindex [split [dict get $frame file] /] end]
	switch $error_verbose {
	0 {}
	1 { send_error "\n$error_head in $file on line $line\n" }
	2 { send_error "\n$error_head in $file on line $line, output is:\n$output\n" }
	3 {
	send_error "\n$error_head in $file on line $line, expecting:\n$pattern\n"
	send_error "$error_prompt but the output is:\n$output\n"
	}
	default { send_error "\n$error_head unrecognized entry \"$error_verbose\" in error_verbose variable.\n" }
	}
	close
	wait
	exit 1
	}

	# 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 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 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 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 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 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 regex_xml_contains_elements {values tag} {
	return [list_to_regex [wrap_list_items $values "<$tag>" "</$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 regex_json_contains_pairs {values attribute} {
	return [list_to_regex [wrap_list_items $values "\"$attribute\": \"" "\""]]
	}

	# skip no dir and/or no history warnings and prompt
	proc skip_warnings {} {
	global prompt
	expect -re "(YANGLINT.)$prompt" {}
	}

	# Send command 'cmd' to the process, then check output string by 'pattern'.
	# The parameter 'pattern' should not contain prompt.
	# If 'pattern' is not specified, only the prompt assumed afterwards.
	# Parameter 'opt' can contain:
	# -ex has a similar meaning to the expect command. The 'pattern' parameter is used as a simple string
	# for exact matching of the output. So 'pattern' is not a regular expression but some characters
	# must still be escaped, eg ][.
	proc command {cmd {pattern ""} {opt ""}} {
	global prompt

	send -- "${cmd}\r"
	expect "${cmd}\r\n"

	if { $pattern eq "" } {
	# command without output
	expect $prompt
	return
	}

	# definition of an expression that matches failure
	set failure_pattern "(.*)\r\n${prompt}$"

	if { $opt eq "" } {
	# check output by regular expression
	expect {
	-re "^${pattern}\r\n${prompt}$" {}
	-indices -re $failure_pattern {
	# Pattern does not match the output. Print error and exit the script.
	check_failed $pattern $expect_out(1,string)
	}
	}
	} elseif { $opt eq "-ex" } {
	# check output by exact matching
	expect {
	-ex "${pattern}\r\n${prompt}" {}
	-indices -re $failure_pattern {
	# Pattern does not match the output. Print error and exit the script.
	check_failed $pattern $expect_out(1,string)
	}
	}
	} else {
	global error_head
	send_error "\n$error_head unrecognized value of parameter 'opt'.\n"
	exit 1
	}
	}

	# whatever is written is sent, output is ignored and then another prompt is expected
	proc next_prompt {} {
	global prompt

	send "\r"
	expect -re "$prompt$"
	}

	# send a completion request and check if the anchored regex output matches
	proc expect_completion {input output} {
	global prompt

	send -- "${input}\t"
	# expecting echoing input, output and 10 terminal control characters
	expect -re "^${input}\r> ${output}.\r.$"
	}

	# send a completion request and check if the anchored regex hint options match
	proc expect_hint {input prev_input hints} {
	set output {}
	foreach i $hints {
	# each element might have some number of spaces and CRLF around it
	append output "${i} *(?:\\r\\n)?"
	}

	send -- "${input}\t"
	# expecting the hints, previous input from which the hints were generated
	# and some number of terminal control characters
	expect -re "^\r\n${output}\r> ${prev_input}.\r.$"
	}

	# send 'exit' and wait for eof
	proc send_exit {} {
	send "exit\r"
	expect eof
	}