Merge branch 'master' of https://github.com/rakudo/rakudo into issue_…

…2714

Configure.pl

@@ -11,7 +11,7 @@
 use FindBin;
 
 BEGIN {
-    my $set_config = ! qx{git config rakudo.initialized};
+    my $set_config = !qx{git config rakudo.initialized};
     unless ( -e '3rdparty/nqp-configure/LICENSE' ) {
         print "Updating nqp-configure submodule...\n";
         my $msg =
@@ -63,7 +63,7 @@ BEGIN
         $cfg->options,      'help!',
         'prefix=s',         'libdir=s',
         'sysroot=s',        'sdkroot=s',
-        'relocatable',   'backends=s',
+        'relocatable',      'backends=s',
         'no-clean',         'with-nqp=s',
         'gen-nqp:s',        'gen-moar:s',
         'moar-option=s@',   'git-protocol=s',
@@ -86,8 +86,11 @@ BEGIN
         exit(0);
     }
     if ( $cfg->opt('ignore-errors') ) {
-        print
-"===WARNING!===\nErrors are being ignored.\nIn the case of any errors the script may behave unexpectedly.\n";
+        $cfg->note(
+            "WARNING!",
+            "Errors are being ignored.\n",
+            "In the case of any errors the script may behave unexpectedly."
+        );
     }
 
     $cfg->configure_paths;

docs/rakudo-nqp-and-pod-notes.md

@@ -115,7 +115,7 @@ Complicating work with pod is that pod blocks can be nested, i.e., a
 pod block can have pod blocks as children, to any depth.  Necessarily
 that applies, in general, to *delimited blocks*. (Other block types
 may have single blocks as children, usually as one or two
-**Pod::Block::Paras**.)
+**Pod::Block::Para**s.)
 
 One consequence of this is that a pod block with children cannot be
 created until all its children have been created.  Another consequence

src/Perl6/Compiler.nqp

@@ -4,6 +4,7 @@ use Perl6::Optimizer;
 
 class Perl6::Compiler is HLL::Compiler {
     has $!language_version;  # Default language version in form 6.c
+    has $!language_modifier; # Active language modifier; PREVIEW mostly.
     has $!language_revisions; # Hash of language revision letters. See gen/<vm>/main-version.nqp
     has $!can_language_versions; # List of valid language version
 
@@ -17,10 +18,14 @@ class Perl6::Compiler is HLL::Compiler {
     method language_name()    { 'Perl' }
     method reset_language_version() {
         $!language_version := NQPMu;
+        $!language_modifier := NQPMu;
     }
     method set_language_version($version) {
         $!language_version := $version;
     }
+    method set_language_modifier($modifier) {
+        $!language_modifier := $modifier;
+    }
     method language_version() {
         if nqp::defined($!language_version) {
             $!language_version
@@ -29,6 +34,9 @@ class Perl6::Compiler is HLL::Compiler {
             $!language_version := self.config<language-version>
         }
     }
+    method language_modifier() {
+        $!language_modifier
+    }
     method    can_language_versions() {
             $!can_language_versions
         ??  $!can_language_versions

src/Perl6/Metamodel/BOOTSTRAP.nqp

@@ -3195,22 +3195,113 @@ BEGIN {
     Submethod.HOW.compose_repr(Submethod);
     Submethod.HOW.compose_invocation(Submethod);
 
+    # Capture store for SET_CAPS.
+    my class RegexCaptures {
+        # An integer array of positional capture counts.
+        has @!pos-capture-counts;
+
+        # A string array of named capture names and a matching integer array of
+        # capture counts.
+        has @!named-capture-names;
+        has @!named-capture-counts;
+
+        # Form this data structure from a capnames hash.
+        method from-capnames(%capnames) {
+            nqp::create(self).'!from-capnames'(%capnames)
+        }
+
+        method !from-capnames(%capnames) {
+            # Initialize.
+            @!pos-capture-counts := nqp::list_i();
+            @!named-capture-names := nqp::list_s();
+            @!named-capture-counts := nqp::list_i();
+
+            # Go over the captures and build up the data structure.
+            for %capnames {
+                my $name := nqp::iterkey_s($_);
+                if $name ne '' {
+                    my $count := nqp::iterval($_);
+                    if nqp::ord($name) != 36 && nqp::ord($name) < 58 {
+                        nqp::bindpos_i(@!pos-capture-counts, +$name, $count);
+                    }
+                    else {
+                        nqp::push_s(@!named-capture-names, $name);
+                        nqp::push_i(@!named-capture-counts, $count);
+                    }
+                }
+            }
+
+            self
+        }
+
+        # Are there any captures?
+        method has-captures() {
+            nqp::elems(@!named-capture-counts) || nqp::elems(@!pos-capture-counts)
+        }
+
+        # Build a list of positional captures, or return a shared empty list if
+        # there are none. This only populates the slots which need an array.
+        my $EMPTY-LIST := nqp::list();
+        my $EMPTY-HASH := nqp::list();
+        method prepare-list() {
+            my int $n := nqp::elems(@!pos-capture-counts);
+            if $n > 0 {
+                my $result := nqp::list();
+                my int $i := 0;
+                while $i < $n {
+                    nqp::bindpos($result, $i, nqp::create(Array))
+                        if nqp::atpos_i(@!pos-capture-counts, $i) >= 2;
+                    $i++;
+                }
+                $result
+            }
+            else {
+                $EMPTY-LIST
+            }
+        }
+
+        # Build a hash of named camptures, or return a shared empty hash if there
+        # are none. This only poplates the slots that need an array.
+        method prepare-hash() {
+            my int $n := nqp::elems(@!named-capture-counts);
+            if $n > 0 {
+                my $result := nqp::hash();
+                my int $i := 0;
+                while $i < $n {
+                    if nqp::atpos_i(@!named-capture-counts, $i) >= 2 {
+                        nqp::bindkey($result,
+                            nqp::atpos_s(@!named-capture-names, $i),
+                            nqp::create(Array));
+                    }
+                    $i++;
+                }
+                $result
+            }
+            else {
+                $EMPTY-HASH
+            }
+        }
+
+        # Get the name of the only capture, if there is only one.
+        method onlyname() { '' }
+    }
     # class Regex is Method {
-    #     has @!caps;
+    #     has $!caps;
     #     has Mu $!nfa;
     #     has @!alt_nfas;
     #     has str $!source;
     #     has $!topic;
     #     has $!slash;
     Regex.HOW.add_parent(Regex, Method);
-    Regex.HOW.add_attribute(Regex, scalar_attr('@!caps', List, Regex));
+    Regex.HOW.add_attribute(Regex, scalar_attr('$!caps', Mu, Regex));
     Regex.HOW.add_attribute(Regex, scalar_attr('$!nfa', Mu, Regex));
     Regex.HOW.add_attribute(Regex, scalar_attr('%!alt_nfas', Hash, Regex));
     Regex.HOW.add_attribute(Regex, scalar_attr('$!source', str, Regex));
     Regex.HOW.add_attribute(Regex, scalar_attr('$!topic', Mu, Regex));
     Regex.HOW.add_attribute(Regex, scalar_attr('$!slash', Mu, Regex));
-    Regex.HOW.add_method(Regex, 'SET_CAPS', nqp::getstaticcode(sub ($self, $caps) {
-            nqp::bindattr(nqp::decont($self), Regex, '@!caps', $caps)
+    Regex.HOW.add_method(Regex, 'SET_CAPS', nqp::getstaticcode(sub ($self, $capnames) {
+            nqp::bindattr(nqp::decont($self), Regex, '$!caps',
+                RegexCaptures.from-capnames($capnames))
         }));
     Regex.HOW.add_method(Regex, 'SET_NFA', nqp::getstaticcode(sub ($self, $nfa) {
             nqp::bindattr(nqp::decont($self), Regex, '$!nfa', $nfa)
@@ -3224,7 +3315,7 @@ BEGIN {
             nqp::bindkey(%alts, $name, $nfa);
         }));
     Regex.HOW.add_method(Regex, 'CAPS', nqp::getstaticcode(sub ($self) {
-            nqp::getattr(nqp::decont($self), Regex, '@!caps')
+            nqp::getattr(nqp::decont($self), Regex, '$!caps')
         }));
     Regex.HOW.add_method(Regex, 'NFA', nqp::getstaticcode(sub ($self) {
             nqp::getattr(nqp::decont($self), Regex, '$!nfa')

src/Perl6/World.nqp

@@ -563,10 +563,14 @@ class Perl6::World is HLL::World {
 
         my str $version := ~$ver-match;
         my @vparts := nqp::split('.', $version);
+        my $vWhatever := nqp::isge_i(nqp::index($version, '*'), 0);
+        my $vPlus := nqp::isge_i(nqp::index($version, '+'), 0);
         my $default_rev := nqp::substr($comp.config<language-version>, 2, 1);
 
         # Do we have dot-splitted version string?
-        if ((@vparts > 1) && nqp::iseq_s(@vparts[0], 'v6')) || ($version eq 'v6') {
+        if !($vWhatever || $vPlus) &&
+            ( ((@vparts > 1) && nqp::iseq_s(@vparts[0], 'v6'))
+              || ($version eq 'v6') ) {
             my $revision := @vparts[1] || $default_rev;
             my $lang_ver := '6.' ~ $revision;
 
@@ -589,20 +593,34 @@ class Perl6::World is HLL::World {
 
         my $Version := self.find_symbol: ['Version'];
         my $vWant   := $ver-match.ast.compile_time_value;
-        my $rev := $vWant.parts.AT-POS(1);
-        my str $rev_mod := $vWant.parts.elems > 2 ?? $vWant.parts.AT-POS(2) !! '';
+        my $vWantParts := $vWant.parts;
+        my %lang_rev := $comp.language_revisions;
+        unless $vWhatever || $vWant.plus {
+            # It makes no sense checking for modifier when something like v6.* or v6.c+ is wanted.
+            my $rev := $vWantParts.AT-POS(1);
+            my str $rev_mod := $vWantParts.elems > 2 ?? $vWantParts.AT-POS(2) !! '';
+            self."!check-version-modifier"($ver-match, $rev, $rev_mod, $comp);
+        }
 
-        self."!check-version-modifier"($ver-match, $rev, $rev_mod, $comp);
+        my @can_ver_reversed;
+        for $comp.can_language_versions { nqp::unshift(@can_ver_reversed, $_) }
 
-        for $comp.can_language_versions -> $can-ver {
+        for @can_ver_reversed -> $can-ver {
+            # Skip if tried version doesn't match the wanted one
             next unless $vWant.ACCEPTS: my $vCan := $Version.new: $can-ver;
 
+            my $vCanElems := $vCan.parts.elems;
             my $can_rev := $vCan.parts.AT-POS: 1;
-            $comp.set_language_version:       '6.' ~ $can_rev;
+
+            # Skip if 2-part version tried now has a required modifier
+            next if nqp::iseq_i($vCanElems, 2) && nqp::existskey(%lang_rev{$can_rev}, 'require');
+
+            $comp.set_language_version: '6.' ~ $can_rev;
+            $comp.set_language_modifier: $vCan.parts.AT-POS: 2 if $vCanElems > 2;
 
             if $can_rev eq 'c' {
                 $*CAN_LOWER_TOPIC := 0;
-                # CORE.c is currently our lowest core, which we don't "load"
+                # CORE.c is our lowest core, which we don't "load"
             }
             else {
                 self.load_setting: $ver-match, 'CORE.' ~ $can_rev

src/core/Kernel.pm6

@@ -57,7 +57,7 @@ class Kernel does Systemic {
         try shell("uname -p", :out, :!err).out.slurp(:close).chomp;
     }
 
-    submethod BUILD(:$!auth = "unknown" --> Nil) { }
+    submethod BUILD(:$!auth = 'unknown' --> Nil) { }
 
     method name {
         $!name //= do {
@@ -185,9 +185,11 @@ class Kernel does Systemic {
     multi method signal(Kernel:D: Signal:D \signal --> Int:D) { signal.value }
     multi method signal(Kernel:D: Int:D    \signal --> Int:D) { signal       }
 
-    method cpu-cores() is raw { nqp::cpucores }
+    method cpu-cores(--> Int) is raw {
+        nqp::cpucores()
+    }
 
-    method cpu-usage() is raw {
+    method cpu-usage(--> Int) is raw {
         my int @rusage;
         nqp::getrusage(@rusage);
         nqp::atpos_i(@rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000
@@ -196,6 +198,18 @@ class Kernel does Systemic {
           + nqp::atpos_i(@rusage, nqp::const::RUSAGE_STIME_MSEC)
     }
 
+    method free-memory(--> Int) {
+        nqp::freemem()
+    }
+
+    my $total-mem := nqp::null();
+    method total-memory(--> Int) {
+        nqp::ifnull(
+          $total-mem,
+          nqp::bind($total-mem,nqp::p6box_i(nqp::totalmem()))
+        )
+    }
+
     my $endian := nqp::null;
     method endian(--> Endian:D) {
         nqp::ifnull(