Browse Source

propagate pipeline errors with 'pipesyntax' keyword, structured mismatch output

master
Julian Noble 2 years ago
parent
commit
740715060b
  1. 17
      scriptlib/tests/pipeswitch.tcl
  2. 91
      src/modules/punk-0.1.tm

17
scriptlib/tests/pipeswitch.tcl

@ -1,11 +1,17 @@
package require punk package require punk
package require shellfilter
foreach d [debug names] {
#debug off $d
}
proc test1 {} { proc test1 {} {
alsoresult,data@@DATA.=\ alsoresult,data@@DATA.=\
result@1/1,returnvalue,status@0.= pipeswitch { result@1/1,returnvalue,status@0.=\
pipeswitch {
puts stderr "pre pipecase code always runs" puts stderr "pre pipecase code always runs"
pipecase ,'p1v0@0.= val {p1v0x b c} |> { pipecase pipenomatchvar nomatch1 ,'p1v0@0.= val {p1v0x b c} |> {
puts stdout "pipecase1 $data" puts stdout "pipecase1 $data"
set data set data
} }
@ -13,7 +19,7 @@ proc test1 {} {
# in between # in between
puts stderr "code after unmatched but before matched will run" puts stderr "code after unmatched but before matched will run"
pipecase input,'p2v1@1.= val {x p2v1 z} |> { pipecase pipenomatchvar nomatch2 input,'p2v1@1.= val {x p2v1 z} |> {
puts stdout "pipecase2 $data" puts stdout "pipecase2 $data"
return [list source pipecase2 data $data] return [list source pipecase2 data $data]
} |> { } |> {
@ -28,14 +34,17 @@ proc test1 {} {
puts stderr "no matches" puts stderr "no matches"
return nomatch return nomatch
} }
puts stdout "returnvalue of pipeswitch return is: $returnvalue" puts stdout "returnvalue of pipeswitch return is: $returnvalue"
puts stdout "[a+ yellow bold]nomatch var pipe1: $nomatch1[a+]"
puts stdout "nomatch destructured to 'matchinfo': [mi@@error/reason/matchinfo= $nomatch1]"
puts stdout "[a+ green bold]nomatch var pipe2 (empty if there was a match): $nomatch2[a+]"
puts stdout "value of pipeswitch result is: $result" puts stdout "value of pipeswitch result is: $result"
puts stdout "status of pipeswitch is: $status" puts stdout "status of pipeswitch is: $status"
puts stdout "alsoresult:$alsoresult" puts stdout "alsoresult:$alsoresult"
puts stdout "dict destructuring, DATA key = $data" puts stdout "dict destructuring, DATA key = $data"
} }
test1 test1
test1
puts stderr "proc test follows" puts stderr "proc test follows"
proc match_args {args} { proc match_args {args} {

91
src/modules/punk-0.1.tm

@ -463,7 +463,8 @@ namespace eval punk {
} }
} else { } else {
#puts stderr "selector:$selector" #puts stderr "selector:$selector"
set msg "Unable to interpret $vspec\n" #keyword 'pipesyntax' at beginning of error message
set msg "pipesyntax Unable to interpret $vspec\n"
append msg "selector: $selector\n" append msg "selector: $selector\n"
append msg "@ must be followed by a selector (possibly compound separated by forward slashes) suitable for lindex or lrange commands, or a not-x expression\n" append msg "@ must be followed by a selector (possibly compound separated by forward slashes) suitable for lindex or lrange commands, or a not-x expression\n"
append msg "Additional accepted keywords include: head tail\n" append msg "Additional accepted keywords include: head tail\n"
@ -658,7 +659,9 @@ namespace eval punk {
set vidx 0 set vidx 0
set mismatches [lmap m $match_state v $var_names {expr {$m != 1} ? {[list mismatch $v]} : {[list match $v]}}] set mismatches [lmap m $match_state v $var_names {expr {$m != 1} ? {[list mismatch $v]} : {[list match $v]}}]
set mismatches_display [lmap m $match_state v $var_names {expr {$m != 1} ? {$v} : {[string repeat " " [string length $v]]}}] set mismatches_display [lmap m $match_state v $var_names {expr {$m != 1} ? {$v} : {[string repeat " " [string length $v]]}}]
set msg "Unmatched: No match of right hand side for vars in $multivar\n" set msg "\n"
append msg "Unmatched\n"
append msg "No match of right hand side for vars in $multivar\n"
append msg "vars/atoms: $var_names\n" append msg "vars/atoms: $var_names\n"
append msg "mismatches: [join $mismatches_display { } ]\n" append msg "mismatches: [join $mismatches_display { } ]\n"
set i 0 set i 0
@ -688,7 +691,7 @@ namespace eval punk {
} }
#error $msg #error $msg
dict unset returndict result dict unset returndict result
dict set returndict mismatch $msg dict set returndict mismatch [dict create varnames $var_names matchinfo $mismatches display $msg]
return $returndict return $returndict
} }
@ -705,7 +708,7 @@ namespace eval punk {
proc _handle_bind_result {d} { proc _handle_bind_result {d} {
set match_caller [info level 2] set match_caller [info level 2]
debug.punk.pipe {_handle_bind_result match_caller: $match_caller} 0 #debug.punk.pipe {_handle_bind_result match_caller: $match_caller} 9
if {![dict exists $d result]} { if {![dict exists $d result]} {
uplevel 1 [list error [dict get $d mismatch]] uplevel 1 [list error [dict get $d mismatch]]
} else { } else {
@ -771,7 +774,9 @@ namespace eval punk {
#uplevel 1 [list unset $multivar] #uplevel 1 [list unset $multivar]
set returnval "" set returnval ""
} else { } else {
set msg "Assignment with = accepts only zero or one argument, unless characters immediately follow the = sign.\n" #keyword pipesyntax at beginning of error message
set msg "pipesyntax\n"
append msg "Assignment with = accepts only zero or one argument, unless characters immediately follow the = sign.\n"
append msg "Characters immediately after the equals sign form the first element of a list if there is *any* literal whitespace\n" append msg "Characters immediately after the equals sign form the first element of a list if there is *any* literal whitespace\n"
append msg "e.g x=\"abc\" will assign \"abc\" including the quotes\n" append msg "e.g x=\"abc\" will assign \"abc\" including the quotes\n"
append msg "but x=\"ab c\" will form a two element list containing \"ab and c\" \n" append msg "but x=\"ab c\" will form a two element list containing \"ab and c\" \n"
@ -955,7 +960,7 @@ namespace eval punk {
proc match_exec {initial_returnvarspec e1 args} { proc match_exec {initial_returnvarspec e1 args} {
set fulltail $args set fulltail $args
debug.punk.pipe {call match_exec: '$initial_returnvarspec' '$e1' '$fulltail'} 4 debug.punk.pipe {call match_exec: '$initial_returnvarspec' '$e1' '$fulltail'} 9
debug.punk.pipe.rep {[rep_listname fulltail]} 6 debug.punk.pipe.rep {[rep_listname fulltail]} 6
@ -1319,7 +1324,8 @@ namespace eval punk {
#return $r #return $r
set segment_result $r set segment_result $r
} else { } else {
set msg "Attempted to evaluate as expression '$e'\n" set msg "pipesyntax"
append msg "Attempted to evaluate as expression '$e'\n"
append msg "due to brace \"\{\" immediately following .= \n" append msg "due to brace \"\{\" immediately following .= \n"
append msg "(place other commands immediately following .= or place script block after a space)\n" append msg "(place other commands immediately following .= or place script block after a space)\n"
append msg "expression error: $evaluated" append msg "expression error: $evaluated"
@ -1335,7 +1341,8 @@ namespace eval punk {
#return $r #return $r
set segment_result $r set segment_result $r
} else { } else {
set msg "Attempted to evaluate as expression\n" set msg "pipesyntax"
append msg "Attempted to evaluate as expression\n"
append msg "due to number or math func immediately following .= \n" append msg "due to number or math func immediately following .= \n"
append msg "(place other commands immediately following .= or place script block after a space)\n" append msg "(place other commands immediately following .= or place script block after a space)\n"
append msg "expression error: $evaluated" append msg "expression error: $evaluated"
@ -1546,7 +1553,7 @@ namespace eval punk {
set forward_result $segment_result set forward_result $segment_result
set previous_result $forward_result set previous_result $forward_result
} else { } else {
debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a+]} 4 #debug.punk.pipe {[a+ cyan bold]End of pipe segments ($i)[a+]} 4
set more_pipe_segments 0 set more_pipe_segments 0
} }
@ -1672,7 +1679,7 @@ namespace eval punk {
configure_unknown configure_unknown
#if client redefines 'unknown' after package require punk, they must call punk::configure_unknown afterwards. #if client redefines 'unknown' after package require punk, they must call punk::configure_unknown afterwards.
proc pipematch {args} { proc pipematch {args} {
debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2 #debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2
variable re_dot_assign variable re_dot_assign
variable re_assign variable re_assign
@ -1701,8 +1708,12 @@ namespace eval punk {
} }
} }
proc pipecase {args} { proc pipenomatchvar {varname args} {
debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2 if {[string first = $varname] >=0} {
#first word "pipesyntax" is looked for by pipecase
error "pipesyntax pipenomatch expects a simple varname as first argument"
}
#debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2
variable re_dot_assign variable re_dot_assign
variable re_assign variable re_assign
@ -1722,32 +1733,53 @@ namespace eval punk {
} }
debug.punk.pipe {[a+ yellow bold]pipematchnomatch [a+]} 1
if {[catch {uplevel 1 $cmdlist} result]} { if {[catch {uplevel 1 $cmdlist} result]} {
return [dict create error [dict create reason $result]] debug.punk.pipe {[a+ yellow bold]pipematchnomatch error $result[a+]} 1
set errordict [dict create error [dict create reason $result]]
uplevel 1 [list set $varname $errordict]
#re-raise the error for pipeswitch to deal with
uplevel 1 [list error $result]
} else { } else {
tailcall return [dict create ok [dict create result $result]] debug.punk.pipe {pipematchnomatch result $result } 4
uplevel 1 [list set $varname ""]
#return raw result only - to pass through to pipeswitch
return $result
#return [dict create ok [dict create result $result]]
} }
} }
proc pipecase {args} {
#debug.punk.pipe {pipecase level [info level] levelinfo [info level 0]} 9
variable re_dot_assign
variable re_assign
proc create_pipeswitch_interp {} { set assign [lindex $args 0]
interp create interp_pipeswitch set arglist [lrange $args 1 end]
interp eval interp_pipeswitch { if {$assign eq ".="} {
namespace eval ::punk {} set cmdlist [list ::punk::match_exec "" "" {*}$arglist]
set ::punk::i_am_slave_interp 1 } elseif {$assign eq "="} {
set cmdlist [list ::punk::match_assign "" "" $arglist]
} elseif {[regexp $re_dot_assign $assign _ returnvarspecs rhs]} {
set cmdlist [list ::punk::match_exec $returnvarspecs $rhs {*}$arglist]
} elseif {[regexp $re_assign $assign _ returnvarspecs rhs]} {
set cmdlist [list ::punk::match_assign $returnvarspecs $rhs $arglist]
} else {
set cmdlist $args
#return [dict create error [dict create reason [dict create pipematch bad_first_word value $assign pipeline [list pipematch $assign {*}$args]]]]
} }
interp eval interp_pipeswitch {
package require shellfilter
package require punk if {[catch {uplevel 1 $cmdlist} result]} {
foreach d [debug names] { if {[string match "pipesyntax*" $result]} {
debug off $d error $result
} }
return [dict create error [dict create reason $result]]
} else {
tailcall return [dict create ok [dict create result $result]]
} }
} }
#we will re-use this interp to evaluate pipeswitch code blocks
if {![info exists ::punk::i_am_slave_interp]} {
create_pipeswitch_interp
}
proc pipeswitch {pipescript} { proc pipeswitch {pipescript} {
uplevel $pipescript uplevel $pipescript
} }
@ -2396,6 +2428,7 @@ namespace eval punk {
interp alias {} pipeswitch {} punk::pipeswitch interp alias {} pipeswitch {} punk::pipeswitch
interp alias {} pipecase {} punk::pipecase interp alias {} pipecase {} punk::pipecase
interp alias {} pipematch {} punk::pipematch interp alias {} pipematch {} punk::pipematch
interp alias {} pipenomatchvar {} punk::pipenomatchvar
proc = {value} { proc = {value} {
return $value return $value

Loading…
Cancel
Save