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