1. my role X::Comp { ... }
  2. my class X::ControlFlow { ... }
  3. my class Exception {
  4. has $!ex;
  5. has $!bt;
  6. method backtrace(Exception:D:) {
  7. if $!bt { $!bt }
  8. elsif nqp::isconcrete($!ex) {
  9. $!bt := Backtrace.new($!ex);
  10. }
  11. else { '' }
  12. }
  13. # Only valid if .backtrace has not been called yet
  14. method vault-backtrace(Exception:D:) {
  15. nqp::isconcrete($!ex) && $!bt ?? Backtrace.new($!ex) !! ''
  16. }
  17. method reset-backtrace(Exception:D:) {
  18. $!ex := Nil
  19. }
  20. multi method Str(Exception:D:) {
  21. my $str;
  22. if nqp::isconcrete($!ex) {
  23. my str $message = nqp::getmessage($!ex);
  24. $str = nqp::isnull_s($message) ?? '' !! nqp::p6box_s($message);
  25. }
  26. $str ||= (try self.?message);
  27. $str = ~$str if defined $str;
  28. $str // "Something went wrong in {self.WHAT.gist}";
  29. }
  30. multi method gist(Exception:D:) {
  31. my $str;
  32. if nqp::isconcrete($!ex) {
  33. my str $message = nqp::getmessage($!ex);
  34. $str = nqp::isnull_s($message)
  35. ?? "Died with {self.^name}"
  36. !! nqp::p6box_s($message);
  37. $str ~= "\n";
  38. try $str ~= self.backtrace
  39. || Backtrace.new()
  40. || ' (no backtrace available)';
  41. }
  42. else {
  43. $str = (try self.?message) // "Unthrown {self.^name} with no message";
  44. }
  45. $str;
  46. }
  47. method throw(Exception:D: $bt?) {
  48. $!ex := nqp::newexception() unless nqp::isconcrete($!ex) and $bt;
  49. $!bt := $bt; # Even if !$bt
  50. nqp::setpayload($!ex, nqp::decont(self));
  51. my $msg := try self.?message;
  52. if defined($msg) {
  53. $msg := try ~$msg;
  54. }
  55. $msg := $msg // "{self.^name} exception produced no message";
  56. nqp::setmessage($!ex, nqp::unbox_s($msg));
  57. nqp::throw($!ex)
  58. }
  59. method rethrow(Exception:D:) {
  60. unless nqp::isconcrete($!ex) {
  61. $!ex := nqp::newexception();
  62. try nqp::setmessage($!ex, self.message);
  63. }
  64. nqp::setpayload($!ex, nqp::decont(self));
  65. nqp::rethrow($!ex)
  66. }
  67. method resume(Exception:D: --> True) {
  68. nqp::resume($!ex);
  69. }
  70. method die(Exception:D:) { self.throw }
  71. method fail(Exception:D:) {
  72. try self.throw;
  73. my $fail := Failure.new($!);
  74. nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $fail);
  75. CATCH { $fail.exception.throw }
  76. }
  77. method is-compile-time(--> False) { }
  78. }
  79. my class X::SecurityPolicy is Exception {}
  80. my class X::SecurityPolicy::Eval is X::SecurityPolicy {
  81. has $.payload = "EVAL is a very dangerous function!!!";
  82. my role SlurpySentry { }
  83. method message() {
  84. do {
  85. # Remove spaces for die(*@msg)/fail(*@msg) forms
  86. given $.payload {
  87. when SlurpySentry {
  88. $_.list.join;
  89. }
  90. default {
  91. .Str;
  92. }
  93. }
  94. } ~ " (use the MONKEY-SEE-NO-EVAL pragma to override this error,\n"
  95. ~ "but only if you're VERY sure your data contains no injection attacks)";
  96. }
  97. method Numeric() { $.payload.Numeric }
  98. method from-slurpy (|cap) {
  99. self.new(:payload(cap does SlurpySentry))
  100. }
  101. }
  102. my class X::AdHoc is Exception {
  103. has $.payload = "Unexplained error";
  104. my role SlurpySentry { }
  105. method message() {
  106. # Remove spaces for die(*@msg)/fail(*@msg) forms
  107. given $.payload {
  108. when SlurpySentry {
  109. $_.list.join;
  110. }
  111. default {
  112. .Str;
  113. }
  114. }
  115. }
  116. method Numeric() { $.payload.Numeric }
  117. method from-slurpy (|cap) {
  118. self.new(:payload(cap does SlurpySentry))
  119. }
  120. }
  121. my class X::NQP::NotFound is Exception {
  122. has $.op;
  123. method message() {
  124. "Could not find nqp::$.op, did you forget 'use nqp;' ?"
  125. }
  126. }
  127. my class X::Dynamic::NotFound is Exception {
  128. has $.name;
  129. method message() {
  130. "Dynamic variable $.name not found";
  131. }
  132. }
  133. my class X::Method::NotFound is Exception {
  134. has Mu $.invocant;
  135. has $.method;
  136. has $.typename;
  137. has Bool $.private = False;
  138. method message() {
  139. my $message = $.private
  140. ?? "No such private method '$.method' for invocant of type '$.typename'"
  141. !! "No such method '$.method' for invocant of type '$.typename'";
  142. if $.method eq 'length' {
  143. $message ~= "\nDid you mean 'elems', 'chars', 'graphs' or 'codes'?";
  144. }
  145. elsif $.method eq 'bytes' {
  146. $message ~= "\nDid you mean '.encode(\$encoding).bytes'?";
  147. }
  148. $message;
  149. }
  150. }
  151. my class X::Method::InvalidQualifier is Exception {
  152. has $.method;
  153. has $.invocant;
  154. has $.qualifier-type;
  155. method message() {
  156. "Cannot dispatch to method $.method on {$.qualifier-type.^name} "
  157. ~ "because it is not inherited or done by {$.invocant.^name}";
  158. }
  159. }
  160. my class X::Role::Parametric::NoSuchCandidate is Exception {
  161. has Mu $.role;
  162. method message {
  163. "No appropriate parametric role variant available for '"
  164. ~ $.role.^name
  165. ~ "'";
  166. }
  167. }
  168. my class X::Pragma::NoArgs is Exception {
  169. has $.name;
  170. method message { "The '$.name' pragma does not take any arguments." }
  171. }
  172. my class X::Pragma::CannotPrecomp is Exception {
  173. has $.what = 'This compilation unit';
  174. method message { "$.what may not be pre-compiled" }
  175. }
  176. my class X::Pragma::CannotWhat is Exception {
  177. has $.what;
  178. has $.name;
  179. method message { "'$.what $.name' is not an option." }
  180. }
  181. my class X::Pragma::MustOneOf is Exception {
  182. has $.name;
  183. has $.alternatives;
  184. method message { "'$.name' pragma expects one parameter out of $.alternatives." }
  185. }
  186. my class X::Pragma::UnknownArg is Exception {
  187. has $.name;
  188. has $.arg;
  189. method message { "Unknown argument '{$.arg.perl}' specified with the '$.name' pragma." }
  190. }
  191. my class X::Pragma::OnlyOne is Exception {
  192. has $.name;
  193. method message { "The '$.name' pragma only takes one argument." }
  194. }
  195. my role X::Control is Exception {
  196. }
  197. my class CX::Next does X::Control {
  198. method message() { "<next control exception>" }
  199. }
  200. my class CX::Redo does X::Control {
  201. method message() { "<redo control exception>" }
  202. }
  203. my class CX::Last does X::Control {
  204. method message() { "<last control exception>" }
  205. }
  206. my class CX::Take does X::Control {
  207. method message() { "<take control exception>" }
  208. }
  209. my class CX::Warn does X::Control {
  210. has $.message;
  211. }
  212. my class CX::Succeed does X::Control {
  213. method message() { "<succeed control exception>" }
  214. }
  215. my class CX::Proceed does X::Control {
  216. method message() { "<proceed control exception>" }
  217. }
  218. my class CX::Return does X::Control {
  219. method message() { "<return control exception>" }
  220. }
  221. my class CX::Emit does X::Control {
  222. method message() { "<emit control exception>" }
  223. }
  224. my class CX::Done does X::Control {
  225. method message() { "<done control exception>" }
  226. }
  227. sub EXCEPTION(|) {
  228. my Mu $vm_ex := nqp::shift(nqp::p6argvmarray());
  229. my Mu $payload := nqp::getpayload($vm_ex);
  230. if nqp::p6bool(nqp::istype($payload, Exception)) {
  231. nqp::bindattr($payload, Exception, '$!ex', $vm_ex);
  232. $payload;
  233. } else {
  234. my int $type = nqp::getextype($vm_ex);
  235. my $ex;
  236. if $type +& nqp::const::CONTROL_NEXT {
  237. $ex := CX::Next.new();
  238. }
  239. elsif $type +& nqp::const::CONTROL_REDO {
  240. $ex := CX::Redo.new();
  241. }
  242. elsif $type +& nqp::const::CONTROL_LAST {
  243. $ex := CX::Last.new();
  244. }
  245. elsif $type == nqp::const::CONTROL_TAKE {
  246. $ex := CX::Take.new();
  247. }
  248. elsif $type == nqp::const::CONTROL_WARN {
  249. my str $message = nqp::getmessage($vm_ex);
  250. $message = 'Warning' if nqp::isnull_s($message) || $message eq '';
  251. $ex := CX::Warn.new(:$message);
  252. }
  253. elsif $type == nqp::const::CONTROL_SUCCEED {
  254. $ex := CX::Succeed.new();
  255. }
  256. elsif $type == nqp::const::CONTROL_PROCEED {
  257. $ex := CX::Proceed.new();
  258. }
  259. elsif $type == nqp::const::CONTROL_RETURN {
  260. $ex := CX::Return.new();
  261. }
  262. elsif $type == nqp::const::CONTROL_EMIT {
  263. $ex := CX::Emit.new();
  264. }
  265. elsif $type == nqp::const::CONTROL_DONE {
  266. $ex := CX::Done.new();
  267. }
  268. else {
  269. $ex := nqp::create(X::AdHoc);
  270. nqp::bindattr($ex, X::AdHoc, '$!payload', nqp::p6box_s(nqp::getmessage($vm_ex) // 'unknown exception'));
  271. }
  272. nqp::bindattr($ex, Exception, '$!ex', $vm_ex);
  273. $ex;
  274. }
  275. }
  276. my class X::Comp::AdHoc { ... }
  277. sub COMP_EXCEPTION(|) {
  278. my Mu $vm_ex := nqp::shift(nqp::p6argvmarray());
  279. my Mu $payload := nqp::getpayload($vm_ex);
  280. if nqp::p6bool(nqp::istype($payload, Exception)) {
  281. nqp::bindattr($payload, Exception, '$!ex', $vm_ex);
  282. $payload;
  283. } else {
  284. my $ex := nqp::create(X::Comp::AdHoc);
  285. nqp::bindattr($ex, Exception, '$!ex', $vm_ex);
  286. nqp::bindattr($ex, X::AdHoc, '$!payload', nqp::p6box_s(nqp::getmessage($vm_ex)));
  287. $ex;
  288. }
  289. }
  290. do {
  291. sub print_exception(|) {
  292. my Mu $ex := nqp::atpos(nqp::p6argvmarray(), 0);
  293. my $e := EXCEPTION($ex);
  294. if %*ENV<RAKUDO_EXCEPTIONS_HANDLER> -> $handler {
  295. my $class := ::("Exceptions::$handler");
  296. unless nqp::istype($class,Failure) {
  297. temp %*ENV<RAKUDO_EXCEPTIONS_HANDLER> = ""; # prevent looping
  298. return unless $class.process($e)
  299. }
  300. }
  301. try {
  302. my $v := $e.vault-backtrace;
  303. my Mu $err := nqp::getstderr();
  304. $e.backtrace; # This is where most backtraces actually happen
  305. if $e.is-compile-time || $e.backtrace && $e.backtrace.is-runtime {
  306. nqp::printfh($err, $e.gist);
  307. nqp::printfh($err, "\n");
  308. if $v {
  309. nqp::printfh($err, "Actually thrown at:\n");
  310. nqp::printfh($err, $v.Str);
  311. nqp::printfh($err, "\n");
  312. }
  313. }
  314. elsif Rakudo::Internals.VERBATIM-EXCEPTION(0) {
  315. nqp::printfh($err, $e.Str);
  316. }
  317. else {
  318. nqp::printfh($err, "===SORRY!===\n");
  319. nqp::printfh($err, $e.Str);
  320. nqp::printfh($err, "\n");
  321. }
  322. Rakudo::Internals.THE_END();
  323. CONTROL { when CX::Warn { .resume } }
  324. }
  325. if $! {
  326. nqp::rethrow(nqp::getattr(nqp::decont($!), Exception, '$!ex'));
  327. $ex
  328. }
  329. }
  330. sub print_control(|) {
  331. nqp::stmts(
  332. (my Mu $ex := nqp::atpos(nqp::p6argvmarray(),0)),
  333. (my int $type = nqp::getextype($ex)),
  334. (my $backtrace = Backtrace.new(nqp::backtrace($ex))),
  335. nqp::if(
  336. nqp::iseq_i($type,nqp::const::CONTROL_WARN),
  337. nqp::stmts(
  338. (my Mu $err := nqp::getstderr),
  339. (my str $msg = nqp::getmessage($ex)),
  340. nqp::printfh($err,nqp::if(nqp::chars($msg),$msg,"Warning")),
  341. nqp::printfh($err, "\n"),
  342. nqp::printfh($err, $backtrace.first-none-setting-line),
  343. nqp::resume($ex)
  344. )
  345. )
  346. );
  347. my $label = $type +& nqp::const::CONTROL_LABELED ?? "labeled " !! "";
  348. if $type +& nqp::const::CONTROL_LAST {
  349. X::ControlFlow.new(illegal => "{$label}last", enclosing => 'loop construct', :$backtrace).throw;
  350. }
  351. elsif $type +& nqp::const::CONTROL_NEXT {
  352. X::ControlFlow.new(illegal => "{$label}next", enclosing => 'loop construct', :$backtrace).throw;
  353. }
  354. elsif $type +& nqp::const::CONTROL_REDO {
  355. X::ControlFlow.new(illegal => "{$label}redo", enclosing => 'loop construct', :$backtrace).throw;
  356. }
  357. elsif $type +& nqp::const::CONTROL_PROCEED {
  358. X::ControlFlow.new(illegal => 'proceed', enclosing => 'when clause', :$backtrace).throw;
  359. }
  360. elsif $type +& nqp::const::CONTROL_SUCCEED {
  361. # XXX: should work like leave() ?
  362. X::ControlFlow.new(illegal => 'succeed', enclosing => 'when clause', :$backtrace).throw;
  363. }
  364. elsif $type +& nqp::const::CONTROL_TAKE {
  365. X::ControlFlow.new(illegal => 'take', enclosing => 'gather', :$backtrace).throw;
  366. }
  367. elsif $type +& nqp::const::CONTROL_EMIT {
  368. X::ControlFlow.new(illegal => 'emit', enclosing => 'supply or react', :$backtrace).throw;
  369. }
  370. elsif $type +& nqp::const::CONTROL_DONE {
  371. X::ControlFlow.new(illegal => 'done', enclosing => 'supply or react', :$backtrace).throw;
  372. }
  373. else {
  374. X::ControlFlow.new(illegal => 'control exception', enclosing => 'handler', :$backtrace).throw;
  375. }
  376. }
  377. my Mu $comp := nqp::getcomp('perl6');
  378. $comp.^add_method('handle-exception',
  379. method (|) {
  380. my Mu $ex := nqp::atpos(nqp::p6argvmarray(), 1);
  381. print_exception($ex);
  382. nqp::exit(1);
  383. 0;
  384. }
  385. );
  386. $comp.^add_method('handle-control',
  387. method (|) {
  388. my Mu $ex := nqp::atpos(nqp::p6argvmarray(), 1);
  389. print_control($ex);
  390. nqp::rethrow($ex);
  391. }
  392. );
  393. }
  394. my role X::OS is Exception {
  395. has $.os-error;
  396. method message() { $.os-error }
  397. }
  398. my role X::IO does X::OS { };
  399. my class X::IO::Unknown does X::IO {
  400. has $.trying;
  401. method message { "Unknown IO error trying '$.trying'" }
  402. }
  403. my class X::IO::Rename does X::IO {
  404. has $.from;
  405. has $.to;
  406. method message() {
  407. "Failed to rename '$.from' to '$.to': $.os-error"
  408. }
  409. }
  410. my class X::IO::Copy does X::IO {
  411. has $.from;
  412. has $.to;
  413. method message() {
  414. "Failed to copy '$.from' to '$.to': $.os-error"
  415. }
  416. }
  417. my class X::IO::Lock does X::IO {
  418. has $.lock-type;
  419. method message() { "Could not obtain $.lock-type lock: $.os-error" }
  420. }
  421. my class X::IO::Move does X::IO {
  422. has $.from;
  423. has $.to;
  424. method message() {
  425. "Failed to move '$.from' to '$.to': $.os-error"
  426. }
  427. }
  428. my class X::IO::DoesNotExist does X::IO {
  429. has $.path;
  430. has $.trying;
  431. method message() {
  432. "Failed to find '$.path' while trying to do '.$.trying'"
  433. }
  434. }
  435. my class X::IO::NotAFile does X::IO {
  436. has $.path;
  437. has $.trying;
  438. method message() {
  439. "'$.path' is not a regular file while trying to do '.$.trying'"
  440. }
  441. }
  442. my class X::IO::Null does X::IO {
  443. method message() {
  444. "Cannot use null character (U+0000) as part of the path"
  445. }
  446. }
  447. my class X::IO::Directory does X::IO {
  448. has $.path;
  449. has $.trying;
  450. has $.use;
  451. method message () {
  452. my $x = "'$.path' is a directory, cannot do '.$.trying' on a directory";
  453. if $.use { $x ~= ", try '{$.use}()' instead" }
  454. $x;
  455. }
  456. }
  457. my class X::IO::Symlink does X::IO {
  458. has $.target;
  459. has $.name;
  460. method message() {
  461. "Failed to create symlink called '$.name' on target '$.target': $.os-error"
  462. }
  463. }
  464. my class X::IO::Link does X::IO {
  465. has $.target;
  466. has $.name;
  467. method message() {
  468. "Failed to create link called '$.name' on target '$.target': $.os-error"
  469. }
  470. }
  471. my class X::IO::Mkdir does X::IO {
  472. has $.path;
  473. has $.mode;
  474. method message() {
  475. "Failed to create directory '$.path' with mode '0o{$.mode.fmt("%03o")}': $.os-error"
  476. }
  477. }
  478. my class X::IO::Chdir does X::IO {
  479. has $.path;
  480. method message() {
  481. "Failed to change the working directory to '$.path': $.os-error"
  482. }
  483. }
  484. my class X::IO::Dir does X::IO {
  485. has $.path;
  486. method message() {
  487. "Failed to get the directory contents of '$.path': $.os-error"
  488. }
  489. }
  490. my class X::IO::Cwd does X::IO {
  491. method message() {
  492. "Failed to get the working directory: $.os-error"
  493. }
  494. }
  495. my class X::IO::Flush does X::IO {
  496. method message() {
  497. "Cannot flush handle: $.os-error"
  498. }
  499. }
  500. my class X::IO::NotAChild does X::IO {
  501. has $.path;
  502. has $.child;
  503. method message() {
  504. "Path {$.child.perl} is not a child of path {$.path.perl}"
  505. }
  506. }
  507. my class X::IO::Resolve does X::IO {
  508. has $.path;
  509. method message() { "Failed to completely resolve {$.path.perl}" }
  510. }
  511. my class X::IO::Rmdir does X::IO {
  512. has $.path;
  513. method message() {
  514. "Failed to remove the directory '$.path': $.os-error"
  515. }
  516. }
  517. my class X::IO::Unlink does X::IO {
  518. has $.path;
  519. method message() {
  520. "Failed to remove the file '$.path': $.os-error"
  521. }
  522. }
  523. my class X::IO::Chmod does X::IO {
  524. has $.path;
  525. has $.mode;
  526. method message() {
  527. "Failed to set the mode of '$.path' to '0o{$.mode.fmt("%03o")}': $.os-error"
  528. }
  529. }
  530. my class X::IO::BinaryAndEncoding does X::IO {
  531. method message { "Cannot open a handle in binary mode (:bin) and also specify an encoding" }
  532. }
  533. my class X::IO::BinaryMode does X::IO {
  534. has $.trying;
  535. method message { "Cannot do '$.trying' on a handle in binary mode" }
  536. }
  537. my role X::Comp is Exception {
  538. has $.filename;
  539. has $.pos;
  540. has $.line;
  541. has $.column;
  542. has @.modules;
  543. has $.is-compile-time = False;
  544. has $.pre;
  545. has $.post;
  546. has @.highexpect;
  547. multi method gist(::?CLASS:D: :$sorry = True, :$expect = True) {
  548. if $.is-compile-time {
  549. my ($red,$clear,$green,$yellow,$eject) =
  550. Rakudo::Internals.error-rcgye;
  551. my $r = $sorry ?? self.sorry_heading() !! "";
  552. $r ~= $.filename eq '<unknown file>'
  553. ?? $.line == 1
  554. ?? $.message
  555. !! "$.message\nat line $.line"
  556. !! "$.message\nat $.filename():$.line";
  557. $r ~= "\n------> $green$.pre$yellow$eject$red$.post$clear" if defined $.pre;
  558. if $expect && @.highexpect {
  559. $r ~= "\n expecting any of:";
  560. for @.highexpect {
  561. $r ~= "\n $_";
  562. }
  563. }
  564. for @.modules.reverse[1..*] {
  565. my $line = nqp::p6box_i($_<line>);
  566. $r ~= $_<module>.defined
  567. ?? "\n from module $_<module> ($_<filename> line $line)"
  568. !! "\n from $_<filename> line $line";
  569. }
  570. $r;
  571. }
  572. else {
  573. self.Exception::gist;
  574. }
  575. }
  576. method sorry_heading() {
  577. my ($red, $clear) = Rakudo::Internals.error-rcgye;
  578. "$red==={$clear}SORRY!$red===$clear Error while compiling{
  579. $.filename eq '<unknown file>'
  580. ?? ':'
  581. !! " $.filename"
  582. }\n"
  583. }
  584. method SET_FILE_LINE($file, $line) {
  585. $!filename = $file;
  586. $!line = $line;
  587. $!is-compile-time = True;
  588. }
  589. }
  590. my class X::Comp::Group is Exception {
  591. has $.panic;
  592. has @.sorrows;
  593. has @.worries;
  594. method is-compile-time(--> True) { }
  595. multi method gist(::?CLASS:D:) {
  596. my $r = "";
  597. if $.panic || @.sorrows {
  598. my ($red, $clear) = Rakudo::Internals.error-rcgye;
  599. $r ~= "$red==={$clear}SORRY!$red===$clear\n";
  600. for @.sorrows {
  601. $r ~= .gist(:!sorry, :!expect) ~ "\n";
  602. }
  603. if $.panic {
  604. $r ~= $.panic.gist(:!sorry) ~ "\n";
  605. }
  606. }
  607. if @.worries {
  608. $r ~= $.panic || @.sorrows
  609. ?? "Other potential difficulties:\n"
  610. !! "Potential difficulties:\n";
  611. for @.worries {
  612. $r ~= .gist(:!sorry, :!expect).indent(4) ~ "\n";
  613. }
  614. }
  615. $r
  616. }
  617. method message() {
  618. my @m;
  619. for @.sorrows {
  620. @m.append(.message);
  621. }
  622. if $.panic {
  623. @m.append($.panic.message);
  624. }
  625. for @.worries {
  626. @m.append(.message);
  627. }
  628. @m.join("\n")
  629. }
  630. }
  631. my role X::MOP is Exception { }
  632. my class X::Comp::BeginTime does X::Comp {
  633. has $.use-case;
  634. has $.exception;
  635. method message() {
  636. $!exception ~~ X::MOP
  637. ?? $!exception.message
  638. !! "An exception occurred while $!use-case"
  639. }
  640. multi method gist(::?CLASS:D: :$sorry = True) {
  641. my $r = $sorry ?? self.sorry_heading() !! "";
  642. $r ~= "$.message\nat $.filename():$.line";
  643. for @.modules.reverse[1..*] {
  644. my $line = nqp::p6box_i($_<line>);
  645. $r ~= $_<module>.defined
  646. ?? "\n from module $_<module> ($_<filename> line $line)"
  647. !! "\n from $_<filename> line $line";
  648. }
  649. unless $!exception ~~ X::MOP {
  650. $r ~= "\nException details:\n" ~ $!exception.gist.indent(2);
  651. }
  652. $r;
  653. }
  654. }
  655. # XXX a hack for getting line numbers from exceptions from the metamodel
  656. my class X::Comp::AdHoc is X::AdHoc does X::Comp {
  657. method is-compile-time(--> True) { }
  658. }
  659. my class X::Comp::FailGoal does X::Comp {
  660. has $.dba;
  661. has $.goal;
  662. method is-compile-time(--> True) { }
  663. method message { "Unable to parse expression in $.dba; couldn't find final $.goal" }
  664. }
  665. my role X::Syntax does X::Comp { }
  666. my role X::Pod { }
  667. my class X::NYI is Exception {
  668. has $.feature;
  669. has $.did-you-mean;
  670. method message() {
  671. my $msg = "$.feature not yet implemented. Sorry.";
  672. $msg ~= "\nDid you mean: {$.did-you-mean.gist}?" if $.did-you-mean;
  673. $msg
  674. }
  675. }
  676. my class X::Comp::NYI is X::NYI does X::Comp { };
  677. my class X::NYI::Available is X::NYI {
  678. has @.available = die("Must give :available<modules> for installation. ");
  679. method available-str {
  680. my @a = @.available;
  681. my $a = @a.pop;
  682. @a ?? (@a.join(', ') || (), $a).join(" or ") !! $a;
  683. }
  684. method message() {
  685. "Please install { self.available-str } for $.feature support. "
  686. }
  687. }
  688. my class X::NYI::BigInt is Exception {
  689. has $.op;
  690. has $.big;
  691. has $.side = 'right';
  692. method message() {
  693. "Big integer $!big not yet supported on {$!side}hand side of '$!op' operator"
  694. }
  695. }
  696. my class X::Experimental does X::Comp {
  697. has $.feature;
  698. has $.use = $!feature;
  699. method message() { "Use of $.feature is experimental; please 'use experimental :$.use'" }
  700. }
  701. my class X::Worry is Exception { }
  702. my class X::Worry::P5 is X::Worry { }
  703. my class X::Worry::P5::Reference is X::Worry::P5 {
  704. method message {
  705. q/To pass an array, hash or sub to a function in Perl 6, just pass it as is.
  706. For other uses of Perl 5's ref operator consider binding with ::= instead.
  707. Parenthesize as \\(...) if you intended a capture of a single variable./
  708. }
  709. }
  710. my class X::Worry::P5::BackReference is X::Worry::P5 {
  711. method message {
  712. q/To refer to a positional match capture, just use $0 (numbering starts at 0).
  713. Parenthesize as \\(...) if you intended a capture of a single numeric value./
  714. }
  715. }
  716. my class X::Worry::P5::LeadingZero is X::Worry::P5 {
  717. has $.value;
  718. method message {
  719. 'Leading 0 has no meaning. If you meant to create an octal number'
  720. ~ ", use '0o' prefix" ~ (
  721. $!value.comb.grep(*.unival > 7)
  722. ?? ", but note that $!value is not a valid octal number"
  723. !! "; like, '0o$!value'"
  724. ) ~ '. If you meant to create a string, please add quotation marks.'
  725. }
  726. }
  727. my class X::Trait::Invalid is Exception {
  728. has $.type; # is, will, of etc.
  729. has $.subtype; # wrong subtype being tried
  730. has $.declaring; # variable, sub, parameter, etc.
  731. has $.name; # '$foo', '@bar', etc.
  732. method message () {
  733. "Cannot use '$.type $.subtype' on $.declaring '$.name'."
  734. }
  735. }
  736. my class X::Trait::Unknown is Exception {
  737. has $.type; # is, will, of etc.
  738. has $.subtype; # wrong subtype being tried
  739. has $.declaring; # variable, sub, parameter, etc.
  740. method message () {
  741. "Can't use unknown trait '$.type $.subtype' in a$.declaring declaration."
  742. }
  743. }
  744. my class X::Comp::Trait::Unknown is X::Trait::Unknown does X::Comp { };
  745. my class X::Trait::NotOnNative is Exception {
  746. has $.type; # is, will, of etc.
  747. has $.subtype; # wrong subtype being tried
  748. has $.native; # type of native (optional)
  749. method message () {
  750. "Can't use trait '$.type $.subtype' on a native"
  751. ~ ( $.native ?? " $.native." !! "." );
  752. }
  753. }
  754. my class X::Comp::Trait::NotOnNative is X::Trait::NotOnNative does X::Comp { };
  755. my class X::Trait::Scope is Exception {
  756. has $.type; # is, will, of etc.
  757. has $.subtype; # export
  758. has $.declaring; # type name of the object
  759. has $.scope; # not supported (but used) scope
  760. has $.supported; # hint about what is allowed instead
  761. method message () {
  762. "Can't apply trait '$.type $.subtype' on a $.scope scoped $.declaring."
  763. ~ ( $.supported ?? " Only {$.supported.join(' and ')} scoped {$.declaring}s are supported." !! '' );
  764. }
  765. }
  766. my class X::Comp::Trait::Scope is X::Trait::Scope does X::Comp { };
  767. my class X::OutOfRange is Exception {
  768. has $.what = 'Argument';
  769. has $.got = '<unknown>';
  770. has $.range = '<unknown>';
  771. has $.comment;
  772. method message() {
  773. my $result = $.comment.defined
  774. ?? "$.what out of range. Is: $.got, should be in $.range.gist(); $.comment"
  775. !! "$.what out of range. Is: $.got, should be in $.range.gist()";
  776. $result;
  777. }
  778. }
  779. my class X::Buf::AsStr is Exception {
  780. has $.method;
  781. method message() {
  782. "Cannot use a Buf as a string, but you called the $.method method on it";
  783. }
  784. }
  785. my class X::Buf::Pack is Exception {
  786. has $.directive;
  787. method message() {
  788. "Unrecognized directive '$.directive'";
  789. }
  790. }
  791. my class X::Buf::Pack::NonASCII is Exception {
  792. has $.char;
  793. method message() {
  794. "non-ASCII character '$.char' while processing an 'A' template in pack";
  795. }
  796. }
  797. my class X::Signature::Placeholder does X::Comp {
  798. has $.placeholder;
  799. method message() {
  800. "Placeholder variable '$.placeholder' cannot override existing signature";
  801. }
  802. }
  803. my class X::Placeholder::Block does X::Comp {
  804. has $.placeholder;
  805. method message() {
  806. "Placeholder variable $.placeholder may not be used here because the surrounding block takes no signature";
  807. }
  808. }
  809. my class X::Placeholder::NonPlaceholder does X::Comp {
  810. has $.variable_name;
  811. has $.placeholder;
  812. has $.decl;
  813. method message() {
  814. my $decl = $!decl ?? ' ' ~ $!decl !! '';
  815. "$!variable_name has already been used as a non-placeholder in the surrounding$decl block,\n" ~
  816. " so you will confuse the reader if you suddenly declare $!placeholder here"
  817. }
  818. }
  819. my class X::Placeholder::Mainline is X::Placeholder::Block {
  820. method message() {
  821. "Cannot use placeholder parameter $.placeholder outside of a sub or block"
  822. }
  823. }
  824. my class X::Placeholder::Attribute is X::Placeholder::Block {
  825. method message() {
  826. "Cannot use placeholder parameter $.placeholder in an attribute initializer"
  827. }
  828. }
  829. my class X::Undeclared does X::Comp {
  830. has $.what = 'Variable';
  831. has $.symbol;
  832. has @.suggestions;
  833. method message() {
  834. my $message := "$.what '$.symbol' is not declared";
  835. if +@.suggestions == 1 {
  836. $message := "$message. Did you mean '@.suggestions[0]'?";
  837. } elsif +@.suggestions > 1 {
  838. $message := "$message. Did you mean any of these?\n { @.suggestions.join("\n ") }\n";
  839. }
  840. $message;
  841. }
  842. }
  843. my class X::Attribute::Undeclared is X::Undeclared {
  844. has $.package-kind;
  845. has $.package-name;
  846. method message() {
  847. "Attribute $.symbol not declared in $.package-kind $.package-name";
  848. }
  849. }
  850. my class X::Attribute::Regex is X::Undeclared {
  851. method message() {
  852. "Attribute $.symbol not available inside of a regex, since regexes are methods on Cursor.\n" ~
  853. "Consider storing the attribute in a lexical, and using that in the regex.";
  854. }
  855. }
  856. my class X::Undeclared::Symbols does X::Comp {
  857. has %.post_types;
  858. has %.unk_types;
  859. has %.unk_routines;
  860. has %.routine_suggestion;
  861. has %.type_suggestion;
  862. multi method gist(X::Undeclared::Symbols:D: :$sorry = True) {
  863. ($sorry ?? self.sorry_heading() !! "") ~ self.message
  864. }
  865. method message(X::Undeclared::Symbols:D:) {
  866. sub l(@l) {
  867. my @lu = @l.map({ nqp::hllize($_) }).unique.sort;
  868. 'used at line' ~ (@lu == 1 ?? ' ' !! 's ') ~ @lu.join(', ')
  869. }
  870. sub s(@s) {
  871. "Did you mean '{ @s.join("', '") }'?";
  872. }
  873. my $r = "";
  874. if %.post_types {
  875. $r ~= "Illegally post-declared type" ~ (%.post_types.elems == 1 ?? "" !! "s") ~ ":\n";
  876. for %.post_types.sort(*.key) {
  877. $r ~= " $_.key() &l($_.value)\n";
  878. }
  879. }
  880. if %.unk_types {
  881. $r ~= "Undeclared name" ~ (%.unk_types.elems == 1 ?? "" !! "s") ~ ":\n";
  882. for %.unk_types.sort(*.key) {
  883. $r ~= " $_.key() &l($_.value)";
  884. if +%.type_suggestion{$_.key()} {
  885. $r ~= ". " ~ s(%.type_suggestion{$_.key()});
  886. }
  887. $r ~= "\n";
  888. }
  889. }
  890. if %.unk_routines {
  891. my $obs = {
  892. y => "tr",
  893. qr => "rx",
  894. local => "temp (or dynamic var)",
  895. new => "method call syntax",
  896. foreach => "for",
  897. }
  898. $r ~= "Undeclared routine" ~ (%.unk_routines.elems == 1 ?? "" !! "s") ~ ":\n";
  899. for %.unk_routines.sort(*.key) {
  900. $r ~= " $_.key() &l($_.value)";
  901. $r ~= " (in Perl 6 please use " ~ $obs{$_.key()} ~ " instead)" if $obs{$_.key()};
  902. if +%.routine_suggestion{$_.key()}.list {
  903. $r ~= ". " ~ s(%.routine_suggestion{$_.key()}.list);
  904. }
  905. $r ~= "\n";
  906. }
  907. }
  908. $r
  909. }
  910. }
  911. my class X::Redeclaration does X::Comp {
  912. has $.symbol;
  913. has $.postfix = '';
  914. has $.what = 'symbol';
  915. method message() {
  916. "Redeclaration of $.what '$.symbol'"
  917. ~ (" $.postfix" if $.postfix)
  918. ~ (" (did you mean to declare a multi-sub?)" if $.what eq 'routine');
  919. }
  920. }
  921. my class X::Redeclaration::Outer does X::Comp {
  922. has $.symbol;
  923. method message() {
  924. "Lexical symbol '$.symbol' is already bound to an outer symbol;\n" ~
  925. "the implicit outer binding must be rewritten as OUTER::<$.symbol>\n" ~
  926. "before you can unambiguously declare a new '$.symbol' in this scope";
  927. }
  928. }
  929. my class X::Dynamic::Postdeclaration does X::Comp {
  930. has $.symbol;
  931. method message() {
  932. "Illegal post-declaration of dynamic variable '$.symbol';\n" ~
  933. "earlier access must be written as CALLERS::<$.symbol>\n" ~
  934. "if that's what you meant"
  935. }
  936. }
  937. my class X::Dynamic::Package does X::Comp {
  938. has $.symbol;
  939. method message() {
  940. "Dynamic variables cannot have package-like names, like $!symbol"
  941. }
  942. }
  943. my class X::Import::Redeclaration does X::Comp {
  944. has @.symbols;
  945. has $.source-package-name;
  946. method message() {
  947. @.symbols == 1
  948. ?? "Cannot import symbol @.symbols[0] from $.source-package-name, because it already exists in this lexical scope"
  949. !! ("Cannot import the following symbols from $.source-package-name, because they already exist in this lexical scope: ", @.symbols.join(', '));
  950. }
  951. }
  952. my class X::Import::OnlystarProto does X::Comp {
  953. has @.symbols;
  954. has $.source-package-name;
  955. method message() {
  956. @.symbols == 1
  957. ?? "Cannot import symbol @.symbols[0] from $.source-package-name, only onlystar-protos can be merged"
  958. !! ("Cannot import the following symbols from $.source-package-name, only onlystar-protos can be merged: ", @.symbols.join(', '));
  959. }
  960. }
  961. my class X::PoisonedAlias does X::Comp {
  962. has $.alias;
  963. has $.package-type = 'package';
  964. has $.package-name;
  965. method message() {
  966. "Cannot use poisoned alias $!alias, because it was declared by several {$!package-type}s." ~
  967. ($!package-name ?? "\nPlease access it via explicit package name like: {$!package-name}::{$!alias}" !! '')
  968. }
  969. }
  970. my class X::Phaser::Multiple does X::Comp {
  971. has $.block;
  972. method message() { "Only one $.block block is allowed" }
  973. }
  974. my class X::Obsolete does X::Comp {
  975. has $.old;
  976. has $.replacement; # can't call it $.new, collides with constructor
  977. has $.when = 'in Perl 6';
  978. method message() { "Unsupported use of $.old; $.when please use $.replacement" }
  979. }
  980. my class X::Parameter::Default does X::Comp {
  981. has $.how;
  982. has $.parameter;
  983. method message() {
  984. $.parameter
  985. ?? "Cannot put default on $.how parameter $.parameter"
  986. !! "Cannot put default on anonymous $.how parameter";
  987. }
  988. }
  989. my class X::Parameter::Default::TypeCheck does X::Comp {
  990. has $.got is default(Nil);
  991. has $.expected is default(Nil);
  992. method message() {
  993. "Default value '$.got.gist()' will never bind to a parameter of type $.expected.^name()"
  994. }
  995. }
  996. my class X::Parameter::AfterDefault does X::Syntax {
  997. has $.type;
  998. has $.modifier;
  999. has $.default;
  1000. method message() {
  1001. "The $.type \"$.modifier\" came after the default value\n"
  1002. ~ "(did you mean \"...$.modifier $.default\"?)"
  1003. }
  1004. }
  1005. my class X::Parameter::Placeholder does X::Comp {
  1006. has $.parameter;
  1007. has $.right;
  1008. method message() {
  1009. "In signature parameter, placeholder variables like $.parameter are illegal\n"
  1010. ~ "you probably meant a named parameter: '$.right'";
  1011. }
  1012. }
  1013. my class X::Parameter::Twigil does X::Comp {
  1014. has $.parameter;
  1015. has $.twigil;
  1016. method message() {
  1017. "In signature parameter $.parameter, it is illegal to use the $.twigil twigil";
  1018. }
  1019. }
  1020. my class X::Parameter::MultipleTypeConstraints does X::Comp {
  1021. has $.parameter;
  1022. method message() {
  1023. ($.parameter ?? "Parameter $.parameter" !! 'A parameter')
  1024. ~ " may only have one prefix type constraint";
  1025. }
  1026. }
  1027. my class X::Parameter::BadType does X::Comp {
  1028. has Mu $.type;
  1029. method message() {
  1030. my $what = ~$!type.HOW.WHAT.^name.match(/ .* '::' <(.*)> HOW/) // 'Namespace';
  1031. "$what $!type.^name() is insufficiently type-like to qualify a parameter"
  1032. }
  1033. }
  1034. my class X::Parameter::WrongOrder does X::Comp {
  1035. has $.misplaced;
  1036. has $.parameter;
  1037. has $.after;
  1038. method message() {
  1039. "Cannot put $.misplaced parameter $.parameter after $.after parameters";
  1040. }
  1041. }
  1042. my class X::Parameter::InvalidConcreteness is Exception {
  1043. has $.expected;
  1044. has $.got;
  1045. has $.routine;
  1046. has $.param;
  1047. has Bool $.should-be-concrete;
  1048. has Bool $.param-is-invocant;
  1049. method message() {
  1050. $!routine = '<anon>' if not $!routine.defined or $!routine eq '';
  1051. $!param = '<anon>' if not $!param.defined or $!param eq '';
  1052. my $beginning = $!param-is-invocant ?? 'Invocant of method' !! "Parameter '$!param' of routine";
  1053. my $must-be = $!should-be-concrete ?? 'an object instance' !! 'a type object';
  1054. my $not-a = $!should-be-concrete ?? 'a type object' !! 'an object instance';
  1055. my $suggestion = $!should-be-concrete ?? '.new' !! 'multi';
  1056. "$beginning '$!routine' must be $must-be of type '$!expected', not $not-a of type '$!got'. Did you forget a '$suggestion'?"
  1057. }
  1058. }
  1059. my class X::Parameter::InvalidType does X::Comp {
  1060. has $.typename;
  1061. has @.suggestions;
  1062. method message() {
  1063. my $msg := "Invalid typename '$.typename' in parameter declaration.";
  1064. if +@.suggestions > 0 {
  1065. $msg := $msg ~ " Did you mean '" ~ @.suggestions.join("', '") ~ "'?";
  1066. }
  1067. $msg;
  1068. }
  1069. }
  1070. my class X::Parameter::RW is Exception {
  1071. has $.got;
  1072. has $.symbol;
  1073. method message() {
  1074. "Parameter '$.symbol' expected a writable container, but got $.got.^name() value"
  1075. }
  1076. }
  1077. my class X::Parameter::TypedSlurpy does X::Comp {
  1078. has $.kind;
  1079. method message() {
  1080. "Slurpy $.kind parameters with type constraints are not supported"
  1081. }
  1082. }
  1083. my class X::Signature::NameClash does X::Comp {
  1084. has $.name;
  1085. method message() {
  1086. "Name $.name used for more than one named parameter";
  1087. }
  1088. }
  1089. my class X::Method::Private::Permission does X::Comp {
  1090. has $.method;
  1091. has $.source-package;
  1092. has $.calling-package;
  1093. method message() {
  1094. "Cannot call private method '$.method' on package $.source-package because it does not trust $.calling-package";
  1095. }
  1096. }
  1097. my class X::Method::Private::Unqualified does X::Comp {
  1098. has $.method;
  1099. method message() {
  1100. "Private method call to $.method must be fully qualified with the package containing the method";
  1101. }
  1102. }
  1103. my class X::Adverb is Exception {
  1104. has $.what;
  1105. has $.source;
  1106. has @.unexpected;
  1107. has @.nogo;
  1108. method message {
  1109. my $text = '';
  1110. if @!unexpected.elems -> $elems {
  1111. $text = $elems > 1
  1112. ?? "$elems unexpected adverbs (@.unexpected[])"
  1113. !! "Unexpected adverb '@!unexpected[0]'"
  1114. }
  1115. if @!nogo {
  1116. $text ~= $text ?? " and u" !! "U";
  1117. $text ~= "nsupported combination of adverbs (@.nogo[])";
  1118. }
  1119. $text ~ " passed to $!what on $!source";
  1120. }
  1121. method unexpected { @!unexpected.sort }
  1122. method nogo { @!nogo.sort }
  1123. }
  1124. my class X::Bind is Exception {
  1125. has $.target;
  1126. method message() {
  1127. $.target.defined
  1128. ?? "Cannot bind to $.target"
  1129. !! 'Cannot use bind operator with this left-hand side'
  1130. }
  1131. }
  1132. my class X::Bind::NativeType does X::Comp {
  1133. has $.name;
  1134. method message() {
  1135. "Cannot bind to natively typed variable '$.name'; use assignment instead"
  1136. }
  1137. }
  1138. my class X::Bind::Slice is Exception {
  1139. has $.type;
  1140. method message() {
  1141. "Cannot bind to {$.type.^name} slice";
  1142. }
  1143. }
  1144. my class X::Bind::ZenSlice is X::Bind::Slice {
  1145. method message() {
  1146. "Cannot bind to {$.type.^name} zen slice";
  1147. }
  1148. }
  1149. my class X::Subscript::Negative is Exception {
  1150. has $.index;
  1151. has $.type;
  1152. method message() {
  1153. "Calculated index ({$.index}) is negative, but {$.type.^name} allows only 0-based indexing";
  1154. }
  1155. }
  1156. my class X::Invalid::Value is Exception {
  1157. has $.method;
  1158. has $.name;
  1159. has $.value;
  1160. method message {
  1161. "Invalid value '$.value' for :$.name on method $.method"
  1162. }
  1163. }
  1164. my class X::Invalid::ComputedValue is Exception {
  1165. has $.method;
  1166. has $.name;
  1167. has $.value;
  1168. has $.reason;
  1169. method message {
  1170. "$.name {"on $.method " if $.method}computed to $.value,"
  1171. ~ " which cannot be used"
  1172. ~ (" because $.reason" if $.reason);
  1173. }
  1174. }
  1175. my class X::Value::Dynamic does X::Comp {
  1176. has $.what;
  1177. method message() { "$.what value must be known at compile time" }
  1178. }
  1179. my class X::Syntax::Name::Null does X::Syntax {
  1180. method message() { 'Name component may not be null'; }
  1181. }
  1182. my class X::Syntax::UnlessElse does X::Syntax {
  1183. has $.keyword;
  1184. method message() { qq|"unless" does not take "$!keyword", please rewrite using "if"| }
  1185. }
  1186. my class X::Syntax::WithoutElse does X::Syntax {
  1187. has $.keyword;
  1188. method message() { qq|"without" does not take "$!keyword", please rewrite using "with"| }
  1189. }
  1190. my class X::Syntax::KeywordAsFunction does X::Syntax {
  1191. has $.word;
  1192. has $.needparens;
  1193. method message {
  1194. "Word '$.word' interpreted as '{$.word}()' function call; please use whitespace "
  1195. ~ ($.needparens ?? 'around the parens' !! 'instead of parens')
  1196. }
  1197. }
  1198. my class X::Syntax::Malformed::Elsif does X::Syntax {
  1199. has $.what = 'else if';
  1200. method message() { qq{In Perl 6, please use "elsif' instead of "$.what"} }
  1201. }
  1202. my class X::Syntax::Reserved does X::Syntax {
  1203. has $.reserved;
  1204. has $.instead = '';
  1205. method message() { "The $.reserved is reserved$.instead" }
  1206. }
  1207. my class X::Syntax::P5 does X::Syntax {
  1208. method message() { 'This appears to be Perl 5 code' }
  1209. }
  1210. my class X::Syntax::NegatedPair does X::Syntax {
  1211. has $.key;
  1212. method message() { "Argument not allowed on negated pair with key '$.key'" }
  1213. }
  1214. my class X::Syntax::Variable::Numeric does X::Syntax {
  1215. has $.what = 'variable';
  1216. method message() { "Cannot declare a numeric $.what" }
  1217. }
  1218. my class X::Syntax::Variable::Match does X::Syntax {
  1219. method message() { 'Cannot declare a match variable' }
  1220. }
  1221. my class X::Syntax::Variable::Initializer does X::Syntax {
  1222. has $.name = '<anon>';
  1223. method message() { "Cannot use variable $!name in declaration to initialize itself" }
  1224. }
  1225. my class X::Syntax::Variable::Twigil does X::Syntax {
  1226. has $.what = 'variable';
  1227. has $.twigil;
  1228. has $.scope;
  1229. has $.additional = '';
  1230. method message() { "Cannot use $.twigil twigil on '$.scope' $.what$.additional" }
  1231. }
  1232. my class X::Syntax::Variable::IndirectDeclaration does X::Syntax {
  1233. method message() { 'Cannot declare a variable by indirect name (use a hash instead?)' }
  1234. }
  1235. my class X::Syntax::Variable::BadType does X::Comp {
  1236. has Mu $.type;
  1237. method message() {
  1238. my $what = ~$!type.HOW.WHAT.^name.match(/ .* '::' <(.*)> HOW/) // 'Namespace';
  1239. "$what $!type.^name() is insufficiently type-like to qualify a variable"
  1240. }
  1241. }
  1242. my class X::Syntax::Variable::ConflictingTypes does X::Comp {
  1243. has Mu $.outer;
  1244. has Mu $.inner;
  1245. method message() {
  1246. "$!inner.^name() not allowed here; variable list already declared with type $!outer.^name()"
  1247. }
  1248. }
  1249. my class X::Syntax::Augment::WithoutMonkeyTyping does X::Syntax {
  1250. method message() { "augment not allowed without 'use MONKEY-TYPING'" };
  1251. }
  1252. my class X::Syntax::Augment::Illegal does X::Syntax {
  1253. has $.package;
  1254. method message() { "Cannot augment $.package because it is closed" };
  1255. }
  1256. my class X::Syntax::Augment::Adverb does X::Syntax {
  1257. method message() { "Cannot put adverbs on a typename when augmenting" }
  1258. }
  1259. my class X::Syntax::Type::Adverb does X::Syntax {
  1260. has $.adverb;
  1261. method message() { "Cannot use adverb $.adverb on a type name (only 'ver' and 'auth' are understood)" }
  1262. }
  1263. my class X::Syntax::Argument::MOPMacro does X::Syntax {
  1264. has $.macro;
  1265. method message() { "Cannot give arguments to $.macro" };
  1266. }
  1267. my class X::Role::Initialization is Exception {
  1268. has $.role;
  1269. method message() { "Can only supply an initialization value for a role if it has a single public attribute, but this is not the case for '{$.role.^name}'" }
  1270. }
  1271. my class X::Syntax::Comment::Embedded does X::Syntax {
  1272. method message() { "Opening bracket required for #` comment" }
  1273. }
  1274. my class X::Syntax::Pod::BeginWithoutIdentifier does X::Syntax does X::Pod {
  1275. method message() {
  1276. '=begin must be followed by an identifier; (did you mean "=begin pod"?)'
  1277. }
  1278. }
  1279. my class X::Syntax::Pod::BeginWithoutEnd does X::Syntax does X::Pod {
  1280. has $.type;
  1281. has $.spaces;
  1282. has $.instead;
  1283. method message() {
  1284. if $.instead {
  1285. qq{Expected "=end $.type" to terminate "=begin $.type"; found "=end $.instead" instead.}
  1286. } else {
  1287. "'=begin' not terminated by matching '$.spaces=end $.type'"
  1288. }
  1289. }
  1290. }
  1291. my class X::Syntax::Confused does X::Syntax {
  1292. has $.reason = 'unknown';
  1293. method message() { $.reason eq 'unknown' ?? 'Confused' !! $.reason }
  1294. }
  1295. my class X::Syntax::Malformed does X::Syntax {
  1296. has $.what;
  1297. method message() { "Malformed $.what" }
  1298. }
  1299. my class X::Syntax::Missing does X::Syntax {
  1300. has $.what;
  1301. method message() { "Missing $.what" }
  1302. }
  1303. my class X::Syntax::BlockGobbled does X::Syntax {
  1304. has $.what;
  1305. method message() {
  1306. my $looks_like_type = $.what ~~ /'::' | <[A..Z]><[a..z]>+/;
  1307. $.what ~~ /^'is '/
  1308. ?? "Trait '$.what' needs whitespace before block"
  1309. !! "{ $.what ?? "Function '$.what'" !! 'Expression' } needs parens to avoid gobbling block" ~
  1310. ($looks_like_type ?? " (or perhaps it's a class that's not declared or available in this scope?)" !! "");
  1311. };
  1312. }
  1313. my class X::Syntax::ConditionalOperator::PrecedenceTooLoose does X::Syntax {
  1314. has $.operator;
  1315. method message() { "Precedence of $.operator is too loose to use inside ?? !!; please parenthesize" }
  1316. }
  1317. my class X::Syntax::ConditionalOperator::SecondPartGobbled does X::Syntax {
  1318. method message() { "Your !! was gobbled by the expression in the middle; please parenthesize" }
  1319. }
  1320. my class X::Syntax::ConditionalOperator::SecondPartInvalid does X::Syntax {
  1321. has $.second-part;
  1322. method message() { "Please use !! rather than $.second-part" }
  1323. }
  1324. my class X::Syntax::Perl5Var does X::Syntax {
  1325. has $.name;
  1326. my %m =
  1327. '$*' => '^^ and $$',
  1328. '$"' => '.join() method',
  1329. '$$' => '$*PID',
  1330. '$(' => '$*GID',
  1331. '$)' => '$*EGID',
  1332. '$<' => '$*UID',
  1333. '$>' => '$*EUID',
  1334. '$;' => 'real multidimensional hashes',
  1335. '$&' => '$<>',
  1336. '$`' => '$/.prematch',
  1337. '$\'' => '$/.postmatch',
  1338. '$,' => '$*OUT.output_field_separator()',
  1339. '$.' => "the .kv method on e.g. .lines",
  1340. '$/' => "the filehandle's .nl-in attribute",
  1341. '$\\' => "the filehandle's .nl-out attribute",
  1342. '$|' => ':autoflush on open',
  1343. '$?' => '$! for handling child errors also',
  1344. '$@' => '$!',
  1345. '$#' => '.fmt',
  1346. '$[' => 'user-defined array indices',
  1347. '$]' => '$*PERL.version or $*PERL.compiler.version',
  1348. '$^C' => 'COMPILING namespace',
  1349. '$^D' => '$*DEBUGGING',
  1350. '$^E' => '$!.extended_os_error',
  1351. '$^F' => '$*SYSTEM_FD_MAX',
  1352. '$^H' => '$?FOO variables',
  1353. '$^I' => '$*INPLACE',
  1354. '$^M' => 'a global form such as $*M',
  1355. '$^N' => '$/[*-1]',
  1356. '$^O' => 'VM.osname',
  1357. '$^R' => 'an explicit result variable',
  1358. '$^S' => 'context function',
  1359. '$^T' => '$*INITTIME',
  1360. '$^V' => '$*PERL.version or $*PERL.compiler.version',
  1361. '$^W' => '$*WARNING',
  1362. '$^X' => '$*EXECUTABLE-NAME',
  1363. '$:' => 'Form module',
  1364. '$-' => 'Form module',
  1365. '$+' => 'Form module',
  1366. '$=' => 'Form module',
  1367. '$%' => 'Form module',
  1368. '$^' => 'Form module',
  1369. '$~' => 'Form module',
  1370. '$^A' => 'Form module',
  1371. '$^L' => 'Form module',
  1372. '@-' => '.from method',
  1373. '@+' => '.to method',
  1374. '%-' => '.from method',
  1375. '%+' => '.to method',
  1376. '%^H' => '$?FOO variables',
  1377. ;
  1378. method message() {
  1379. my $v = $.name ~~ m/ <[ $ @ % & ]> [ \^ <[ A..Z ]> | \W ] /;
  1380. $v
  1381. ?? %m{~$v}
  1382. ?? "Unsupported use of $v variable; in Perl 6 please use {%m{~$v}}"
  1383. !! "Unsupported use of $v variable"
  1384. !! 'Weird unrecognized variable name: ' ~ $.name;
  1385. }
  1386. }
  1387. my class X::Syntax::Self::WithoutObject does X::Syntax {
  1388. method message() { "'self' used where no object is available" }
  1389. }
  1390. my class X::Syntax::VirtualCall does X::Syntax {
  1391. has $.call;
  1392. method message() { "Virtual method call $.call may not be used on partially constructed object (maybe you mean {$.call.subst('.','!')} for direct attribute access here?)" }
  1393. }
  1394. my class X::Syntax::NoSelf does X::Syntax {
  1395. has $.variable;
  1396. method message() { "Variable $.variable used where no 'self' is available" }
  1397. }
  1398. my class X::Syntax::Number::RadixOutOfRange does X::Syntax {
  1399. has $.radix;
  1400. method message() { "Radix $.radix out of range (allowed: 2..36)" }
  1401. }
  1402. my class X::Syntax::Number::IllegalDecimal does X::Syntax {
  1403. method message() { "Decimal point must be followed by digit" }
  1404. }
  1405. my class X::Syntax::Number::LiteralType does X::Syntax {
  1406. has $.varname;
  1407. has $.vartype;
  1408. has $.value;
  1409. has $.valuetype;
  1410. has $.suggestiontype;
  1411. method message() {
  1412. my $vartype := $!vartype.WHAT.^name;
  1413. my $value := $!value.perl;
  1414. my $val = "Cannot assign a literal of type {$.valuetype} ($value) to a variable of type $vartype. You can declare the variable to be of type $.suggestiontype, or try to coerce the value with { $value ~ '.' ~ $vartype } or $vartype\($value\)";
  1415. try $val ~= ", or just write the value as " ~ $!value."$vartype"().perl;
  1416. $val;
  1417. }
  1418. }
  1419. my class X::Syntax::NonAssociative does X::Syntax {
  1420. has $.left;
  1421. has $.right;
  1422. method message() {
  1423. "Operators '$.left' and '$.right' are non-associative and require parentheses";
  1424. }
  1425. }
  1426. my class X::Syntax::NonListAssociative is X::Syntax::NonAssociative {
  1427. method message() {
  1428. "Only identical operators may be list associative; since '$.left' and '$.right' differ, they are non-associative and you need to clarify with parentheses";
  1429. }
  1430. }
  1431. my class X::Syntax::CannotMeta does X::Syntax {
  1432. has $.meta;
  1433. has $.operator;
  1434. has $.reason;
  1435. has $.dba;
  1436. method message() {
  1437. "Cannot $.meta $.operator because $.dba operators are $.reason";
  1438. }
  1439. }
  1440. my class X::Syntax::Adverb does X::Syntax {
  1441. has $.what;
  1442. method message() { "You can't adverb " ~ $.what }
  1443. }
  1444. my class X::Syntax::Regex::Adverb does X::Syntax {
  1445. has $.adverb;
  1446. has $.construct;
  1447. method message() { "Adverb $.adverb not allowed on $.construct" }
  1448. }
  1449. my class X::Syntax::Regex::UnrecognizedMetachar does X::Syntax {
  1450. has $.metachar;
  1451. method message() { "Unrecognized regex metacharacter $.metachar (must be quoted to match literally)" }
  1452. }
  1453. my class X::Syntax::Regex::UnrecognizedModifier does X::Syntax {
  1454. has $.modifier;
  1455. method message() { "Unrecognized regex modifier :$.modifier" }
  1456. }
  1457. my class X::Syntax::Regex::NullRegex does X::Syntax {
  1458. method message() { 'Null regex not allowed' }
  1459. }
  1460. my class X::Syntax::Regex::MalformedRange does X::Syntax {
  1461. method message() {
  1462. 'Malformed Range. If attempting to use variables for end points, '
  1463. ~ 'wrap the entire range in curly braces.'
  1464. }
  1465. }
  1466. my class X::Syntax::Regex::Unspace does X::Syntax {
  1467. has $.char;
  1468. method message { "No unspace allowed in regex; if you meant to match the literal character, " ~
  1469. "please enclose in single quotes ('" ~ $.char ~ "') or use a backslashed form like \\x" ~
  1470. sprintf('%02x', $.char.ord)
  1471. }
  1472. }
  1473. my class X::Syntax::Regex::Unterminated does X::Syntax {
  1474. method message { 'Regex not terminated.' }
  1475. }
  1476. my class X::Syntax::Regex::SpacesInBareRange does X::Syntax {
  1477. method message { 'Spaces not allowed in bare range.' }
  1478. }
  1479. my class X::Syntax::Regex::SolitaryQuantifier does X::Syntax {
  1480. method message { 'Quantifier quantifies nothing' }
  1481. }
  1482. my class X::Syntax::Regex::NonQuantifiable does X::Syntax {
  1483. method message { 'Can only quantify a construct that produces a match' }
  1484. }
  1485. my class X::Syntax::Regex::SolitaryBacktrackControl does X::Syntax {
  1486. method message { "Backtrack control ':' does not seem to have a preceding atom to control" }
  1487. }
  1488. my class X::Syntax::Term::MissingInitializer does X::Syntax {
  1489. method message { 'Term definition requires an initializer' }
  1490. }
  1491. my class X::Syntax::Variable::MissingInitializer does X::Syntax {
  1492. has $.type;
  1493. has $.implicit;
  1494. method message {
  1495. $.implicit ??
  1496. "Variable definition of type $.type (implicit $.implicit) requires an initializer" !!
  1497. "Variable definition of type $.type requires an initializer"
  1498. }
  1499. }
  1500. my class X::Syntax::AddCategorical::TooFewParts does X::Syntax {
  1501. has $.category;
  1502. has $.needs;
  1503. method message() { "Not enough symbols provided for categorical of type $.category; needs $.needs" }
  1504. }
  1505. my class X::Syntax::AddCategorical::TooManyParts does X::Syntax {
  1506. has $.category;
  1507. has $.needs;
  1508. method message() { "Too many symbols provided for categorical of type $.category; needs only $.needs" }
  1509. }
  1510. my class X::Syntax::Signature::InvocantMarker does X::Syntax {
  1511. method message() {
  1512. "Can only use : as invocant marker in a signature after the first parameter"
  1513. }
  1514. }
  1515. my class X::Syntax::Signature::InvocantNotAllowed does X::Syntax {
  1516. method message() {
  1517. "Can only use the : invocant marker in the signature for a method"
  1518. }
  1519. }
  1520. my class X::Syntax::Extension::Category does X::Syntax {
  1521. has $.category;
  1522. method message() {
  1523. "Cannot add tokens of category '$.category'";
  1524. }
  1525. }
  1526. my class X::Syntax::Extension::Null does X::Syntax {
  1527. method message() {
  1528. "Null operator is not allowed";
  1529. }
  1530. }
  1531. my class X::Syntax::Extension::TooComplex does X::Syntax {
  1532. has $.name;
  1533. method message() {
  1534. "Colon pair value '$.name' too complex to use in name";
  1535. }
  1536. }
  1537. my class X::Syntax::Extension::SpecialForm does X::Syntax {
  1538. has $.category;
  1539. has $.opname;
  1540. has $.hint;
  1541. method message() {
  1542. "Cannot override $.category operator '$.opname', as it is a special form " ~
  1543. "handled directly by the compiler" ~ ($!hint ?? "\n$!hint" !! "")
  1544. }
  1545. }
  1546. my class X::Syntax::InfixInTermPosition does X::Syntax {
  1547. has $.infix;
  1548. method message() {
  1549. "Preceding context expects a term, but found infix {$.infix.trim} instead";
  1550. }
  1551. }
  1552. my class X::Syntax::DuplicatedPrefix does X::Syntax {
  1553. has $.prefixes;
  1554. method message() {
  1555. my $prefix = substr($.prefixes,0,1);
  1556. "Expected a term, but found either infix $.prefixes or redundant prefix $prefix\n"
  1557. ~ " (to suppress this message, please use a space like $prefix $prefix)";
  1558. }
  1559. }
  1560. my class X::Attribute::Package does X::Comp {
  1561. has $.package-kind;
  1562. has $.name;
  1563. method message() { "A $.package-kind cannot have attributes, but you tried to declare '$.name'" }
  1564. }
  1565. my class X::Attribute::NoPackage does X::Comp {
  1566. has $.name;
  1567. method message() { "You cannot declare attribute '$.name' here; maybe you'd like a class or a role?" }
  1568. }
  1569. my class X::Attribute::Required does X::MOP {
  1570. has $.name;
  1571. has $.why;
  1572. method message() {
  1573. $.why && nqp::istype($.why,Str)
  1574. ?? "The attribute '$.name' is required because $.why,\nbut you did not provide a value for it."
  1575. !! "The attribute '$.name' is required, but you did not provide a value for it."
  1576. }
  1577. }
  1578. my class X::Attribute::Scope::Package does X::Comp {
  1579. has $.scope;
  1580. has $.allowed;
  1581. has $.disallowed;
  1582. method message() { "Cannot use {$.scope}-scoped attribute in $.disallowed"
  1583. ~ ($.allowed ?? ", only $.allowed." !! ".") }
  1584. }
  1585. my class X::Declaration::Scope does X::Comp {
  1586. has $.scope;
  1587. has $.declaration;
  1588. method message() { "Cannot use '$.scope' with $.declaration declaration" }
  1589. }
  1590. my class X::Declaration::Scope::Multi is X::Declaration::Scope {
  1591. method message() {
  1592. "Cannot use '$.scope' with individual multi candidates. Please declare an {$.scope}-scoped proto instead";
  1593. }
  1594. }
  1595. my class X::Declaration::OurScopeInRole does X::Comp {
  1596. has $.declaration;
  1597. method message() {
  1598. "Cannot declare our-scoped $.declaration inside of a role\n" ~
  1599. "(the scope inside of a role is generic, so there is no unambiguous\n" ~
  1600. "package to install the symbol in)"
  1601. }
  1602. }
  1603. my class X::Anon::Multi does X::Comp {
  1604. has $.multiness;
  1605. has $.routine-type = 'routine';
  1606. method message() { "An anonymous $.routine-type may not take a $.multiness declarator" }
  1607. }
  1608. my class X::Anon::Augment does X::Comp {
  1609. has $.package-kind;
  1610. method message() { "Cannot augment anonymous $.package-kind" }
  1611. }
  1612. my class X::Augment::NoSuchType does X::Comp {
  1613. has $.package-kind;
  1614. has $.package;
  1615. method message() { "You tried to augment $.package-kind $.package, but it does not exist" }
  1616. }
  1617. my class X::Routine::Unwrap is Exception {
  1618. method message() { "Cannot unwrap routine: invalid wrap handle" }
  1619. }
  1620. my class X::Constructor::Positional is Exception {
  1621. has $.type;
  1622. method message() { "Default constructor for '" ~ $.type.^name ~ "' only takes named arguments" }
  1623. }
  1624. my class X::Hash::Store::OddNumber is Exception {
  1625. has $.found;
  1626. has $.last;
  1627. method message() {
  1628. my $msg =
  1629. "Odd number of elements found where hash initializer expected";
  1630. if $.found == 1 {
  1631. $msg ~= $.last
  1632. ?? ":\nOnly saw: $.last.perl()"
  1633. !! ":\nOnly saw 1 element"
  1634. }
  1635. else {
  1636. $msg ~= ":\nFound $.found (implicit) elements";
  1637. $msg ~= ":\nLast element seen: $.last.perl()" if $.last;
  1638. }
  1639. }
  1640. }
  1641. my class X::Pairup::OddNumber is Exception {
  1642. method message() { "Odd number of elements found for .pairup()" }
  1643. }
  1644. my class X::Match::Bool is Exception {
  1645. has $.type;
  1646. method message() { "Cannot use Bool as Matcher with '" ~ $.type ~ "'. Did you mean to use \$_ inside a block?" }
  1647. }
  1648. my class X::LibNone does X::Comp {
  1649. method message { q/Must specify at least one repository. Did you mean 'use lib "lib"' ?/ }
  1650. }
  1651. my class X::Package::UseLib does X::Comp {
  1652. has $.what;
  1653. method message { "Cannot 'use lib' inside a $.what" }
  1654. }
  1655. my class X::Package::Stubbed does X::Comp {
  1656. has @.packages;
  1657. # TODO: suppress display of line number
  1658. method message() {
  1659. "The following packages were stubbed but not defined:\n "
  1660. ~ @.packages.join("\n ");
  1661. }
  1662. }
  1663. my class X::Phaser::PrePost is Exception {
  1664. has $.phaser = 'PRE';
  1665. has $.condition;
  1666. method message {
  1667. my $what = $.phaser eq 'PRE' ?? 'Precondition' !! 'Postcondition';
  1668. $.condition.defined
  1669. ?? "$what '$.condition.trim()' failed"
  1670. !! "$what failed";
  1671. }
  1672. }
  1673. my class X::Str::InvalidCharName is Exception {
  1674. has $.name;
  1675. method message() {
  1676. $!name.chars ?? "Unrecognized character name [{$!name}]"
  1677. !! "Cannot use empty name as character name"
  1678. }
  1679. }
  1680. my class X::Str::Numeric is Exception {
  1681. has $.source;
  1682. has $.pos;
  1683. has $.reason;
  1684. method source-indicator {
  1685. my ($red,$clear,$green,$,$eject) = Rakudo::Internals.error-rcgye;
  1686. my sub escape($str) { $str.perl.substr(1).chop }
  1687. join '', "in '",
  1688. $green,
  1689. escape(substr($.source,0, $.pos)),
  1690. $eject,
  1691. $red,
  1692. escape(substr($.source,$.pos)),
  1693. $clear,
  1694. "' (indicated by ",
  1695. $eject,
  1696. $clear,
  1697. ")",
  1698. ;
  1699. }
  1700. method message() {
  1701. "Cannot convert string to number: $.reason $.source-indicator";
  1702. }
  1703. }
  1704. my class X::Str::Match::x is Exception {
  1705. has $.got is default(Nil);
  1706. method message() {
  1707. "in Str.match, got invalid value of type {$.got.^name} for :x, must be Int or Range"
  1708. }
  1709. }
  1710. my class X::Str::Subst::Adverb is Exception {
  1711. has $.name;
  1712. has $.got;
  1713. method message() {
  1714. "Cannot use :$.name adverb in Str.subst, got $.got"
  1715. }
  1716. }
  1717. my class X::Str::Trans::IllegalKey is Exception {
  1718. has $.key;
  1719. method message {
  1720. "in Str.trans, got illegal substitution key of type {$.key.^name} (should be a Regex or Str)"
  1721. }
  1722. }
  1723. my class X::Str::Trans::InvalidArg is Exception {
  1724. has $.got is default(Nil);
  1725. method message() {
  1726. "Only Pair objects are allowed as arguments to Str.trans, got {$.got.^name}";
  1727. }
  1728. }
  1729. my class X::Str::Sprintf::Directives::Count is Exception {
  1730. has $.args-used;
  1731. has $.args-have;
  1732. method message() {
  1733. "Your printf-style directives specify "
  1734. ~ ($.args-used == 1 ?? "1 argument, but "
  1735. !! "$.args-used arguments, but ")
  1736. ~ ($.args-have < 1 ?? "no argument was"
  1737. !! $.args-have == 1 ?? "1 argument was"
  1738. !! "$.args-have arguments were")
  1739. ~ " supplied";
  1740. }
  1741. }
  1742. my class X::Str::Sprintf::Directives::Unsupported is Exception {
  1743. has $.directive;
  1744. has $.sequence;
  1745. method message() {
  1746. "Directive $.directive is not valid in sprintf format sequence $.sequence"
  1747. }
  1748. }
  1749. my class X::Str::Sprintf::Directives::BadType is Exception {
  1750. has $.type;
  1751. has $.directive;
  1752. method message() {
  1753. "Directive $.directive not applicable for type $.type"
  1754. }
  1755. }
  1756. my class X::Range::InvalidArg is Exception {
  1757. has $.got is default(Nil);
  1758. method message() {
  1759. "{$.got.^name} objects are not valid endpoints for Ranges";
  1760. }
  1761. }
  1762. my class X::Sequence::Deduction is Exception {
  1763. has $.from;
  1764. method message() {
  1765. $!from ?? "Unable to deduce arithmetic or geometric sequence from $!from (or did you really mean '..'?)"
  1766. !! 'Unable to deduce sequence for some unfathomable reason'
  1767. }
  1768. }
  1769. my class X::Cannot::Lazy is Exception {
  1770. has $.action;
  1771. has $.what;
  1772. method message() {
  1773. $.what
  1774. ?? "Cannot $.action a lazy list onto a $.what"
  1775. !! "Cannot $.action a lazy list";
  1776. }
  1777. }
  1778. my class X::Cannot::Empty is Exception {
  1779. has $.action;
  1780. has $.what;
  1781. method message() {
  1782. "Cannot $.action from an empty $.what";
  1783. }
  1784. }
  1785. my class X::Cannot::New is Exception {
  1786. has $.class;
  1787. method message() {
  1788. "Cannot make a {$.class.^name} object using .new";
  1789. }
  1790. }
  1791. my class X::Backslash::UnrecognizedSequence does X::Syntax {
  1792. has $.sequence;
  1793. method message() { "Unrecognized backslash sequence: '\\$.sequence'" }
  1794. }
  1795. my class X::Backslash::NonVariableDollar does X::Syntax {
  1796. method message() { "Non-variable \$ must be backslashed" }
  1797. }
  1798. my class X::ControlFlow is Exception {
  1799. has $.illegal; # something like 'next'
  1800. has $.enclosing; # .... outside a loop
  1801. has $.backtrace; # where the bogus control flow op was
  1802. method backtrace() {
  1803. $!backtrace || nextsame();
  1804. }
  1805. method message() { "$.illegal without $.enclosing" }
  1806. }
  1807. my class X::ControlFlow::Return is X::ControlFlow {
  1808. method illegal() { 'return' }
  1809. method enclosing() { 'Routine' }
  1810. method message() { 'Attempt to return outside of any Routine' }
  1811. }
  1812. my class X::Composition::NotComposable does X::Comp {
  1813. has $.target-name;
  1814. has $.composer;
  1815. method message() {
  1816. $!composer.^name ~ " is not composable, so $!target-name cannot compose it";
  1817. }
  1818. }
  1819. my class X::TypeCheck is Exception {
  1820. has $.operation;
  1821. has $.got is default(Nil);
  1822. has $.expected is default(Nil);
  1823. method gotn() {
  1824. my $perl = (try $!got.perl) // "?";
  1825. $perl = "$perl.substr(0,21)..." if $perl.chars > 24;
  1826. (try $!got.^name eq $!expected.^name
  1827. ?? $perl
  1828. !! "$!got.^name() ($perl)"
  1829. ) // "?"
  1830. }
  1831. method expectedn() {
  1832. (try $!got.^name eq $!expected.^name
  1833. ?? $!expected.perl
  1834. !! $!expected.^name
  1835. ) // "?"
  1836. }
  1837. method priors() {
  1838. (try nqp::isconcrete($!got) && $!got ~~ Failure)
  1839. ?? "Earlier failure:\n " ~ $!got.mess ~ "\nFinal error:\n "
  1840. !! ''
  1841. }
  1842. method message() {
  1843. self.priors() ~
  1844. "Type check failed in $.operation; expected $.expectedn but got $.gotn";
  1845. }
  1846. }
  1847. my class X::TypeCheck::Binding is X::TypeCheck {
  1848. has $.symbol;
  1849. method operation { 'binding' }
  1850. method message() {
  1851. my $to = $.symbol.defined && $.symbol ne '$'
  1852. ?? " to '$.symbol'"
  1853. !! "";
  1854. my $expected = (try nqp::eqaddr($.expected,$.got))
  1855. ?? "expected type $.expectedn cannot be itself"
  1856. !! "expected $.expectedn but got $.gotn";
  1857. self.priors() ~ "Type check failed in $.operation$to; $expected";
  1858. }
  1859. }
  1860. my class X::TypeCheck::Binding::Parameter is X::TypeCheck::Binding {
  1861. has Parameter $.parameter;
  1862. has Bool $.constraint;
  1863. method expectedn() {
  1864. $.constraint && $.expected ~~ Code
  1865. ?? 'anonymous constraint to be met'
  1866. !! callsame()
  1867. }
  1868. method message() {
  1869. my $to = $.symbol.defined && $.symbol ne '$'
  1870. ?? " to parameter '$.symbol'"
  1871. !! " to anonymous parameter";
  1872. my $expected = (try nqp::eqaddr($.expected,$.got))
  1873. ?? "expected type $.expectedn cannot be itself"
  1874. !! "expected $.expectedn but got $.gotn";
  1875. my $what-check = $.constraint ?? 'Constraint type' !! 'Type';
  1876. self.priors() ~ "$what-check check failed in $.operation$to; $expected";
  1877. }
  1878. }
  1879. my class X::TypeCheck::Return is X::TypeCheck {
  1880. method operation { 'returning' }
  1881. method message() {
  1882. my $expected = $.expected =:= $.got
  1883. ?? "expected return type $.expectedn cannot be itself " ~
  1884. "(perhaps $.operation a :D type object?)"
  1885. !! "expected $.expectedn but got $.gotn";
  1886. self.priors() ~
  1887. "Type check failed for return value; $expected";
  1888. }
  1889. }
  1890. my class X::TypeCheck::Assignment is X::TypeCheck {
  1891. has $.symbol;
  1892. method operation { 'assignment' }
  1893. method message {
  1894. my $to = $.symbol.defined && $.symbol ne '$'
  1895. ?? " to $.symbol" !! "";
  1896. my $expected = $.expected =:= $.got
  1897. ?? "expected type $.expectedn cannot be itself " ~
  1898. "(perhaps Nil was assigned to a :D which had no default?)"
  1899. !! "expected $.expectedn but got $.gotn";
  1900. self.priors() ~ "Type check failed in assignment$to; $expected";
  1901. }
  1902. }
  1903. my class X::TypeCheck::Argument is X::TypeCheck {
  1904. has $.protoguilt;
  1905. has @.arguments;
  1906. has $.objname;
  1907. has $.signature;
  1908. method message {
  1909. my $multi = $!signature ~~ /\n/ // '';
  1910. "Calling {$!objname}({ join(', ', @!arguments) }) will never work with " ~ (
  1911. $!protoguilt ?? 'proto signature ' !!
  1912. $multi ?? 'any of these multi signatures:' !!
  1913. 'declared signature '
  1914. ) ~ $!signature;
  1915. }
  1916. }
  1917. my class X::TypeCheck::Splice is X::TypeCheck does X::Comp {
  1918. has $.action;
  1919. method message {
  1920. self.priors() ~
  1921. "Type check failed in {$.action}; expected $.expectedn but got $.gotn";
  1922. }
  1923. }
  1924. my class X::Assignment::RO is Exception {
  1925. has $.value = "value";
  1926. method message {
  1927. "Cannot modify an immutable {$.value.^name} ({$.value.gist})"
  1928. }
  1929. method typename { $.value.^name }
  1930. }
  1931. my class X::Assignment::RO::Comp does X::Comp {
  1932. has $.variable;
  1933. method message {
  1934. "Cannot assign to readonly variable {$.variable}"
  1935. }
  1936. }
  1937. my class X::Immutable is Exception {
  1938. has $.typename;
  1939. has $.method;
  1940. method message {
  1941. "Cannot call '$.method' on an immutable '$.typename'";
  1942. }
  1943. }
  1944. my class X::NoDispatcher is Exception {
  1945. has $.redispatcher;
  1946. method message() {
  1947. "$.redispatcher is not in the dynamic scope of a dispatcher";
  1948. }
  1949. }
  1950. my class X::Localizer::NoContainer is Exception {
  1951. has $.localizer;
  1952. method message() {
  1953. "Can only use '$.localizer' on a container";
  1954. }
  1955. }
  1956. my class X::Mixin::NotComposable is Exception {
  1957. has $.target;
  1958. has $.rolish;
  1959. method message() {
  1960. "Cannot mix in non-composable type {$.rolish.^name} into object of type {$.target.^name}";
  1961. }
  1962. }
  1963. my class X::Inheritance::Unsupported does X::Comp {
  1964. # note that this exception is thrown before the child type object
  1965. # has been composed, so it's useless to carry it around. Use the
  1966. # name instead.
  1967. has $.child-typename;
  1968. has $.parent;
  1969. method message {
  1970. $!parent.^name ~ ' does not support inheritance, so '
  1971. ~ $!child-typename ~ ' cannot inherit from it';
  1972. }
  1973. }
  1974. my class X::Inheritance::UnknownParent is Exception {
  1975. has $.child;
  1976. has $.parent;
  1977. has @.suggestions is rw;
  1978. method message {
  1979. my $message := "'" ~ $.child ~ "' cannot inherit from '" ~ $.parent ~ "' because it is unknown.";
  1980. if +@.suggestions > 1 {
  1981. $message := $message ~ "\nDid you mean one of these?\n '" ~ @.suggestions.join("'\n '") ~ "'\n";
  1982. } elsif +@.suggestions == 1 {
  1983. $message := $message ~ "\nDid you mean '" ~ @.suggestions[0] ~ "'?\n";
  1984. }
  1985. $message;
  1986. }
  1987. }
  1988. my class X::Inheritance::SelfInherit is Exception {
  1989. has $.name;
  1990. method message {
  1991. "'$.name' cannot inherit from itself."
  1992. }
  1993. }
  1994. my class X::Export::NameClash does X::Comp {
  1995. has $.symbol;
  1996. method message() {
  1997. "A symbol '$.symbol' has already been exported";
  1998. }
  1999. }
  2000. my class X::HyperOp::NonDWIM is Exception {
  2001. has &.operator;
  2002. has $.left-elems;
  2003. has $.right-elems;
  2004. has $.recursing;
  2005. method message() {
  2006. "Lists on either side of non-dwimmy hyperop of &.operator.name() are not of the same length"
  2007. ~ " while recursing" x +$.recursing
  2008. ~ "\nleft: $.left-elems elements, right: $.right-elems elements";
  2009. }
  2010. }
  2011. my class X::HyperOp::Infinite is Exception {
  2012. has &.operator;
  2013. has $.side;
  2014. method message() {
  2015. $.side eq "both"
  2016. ?? "Lists on both sides of hyperop of &.operator.name() are known to be infinite"
  2017. !! "List on $.side side of hyperop of &.operator.name() is known to be infinite"
  2018. }
  2019. }
  2020. my class X::Set::Coerce is Exception {
  2021. has $.thing;
  2022. method message {
  2023. "Cannot coerce object of type {$.thing.^name} to Set. To create a one-element set, pass it to the 'set' function";
  2024. }
  2025. }
  2026. my role X::Temporal is Exception { }
  2027. my class X::Temporal::InvalidFormat does X::Temporal {
  2028. has $.invalid-str;
  2029. has $.target = 'Date';
  2030. has $.format;
  2031. method message() {
  2032. "Invalid $.target string '$.invalid-str'; use $.format instead";
  2033. }
  2034. }
  2035. my class X::DateTime::TimezoneClash does X::Temporal {
  2036. method message() {
  2037. 'DateTime.new(Str): :timezone argument not allowed with a timestamp offset';
  2038. }
  2039. }
  2040. my class X::DateTime::InvalidDeltaUnit does X::Temporal {
  2041. has $.unit;
  2042. method message() {
  2043. "Cannnot use unit $.unit with Date.delta";
  2044. }
  2045. }
  2046. my class X::Eval::NoSuchLang is Exception {
  2047. has $.lang;
  2048. method message() {
  2049. "No compiler available for language '$.lang'";
  2050. }
  2051. }
  2052. my class X::Import::MissingSymbols is Exception {
  2053. has $.from;
  2054. has @.missing;
  2055. method message() {
  2056. "Trying to import from '$.from', but the following symbols are missing: "
  2057. ~ @.missing.join(', ');
  2058. }
  2059. }
  2060. my class X::Import::NoSuchTag is Exception {
  2061. has $.source-package;
  2062. has $.tag;
  2063. method message() {
  2064. "Error while importing from '$.source-package': no such tag '$.tag'"
  2065. }
  2066. }
  2067. my class X::Import::Positional is Exception {
  2068. has $.source-package;
  2069. method message() {
  2070. "Error while importing from '$.source-package':\n"
  2071. ~ "no EXPORT sub, but you provided positional argument in the 'use' statement"
  2072. }
  2073. }
  2074. my class X::Numeric::Real is Exception {
  2075. has $.target;
  2076. has $.reason;
  2077. has $.source;
  2078. method message() {
  2079. "Can not convert $.source to {$.target.^name}: $.reason";
  2080. }
  2081. }
  2082. my class X::Numeric::DivideByZero is Exception {
  2083. has $.using;
  2084. has $.details;
  2085. has $.numerator;
  2086. method message() {
  2087. "Attempt to divide{$.numerator ?? " $.numerator" !! ''} by zero"
  2088. ~ ( $.using ?? " using $.using" !! '' )
  2089. ~ ( $_ with $.details );
  2090. }
  2091. }
  2092. my class X::Numeric::Overflow is Exception {
  2093. method message() { "Numeric overflow" }
  2094. }
  2095. my class X::Numeric::Underflow is Exception {
  2096. method message() { "Numeric underflow" }
  2097. }
  2098. my class X::Numeric::Confused is Exception {
  2099. has $.num;
  2100. has $.base;
  2101. method message() {
  2102. "This call only converts base-$.base strings to numbers; value "
  2103. ~ "{$.num.perl} is of type {$.num.WHAT.^name}, so cannot be converted!"
  2104. ~ (
  2105. "\n(If you really wanted to convert {$.num.perl} to a base-$.base"
  2106. ~ " string, use {$.num.perl}.base($.base) instead.)"
  2107. if $.num.perl.^can('base')
  2108. );
  2109. }
  2110. }
  2111. my class X::PseudoPackage::InDeclaration does X::Comp {
  2112. has $.pseudo-package;
  2113. has $.action;
  2114. method message() {
  2115. "Cannot use pseudo package $.pseudo-package in $.action";
  2116. }
  2117. }
  2118. my class X::NoSuchSymbol is Exception {
  2119. has $.symbol;
  2120. method message { "No such symbol '$.symbol'" }
  2121. }
  2122. my class X::Item is Exception {
  2123. has $.aggregate;
  2124. has $.index;
  2125. method message { "Cannot index {$.aggregate.^name} with $.index" }
  2126. }
  2127. my class X::Multi::Ambiguous is Exception {
  2128. has $.dispatcher;
  2129. has @.ambiguous;
  2130. has $.capture;
  2131. method message {
  2132. join "\n",
  2133. "Ambiguous call to '$.dispatcher.name()'; these signatures all match:",
  2134. @.ambiguous.map(*.signature.perl)
  2135. }
  2136. }
  2137. my class X::Multi::NoMatch is Exception {
  2138. has $.dispatcher;
  2139. has $.capture;
  2140. method message {
  2141. my @cand = $.dispatcher.dispatchees.map(*.signature.gist);
  2142. my @un-rw-cand;
  2143. if first / 'is rw' /, @cand {
  2144. my $rw-capture = Capture.new(
  2145. :list( $!capture.list.map({ $ = $_ }) ),
  2146. :hash( $!capture.hash.map({ .key => $ = .value }).hash ),
  2147. );
  2148. @un-rw-cand = $.dispatcher.dispatchees».signature.grep({
  2149. $rw-capture ~~ $^cand
  2150. })».gist;
  2151. }
  2152. my $where = so first / where /, @cand;
  2153. my @bits;
  2154. my @priors;
  2155. if $.capture {
  2156. for $.capture.list {
  2157. try @bits.push($where ?? .perl !! .WHAT.perl );
  2158. @bits.push($_.^name) if $!;
  2159. when Failure {
  2160. @priors.push(" " ~ .mess);
  2161. }
  2162. }
  2163. for $.capture.hash {
  2164. if .value ~~ Failure {
  2165. @priors.push(" " ~ .value.mess);
  2166. }
  2167. if .value ~~ Bool {
  2168. @bits.push(':' ~ ('!' x !.value) ~ .key);
  2169. }
  2170. else {
  2171. try @bits.push(":$(.key)\($($where ?? .value.?perl !! .value.WHAT.?perl ))");
  2172. @bits.push(':' ~ .value.^name) if $!;
  2173. }
  2174. }
  2175. }
  2176. else {
  2177. @bits.push('...');
  2178. }
  2179. if @cand[0] ~~ /': '/ {
  2180. my $invocant = @bits.shift;
  2181. my $first = @bits ?? @bits.shift !! '';
  2182. @bits.unshift($invocant ~ ': ' ~ $first);
  2183. }
  2184. my $cap = '(' ~ @bits.join(", ") ~ ')';
  2185. @priors = flat "Earlier failures:\n", @priors, "\nFinal error:\n " if @priors;
  2186. @priors.join ~ "Cannot resolve caller $.dispatcher.name()$cap; " ~ (
  2187. @un-rw-cand
  2188. ?? "the following candidates\nmatch the type but require "
  2189. ~ 'mutable arguments:' ~ join("\n ", '', @un-rw-cand) ~ (
  2190. "\n\nThe following do not match for other reasons:"
  2191. ~ join("\n ", '', sort keys @cand ∖ @un-rw-cand)
  2192. unless @cand == @un-rw-cand
  2193. )
  2194. !! join "\n ",
  2195. 'none of these signatures match:',
  2196. @cand
  2197. );
  2198. }
  2199. }
  2200. my class X::Caller::NotDynamic is Exception {
  2201. has $.symbol;
  2202. method message() {
  2203. "Cannot access '$.symbol' through CALLER, because it is not declared as dynamic";
  2204. }
  2205. }
  2206. my class X::Inheritance::NotComposed does X::MOP {
  2207. # normally, we try very hard to capture the types
  2208. # and not just their names. But in this case, both types
  2209. # involved aren't composed yet, so they basically aren't
  2210. # usable at all.
  2211. has $.child-name;
  2212. has $.parent-name;
  2213. method message() {
  2214. "'$.child-name' cannot inherit from '$.parent-name' because '$.parent-name' isn't composed yet"
  2215. ~ ' (maybe it is stubbed)';
  2216. }
  2217. }
  2218. my class X::PhaserExceptions is Exception {
  2219. has @.exceptions;
  2220. method message() {
  2221. "Multiple exceptions were thrown by LEAVE/POST phasers"
  2222. }
  2223. multi method gist(X::PhaserExceptions:D:) {
  2224. join "\n", flat
  2225. "Multiple exceptions were thrown by LEAVE/POST phasers\n",
  2226. @!exceptions>>.gist>>.indent(4)
  2227. }
  2228. }
  2229. nqp::bindcurhllsym('P6EX', BEGIN nqp::hash(
  2230. 'X::TypeCheck::Binding',
  2231. -> Mu $got, Mu $expected, $symbol? {
  2232. X::TypeCheck::Binding.new(:$got, :$expected, :$symbol).throw;
  2233. },
  2234. 'X::TypeCheck::Binding::Parameter',
  2235. -> Mu $got, Mu $expected, $symbol, $parameter, $is-constraint? {
  2236. my $constraint = $is-constraint ?? True !! False;
  2237. X::TypeCheck::Binding::Parameter.new(:$got, :$expected, :$symbol, :$parameter, :$constraint).throw;
  2238. },
  2239. 'X::TypeCheck::Assignment',
  2240. -> Mu $symbol, Mu $got, Mu $expected {
  2241. X::TypeCheck::Assignment.new(:$symbol, :$got, :$expected).throw;
  2242. },
  2243. 'X::TypeCheck::Return',
  2244. -> Mu $got, Mu $expected {
  2245. X::TypeCheck::Return.new(:$got, :$expected).throw;
  2246. },
  2247. 'X::Assignment::RO',
  2248. -> $value = "value" {
  2249. X::Assignment::RO.new(:$value).throw;
  2250. },
  2251. 'X::ControlFlow::Return',
  2252. {
  2253. X::ControlFlow::Return.new().throw;
  2254. },
  2255. 'X::NoDispatcher',
  2256. -> $redispatcher {
  2257. X::NoDispatcher.new(:$redispatcher).throw;
  2258. },
  2259. 'X::Method::NotFound',
  2260. -> Mu $invocant, $method, $typename, $private = False {
  2261. X::Method::NotFound.new(:$invocant, :$method, :$typename, :$private).throw
  2262. },
  2263. 'X::Multi::Ambiguous',
  2264. -> $dispatcher, @ambiguous, $capture {
  2265. X::Multi::Ambiguous.new(:$dispatcher, :@ambiguous, :$capture).throw
  2266. },
  2267. 'X::Multi::NoMatch',
  2268. -> $dispatcher, $capture {
  2269. X::Multi::NoMatch.new(:$dispatcher, :$capture).throw
  2270. },
  2271. 'X::Role::Initialization',
  2272. -> $role {
  2273. X::Role::Initialization.new(:$role).throw
  2274. },
  2275. 'X::Role::Parametric::NoSuchCandidate',
  2276. -> Mu $role {
  2277. X::Role::Parametric::NoSuchCandidate.new(:$role).throw;
  2278. },
  2279. 'X::Inheritance::NotComposed',
  2280. -> $child-name, $parent-name {
  2281. X::Inheritance::NotComposed.new(:$child-name, :$parent-name).throw;
  2282. },
  2283. 'X::Parameter::RW',
  2284. -> Mu $got, $symbol {
  2285. X::Parameter::RW.new(:$got, :$symbol).throw;
  2286. },
  2287. 'X::PhaserExceptions',
  2288. -> @exceptions {
  2289. X::PhaserExceptions.new(exceptions =>
  2290. @exceptions.map(-> Mu \e { EXCEPTION(e) })).throw;
  2291. },
  2292. 'X::Trait::Invalid',
  2293. -> $type, $subtype, $declaring, $name {
  2294. X::Trait::Invalid.new(:$type, :$subtype, :$declaring, :$name).throw;
  2295. },
  2296. 'X::Parameter::InvalidConcreteness',
  2297. -> $expected, $got, $routine, $param, Bool() $should-be-concrete, Bool() $param-is-invocant {
  2298. X::Parameter::InvalidConcreteness.new(:$expected, :$got, :$routine, :$param, :$should-be-concrete, :$param-is-invocant).throw;
  2299. },
  2300. 'X::NYI',
  2301. -> $feature {
  2302. X::NYI.new(:$feature).throw;
  2303. },
  2304. ));
  2305. my class X::HyperWhatever::Multiple is Exception {
  2306. method message() {
  2307. "Multiple HyperWhatevers and Whatevers may not be used together"
  2308. }
  2309. }
  2310. my class X::EXPORTHOW::InvalidDirective does X::Comp {
  2311. has $.directive;
  2312. method message() {
  2313. "Unknown EXPORTHOW directive '$.directive' encountered during import"
  2314. }
  2315. }
  2316. my class X::EXPORTHOW::NothingToSupersede does X::Comp {
  2317. has $.declarator;
  2318. method message() {
  2319. "There is no package declarator '$.declarator' to supersede"
  2320. }
  2321. }
  2322. my class X::EXPORTHOW::Conflict does X::Comp {
  2323. has $.declarator;
  2324. has $.directive;
  2325. method message() {
  2326. "'EXPORTHOW::{$.directive}::{$.declarator}' conflicts with an existing meta-object imported into this lexical scope"
  2327. }
  2328. }
  2329. my class X::UnitScope::Invalid does X::Syntax {
  2330. has $.what;
  2331. has $.where;
  2332. method message() {
  2333. "A unit-scoped $.what definition is not allowed $.where;\n"
  2334. ~ "Please use the block form."
  2335. }
  2336. }
  2337. my class X::UnitScope::TooLate does X::Syntax {
  2338. has $.what;
  2339. method message() {
  2340. "Too late for unit-scoped $.what definition;\n"
  2341. ~ "Please use the block form."
  2342. }
  2343. }
  2344. my class X::StubCode is Exception {
  2345. has $.message = 'Stub code executed';
  2346. }
  2347. my class X::TooLateForREPR is X::Comp {
  2348. has $.type;
  2349. method message() {
  2350. "Cannot change REPR of $!type.^name() now (must be set at initial declaration)";
  2351. }
  2352. }
  2353. my class X::MustBeParametric is Exception {
  2354. has $.type;
  2355. method message() {
  2356. "$!type.^name() *must* be parameterized";
  2357. }
  2358. }
  2359. my class X::NotParametric is Exception {
  2360. has $.type;
  2361. method message() {
  2362. "$!type.^name() cannot be parameterized";
  2363. }
  2364. }
  2365. my class X::InvalidType does X::Comp {
  2366. has $.typename;
  2367. has @.suggestions;
  2368. method message() {
  2369. my $msg := "Invalid typename '$.typename'";
  2370. if +@.suggestions > 0 {
  2371. $msg := $msg ~ ". Did you mean '" ~ @.suggestions.join("', '") ~ "'?";
  2372. }
  2373. $msg;
  2374. }
  2375. }
  2376. my class X::InvalidTypeSmiley does X::Comp {
  2377. has $.name;
  2378. method message() {
  2379. "Invalid type smiley '$.name' used in type name";
  2380. }
  2381. }
  2382. my class X::Seq::Consumed is Exception {
  2383. method message() {
  2384. "This Seq has already been iterated, and its values consumed\n" ~
  2385. "(you might solve this by adding .cache on usages of the Seq, or\n" ~
  2386. "by assigning the Seq into an array)"
  2387. }
  2388. }
  2389. my class X::Seq::NotIndexable is Exception {
  2390. method message() {
  2391. "Cannot index a Seq; coerce it to a list or assign it to an array first"
  2392. }
  2393. }
  2394. my class X::WheneverOutOfScope is Exception {
  2395. method message() {
  2396. "Cannot have a 'whenever' block outside the scope of a 'supply' block"
  2397. }
  2398. }
  2399. my class X::IllegalOnFixedDimensionArray is Exception {
  2400. has $.operation;
  2401. method message() {
  2402. "Cannot $.operation a fixed-dimension array"
  2403. }
  2404. }
  2405. my class X::NotEnoughDimensions is Exception {
  2406. has $.operation;
  2407. has $.got-dimensions;
  2408. has $.needed-dimensions;
  2409. method message() {
  2410. "Cannot $.operation a $.needed-dimensions dimension array with only $.got-dimensions dimensions"
  2411. }
  2412. }
  2413. my class X::TooManyDimensions is Exception {
  2414. has $.operation;
  2415. has $.got-dimensions;
  2416. has $.needed-dimensions;
  2417. method message() {
  2418. "Cannot $.operation a $.needed-dimensions dimension array with $.got-dimensions dimensions"
  2419. }
  2420. }
  2421. my class X::IllegalDimensionInShape is Exception {
  2422. has $.dim;
  2423. method message() {
  2424. "Illegal dimension in shape: $.dim. All dimensions must be integers bigger than 0"
  2425. }
  2426. }
  2427. my class X::Assignment::ArrayShapeMismatch is Exception {
  2428. has $.target-shape;
  2429. has $.source-shape;
  2430. method message() {
  2431. "Cannot assign an array of shape $.source-shape to an array of shape $.target-shape"
  2432. }
  2433. }
  2434. my class X::Assignment::ToShaped is Exception {
  2435. has $.shape;
  2436. method message() {
  2437. "Assignment to array with shape $.shape must provide structured data"
  2438. }
  2439. }
  2440. my class X::Language::Unsupported is Exception {
  2441. has $.version;
  2442. method message() {
  2443. "No compiler available for Perl $.version"
  2444. }
  2445. }
  2446. my class X::Proc::Unsuccessful is Exception {
  2447. has $.proc;
  2448. method message() {
  2449. "The spawned command '{$.proc.command[0]}' exited unsuccessfully (exit code: $.proc.exitcode())"
  2450. }
  2451. }
  2452. class CompUnit::DependencySpecification { ... }
  2453. my class X::CompUnit::UnsatisfiedDependency is Exception {
  2454. has CompUnit::DependencySpecification $.specification;
  2455. my sub is-core($name) {
  2456. my @parts = $name.split("::");
  2457. my $ns := ::CORE.WHO;
  2458. for @parts {
  2459. return False unless $ns{$_}:exists;
  2460. $ns := $ns{$_}.WHO;
  2461. };
  2462. True
  2463. };
  2464. method message() {
  2465. my $name = $.specification.short-name;
  2466. my $line = $.specification.source-line-number;
  2467. is-core($name)
  2468. ?? "{$name} is a builtin type, not an external module"
  2469. !! "Could not find $.specification at line $line in:\n"
  2470. ~ $*REPO.repo-chain.map(*.Str).join("\n").indent(4)
  2471. ~ ($.specification ~~ / $<name>=.+ '::from' $ /
  2472. ?? "\n\nIf you meant to use the :from adverb, use"
  2473. ~ " a single colon for it: $<name>:from<...>\n"
  2474. !! ''
  2475. )
  2476. }
  2477. }
  2478. my class Exceptions::JSON {
  2479. method process($ex) {
  2480. nqp::printfh(
  2481. nqp::getstderr,
  2482. Rakudo::Internals::JSON.to-json( $ex.^name => Hash.new(
  2483. (message => $ex.?message),
  2484. $ex.^attributes.grep(*.has_accessor).map: {
  2485. with .name.substr(2) -> $attr {
  2486. $attr => (
  2487. (.defined and not $_ ~~ Real|Positional|Associative)
  2488. ?? .Str !! $_
  2489. ) given $ex."$attr"()
  2490. }
  2491. }
  2492. ))
  2493. );
  2494. False # done processing
  2495. }
  2496. }