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 shellfilter
foreach d [debug names] {
#debug off $d
}
proc test1 {} {
alsoresult,data@@DATA.=\
result@1/1,returnvalue,status@0.= pipeswitch {
result@1/1,returnvalue,status@0.=\
pipeswitch {
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"
set data
}
@ -13,7 +19,7 @@ proc test1 {} {
# in between
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"
return [list source pipecase2 data $data]
} |> {
@ -28,14 +34,17 @@ proc test1 {} {
puts stderr "no matches"
return nomatch
}
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 "status of pipeswitch is: $status"
puts stdout "alsoresult:$alsoresult"
puts stdout "dict destructuring, DATA key = $data"
}
test1
test1
puts stderr "proc test follows"
proc match_args {args} {

91
src/modules/punk-0.1.tm

@ -463,7 +463,8 @@ namespace eval punk {
}
} else {
#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 "@ 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"
@ -658,7 +659,9 @@ namespace eval punk {
set vidx 0
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 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 "mismatches: [join $mismatches_display { } ]\n"
set i 0
@ -688,7 +691,7 @@ namespace eval punk {
}
#error $msg
dict unset returndict result
dict set returndict mismatch $msg
dict set returndict mismatch [dict create varnames $var_names matchinfo $mismatches display $msg]
return $returndict
}
@ -705,7 +708,7 @@ namespace eval punk {
proc _handle_bind_result {d} {
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]} {
uplevel 1 [list error [dict get $d mismatch]]
} else {
@ -771,7 +774,9 @@ namespace eval punk {
#uplevel 1 [list unset $multivar]
set returnval ""
} 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 "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"
@ -955,7 +960,7 @@ namespace eval punk {
proc match_exec {initial_returnvarspec e1 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
@ -1319,7 +1324,8 @@ namespace eval punk {
#return $r
set segment_result $r
} 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 "(place other commands immediately following .= or place script block after a space)\n"
append msg "expression error: $evaluated"
@ -1335,7 +1341,8 @@ namespace eval punk {
#return $r
set segment_result $r
} 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 "(place other commands immediately following .= or place script block after a space)\n"
append msg "expression error: $evaluated"
@ -1546,7 +1553,7 @@ namespace eval punk {
set forward_result $segment_result
set previous_result $forward_result
} 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
}
@ -1672,7 +1679,7 @@ namespace eval punk {
configure_unknown
#if client redefines 'unknown' after package require punk, they must call punk::configure_unknown afterwards.
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_assign
@ -1701,8 +1708,48 @@ namespace eval punk {
}
}
proc pipenomatchvar {varname args} {
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_assign
set assign [lindex $args 0]
set arglist [lrange $args 1 end]
if {$assign eq ".="} {
set cmdlist [list ::punk::match_exec "" "" {*}$arglist]
} 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]]]]
}
debug.punk.pipe {[a+ yellow bold]pipematchnomatch [a+]} 1
if {[catch {uplevel 1 $cmdlist} 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 {
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 {pipematch level [info level] levelinfo [info level 0]} 2
#debug.punk.pipe {pipecase level [info level] levelinfo [info level 0]} 9
variable re_dot_assign
variable re_assign
@ -1723,6 +1770,9 @@ namespace eval punk {
if {[catch {uplevel 1 $cmdlist} result]} {
if {[string match "pipesyntax*" $result]} {
error $result
}
return [dict create error [dict create reason $result]]
} else {
tailcall return [dict create ok [dict create result $result]]
@ -1730,24 +1780,6 @@ namespace eval punk {
}
proc create_pipeswitch_interp {} {
interp create interp_pipeswitch
interp eval interp_pipeswitch {
namespace eval ::punk {}
set ::punk::i_am_slave_interp 1
}
interp eval interp_pipeswitch {
package require shellfilter
package require punk
foreach d [debug names] {
debug off $d
}
}
}
#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} {
uplevel $pipescript
}
@ -2396,6 +2428,7 @@ namespace eval punk {
interp alias {} pipeswitch {} punk::pipeswitch
interp alias {} pipecase {} punk::pipecase
interp alias {} pipematch {} punk::pipematch
interp alias {} pipenomatchvar {} punk::pipenomatchvar
proc = {value} {
return $value

Loading…
Cancel
Save