Author: sparky
Date: Fri Dec  3 22:21:39 2010
New Revision: 11941

Modified:
   toys/rsget.pl/RSGet/Plugin.pm
   toys/rsget.pl/RSGet/Processor.pm
Log:
- add line information to generated plugins - finally some meaningful warnings


Modified: toys/rsget.pl/RSGet/Plugin.pm
==============================================================================
--- toys/rsget.pl/RSGet/Plugin.pm       (original)
+++ toys/rsget.pl/RSGet/Plugin.pm       Fri Dec  3 22:21:39 2010
@@ -31,8 +31,10 @@
        );
        my $parts = join "|", keys %parts;
 
+       my $line = 0;
        my $part;
        while ( <F_IN> ) {
+               $line++;
                chomp;
                next if /^\s*#/;
                next if /^\s*$/;
@@ -58,6 +60,7 @@
        }
 
        while ( <F_IN> ) {
+               $line++;
                chomp;
                next if /^\s*#/;
                next if /^\s*$/;
@@ -65,13 +68,12 @@
                if ( /^($parts)\s*:/ ) {
                        $part = $1;
                        if ( $part eq "perl" ) {
-                               my @perl = <F_IN>;
-                               $parts{perl} = \...@perl;
+                               push @{ $parts{perl} }, ( qq(#line $line 
"$self->{file} [perl]"), <F_IN> );
                        }
                        next;
                }
 
-               push @{ $parts{ $part } }, $_;
+               push @{ $parts{ $part } }, ( qq(#line $line "$self->{file} 
[$part]"), $_ );
        }
 
        close F_IN;

Modified: toys/rsget.pl/RSGet/Processor.pm
==============================================================================
--- toys/rsget.pl/RSGet/Processor.pm    (original)
+++ toys/rsget.pl/RSGet/Processor.pm    Fri Dec  3 22:21:39 2010
@@ -78,6 +78,7 @@
 
        my $unify_body = ( join "\n", @{ $parts->{unify} } ) || 's/#.*//; 
s{/$}{};';
 
+       pr qq(#line 1 "$opts->{pkg} preamble"\n);
        pr "package $opts->{pkg};\n\n";
        pr <<'EOF';
        use strict;
@@ -100,6 +101,11 @@
        p_sub( "stage0" );
        my @machine = @{ $parts->{start} };
        while ( $_ = shift @machine ) {
+               if ( /^#line/ ) {
+                       pr $_ . "\n";
+                       next;
+               }
+
                $space = "";
                $space = $1 if s/^(\s+)//;
 
@@ -163,7 +169,7 @@
        pr @{$parts->{perl}};
 
        pr "\npackage $opts->{pkg};\n";
-       pr "sub unify { local \$_ = shift; $unify_body;\nreturn \$_;\n};\n";
+       pr "sub unify { local \$_ = shift;\n$unify_body;\nreturn \$_;\n};\n";
        pr '\&unify;';
 
        my $unify = eval_it( $processed );
_______________________________________________
pld-cvs-commit mailing list
pld-cvs-commit@lists.pld-linux.org
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit

Reply via email to