Skip to content
Snippets Groups Projects
site.exp 2.23 KiB
Newer Older
set lus2lic "./lus2lic"


proc should_work { test_name command_line args } {
    global verbose

    set cl [file tail $command_line]
    set cl $command_line

    set failed 0

    # When verbose, tell the user what we are running
    if { $verbose > 1 } {
        send_user "starting $command_line\n"
    }
    # Running the program.
    eval spawn $command_line {*}$args
    expect {
        # Check for any warning messages in the output first
        Warning {
            set failed 1
            exp_continue
        }
        Error {
            set failed 1
            exp_continue
        }
        "error" {
            set failed 1
            exp_continue
        }
        "oops: an internal" {
            set failed 1
            exp_continue
        }
        # to avoid that match_max (the expect buffer size) is reached 
        # which truncate the outputs
        "\n" {
            exp_continue
        }
        eof {
            if $failed {
                fail "$test_name: $cl $args"
            } else {
                pass "$cl $args"
            }
        }
        # Timeout requires inspection to determine the cause of failure.
        timeout {
            unresolved "Time out: $cl $args"
        }
    }
    return $spawn_id
}
proc should_fail { test_name fail_kind command_line args } {
    global verbose

    set failed 0
    set cl [file tail $command_line]
    # When verbose, tell the user what we are running
    if { $verbose > 1 } {
        send_user "starting $cl\n"
    }
    # Running the program.
    eval spawn $command_line  {*}$args
    expect {
       "oops: an internal" {
           expect eof
           fail "$test_name ($fail_kind): $cl $args"
        }
        Error {
            set failed 1
            exp_continue
        }
        "\n" {
            exp_continue
        }
        eof {
            if $failed {
                xfail "$test_name ($fail_kind): $cl $args" 
            } else {
                xpass "$test_name ($fail_kind): $cl $args"
            }
        }
        timeout {
            unresolved "Time out $test_name ($fail_kind): $cl $args"
        }
    }
    return $spawn_id
}

proc emptyfile {filename} {
  set rc [catch {file size $filename} size]
  return [expr {$rc == 0 && $size > 0}]
}