Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

executable file 216 lines (183 sloc) 5.201 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215
use v6;

use Test;

plan 36;

# L<S04/The Relationship of Blocks and Declarations/function has been renamed>
{
  my $a = 42;
  {
    is((temp $a = 23; $a), 23, "temp() changed the variable (1)");
  }
  is $a, 42, "temp() restored the variable (1)";
}

# Test that temp() restores the variable at scope exit, not at subroutine
# entry.
{
  my $a = 42;
  my $get_a = { $a };
  {
    is((temp $a = 23; $a), 23, "temp() changed the variable (2-1)");
    is $get_a(), 23, "temp() changed the variable (2-2)";
  }
  is $a, 42, "temp() restored the variable (2)";
}

# temp() shouldn't change the variable containers
{
  my $a = 42;
  my $get_a = { $a };
  {
    ok((temp $a = 23; $a =:= $get_a()), "temp() shouldn't change the variable containers");
  }
}

{
  our $pkgvar = 42;
  {
    is((temp $pkgvar = 'not 42'; $pkgvar), 'not 42', "temp() changed the package variable (3-1)");
  }
  is $pkgvar, 42, "temp() restored the package variable (3-2)";
}

# Test that temp() restores variable even when not exited regularly (using a
# (possibly implicit) call to return()), but when left because of an exception.
{
  my $a = 42;
  try {
    is((temp $a = 23; $a), 23, "temp() changed the variable in a try block");
    die 57;
  };
  is $a, 42, "temp() restored the variable, the block was exited using an exception";
}

EVAL('
{
my @array = (0, 1, 2);
{
temp @array[1] = 42;
is @array[1], 42, "temp() changed our array element";
}
is @array[1], 1, "temp() restored our array element";
}
"1 - delete this line when the parsefail EVAL() is removed";
') or skip("parsefail: temp \@array[1]", 2);

{
  my %hash = (:a(1), :b(2), :c(3));
  {
    temp %hash<b> = 42;
    is %hash<b>, 42, "temp() changed our hash element";
  }
  is %hash<b>, 2, "temp() restored our array element";
}

{
  my $struct = [
    "doesnt_matter",
    {
      doesnt_matter => "doesnt_matter",
      key => [
        "doesnt_matter",
        42,
      ],
    },
  ];

  {
    temp $struct[1]<key>[1] = 23;
    is $struct[1]<key>[1], 23, "temp() changed our nested arrayref/hashref element";
  }
  is $struct[1]<key>[1], 42, "temp() restored our nested arrayref/hashref element";
}

# Block TEMP{}
# L<S06/Temporization/You can also modify the behaviour of temporized code structures>
# (Test is more or less directly from S06.)
#?niecza 2 skip 'spec clarification needed'
{
  my $next = 0;

  # Here is the real implementation of &advance.
  sub advance() {
    my $curr = $next++;
    TEMP {{ $next = $curr }} # TEMP block returns the closure { $next = $curr }
    return $curr;
  };

  # and later...

  is advance(), 0, "TEMP{} block (1)";
  is advance(), 1, "TEMP{} block (2)";
  is advance(), 2, "TEMP{} block (3)";
  is $next, 3, "TEMP{} block (4)";

  #?rakudo 4 todo 'TEMP phasers NYI'
  #?pugs 4 todo 'feature'
  flunk "TEMP{} block (5)";
  flunk "TEMP{} block (6)";
  flunk "TEMP{} block (7)";
  flunk "TEMP{} block (8)";

  # Following does parse, but isn't executed (don't know why).
  # If the "{" on the following line is changed to "if 1 {", it is executed,
  # too, but then it dies complaining about not finding a matching temp()
  # function. So, for now, we just comment the following block and add
  # unconditional flunk()s.
  # {
  # #?pugs 4 todo 'feature'
  # is temp(advance()), 3, "TEMP{} block (5)";
  # is $next, 4, "TEMP{} block (6)";
  # is temp(advance()), 4, "TEMP{} block (7)";
  # is temp(advance()), 5, "TEMP{} block (8)";
  # } # $next = 3

  is $next, 3, "TEMP{} block (9)";
  is advance(), 3, "TEMP{} block (10)";
  is $next, 4, "TEMP{} block (11)";
}

# Following are OO tests, but I think they fit better in var/temp.t than in
# oo/.
# L<S06/Temporization/temp invokes its argument's .TEMP method.>
{
  my $was_in_own_temp_handler = 0;

  class WierdTemp is Int {
    method TEMP {
      $was_in_own_temp_handler++;
      return { $was_in_own_temp_handler++ };
    }
  }

  my $a = WierdTemp.new();
  ok defined($a), "instantiating a WierdTemp worked";
  is $was_in_own_temp_handler, 0, ".TEMP method wasn't yet executed";

  #?rakudo todo 'TEMP phasers NYI'
  {
    is((temp $a; $was_in_own_temp_handler), 1, ".TEMP method was executed on temporization");
  }
  #?rakudo todo 'TEMP phasers NYI'
  is $was_in_own_temp_handler, 2, ".TEMP method was executed on restoration";
}

{
  my $depth = 0;
  my $c = 1;
  sub a {
    ++temp $c;
    a() if ++$depth < 3;
  }
  a();
  #?rakudo.parrot todo 'temp and recursion'
  is $c, 1, 'recursive nested temps are restored properly';
}

{
  my $a=1;
  {
    temp $a=2;
    temp $a=3;
  }
  is $a, 1, 'multiple temps in the same scope are restored properly';
}

{
  my $value = 0;

  my sub non-recursive {
      temp $value = $value + 1;
  }

  my sub recursive(Int $limit) {
      temp $value = $value + 1;

      if $limit > 0 {
          recursive($limit - 1);
      }
  }

  is($value, 0, 'sanity');
  non-recursive();
  is($value, 0, 'non-recursive function properly resets value');

  # recover if the previous test failed
  $value = 0;

  recursive(10);
  #?rakudo.parrot todo 'temp + recursion'
  is($value, 0, 'recursive function properly resets value');
}

# vim: ft=perl6
Something went wrong with that request. Please try again.