jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

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

master
Julian Noble 2 years ago
parent
36e271674c
commit
740715060b
2 changed files with 75 additions and 33 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 17
      scriptlib/tests/pipeswitch.tcl
  2. 91
      src/modules/punk-0.1.tm

17
scriptlib/tests/pipeswitch.tcl
Unescape View File

@ -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
Unescape View File

@ -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,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} { 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_dot_assign
variable re_assign variable re_assign
@ -1723,6 +1770,9 @@ namespace eval punk {
if {[catch {uplevel 1 $cmdlist} result]} { if {[catch {uplevel 1 $cmdlist} result]} {
if {[string match "pipesyntax*" $result]} {
error $result
}
return [dict create error [dict create reason $result]] return [dict create error [dict create reason $result]]
} else { } else {
tailcall return [dict create ok [dict create result $result]] 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} { 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

Write Preview
Loading…
Cancel
Save