This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix recursive substitution [test]
authorTim Bunce <Tim.Bunce@ig.co.uk>
Tue, 18 Oct 1994 16:46:27 +0000 (04:46 +1200)
committerChip Salzenberg <chip@atlantic.net>
Thu, 15 May 1997 22:15:00 +0000 (10:15 +1200)
t/op/subst.t

index 0f554b6..b2332b8 100755 (executable)
@@ -2,7 +2,7 @@
 
 # $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $
 
-print "1..56\n";
+print "1..60\n";
 
 $x = 'foo';
 $_ = "x";
@@ -198,3 +198,34 @@ print $_ eq 'a,/' ? "ok 55\n" : "not ok 55\n";
 $_ = '+,-';
 tr/-+,/ab\-/;
 print $_ eq 'b-a' ? "ok 56\n" : "not ok 56\n";
+
+
+# test recursive substitutions
+# code based on the recursive expansion of makefile variables
+
+my %MK = (
+    AAAAA => '$(B)', B=>'$(C)', C => 'D',                      # long->short
+    E     => '$(F)', F=>'p $(G) q', G => 'HHHHH',      # short->long
+    DIR => '$(UNDEFINEDNAME)/xxx',
+);
+sub var { 
+    my($var,$level) = @_;
+    return "\$($var)" unless exists $MK{$var};
+    return exp_vars($MK{$var}, $level+1); # can recurse
+}
+sub exp_vars { 
+    my($str,$level) = @_;
+    $str =~ s/\$\((\w+)\)/var($1, $level+1)/ge; # can recurse
+    #warn "exp_vars $level = '$str'\n";
+    $str;
+}
+
+print exp_vars('$(AAAAA)',0)           eq 'D'
+       ? "ok 57\n" : "not ok 57\n";
+print exp_vars('$(E)',0)               eq 'p HHHHH q'
+       ? "ok 58\n" : "not ok 58\n";
+print exp_vars('$(DIR)',0)             eq '$(UNDEFINEDNAME)/xxx'
+       ? "ok 59\n" : "not ok 59\n";
+print exp_vars('foo $(DIR)/yyy bar',0) eq 'foo $(UNDEFINEDNAME)/xxx/yyy bar'
+       ? "ok 60\n" : "not ok 60\n";
+