Changeset 5001

Show
Ignore:
Timestamp:
06/26/05 11:08:26 (4 years ago)
Author:
iblech
svk:copy_cache_prev:
6856
Message:

Fixed chomp($str) to not edit $str inplace.
* Pugs.Prim -- Fixed the implementation of &chomp.
* examples/, ext/, t/, src/perl6/Prelude/PIR.pm, Makefile.PL -- Test fixes.
* Added note about chomp's new behaviour to docs/quickref/data.

Renamed ext/WTemplate/readme to ext/WTemplate/README (consitency).

Files:
1 removed
36 modified
1 moved

Legend:

Unmodified
Added
Removed

  • Makefile.PL

    r4974 r5001  
    278278 
    279279pugs.prof :: profiled 
    280         find t -type f | grep -v D | grep -v R | grep -v pugsrun | ./pugs +RTS -p -RTS -e 'my sub exit {}; for =\$\$*IN -> \$\$t is copy { chomp \$\$t; require \$\$t }' 
     280        find t -type f | grep -v D | grep -v R | grep -v pugsrun | ./pugs +RTS -p -RTS -e 'my sub exit {}; for =\$\$*IN -> \$\$t is copy { \$\$t .= chomp; require \$\$t }' 
    281281 
    282282optimised :: optimized 

  • docs/quickref/data

    r3797 r5001  
    1212    Methods: 
    1313 
    14     .chomp 
     14    .chomp    # Returns chomped string with a .newline property giving the 
     15                newline removed 
    1516    .chop 
    1617    .ord 

  • examples/advocacy/motd-i.p6

    r4451 r5001  
    1717my $fh = open($dict) err die $!; 
    1818 
    19 for =$fh->$line is copy{ 
    20     chomp $line;  
    21     push @list,$line || next() 
     19for =$fh->$line { 
     20    push @list,chomp($line) || next() 
    2221}; 
    2322 
    … …  
    4039while $keyed = =$*IN { 
    4140    clear; 
    42     chomp $keyed; 
     41    $keyed .= chomp; 
    4342     my @keyed_args ; 
    4443    if $keyed { 
    … …  
    5655    print "y/N ...";  
    5756    my $ans = =$*IN ;# XXX want 'is chomped'; 
    58     chomp $ans;  
     57    $ans .= chomp; 
    5958 
    6059    # User wants to save changes 

  • examples/advocacy/motd.p6

    r4451 r5001  
    1515my $dict      = canonpath("$progdir/pugspraise"); 
    1616my $fh        = open $dict err die $!; 
    17 my @list      = map -> $a is copy {chomp $a; $a;} =$fh; 
     17my @list      = map &chomp, =$fh; 
    1818 
    1919#XXX it sure would make things tidier filehandle could be autochomped. 

  • examples/cookbook/01strings/01-10interpolating-functions.p6

    r3174 r5001  
    4040        From: Your Bank 
    4141        Cc: &get_manager_list($naughty) 
    42         Date: { do { my $now = `date`; chomp $now; $now } } (today) 
     42        Date: { do { my $now = `date`; $now .= chomp; $now } } (today) 
    4343 
    4444        Dear $naughty, 

  • examples/functional/monads.p6

    r2824 r5001  
    6464  return { 
    6565    my $line = =$IN; 
    66     chomp $line; 
     66    $line .= chomp; 
    6767    $line; 
    6868  }; 

  • examples/games/animals.p6

    r3174 r5001  
    2626  print "No!?  What was it then? "; 
    2727  # XXX: chomp(my $new = =$*IN)'d be nicer 
    28   my $new = =$*IN; chomp $new; 
     28  my $new = =$*IN; $new .= chomp; 
    2929  print "And a question that distinguishes a $this from a $new would be? "; 
    30   my $q   = =$*IN; chomp $q; 
     30  my $q   = =$*IN; $q .= chomp; 
    3131  my $yes = yes "And for a $new, the answer would be..."; 
    3232 

  • examples/games/hangman.p6

    r3189 r5001  
    120120while ($letter = =$*IN) { 
    121121    cls; 
    122     chomp($letter); 
     122    $letter .= chomp; 
    123123 
    124124    if (guess($letter)) { 

  • examples/games/wizard.p6

    r4091 r5001  
    33multi sub prompt (Str ?$prompt) { 
    44    print $prompt; 
    5     my $input; ($input = =<>).chomp; 
     5    my $input; ($input = =<>) .= chomp; 
    66    return $input; 
    77} 

  • examples/golf/tsanta.pl

    r1031 r5001  
    3434   my $golf = 0; 
    3535   while (<FF>) { 
    36       chomp; next unless length; 
     36      $_ .= chomp; next unless length; 
    3737      s/^#!.*?perl// if $. == 1; 
    3838      $golf += length; 

  • examples/irclog2html.p6

    r3258 r5001  
    183183# ($time, $type, $nick, $text). 
    184184sub parse_ilogger2(Str $line is copy) { 
    185   chomp $line; 
     185  $line .= chomp; 
    186186  $line ~~ rx:Perl5/^\[(\d\d:\d\d)\] (.*)$/ or 
    187187    die "Couldn't parse line »$line«!"; 

  • examples/junctions/2.p6

    r3174 r5001  
    88say "enter a colour: "; 
    99my $y = =$*IN; 
    10 chomp $y; 
     10$y .= chomp; 
    1111 
    1212my $result = ($x eq $y) ?? "acceptable" :: 'unacceptable' ; 

  • examples/junctions/passwd-check.p6

    r3174 r5001  
    1111 
    1212  print "Enter new password: "; 
    13   my $password = =$IN; 
    14   chomp $password; 
    15   $password; 
     13  my $password = chomp =$IN; 
    1614} 
    1715 

  • examples/matrix.p5

    r3079 r5001  
    66print "5x5 matrix in one line: " unless @ARGV; 
    77my $matrix = shift || <>; 
    8 chomp $matrix; 
     8$matrix .= chomp; 
    99$matrix ||= "abcdefghijklmnopqrstuvwxy"; 
    1010my @matrix = [ ('_') x 7 ]; 
    … …  
    6868substr(join('', @{ $matrix[1] }), 1, 5) =~ /$re/ or die;  # Precompile 
    6969while (<$fh>) { 
    70     chomp; 
     70    $_ .= chomp; 
    7171    next if tr/a-z//c;  # Regex would destroy the compiled one 
    7272    // and push @matches, [ $_, sum map $scores{$_}, split // ]; 

  • examples/matrix.p6

    r4103 r5001  
    44print "5x5 matrix in one line: " unless @*ARGS; 
    55my $matrix = @*ARGS[0] || =<>; 
    6 chomp $matrix; 
     6$matrix .= chomp; 
    77$matrix ||= "abcdefghijklmnopqrstuvwxy"; 
    88 

  • examples/naive_bayesian/naive_bayesian.p5

    r3174 r5001  
    1717    open DB, "<words.db.p5" || die "Cannot open the words.db.p5 file: $!"; 
    1818    while (my $line = <DB>) { 
    19         chomp($line); 
     19        $line .= chomp; 
    2020        my ($key, $value) = split(/\t/, $line); 
    2121        $words{$key} = $value; 

  • examples/naive_bayesian/naive_bayesian.p6

    r4402 r5001  
    1010    for (=$db) -> $_line { 
    1111        my $line = $_line; 
    12         chomp($line); 
     12        $line .= chomp; 
    1313        my ($key, $value) = split("\t", $line); 
    1414        %words{"$key"} = $value; 

  • examples/network/bot_irc.p6

    r3174 r5001  
    3333while ($ligne = readline($hdl)) 
    3434{ 
    35     chomp($ligne); 
     35    $ligne .= chomp; 
    3636    say "Serveur said : $ligne"; # if $debug; 
    3737 

  • examples/obfu/l33t.p6

    r4900 r5001  
    196196method debug_action(Str $cmd is copy) returns Bool { 
    197197    $:runnable = bool::false; 
    198     $cmd.chomp; 
     198    $cmd .= chomp; 
    199199    $cmd ||= $:last_db_command; 
    200200    $:last_db_command = $cmd; 

  • ext/Config-Tiny/lib/Config/Tiny.pm

    r4401 r5001  
    2424            for =$input -> $line is copy { 
    2525                ++$cnt; 
    26                 chomp $line; 
     26                $line .= chomp; 
    2727 
    2828                # Skip comments and empty lines 

  • ext/File-Spec/t/30_cwd.t

    r2847 r5001  
    2121    my @retval = system("cd"); 
    2222    my $cwd = @retval[0]; 
    23     chomp($cwd); 
     23    $cwd .= chomp; 
    2424    return $cwd; 
    2525  } 

  • ext/Kwid-Event-Parser/lib/Kwid/Event/Parser.pm

    r2987 r5001  
    2828        my $line = $fh.readline; 
    2929        last unless $line.defined; # exit as soon as possible 
    30         chomp($line); 
     30        $line .= chomp; 
    3131        if ($line ~~ rx:perl5{^=kwid}) { 
    3232            $is_parsing = 1; 
    … …  
    7777                            $_line = $fh.readline; 
    7878                        }            
    79                         chomp($verbatim);              
     79                        $verbatim .= chomp; 
    8080                        %events<start_element>('verbatim'); 
    8181                        %events<verbatim>($verbatim); 
    … …  
    9393                            while (defined($_line)             &&  
    9494                                   !($_line ~~ rx:perl5{^\n$}) ) { 
    95                                 chomp($_line); 
     95                                $_line .= chomp; 
    9696                                interpolate($_line, %events); 
    9797                                $_line = $fh.readline; 

  • ext/Kwid-Event-Parser/t/basic.t

    r4203 r5001  
    9494        } 
    9595        # trim the last newline 
    96         chomp($buffer); 
     96        $buffer .= chomp; 
    9797    }, 
    9898    string  => -> ($str)  { $buffer ~= $str  }    

  • ext/Locale-KeyedText/lib/Locale/KeyedText.pm

    r4711 r5001  
    711711                LOOP: { 
    712712                        show_message( $translator, Locale::KeyedText.new_message( 'MYAPP_PROMPT' ) ); 
    713                         my Str $user_input = $*IN; $user_input.chomp; 
     713                        my Str $user_input = $*IN; $user_input .= chomp; 
    714714                        $user_input or last LOOP; # user chose to exit program 
    715715                        try { 

  • ext/Pod-Event-Parser/lib/Pod/Event/Handler/HTML.pm

    r3086 r5001  
    8888            } 
    8989            # trim the last newline 
    90             chomp($buffer); 
     90            $buffer .= chomp; 
    9191        }, 
    9292        string  => -> ($str)  { $buffer ~= $str  } 

  • ext/Pod-Event-Parser/lib/Pod/Event/Parser.pm

    r3086 r5001  
    2929        my $line = $fh.readline; 
    3030        last unless $line.defined; # exit as soon as possible 
    31         chomp($line); 
     31        $line .= chomp; 
    3232        if ($line ~~ rx:perl5{^=pod}) { 
    3333            $is_parsing = 1; 
    … …  
    9595                            while (defined($_line)             &&  
    9696                                   !($_line ~~ rx:perl5{^\n$}) ) { 
    97                                 chomp($_line); 
     97                                $_line .= chomp; 
    9898                                interpolate($_line, %events); 
    9999                                $_line = $fh.readline; 

  • ext/Pod-Event-Parser/t/complex.t

    r4126 r5001  
    2727} 
    2828$fh.close(); 
    29 chomp($expected_output); 
     29$expected_output .= chomp; 
    3030 
    3131# now compare 

  • src/Pugs/Prim.hs

    r4986 r5001  
    110110            return $ VStr [last str] 
    111111op1 "chomp" = \x -> do 
    112     ref <- fromVal x 
    113112    str <- fromVal x 
    114113    if null str || last str /= '\n' 
    115         then return undef 
     114        then return $ VStr str 
    116115        else do 
    117             writeRef ref $ VStr (init str) 
    118             return $ VStr [last str] 
     116            -- writeRef ref $ VStr (init str) 
     117            return $ VStr $ init str 
    119118op1 "Str::split" = op1Cast (castV . words) 
    120119op1 "lc" = op1Cast (VStr . map toLower) 
    … …  
    13241323\\n   Any       pre     undefine  safe   (?rw!Any)\ 
    13251324\\n   Str       pre     chop    safe   (?rw!Str=$_)\ 
    1326 \\n   Str       pre     chomp   safe   (?rw!Str=$_)\ 
     1325\\n   Str       pre     chomp   safe   (?Str=$_)\ 
    13271326\\n   Any       right   =       safe   (rw!Any, Any)\ 
    13281327\\n   Int       pre     index   safe   (Str, Str, ?Int=0)\ 

  • src/Pugs/Run/Args.hs

    r3910 r5001  
    145145joinDashE :: [Arg] -> [Arg] 
    146146joinDashE [] = [] 
    147 joinDashE ((Switch 'p'):args) = joinDashE ((Opt "-e" "while ($_ = =<>) { chomp $_;"):script++[(Opt "-e" "; say $_; }")]++rest) 
     147joinDashE ((Switch 'p'):args) = joinDashE ((Opt "-e" "while ($_ = =<>) { $_ .= chomp;"):script++[(Opt "-e" "; say $_; }")]++rest) 
    148148                                 where 
    149149                                   (script,rest) = partition isDashE args 
    150150                                   isDashE (Opt "-e" _) = True 
    151151                                   isDashE (_) = False 
    152 joinDashE ((Switch 'n'):args) = joinDashE ((Opt "-e" "while ($_ = =<>) { chomp $_;"):script++[(Opt "-e" "}")]++rest) 
     152joinDashE ((Switch 'n'):args) = joinDashE ((Opt "-e" "while ($_ = =<>) { $_ .= chomp;"):script++[(Opt "-e" "}")]++rest) 
    153153                                 where 
    154154                                   (script,rest) = partition isDashE args 

  • src/perl6/Prelude/PIR.pm

    r4918 r5001  
    55sub prefix:<?> ($var) returns Bool is primitive { true $var } 
    66 
    7 sub chomp (Str $str is rw) returns Str is primitive { 
     7sub chomp (Str $str) returns Str is primitive { 
     8    # XXX return $str but newline("\n") 
    89    if substr($str, -1, 1) eq "\n" { 
    9         $str = substr $str, 0, chars($str) - 1; 
    10         "\n"; 
     10        substr $str, 0, chars($str) - 1; 
    1111    } else { 
    12         undef; 
     12        $str; 
    1313    } 
    1414} 

  • t/builtins/strings/chomp.t

    r3290 r5001  
    44use Test; 
    55 
    6 plan 10; 
     6plan 13; 
    77 
    88=pod 
    … …  
    1313 
    1414# L<S29/"Perl6::Str" /chomp/> 
     15# See http://use.perl.org/~autrijus/journal/25351, too. 
    1516 
    1617{ 
    1718    my $foo = "foo\n"; 
    1819    chomp($foo); 
     20    is($foo, "foo\n", 'our variable was not yet chomped'); 
     21    $foo .= chomp; 
    1922    is($foo, 'foo', 'our variable is chomped correctly'); 
    20     chomp($foo); 
     23    $foo .= chomp; 
    2124    is($foo, 'foo', 'our variable is chomped again with no effect'); 
    2225} 
    … …  
    2427{ 
    2528    my $foo = "foo\n\n"; 
    26     chomp($foo); 
     29    $foo .= chomp; 
    2730    is($foo, "foo\n", 'our variable is chomped correctly'); 
    28     chomp($foo); 
     31    $foo .= chomp; 
    2932    is($foo, 'foo', 'our variable is chomped again correctly'); 
    30     chomp($foo); 
     33    $foo .= chomp; 
    3134    is($foo, 'foo', 'our variable is chomped again with no effect'); 
    3235} 
    … …  
    3437{ 
    3538    my $foo = "foo\nbar\n"; 
    36     chomp($foo); 
     39    $foo .= chomp; 
    3740    is($foo, "foo\nbar", 'our variable is chomped correctly'); 
    38     chomp($foo); 
     41    $foo .= chomp; 
    3942    is($foo, "foo\nbar", 'our variable is chomped again with no effect'); 
    4043} 
    … …  
    4245{ 
    4346    my $foo = "foo\n "; 
    44     chomp($foo); 
     47    $foo .= chomp; 
    4548    is($foo, "foo\n ", 'our variable is chomped with no effect'); 
    4649} 
    … …  
    4851{ 
    4952    my $foo = "foo\n"; 
    50     my $chomped_foo = chomp($foo); 
    51     is($chomped_foo, "\n", 'chomp returns the chomped value'); 
    52     is($foo, 'foo', 'and our variable is chomped correctly');     
     53    my $chomped_foo = try { chomp($foo).newline }; 
     54    is($chomped_foo, "\n", 'chomp(...).newline returns the chomped value', :todo<feature>); 
     55    is($foo, "foo\n", 'and our variable was not chomped'); 
    5356} 
    5457 
     58{ 
     59    my $foo = "foo\n"; 
     60    $foo .= chomp; 
     61    my $chomped_foo = try { $foo.newline }; 
     62    is($chomped_foo, "\n", 'chomp(...).newline returns the chomped value', :todo<feature>); 
     63    is($foo, "foo", 'and our variable was chomped'); 
     64} 

  • t/builtins/system/01-strings-with-spaces.t

    r4546 r5001  
    185185 
    186186    my $output = slurp $outfile; 
    187     chomp $output; 
     187    $output .= chomp; 
    188188 
    189189    is($output,$expected,$name) 

  • t/magicals/pid.t

    r3722 r5001  
    2929 
    3030my $child_pid = slurp $tempfile; 
    31 chomp $child_pid; 
     31$child_pid .= chomp; 
    3232unlink $tempfile; 
    3333 

  • t/pugsrun/01-dash-uppercase-i.t

    r3722 r5001  
    6565  $command = join " ", map { qq("-I$_") } @dirs; 
    6666  my $got = run_pugs( $command ~ " $fragment" ); 
    67   chomp $got; 
     67  $got .= chomp; 
    6868 
    6969  if (substr($got,0,1) ~~ "[") { 
    … …  
    8181  $got = run_pugs( $command ~ " $fragment" ); 
    8282   
    83   chomp $got; 
     83  $got .= chomp; 
    8484  if (substr($got,0,1) ~~ "[") { 
    8585    # Convert from arrayref to array 

  • t/pugsrun/01-multiple-e.t

    r3722 r5001  
    5353my @expected = <Hello Pugs>; 
    5454my $got      = slurp $out_fn; 
    55 chomp $got; 
     55$got .= chomp; 
    5656if (substr($got,0,1) ~~ "\\") { 
    5757  $got = substr($got,1); 

  • t/pugsrun/03-dash-p.t

    r4549 r5001 </