diff options
author | schnetter <schnetter@17b73243-c579-4c4c-a9d2-2d5706c11dac> | 2004-01-19 14:50:51 +0000 |
---|---|---|
committer | schnetter <schnetter@17b73243-c579-4c4c-a9d2-2d5706c11dac> | 2004-01-19 14:50:51 +0000 |
commit | 1fd1c9e06006a4a96e97afca588dd73e02bdd314 (patch) | |
tree | ab011183c22c83cdaa962b29bf3a4cee076d0da5 /lib/sbin/f_file_processor.pl | |
parent | 6b159579c63e41bcc1ed9e34b91efe753886060c (diff) |
Make error messages and debug information point to the real source
file instead of the preprocessed file. The options C_LINE_DIRECTIVES
and F_LINE_DIRECTIVES control this behaviour.
git-svn-id: http://svn.cactuscode.org/flesh/trunk@3527 17b73243-c579-4c4c-a9d2-2d5706c11dac
Diffstat (limited to 'lib/sbin/f_file_processor.pl')
-rw-r--r-- | lib/sbin/f_file_processor.pl | 191 |
1 files changed, 105 insertions, 86 deletions
diff --git a/lib/sbin/f_file_processor.pl b/lib/sbin/f_file_processor.pl index acd9431a..c19fea67 100644 --- a/lib/sbin/f_file_processor.pl +++ b/lib/sbin/f_file_processor.pl @@ -20,26 +20,14 @@ # line splitting. # # @enddesc -# @history -# @hdate Wed Apr 21 1997 @hauthor Joan Masso -# @hdesc get rid of cC comments and handle ! comments properly -# and fix it so now it is really 72 and we do not get -# breaks in the middle of fortran strings! -# @hdate Wed Nov 24 12:17:43 1999 @hauthor Tom Goodale -# @hdesc Added in Erik Schnetters free-format stuff -# grdoc-ed -# reformated as per rest of perl code in Cactus. -# @endhistory -# @hdate Fri 5 December 2003 -# @hauthor Thomas Radke -# @hdesc Added Fokke Dijkstra's patch to properly deal with comments in lines -# with strings -# @endhistory # @version $Header$ #@@*/ $MULTILINE_MATCHING = 1; # Multi-line is on! +# Do we want line directives? +$line_directives = $line_directives eq 'yes'; + # Pick the correct set of comments to remove. if ($free_format) { @@ -51,42 +39,55 @@ else } # Loop over all lines. +$line = 1; +$file = "$source_file_name"; +$autoline = 1; +$autofile = ""; while (<>) { # Get rid of final \n chomp; - # concatenate lines if \ at end-of-line - while (/\\$/) + # Handle directives + if (/^\#/) { - chop; # drop the backslash - chomp($_ .= <STDIN>); # concatenate the following line (sans \n) + if ($line_directives) + { + # Handle line directives + if (/^\#\s*(\d+)\s*"([^"]*)"/) + { + $line = $1; + $file = $2; + } else { + ++$line; + } + next; + } + else + { + # Ignore directives + next; + } } - next if (/^\s*$/); # Blank lines slow down compilation, - # and on some systems cpp makes ++lots of them - - next if (/^\#/); # Remove any remaining # directives (e.g. line directives). - # Get rid of any tabs s/\t/ /g; - # Chop fortran comments to 72 columns (they stay in code) + # Chop Fortran comments to 132 columns (they stay in code) # removing any quotes # (standard c C, or even ! comments) if (/^$standard_comments.*$/) { # Remove quotes s/['"]//g; - if (/(.{132,132}).*/) + if (/(.{132,132})/) { - print $1; + &printline ($1); } else { - print; + &printline ($_); } - print "\n"; } else { @@ -133,28 +134,26 @@ while (<>) } } - # OK, now put in the line breaks (&& or &!) - s/\&\&\s*/\n /g; - s/\&\!\s*/\n/g; + # Get rid of trailing blanks + s/\s*$//; - # Get rid of lonesome semicolons - s/\s*\;\s*$//; - - # And now we can fix the lines. This is actually a little complicated. - # since there is a different case if the thing matches a newline - # than if it doesn't. - if (/\n/) + # Put in the line breaks (&&) + if($free_format) { - foreach $LINE (split('\n',$_)) - { - &splitline($LINE); - } + s/\s*\&\&\s*/\n /g; } else { - &splitline($_); + s/\s*\&\&\s*/\n /g; + } + + foreach my $LINE (split('\n',$_)) + { + &splitline($LINE); } } + + ++$line; } #/*@@ @@ -167,15 +166,15 @@ while (<>) #@@*/ sub splitline { - my ($line) = @_; + my ($LINE) = @_; if($free_format) { - &free_format_splitline($line); + &free_format_splitline($LINE); } else { - &fixed_format_splitline($line); + &fixed_format_splitline($LINE); } } @@ -192,27 +191,21 @@ sub fixed_format_splitline { my ($LINE) = @_; - # Remove ,, and , \) from blank thorns - while ($LINE =~ s/,\s*,/,/) {}; - $LINE =~ s/,\s*\)/\)/; - - # Strip out leading spaces in favor of 7 spaces - # $LINE =~ s/^\s+/ /; # Note the new treatement of comments with \S - if ($LINE =~ /^([^\S].{71,71}).*/) + if ($LINE =~ /^([^\S].{71,71})/) { - print "$1\n"; + &printline ($1); $LINE =~ s/.{72,72}//; - while ($LINE =~ /^(.{66,66}).*/) + while ($LINE =~ /^(.{66,66})/) { - print " &$1\n"; + &printline (" &$1"); $LINE =~ s/.{66,66}//; } - print " &$LINE\n"; + &printline (" &$LINE"); } else { - print "$LINE\n"; + &printline ($LINE); } } @@ -222,7 +215,7 @@ sub fixed_format_splitline # @date Thu Sep 30 12:05:36 1999 # @author Erik Schnetter # @desc -# Splits lines for freeformat fortran 90. +# Splits lines for free-format Fortran 90. # @enddesc #@@*/ sub free_format_splitline @@ -230,43 +223,69 @@ sub free_format_splitline my ($LINE) = @_; my $OUT; - # Remove ,, and , \) from blank thorns - while ($LINE =~ s/,\s*,/,/) {}; - $LINE =~ s/,\s*\)/\)/; - - # Remove trailing spaces - $LINE =~ s/\s*$//; - $LINE =~ s/\s*\&$/\&/; - - # Some preprocessors put extraneous spaces in 8-( - $LINE =~ s:\. ([a-zA-Z]+) \.:\.$1\.:ig; - - # Strip out leading spaces in favor of 3 spaces - # $LINE =~ s/^\s+/ /; - if ($LINE =~ /^(.{78,78})...*/) + if ($LINE =~ /^(.{78,78})../) { $OUT = $1; - print "$OUT"; # Check if the line already has a continuation mark. - print "&" if (! ($OUT =~ /\&[\s]*$/)); - print "\n"; + $OUT = "$OUT&" if (! ($OUT =~ /\&\s*$/)); + &printline ($OUT); $LINE =~ s/.{78,78}//; - while ($LINE =~ /^(.{75,75}).*/) + while ($LINE =~ /^(.{76,76})/) { - $LINE =~ /^(.{74,74}).*/; + $LINE =~ /^(.{75,75})/; $OUT = $1; - print " &" if (! ($OUT =~ /^[\s]*\&/)); - print "$OUT"; - print "&" if (! ($OUT =~ /\&[\s]*$/)); - print "\n"; - $LINE =~ s/.{74,74}//; + $OUT = " &$OUT" if (! ($OUT =~ /^\s*\&/)); + $OUT = "$OUT&" if (! ($OUT =~ /\&\s*$/)); + &printline ($OUT); + $LINE =~ s/.{75,75}//; + } + if ($LINE =~ /^\s*\&\s*$/) + { + &printline (" &$LINE"); + } + else + { + $OUT = $LINE; + $OUT = " &$OUT" if (! ($LINE =~ /^\s*\&/)); + &printline ($OUT); } - print " &" if (! ($LINE =~ /^[\s]*\&/)); - print "$LINE\n" if (! ($LINE =~ /^[\s]*\&[\s]*$/)); } else { + &printline ($LINE); + } +} + + + +# Print a line and append a newline +# Emit line number and file name directives if necessary +sub printline +{ + my ($LINE) = @_; + + if ($LINE eq '') { + # don't print empty lines + } else { + if ($line_directives) { + if ($file ne $autofile) { + print "# $line \"$file\"\n"; + $autoline = $line; + $autofile = $file; + } elsif ($line ne $autoline) { + if ($line>$autoline && $line<=$autoline+3) { + while ($autoline!=$line) { + print "\n"; + ++$autoline; + } + } else { + print "# $line\n"; + $autoline = $line; + } + } + } print "$LINE\n"; + ++$autoline; } } |