Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
First cut of a backtrace printer. With recent Parrot improvements, it…
… actually seems to show the Perl 6 line numbers reasonably reliably. Many enhancements to come, but commit early, commit often and all that. :-)
- Loading branch information
Showing
3 changed files
with
82 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,69 @@ | ||
| class Perl6::BacktracePrinter; | ||
|
|
||
| # Drives the overall backtrace production process. | ||
| method backtrace_for($exception) { | ||
| my @backtrace := $exception.backtrace(); | ||
| if self.is_runtime(@backtrace) { | ||
| # Runtime error. Start with the error message. | ||
| my $trace := pir::getattribute__pps($exception, 'message') ~ "\n"; | ||
|
|
||
| # If top frame is 'die', drop it from the top. | ||
| if ~@backtrace[0]<sub> eq '&die' { | ||
| @backtrace.shift; | ||
| } | ||
|
|
||
| # Go through frames to find annotations to print. | ||
| my $cur_annotations; | ||
| for @backtrace { | ||
| # If we're seeking an annotation set, take the current one. | ||
| unless $cur_annotations { | ||
| $cur_annotations := $_<annotations>; | ||
| } | ||
|
|
||
| # If we hit the end of the user's code, we're done; emit last | ||
| # annotations and say we're in main program body. | ||
| if ~$_<sub> eq '!UNIT_START' { | ||
| $trace := $trace ~ self.backtrace_line(0, $cur_annotations); | ||
| last; | ||
| } | ||
|
|
||
| # If we're not in an intermediate block, then we've hit some sub | ||
| # should emit annotations here. We go on not having a p6type but | ||
| # also checking for some built-in ops can be handy and give more | ||
| # informative line numbers. | ||
| if !pir::isnull(pir::getprop__psp('$!p6type', $_<sub>)) | ||
| || pir::substr(~$_<sub>, 0, 6) eq '&infix' { | ||
| $trace := $trace ~ self.backtrace_line($_<sub>, $cur_annotations); | ||
| $cur_annotations := 0; | ||
| } | ||
| } | ||
| return $trace; | ||
| } else { | ||
| # For parse time exceptions, we just want the message, with no | ||
| # back trace beyond this. | ||
| return "===SORRY!===\n" ~ | ||
| pir::getattribute__pps($exception, 'message') ~ "\n"; | ||
| } | ||
| } | ||
|
|
||
| # Checks if we have a !UNIT_START anywhere in the backtrace, in which case | ||
| # we must be at runtime. | ||
| method is_runtime(@backtrace) { | ||
| for @backtrace { | ||
| if ~$_<sub> eq '!UNIT_START' { | ||
| return 1; | ||
| } | ||
| } | ||
| return 0; | ||
| } | ||
|
|
||
| # Renders one line in the backtrace, using the given sub name and | ||
| # annotations set. | ||
| method backtrace_line($current_sub, $location) { | ||
| "in " ~ | ||
| ($current_sub ?? "'" ~ ~$current_sub ~ "'" !! 'main program body') ~ | ||
| " at " ~ | ||
| ($location<line> ?? 'line ' ~ $location<line> !! '<unknown line>' ) ~ | ||
| ($location<file> ?? ':' ~ $location<file> !! '' ) ~ | ||
| "\n" | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters