This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Auto-insert defined() test in while when test expression is
authorNick Ing-Simmons <nik@tiuk.ti.com>
Sat, 25 Apr 1998 13:58:17 +0000 (13:58 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Sat, 25 Apr 1998 13:58:17 +0000 (13:58 +0000)
readline (i.e. <>), glob, readdir, or each.

p4raw-id: //depot/ansiperl@900

op.c
pod/perlop.pod
t/op/defins.t [new file with mode: 0755]

diff --git a/op.c b/op.c
index 7459ae6..2dd64f8 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2669,7 +2669,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
        case OP_NULL:
            if (k2 && k2->op_type == OP_READLINE
                  && (k2->op_flags & OPf_STACKED)
-                 && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
+                 && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
                warnop = k2->op_type;
            break;
 
@@ -2831,8 +2831,26 @@ newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
            || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
            expr = newUNOP(OP_DEFINED, 0,
                newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+       } else if (expr->op_flags & OPf_KIDS) {
+           OP *k1 = ((UNOP*)expr)->op_first;
+           OP *k2 = (k1) ? k1->op_sibling : NULL;
+           switch (expr->op_type) {
+             case OP_NULL: 
+               if (k2 && k2->op_type == OP_READLINE
+                     && (k2->op_flags & OPf_STACKED)
+                     && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
+                   expr = newUNOP(OP_DEFINED, 0, expr);
+               break;                                
+
+             case OP_SASSIGN:
+               if (k1->op_type == OP_READDIR
+                     || k1->op_type == OP_GLOB
+                     || k1->op_type == OP_EACH)
+                   expr = newUNOP(OP_DEFINED, 0, expr);
+               break;
+           }
        }
-    }
+    }           
 
     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
     o = new_logop(OP_AND, 0, &expr, &listop);
@@ -2866,8 +2884,27 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
                 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
        expr = newUNOP(OP_DEFINED, 0,
            newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+    } else if (expr && (expr->op_flags & OPf_KIDS)) {
+       OP *k1 = ((UNOP*)expr)->op_first;
+       OP *k2 = (k1) ? k1->op_sibling : NULL;
+       switch (expr->op_type) {
+         case OP_NULL: 
+           if (k2 && k2->op_type == OP_READLINE
+                 && (k2->op_flags & OPf_STACKED)
+                 && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
+               expr = newUNOP(OP_DEFINED, 0, expr);
+           break;                                
+
+         case OP_SASSIGN:
+           if (k1->op_type == OP_READDIR
+                 || k1->op_type == OP_GLOB
+                 || k1->op_type == OP_EACH)
+               expr = newUNOP(OP_DEFINED, 0, expr);
+           break;
+       }
     }
 
+
     if (!block)
        block = newOP(OP_NULL, 0);
 
index 5d1aae7..e8818f7 100644 (file)
@@ -1054,17 +1054,35 @@ Ordinarily you must assign that value to a variable, but there is one
 situation where an automatic assignment happens.  I<If and ONLY if> the
 input symbol is the only thing inside the conditional of a C<while> or
 C<for(;;)> loop, the value is automatically assigned to the variable
-C<$_>.  The assigned value is then tested to see if it is defined.
-(This may seem like an odd thing to you, but you'll use the construct
-in almost every Perl script you write.)  Anyway, the following lines
-are equivalent to each other:
+C<$_>.  In these loop constructs, the assigned value (whether assignment
+is automatic or explcit) is then tested to see if it is defined.
+The defined test avoids problems where line has a string value
+that would be treated as false by perl e.g. "" or "0" with no trailing
+newline. (This may seem like an odd thing to you, but you'll use the 
+construct in almost every Perl script you write.) Anyway, the following 
+lines are equivalent to each other:
 
     while (defined($_ = <STDIN>)) { print; }
+    while ($_ = <STDIN>) { print; }
     while (<STDIN>) { print; }
     for (;<STDIN>;) { print; }
     print while defined($_ = <STDIN>);
+    print while ($_ = <STDIN>);
     print while <STDIN>;
 
+and this also behaves similarly, but avoids the use of $_ :
+
+    while (my $line = <STDIN>) { print $line }    
+
+If you really mean such values to terminate the loop they should be 
+tested for explcitly:
+
+    while (($_ = <STDIN>) ne '0') { ... }
+    while (<STDIN>) { last unless $_; ... }
+
+In other boolean contexts C<E<lt>I<filehandle>E<gt>> without explcit C<defined>
+test or comparison will solicit a warning if C<-w> is in effect.
+
 The filehandles STDIN, STDOUT, and STDERR are predefined.  (The
 filehandles C<stdin>, C<stdout>, and C<stderr> will also work except in
 packages, where they would be interpreted as local identifiers rather
@@ -1124,9 +1142,9 @@ Getopts modules or put a loop on the front like this:
        ...             # code for each line
     }
 
-The E<lt>E<gt> symbol will return FALSE only once.  If you call it again after
-this it will assume you are processing another @ARGV list, and if you
-haven't set @ARGV, will input from STDIN.
+The E<lt>E<gt> symbol will return C<undef> for end-of-file only once.  
+If you call it again after this it will assume you are processing another 
+@ARGV list, and if you haven't set @ARGV, will input from STDIN.
 
 If the string inside the angle brackets is a reference to a scalar
 variable (e.g., E<lt>$fooE<gt>), then that variable contains the name of the
@@ -1174,9 +1192,12 @@ A glob evaluates its (embedded) argument only when it is starting a new
 list.  All values must be read before it will start over.  In a list
 context this isn't important, because you automatically get them all
 anyway.  In a scalar context, however, the operator returns the next value
-each time it is called, or a FALSE value if you've just run out.  Again,
-FALSE is returned only once.  So if you're expecting a single value from
-a glob, it is much better to say
+each time it is called, or a C<undef> value if you've just run out. As
+for filehandles an automatic C<defined> is generated when the glob
+occurs in the test part of a C<while> or C<for> - because legal glob returns
+(e.g. a file called F<0>) would otherwise terminate the loop.
+Again, C<undef> is returned only once.  So if you're expecting a single value 
+from a glob, it is much better to say
 
     ($file) = <blurch*>;
 
diff --git a/t/op/defins.t b/t/op/defins.t
new file mode 100755 (executable)
index 0000000..5dd614d
--- /dev/null
@@ -0,0 +1,144 @@
+#!./perl -w
+
+#
+# test auto defined() test insertion
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $SIG{__WARN__} = sub { $warns++; warn $_[0] };
+    print "1..14\n";
+}
+    
+print "not " if $warns;
+print "ok 1\n";
+
+open(FILE,">./0");
+print FILE "1\n";
+print FILE "0";
+close(FILE);
+
+open(FILE,"<./0");
+my $seen = 0;
+my $dummy;
+while (my $name = <FILE>)
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 2\n";
+
+seek(FILE,0,0);
+$seen = 0;
+my $line = '';
+do 
+ {
+  $seen++ if $line eq '0';
+ } while ($line = <FILE>);
+
+print "not " unless $seen;
+print "ok 3\n";
+
+
+seek(FILE,0,0);
+$seen = 0;    
+while (($seen ? $dummy : $name) = <FILE>)
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 4\n";
+
+seek(FILE,0,0);
+$seen = 0;    
+my %where;    
+while ($where{$seen} = <FILE>)
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 5\n";
+
+opendir(DIR,'.');
+$seen = 0;
+while (my $name = readdir(DIR))
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 6\n";
+
+rewinddir(DIR);
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = readdir(DIR))
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 7\n";
+
+rewinddir(DIR);
+$seen = 0;    
+while ($where{$seen} = readdir(DIR))
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 8\n";
+
+$seen = 0;
+while (my $name = glob('*'))
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 9\n";
+
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = glob('*'))
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 10\n";
+
+$seen = 0;    
+while ($where{$seen} = glob('*'))
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 11\n";
+
+unlink("./0");
+
+my %hash = (0 => 1, 1 => 2);
+
+$seen = 0;
+while (my $name = each %hash)
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 12\n";
+
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = each %hash)
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 13\n";
+
+$seen = 0;    
+while ($where{$seen} = each %hash)
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 14\n";
+