File indexing completed on 2024-04-06 12:04:19
0001
0002
0003 exec tclsh "$0" ${1+"$@"}
0004
0005
0006 set eps 1.0e-5
0007
0008 proc print_usage {} {
0009 puts stderr ""
0010 puts stderr "Usage: [file tail [info script]] file1 file2 \[epsilon\]"
0011 puts stderr ""
0012 return
0013 }
0014
0015
0016 if {$argc != 2 && $argc != 3} {
0017 print_usage
0018 exit 1
0019 }
0020
0021
0022 foreach {file1 file2} $argv break
0023 foreach fname [list $file1 $file2] {
0024 if {![file readable $fname]} {
0025 puts stderr "Error: file \"$fname\" does not exist (or unreadable)"
0026 exit 1
0027 }
0028 }
0029
0030 if {$argc > 2} {
0031 set eps [lindex $argv 2]
0032 if {![string is double -strict $eps]} {
0033 print_usage
0034 exit 1
0035 }
0036 if {$eps < 0.0} {
0037 puts stderr "Error: comparison precision can not be negative"
0038 exit 1
0039 }
0040 }
0041 set eps [expr {1.0 * $eps}]
0042
0043 proc file_contents {filename} {
0044 set chan [open $filename "r"]
0045 set contents [read $chan [file size $filename]]
0046 close $chan
0047 return $contents
0048 }
0049
0050 proc is_commentline {line} {
0051 string equal -length 1 $line "\#"
0052 }
0053
0054 proc uncomment {filename} {
0055 set uncommented [list]
0056 set linenum 0
0057 foreach line [split [file_contents $filename] "\n"] {
0058 incr linenum
0059 if {![is_commentline $line]} {
0060 lappend uncommented $linenum $line
0061 }
0062 }
0063 list $linenum $uncommented
0064 }
0065
0066 proc is_same_double {x y eps} {
0067 set mag [expr {abs(($x + $y)/2.0)}]
0068 set diff [expr {abs($x - $y)/($mag + 1.0)}]
0069 if {$diff <= $eps} {
0070 return 1
0071 } else {
0072 return 0
0073 }
0074 }
0075
0076 proc min {n1 n2} {
0077 if {$n1 < $n2} {
0078 return $n1
0079 } else {
0080 return $n2
0081 }
0082 }
0083
0084 proc numequal {line1 line2 eps} {
0085 if {[string equal $line1 $line2]} {
0086 return 1
0087 }
0088 set words1 [regexp -all -inline {\S+} [string map {= " "} $line1]]
0089 set words2 [regexp -all -inline {\S+} [string map {= " "} $line2]]
0090 if {[llength $words1] != [llength $words2]} {
0091 return 0
0092 }
0093 foreach w1 $words1 w2 $words2 {
0094 if {[string is integer -strict $w1] && \
0095 [string is integer -strict $w2]} {
0096
0097 if {$w1 != $w2} {
0098 return 0
0099 }
0100 } elseif {[string is double -strict $w1] && \
0101 [string is double -strict $w2]} {
0102
0103 if {![is_same_double $w1 $w2 $eps]} {
0104 return 0
0105 }
0106 } else {
0107
0108 if {![string equal $w1 $w2]} {
0109 return 0
0110 }
0111 }
0112 }
0113 return 1
0114 }
0115
0116 foreach {n1 lines1} [uncomment $file1] break
0117 foreach {n2 lines2} [uncomment $file2] break
0118
0119 if {$n1 != $n2} {
0120 puts stderr "Files \"$file1\" and \"$file2\" have different number of lines ($n1 and $n2)"
0121 exit 1
0122 }
0123
0124 if {[llength $lines1] != [llength $lines2]} {
0125 puts stderr "Files \"$file1\" and \"$file2\" have different number of comments"
0126 exit 1
0127 }
0128
0129 set diffs_found 0
0130 foreach {n1 l1} $lines1 {n2 l2} $lines2 {
0131 if {$n1 != $n2} {
0132 puts stderr "Different line [min $n1 $n2] in files \"$file1\" and \"$file2\""
0133 incr diffs_found
0134 } elseif {![numequal $l1 $l2 $eps]} {
0135 puts stderr "Different line $n1 in files \"$file1\" and \"$file2\""
0136 incr diffs_found
0137 }
0138 }
0139
0140 if {$diffs_found} {
0141 puts "$diffs_found different lines found"
0142 exit 1
0143 }
0144
0145 exit 0