[perl #127847] [PATCH] Bug #126800

[via RT]

# New Ticket Created by  Bernhard Specht 
# Please include the string:  [perl #127847]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/Ticket/Display.html?id=127847 >


disallow dimensions smaller or equal 0 in shapes

From 93c5f8a96d7f8f31040d22e3e4e1ad989d52cdd9 Mon Sep 17 00:00:00 2001
From: bspecht <bernh...@specht.net>
Date: Wed, 6 Apr 2016 22:36:24 +0200
Subject: [PATCH] disallow dimensions smaller or equal 0 in shapes

---
 src/core/Exception.pm        |  9 ++++++++-
 src/core/Rakudo/Internals.pm | 14 ++++++++------
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/core/Exception.pm b/src/core/Exception.pm
index cb90544..2d8b4c8 100644
--- a/src/core/Exception.pm
+++ b/src/core/Exception.pm
@@ -2252,7 +2252,7 @@ my class X::PhaserExceptions is Exception {
 }
 
 nqp::bindcurhllsym('P6EX', nqp::hash(
-  'X::TypeCheck::Binding', 
+  'X::TypeCheck::Binding',
   sub (Mu $got, Mu $expected, $symbol?) {
       X::TypeCheck::Binding.new(:$got, :$expected, :$symbol).throw;
   },
@@ -2444,6 +2444,13 @@ my class X::TooManyDimensions is Exception {
     }
 }
 
+my class X::IllegalDimensionInShape is Exception {
+    has $.dim;
+    method message() {
+        "Illegal dimension in shape: $.dim. All dimensions must be integers 
bigger than 0"
+    }
+}
+
 my class X::Assignment::ArrayShapeMismatch is Exception {
     has $.target-shape;
     has $.source-shape;
diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm
index c66bbe3..76605f4 100644
--- a/src/core/Rakudo/Internals.pm
+++ b/src/core/Rakudo/Internals.pm
@@ -6,6 +6,7 @@ my class X::Assignment::ToShaped { ... };
 my class X::Str::Sprintf::Directives::BadType { ... };
 my class X::Str::Sprintf::Directives::Count { ... };
 my class X::Str::Sprintf::Directives::Unsupported { ... };
+my class X::IllegalDimensionInShape { ... };
 
 my class Rakudo::Internals {
 
@@ -399,11 +400,12 @@ my class Rakudo::Internals {
         my $key := nqp::list(meta-obj);
         my $dims := nqp::list_i();
         for @dims {
-            if nqp::istype($_, Whatever) {
-                X::NYI.new(feature => 'Jagged array shapes');
+            my $dim = $_.Int;
+            if $dim <= 0 {
+                X::IllegalDimensionInShape.new(dim => $dim).throw;
             }
             nqp::push($key, type-key);
-            nqp::push_i($dims, $_.Int);
+            nqp::push_i($dims, $dim);
         }
         my $storage := nqp::create(nqp::parameterizetype(SHAPE-STORAGE-ROOT, 
$key));
         nqp::setdimensions($storage, $dims);
@@ -780,7 +782,7 @@ my class Rakudo::Internals {
     method get-local-timezone-offset() {
         my $utc     = time;
         my Mu $fia := nqp::p6decodelocaltime(nqp::unbox_i($utc));
-        
+
         DateTime.new(
           :year(nqp::atpos_i($fia,5)),
           :month(nqp::atpos_i($fia,4)),
@@ -1209,7 +1211,7 @@ my class Rakudo::Internals {
 
     # normal increment magic chars & incremented char at same index
     my $succ-nlook = 
'012345678ABCDEFGHIJKLMNOPQRSTUVWXYabcdefghijklmnopqrstuvwxyΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟÎ
 Î¡Î£Î¤Î¥Î¦Î§Î¨Î±Î²Î³Î´ÎµÎ¶Î·Î¸Î¹ÎºÎ»Î¼Î½Î¾Î¿Ï€ÏÏƒÏ„Ï…
φχψאבגדהוזחטיךכלםמןנ
סעףפץצקרשАБВГДЕЖЗИЙКЛМНОПР
СТУФХЦЧШЩЪЫЬЭЮабвгдежзийклмнопрстуфх
цчшщъыьэю٠
١٢٣٤٥٦٧٨०१२३४५६७८০১২৩৪৫৬৭৮੦੧੨੩੪੫੬੭੮૦૧૨૩૪૫૬૭૮୦୧୨୩୪୫୬୭୮⁰ⁱ⁲⁳⁴⁵⁶⁷⁸₀₁₂₃₄â‚
…₆₇₈ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅰⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺ①
②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑴⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂⒃⒄â’
…⒆⒜⒝⒞⒟⒠
⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴▁▂▃▄▅
▆▇⚀⚁⚂⚃⚄❶❷❸❹❺❻❼❽❾０１２３４５６７８🍺🐪';
-    my $succ-nchrs = 
'123456789BCDEFGHIJKLMNOPQRSTUVWXYZbcdefghijklmnopqrstuvwxyzΒΓΔΕΖΗΘΙΚΛΜΝΞΟÎ
 Î¡Î£Î¤Î¥Î¦Î§Î¨Î©Î²Î³Î´ÎµÎ¶Î·Î¸Î¹ÎºÎ»Î¼Î½Î¾Î¿Ï€ÏÏƒÏ„Ï…
φχψωבגדהוזחטיךכלםמןנ
סעףפץצקרשתБВГДЕЖЗИЙКЛМНОПР
СТУФХЦЧШЩЪЫЬЭЮЯбвгдежзийклмнопрстуфх
цчшщъыьэюя١٢٣٤٥٦٧٨٩१२३४५६७८९১২৩৪৫৬৭৮৯੧੨੩੪੫੬੭੮੯૧૨૩૪૫૬૭૮૯୧୨୩୪୫୬୭୮୯ⁱ⁲⁳⁴⁵⁶⁷⁸⁹₁₂₃₄â‚
…₆₇₈₉ⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅫⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺâ…
»â‘¡â‘¢â‘£â‘¤â‘¥â‘¦â‘§â‘¨â‘©â‘ªâ‘«â‘¬â‘­â‘®â‘¯â‘°â‘±â‘²â‘³â‘µâ‘¶â‘·â‘¸â‘¹â‘ºâ‘»â‘¼â‘½â‘¾â‘¿â’€â’â’‚⒃⒄â’
…⒆⒇⒝⒞⒟⒠
⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴⒵▂▃▄▅
▆▇█⚁⚂⚃⚄⚅
❷❸❹❺❻❼❽❾❿１２３４５６７８９🍻🐫'; 
+    my $succ-nchrs = 
'123456789BCDEFGHIJKLMNOPQRSTUVWXYZbcdefghijklmnopqrstuvwxyzΒΓΔΕΖΗΘΙΚΛΜΝΞΟÎ
 Î¡Î£Î¤Î¥Î¦Î§Î¨Î©Î²Î³Î´ÎµÎ¶Î·Î¸Î¹ÎºÎ»Î¼Î½Î¾Î¿Ï€ÏÏƒÏ„Ï…
φχψωבגדהוזחטיךכלםמןנ
סעףפץצקרשתБВГДЕЖЗИЙКЛМНОПР
СТУФХЦЧШЩЪЫЬЭЮЯбвгдежзийклмнопрстуфх
цчшщъыьэюя١٢٣٤٥٦٧٨٩१२३४५६७८९১২৩৪৫৬৭৮৯੧੨੩੪੫੬੭੮੯૧૨૩૪૫૬૭૮૯୧୨୩୪୫୬୭୮୯ⁱ⁲⁳⁴⁵⁶⁷⁸⁹₁₂₃₄â‚
…₆₇₈₉ⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅫⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺâ…
»â‘¡â‘¢â‘£â‘¤â‘¥â‘¦â‘§â‘¨â‘©â‘ªâ‘«â‘¬â‘­â‘®â‘¯â‘°â‘±â‘²â‘³â‘µâ‘¶â‘·â‘¸â‘¹â‘ºâ‘»â‘¼â‘½â‘¾â‘¿â’€â’â’‚⒃⒄â’
…⒆⒇⒝⒞⒟⒠
⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴⒵▂▃▄▅
▆▇█⚁⚂⚃⚄⚅
❷❸❹❺❻❼❽❾❿１２３４５６７８９🍻🐫';
 
     # magic increment chars at boundary & incremented char at same index
     my $succ-blook = '9ZzΩωתЯя٩९৯੯૯୯⁹₉Ⅻⅻ⑳⒇⒵█⚅
❿９🍻🐫';
@@ -1217,7 +1219,7 @@ my class Rakudo::Internals {
 
     # normal decrement magic chars & incremented char at same index
     my $pred-nlook = 
'123456789BCDEFGHIJKLMNOPQRSTUVWXYZbcdefghijklmnopqrstuvwxyzΒΓΔΕΖΗΘΙΚΛΜΝΞΟÎ
 Î¡Î£Î¤Î¥Î¦Î§Î¨Î©Î²Î³Î´ÎµÎ¶Î·Î¸Î¹ÎºÎ»Î¼Î½Î¾Î¿Ï€ÏÏƒÏ„Ï…
φχψωבגדהוזחטיךכלםמןנ
סעףפץצקרשתБВГДЕЖЗИЙКЛМНОПР
СТУФХЦЧШЩЪЫЬЭЮЯбвгдежзийклмнопрстуфх
цчшщъыьэюя١٢٣٤٥٦٧٨٩१२३४५६७८९১২৩৪৫৬৭৮৯੧੨੩੪੫੬੭੮੯૧૨૩૪૫૬૭૮૯୧୨୩୪୫୬୭୮୯ⁱ⁲⁳⁴⁵⁶⁷⁸⁹₁₂₃₄â‚
…₆₇₈₉ⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅫⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺâ…
»â‘¡â‘¢â‘£â‘¤â‘¥â‘¦â‘§â‘¨â‘©â‘ªâ‘«â‘¬â‘­â‘®â‘¯â‘°â‘±â‘²â‘³â‘µâ‘¶â‘·â‘¸â‘¹â‘ºâ‘»â‘¼â‘½â‘¾â‘¿â’€â’â’‚⒃⒄â’
…⒆⒇⒝⒞⒟⒠
⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴⒵▂▃▄▅
▆▇█⚁⚂⚃⚄⚅
❷❸❹❺❻❼❽❾❿１２３４５６７８９🍻🐫';
-    my $pred-nchrs = 
'012345678ABCDEFGHIJKLMNOPQRSTUVWXYabcdefghijklmnopqrstuvwxyΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟÎ
 Î¡Î£Î¤Î¥Î¦Î§Î¨Î±Î²Î³Î´ÎµÎ¶Î·Î¸Î¹ÎºÎ»Î¼Î½Î¾Î¿Ï€ÏÏƒÏ„Ï…
φχψאבגדהוזחטיךכלםמןנ
סעףפץצקרשАБВГДЕЖЗИЙКЛМНОПР
СТУФХЦЧШЩЪЫЬЭЮабвгдежзийклмнопрстуфх
цчшщъыьэю٠
١٢٣٤٥٦٧٨०१२३४५६७८০১২৩৪৫৬৭৮੦੧੨੩੪੫੬੭੮૦૧૨૩૪૫૬૭૮୦୧୨୩୪୫୬୭୮⁰ⁱ⁲⁳⁴⁵⁶⁷⁸₀₁₂₃₄â‚
…₆₇₈ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅰⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺ①
②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑴⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂⒃⒄â’
…⒆⒜⒝⒞⒟⒠
⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴▁▂▃▄▅
▆▇⚀⚁⚂⚃⚄❶❷❸❹❺❻❼❽❾０１２３４５６７８🍺🐪';
 
+    my $pred-nchrs = 
'012345678ABCDEFGHIJKLMNOPQRSTUVWXYabcdefghijklmnopqrstuvwxyΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟÎ
 Î¡Î£Î¤Î¥Î¦Î§Î¨Î±Î²Î³Î´ÎµÎ¶Î·Î¸Î¹ÎºÎ»Î¼Î½Î¾Î¿Ï€ÏÏƒÏ„Ï…
φχψאבגדהוזחטיךכלםמןנ
סעףפץצקרשАБВГДЕЖЗИЙКЛМНОПР
СТУФХЦЧШЩЪЫЬЭЮабвгдежзийклмнопрстуфх
цчшщъыьэю٠
١٢٣٤٥٦٧٨०१२३४५६७८০১২৩৪৫৬৭৮੦੧੨੩੪੫੬੭੮૦૧૨૩૪૫૬૭૮୦୧୨୩୪୫୬୭୮⁰ⁱ⁲⁳⁴⁵⁶⁷⁸₀₁₂₃₄â‚
…₆₇₈ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩⅪⅰⅱⅲⅳⅴⅵⅶⅷⅸⅹⅺ①
②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑴⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂⒃⒄â’
…⒆⒜⒝⒞⒟⒠
⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴▁▂▃▄▅
▆▇⚀⚁⚂⚃⚄❶❷❸❹❺❻❼❽❾０１２３４５６７８🍺🐪';
 
     # magic decrement chars at boundary & incremented char at same index
     my $pred-blook = '0AaΑαאАа٠०০੦૦୦⁰₀Ⅰⅰ①
⑴⒜▁⚀❶０🍺🐪';
-- 
2.8.0