Move &DEPRECATED to Rakudo::Deprecations.DEPRECATED

The main issue is that in setting compilation, we are referring to &DEPRECATED *long* before it actually gets defined. This is normally not an issue (afaik), but it apparently *is* in the core setting, especially in combination with precompiled modules doing deprecations. This provides an alternate fix for 472f6e4 , and it paves the way to making "has $.a is DEPRECATED<b>" work.
rakudo · May 24, 2018 · 89a4cf0 · 89a4cf0
1 parent 154d985
commit 89a4cf0
Show file tree

Hide file tree

Showing 9 changed files with 67 additions and 54 deletions.
diff --git a/lib/Test.pm6 b/lib/Test.pm6
@@ -276,7 +276,7 @@ sub bail-out ($desc?) is export {
 }
 
 multi sub is_approx(Mu $got, Mu $expected, $desc = '') is export {
-    DEPRECATED('is-approx'); # Remove for 6.d release
+    Rakudo::Deprecations.DEPRECATED('is-approx'); # Remove for 6.d release
 
     $time_after = nqp::time_n;
     my $tol = $expected.abs < 1e-6 ?? 1e-5 !! $expected.abs * 1e-6;

diff --git a/src/core/Deprecations.pm6 b/src/core/Deprecations.pm6
@@ -51,57 +51,59 @@ class Deprecation {
     }
 }
 
-sub DEPRECATED($alternative,$from?,$removed?,:$up = 1,:$what,:$file,:$line,Bool :$lang-vers) {
-    state $ver  = $*PERL.compiler.version;
-    my $version = $lang-vers ?? nqp::getcomp('perl6').language_version !! $ver;
-    # if $lang-vers was given, treat the provided versions as language
-    # versions, rather than compiler versions. Note that we can't
-    # `state` the lang version (I think) because different CompUnits
-    # might be using different versions.
+class Rakudo::Deprecations {
+    method DEPRECATED($alternative,$from?,$removed?,:$up = 1,:$what,:$file,:$line,Bool :$lang-vers) {
+        state $ver  = $*PERL.compiler.version;
+        my $version = $lang-vers ?? nqp::getcomp('perl6').language_version !! $ver;
+        # if $lang-vers was given, treat the provided versions as language
+        # versions, rather than compiler versions. Note that we can't
+        # `state` the lang version (I think) because different CompUnits
+        # might be using different versions.
 
-    my Version $vfrom;
-    my Version $vremoved;
-    $from && nqp::iseq_i($version cmp ($vfrom = Version.new: $from), -1)
-          && return; # not deprecated yet;
-    $vremoved = Version.new($removed) if $removed;
+        my Version $vfrom;
+        my Version $vremoved;
+        $from && nqp::iseq_i($version cmp ($vfrom = Version.new: $from), -1)
+              && return; # not deprecated yet;
+        $vremoved = Version.new($removed) if $removed;
 
-    my $bt = Backtrace.new;
-    my $deprecated =
-      $bt[ my $index = $bt.next-interesting-index(2, :named, :setting) ];
+        my $bt = Backtrace.new;
+        my $deprecated =
+          $bt[ my $index = $bt.next-interesting-index(2, :named, :setting) ];
 
-    if $up ~~ Whatever {
-        $index = $_ with $bt.next-interesting-index($index, :noproto);
-    }
-    else {
-        $index = $_
-          with $bt.next-interesting-index($index, :noproto, :setting)
-          for ^$up;
-    }
-    my $callsite = $bt[$index];
+        if $up ~~ Whatever {
+            $index = $_ with $bt.next-interesting-index($index, :noproto);
+        }
+        else {
+            $index = $_
+              with $bt.next-interesting-index($index, :noproto, :setting)
+              for ^$up;
+        }
+        my $callsite = $bt[$index];
 
-    # get object, existing or new
-    my $dep = $what
-      ?? Deprecation.new(
-        :name($what),
-        :$alternative,
-        :from($vfrom),
-        :removed($vremoved) )
-      !! Deprecation.new(
-        file    => $deprecated.file,
-        type    => $deprecated.subtype.tc,
-        package => try { $deprecated.package.^name } // 'unknown',
-        name    => $deprecated.subname,
-        :$alternative,
-        :from($vfrom),
-        :removed($vremoved),
-    );
-    $dep = %DEPRECATIONS{$dep.WHICH} //= $dep;
+        # get object, existing or new
+        my $dep = $what
+          ?? Deprecation.new(
+            :name($what),
+            :$alternative,
+            :from($vfrom),
+            :removed($vremoved) )
+          !! Deprecation.new(
+            file    => $deprecated.file,
+            type    => $deprecated.subtype.tc,
+            package => try { $deprecated.package.^name } // 'unknown',
+            name    => $deprecated.subname,
+            :$alternative,
+            :from($vfrom),
+            :removed($vremoved),
+        );
+        $dep = %DEPRECATIONS{$dep.WHICH} //= $dep;
 
-    state $fatal = %*ENV<RAKUDO_DEPRECATIONS_FATAL>;
-    die $dep.report if $fatal;
+        state $fatal = %*ENV<RAKUDO_DEPRECATIONS_FATAL>;
+        die $dep.report if $fatal;
 
-    # update callsite
-    ++$dep.callsites{$file // $callsite.file.IO}{$line // $callsite.line};
+        # update callsite
+        ++$dep.callsites{$file // $callsite.file.IO}{$line // $callsite.line};
+    }
 }
 
 END {

diff --git a/src/core/IO/Path.pm6 b/src/core/IO/Path.pm6
@@ -409,7 +409,7 @@ my class IO::Path is Cool does IO {
 
     proto method chdir(|) {*}
     multi method chdir(IO::Path:D: Str() $path, :$test!) {
-        DEPRECATED(
+        Rakudo::Deprecations.DEPRECATED(
             :what<:$test argument>,
             'individual named parameters (e.g. :r, :w, :x)',
             "v2017.03.101.ga.5800.a.1", "v6.d", :up(*),

diff --git a/src/core/Instant.pm6 b/src/core/Instant.pm6
@@ -124,8 +124,14 @@ Rakudo::Internals.REGISTER-DYNAMIC: '$*INIT-INSTANT', {
 }
 Rakudo::Internals.REGISTER-DYNAMIC: '$*INITTIME', {
     my ($file, $line) = .file, .line with callframe 3;
-    DEPRECATED('$*INIT-INSTANT', '2017.09.84.gb.02.da.4.d.1.a', '2018.08',
-        :what<$*INITTIME>, :$file, :$line);
+    Rakudo::Deprecations.DEPRECATED(
+      '$*INIT-INSTANT',
+      '2017.09.84.gb.02.da.4.d.1.a',
+      '2018.08',
+      :what<$*INITTIME>,
+      :$file,
+      :$line
+    );
     $*INIT-INSTANT
 }
 

diff --git a/src/core/JSON/Pretty.pm6 b/src/core/JSON/Pretty.pm6
@@ -1,10 +1,14 @@
 sub to-json(|c) {
-    DEPRECATED('JSON::Fast, JSON::Tiny or JSON::Pretty from https://modules.perl6.org/');
+    Rakudo::Deprecations.DEPRECATED(
+      'JSON::Fast, JSON::Tiny or JSON::Pretty from https://modules.perl6.org/'
+    );
     Rakudo::Internals::JSON.to-json(|c);
 }
 
 sub from-json($text) {
-    DEPRECATED('JSON::Fast, JSON::Tiny or JSON::Pretty from https://modules.perl6.org/');
+    Rakudo::Deprecations.DEPRECATED(
+      'JSON::Fast, JSON::Tiny or JSON::Pretty from https://modules.perl6.org/'
+    );
     Rakudo::Internals::JSON.from-json($text);
 }
 

diff --git a/src/core/core_prologue.pm6 b/src/core/core_prologue.pm6
@@ -6,6 +6,7 @@ my class List { ... }
 my class Map { ... }
 my class Match { ... }
 my class Failure { ... }
+my class Rakudo::Deprecations { ... }
 my class Rakudo::Internals { ... }
 my class Rakudo::Internals::JSON { ... }
 my class Rakudo::Iterator { ... }

diff --git a/src/core/io_operators.pm6 b/src/core/io_operators.pm6
@@ -124,7 +124,7 @@ multi sub chdir(|c) {
 
 proto sub indir($, $, *%) {*}
 multi sub indir(IO() $path, &what, :$test!) {
-    DEPRECATED(
+    Rakudo::Deprecations.DEPRECATED(
         :what<:$test argument>,
         'individual named parameters (e.g. :r, :w, :x)',
         "v2017.03.101.ga.5800.a.1", "v6.d", :up(*),

diff --git a/src/core/set_precedes.pm6 b/src/core/set_precedes.pm6
@@ -5,7 +5,7 @@
 #   ≽       succeeds
 
 proto sub infix:<<(<+)>>($, $, *% --> Bool:D) is pure {
-    DEPRECATED(
+    Rakudo::Deprecations.DEPRECATED(
       "set operator {$*INSTEAD // "(<=)"}",
       "",
       "6.d",

diff --git a/src/core/traits.pm6 b/src/core/traits.pm6
@@ -151,7 +151,7 @@ multi sub trait_mod:<is>(Routine:D $r, :$DEPRECATED!) {
     my $new := nqp::istype($DEPRECATED,Bool)
       ?? "something else"
       !! $DEPRECATED;
-    $r.add_phaser( 'ENTER', -> { (CHECK &DEPRECATED)($new) } );
+    $r.add_phaser( 'ENTER', -> { Rakudo::Deprecations.DEPRECATED($new) } );
 }
 multi sub trait_mod:<is>(Routine:D $r, Mu :$inlinable!) {
     $r.set_inline_info(nqp::decont($inlinable));