Add system var deprecation capability

And deprecate $*OS.
rakudo · May 11, 2014 · b8567ca · b8567ca
1 parent c1845e2
commit b8567ca
Showing 1 changed file with 35 additions and 13 deletions.
diff --git a/src/core/Deprecations.pm b/src/core/Deprecations.pm
@@ -9,7 +9,7 @@ class Deprecation {
     has $.alternative;  # alternative for code that is deprecated
     has %.callsites;    # places where called (file -> line -> count)
 
-    method WHICH { ($!file,$!type,$!package,$!name).join(':') }
+    method WHICH { ($!file||"",$!type||"",$!package||"",$!name).join(':') }
 
     proto method report (|) { * }
     multi method report (Deprecation:U:) {
@@ -27,34 +27,56 @@ class Deprecation {
         $message.chop;
     }
     multi method report (Deprecation:D:) {
-        my $message = "$.type $.name (from $.package) called at:\n";
+        my $type    = $.type ?? "$.type " !! "";
+        my $name    = $.name ?? "$.name " !! "";
+        my $package = $.package ?? "(from $.package) " !! "";
+        my $message = $type ~ $name ~ $package ~ "called at:\n";
         for %.callsites.kv -> $file, $lines {
             $message ~=
               "  $file, line{ 's' if +$lines > 1 } {$lines.keys.join(',')}\n";
         }
         $message ~= "Please use $.alternative instead.\n";
         $message;
     }
+
+    class Obsolete is Str {
+        has $!name;
+        has $!value;
+        has $!instead;
+
+        submethod BUILD (:$!name, :$!value, :$!instead) {}
+
+        method Str  { DEPRECATED( $!instead, :up(2), :what($!name) ); $!value }
+        method gist { DEPRECATED( $!instead, :up(2), :what($!name) ); $!value }
+    }
+
+    # system variable deprecations
+    $*OS = Obsolete.new(:name('$*OS'),:value($*OS),:instead('$*DISTRO.OS'));
 }
 
-sub DEPRECATED ($alternative) {
+sub DEPRECATED ($alternative, :$up = 1, :$what ) {
 
     my $bt = Backtrace.new;
     my $deprecated = $bt[ my $index = $bt.next-interesting-index(2, :named) ];
-    my $callsite   = $bt[$index = $bt.next-interesting-index($index, :noproto)];
+    my $callsite;
+    $callsite = $bt[$index = $bt.next-interesting-index($index, :noproto)]
+      for ^$up;
 
     # get object, existing or new
-    my $what = Deprecation.new(
-      file    => $deprecated.file,
-      type    => $deprecated.subtype.tc,
-      package => try { $deprecated.package.HOW.name($deprecated) } // 'unknown',
-      name    => $deprecated.subname,
-      :$alternative,
-    );
-    $what = %DEPRECATIONS{$what.WHICH} //= $what;
+    my $dep = $what
+      ?? Deprecation.new( :name($what), :$alternative )
+      !! Deprecation.new(
+        file    => $deprecated.file,
+        type    => $deprecated.subtype.tc,
+        package => try {
+            $deprecated.package.HOW.name($deprecated)
+        } // 'unknown',
+        name    => $deprecated.subname,
+        :$alternative );
+    $dep = %DEPRECATIONS{$dep.WHICH} //= $dep;
 
     # update callsite
-    $what.callsites{$callsite.file}{$callsite.line}++;
+    $dep.callsites{$callsite.file}{$callsite.line}++;
 } 
 
 END {