Inlcude file name after the SORRY line

that way bulk messages (like for missing subroutines) get the file name exactly once (not 0 times as before, and not repeated for every occurrence either)
rakudo · Aug 5, 2013 · 156de3b · 156de3b
1 parent 89216fa
commit 156de3b
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 46 deletions.
diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
@@ -2384,6 +2384,7 @@ class Perl6::World is HLL::World {
         %opts<panic> := @panic[0] if @panic;
         %opts<sorrows> := p6ize_recursive(@*SORROWS) if @*SORROWS;
         %opts<worries> := p6ize_recursive(@*WORRIES) if @*WORRIES;
+        %opts<filename> := nqp::box_s(nqp::getlexdyn('$?FILES'), self.find_symbol(['Str']));
         try {
             my $group_type := self.find_symbol(['X', 'Comp', 'Group']);
             return $group_type.new(|%opts);

diff --git a/src/core/Exception.pm b/src/core/Exception.pm
@@ -132,51 +132,6 @@ sub COMP_EXCEPTION(|) {
     }
 }
 
-my class X::Comp::Group is Exception {
-    has $.panic;
-    has @.sorrows;
-    has @.worries;
-
-    method is-compile-time() { True }
-
-    method gist(::?CLASS:D:) {
-        my $r = "";
-        if $.panic || @.sorrows {
-            my $color = %*ENV<RAKUDO_ERROR_COLOR> // $*OS ne 'MSWin32';
-            my ($red, $clear) = $color ?? ("\e[31m", "\e[0m") !! ("", "");
-            $r ~= "$red==={$clear}SORRY!$red===$clear\n";
-            for @.sorrows {
-                $r ~= .gist(:!sorry, :!expect) ~ "\n";
-            }
-            if $.panic {
-                $r ~= $.panic.gist(:!sorry) ~ "\n";
-            }
-        }
-        if @.worries {
-            $r ~= $.panic || @.sorrows
-                ?? "Other potential difficulties:\n"
-                !! "Potential difficulties:\n";
-            for @.worries {
-                $r ~= .gist(:!sorry, :!expect).indent(4) ~ "\n";
-            }
-        }
-        $r
-    }
-
-    method message() {
-        my @m;
-        for @.sorrows {
-            @m.push(.message);
-        }
-        if $.panic {
-            @m.push($.panic.message);
-        }
-        for @.worries {
-            @m.push(.message);
-        }
-        @m.join("\n")
-    }
-}
 
 do {
     sub is_runtime($bt) {
@@ -428,7 +383,7 @@ my role X::Comp is Exception {
     method sorry_heading() {
         my $color = %*ENV<RAKUDO_ERROR_COLOR> // $*OS ne 'MSWin32';
         my ($red, $clear) = $color ?? ("\e[31m", "\e[0m") !! ("", "");
-        "$red==={$clear}SORRY!$red===$clear\n"
+        "$red==={$clear}SORRY!$red===$clear Error while compiling $.filename\n"
     }
     method SET_FILE_LINE($file, $line) {
         $!filename = $file;
@@ -437,6 +392,52 @@ my role X::Comp is Exception {
     }
 }
 
+my class X::Comp::Group does X::Comp {
+    has $.panic;
+    has @.sorrows;
+    has @.worries;
+
+    method is-compile-time() { True }
+
+    multi method gist(::?CLASS:D:) {
+        my $r = "";
+        if $.panic || @.sorrows {
+            my $color = %*ENV<RAKUDO_ERROR_COLOR> // $*OS ne 'MSWin32';
+            my ($red, $clear) = $color ?? ("\e[31m", "\e[0m") !! ("", "");
+            $r ~= "$red==={$clear}SORRY!$red===$clear Error while compiling $.filename\n";
+            for @.sorrows {
+                $r ~= .gist(:!sorry, :!expect) ~ "\n";
+            }
+            if $.panic {
+                $r ~= $.panic.gist(:!sorry) ~ "\n";
+            }
+        }
+        if @.worries {
+            $r ~= $.panic || @.sorrows
+                ?? "Other potential difficulties:\n"
+                !! "Potential difficulties:\n";
+            for @.worries {
+                $r ~= .gist(:!sorry, :!expect).indent(4) ~ "\n";
+            }
+        }
+        $r
+    }
+
+    method message() {
+        my @m;
+        for @.sorrows {
+            @m.push(.message);
+        }
+        if $.panic {
+            @m.push($.panic.message);
+        }
+        for @.worries {
+            @m.push(.message);
+        }
+        @m.join("\n")
+    }
+}
+
 # XXX a hack for getting line numbers from exceptions from the metamodel
 my class X::Comp::AdHoc is X::AdHoc does X::Comp {
     method is-compile-time() { True }