[Richard Suchenwirth] 2002-10-01 - COBOL (COmmon Business-Oriented Language) is another of the ancient programming languages (FORTRAN and LISP were slightly earlier), first defined in 1960. It still lives, though - legacy apps seem to be too expensive to rewrite... Reading a 25-year old book on COBOL, I mostly felt pity for the folks back then. Things are so much easier today, especially with Tcl ;-) Compare their ADD 1 TO I against our incr i Hmm.. Somehow Tcl has some COBOL heritage, in being wordier than C's ''i++'', and closer to English (but not as close as COBOL was).. There's one feature I noticed in PICTURE clauses in the DATA DIVISION that Tcl's [format] doesn't offer: leading asterisks for numbers, to prevent fraud e.g. on checks. This prompted me to try a partial reimplementation of PICTURE constraints, which in contrast to COBOL's organization just puts a string in a "picture" if possible, and otherwise raises an error. Like so often, I'm not sure how useful this is - but it was a nice little evening challenge (especially the beastly [regsub]/[subst] combination to resolve multipliers like X(5) to XXXXX, which I thought of when I awoke the next morning)... See the cases in the ''test'' suite below for how far I got in this emulation. Again, I put the tests before the implementation, as a reminder that tests should be defined early. } proc test:picture {} { set failed 0 foreach {input expected} { {picture ****9.99 12.34} ***12.34 {picture ****9.99 .12} ****0.12 {picture ****9.99 12345.67} 12345.67 {picture 9999.99 12.34} 0012.34 {picture 9(4).9(2) 12.34} 0012.34 {picture ZZZ9.99 0012.34} " 12.34" {picture 9.99 12.34} error {picture 9.99 .34} 0.34 {picture 99AA99 12CD56} 12CD56 {picture 99AA99 1234EF} error {picture XXXXXX 12CD56} 12CD56 {picture X(6) 12CD56} 12CD56 {picture AAAA BCDE} BCDE {picture AAAA AB34} error } { set err [catch $input res] if {[string compare $res $expected] && !$err && $expected!="error"} { append res " - expected: $expected" incr failed } puts [list $input -> $res] } puts [expr {$failed? "failed $failed test(s)" : "passed all tests"}] } proc picture {picture value} { set re {((.)\(([0-9]+)\))} if [regsub -all $re $picture {[string repeat \2 \3]} t] { set picture [subst $t] ;# turn e.g. A(3)X(2) to AAAXX } set length [string length $picture] set fvalue [format %${length}s $value] if {[string length $fvalue]>$length} { error [list value $value does not fit in picture $picture] } set res "" foreach p [split $picture ""] v [split $fvalue ""] { append sofar $v set error 0 switch -regexp -- $v { " " { if {$p=="*" && ![llength $sofar]} {set v *} if {$p=="9" && ![llength $sofar] && $sofar!=0} {set v 0} } 0 {if {$p=="Z" && !$sofar} {set v " "}} [1-9] {if {$p!="X" && $p!="9" && $p!="*"} {incr error}} [^0-9.] {if {$p!="X" && $p!="A"} {incr error}} {[^A-Z .]} {if {$p!="X"} {incr error}} } if $error {error [list $v in $value doesn't match $p in $picture]} append res $v } set res } test:picture # But the task of left-padding a string can also be had in a one-liner: proc padchars {s char n} { return [string repeat $char [expr {$n-[string length $s]}]]$s } puts [padchars 12.34 * 8] ;#-> ***12.34 ---- [Tcl and other languages] - [Arts and crafts of Tcl-Tk programming]