Added a script to generate template doxygen headers from existing

fortran code, respecting already existing comments (Fiona Reid)


svn-origin-rev: 14084
This commit is contained in:
Iain Bethune 2014-06-16 15:11:57 +00:00
parent 4c3b374e4f
commit 84d13c5001
6 changed files with 766 additions and 0 deletions

View file

@ -21,6 +21,7 @@ MAINEXEDIR := $(CP2KHOME)/exe
MAINLIBDIR := $(CP2KHOME)/lib
MAINOBJDIR := $(CP2KHOME)/obj
PRETTYOBJDIR := $(CP2KHOME)/obj/prettified
DOXYIFYOBJDIR := $(CP2KHOME)/obj/doxyified
INSTANTIATEDDIR := $(CP2KHOME)/obj/instantiated
TOOLSRC := $(CP2KHOME)/tools
SRCDIR := $(CP2KHOME)/src
@ -49,6 +50,7 @@ endif
# Declare PHONY targets =====================================================
.PHONY : $(VERSION) $(EXE_NAMES) \
dirs makedep default_target all \
doxyifydir doxyify doxyifyclean \
prettydir pretty prettyclean doxygen/clean doxygen \
install clean realclean distclean mrproper help templates instantiationdir templatesclean
@ -221,6 +223,25 @@ $(PRETTYOBJDIR)/%.pretty: %.c
# TODO: call indent here?
@touch $@
# Doxyifier stuff ===========================================================
vpath %.doxyified $(DOXYIFYOBJDIR)
doxyifydir:
@mkdir -p $(DOXYIFYOBJDIR)
doxyify: doxyifydir $(addprefix $(DOXYIFYOBJDIR)/, $(ALL_OBJECTS:.o=.doxyified))
TOOL_HELP += "doxyify : Autogenerate doxygen headers for subroutines"
doxyifyclean:
-rm -rf $(DOXYIFYOBJDIR)
TOOL_HELP += "doxyifyclean : Remove doxyify marker files"
$(DOXYIFYOBJDIR)/%.doxyified: %.F
$(TOOLSRC)/doxyify/doxyify.sh $<
@touch $@
$(DOXYIFYOBJDIR)/%.doxyified: %.c
@touch $@
# doxygen stuff =============================================================
doxygen/clean:

138
tools/doxyify/README Normal file
View file

@ -0,0 +1,138 @@
This file describes the scripts used to add missing comments and parse existing comments
for subroutines and functions in CP2K. The objective of the script(s) is to ensure that
all subroutines and functions in CP2K have a standard DOXYGEN comment block and to flag
any missing comments such that the CP2K developers can add/update these when time is
available.
The driver script doxyify.sh will process CP2K source code (*.F files) files
processing one file at a time. The following steps are carried out for each *.F file:
1. Run remove_double_ampersands.pl - removes any any double ampersand characters
2. Run fixcomments.pl - does the addition of missing comments or updating of existing comments
3. Run remove_extra_comments.pl - removes any extra comment lines which arise from application
of fixcomments.pl
4. Finally, overwrite the original *.F file with the updated version
To run the script you should execute it with the name of the source file you want to
process or a list of files e.g.
./doxyify.sh full_path_to_cp2k_src/myfile.F # Processes one file
./doxyify.sh full_path_to_cp2k_src/myfile.F full_path_to_cp2k_src/myfile2.F full_path_to_cp2k_src/myfile2.F # Processes multiple files
In debug mode, the script will produce a lot of output if the whole source tree is processed so you may
wish to redirect the stdout to file, e.g.
./doxyify.sh > comments.txt
*******************************
* remove_double_ampersands.pl *
*******************************
Removes any double ampersand characters that occur at the end of one line and the start of
the next line, e.g:
SUBROUTINE fred(a,b, &
& c,d)
becomes
SUBROUTINE fred(a,b, &
c,d)
This is performed throughout the source code and is necessary as the ampersand is used
by fixcomments.pl to determine whether a subroutine/function definition extends across
multiple lines.
******************
* fixcomments.pl *
******************
The script adds in missing comments and parses existing comments checking whether any data
is missing. For procedures with no existing comments, e.g. a subroutine with 3 arguments a, b
and c:
SUBROUTINE fred (a,b,c)
will be updated to (the ... are to indicate comments are required)
! *****************************************************************************
!> \brief ...
!> \param a ...
!> \param b ...
!> \param c ...
! *****************************************************************************
SUBROUTINE fred (a,b,c)
The scripts works as follows.
We read through the source file until we see a comment block e.g. something beginning
with !>
We then loop over the comment block looking for entries for \brief, \param, \date,
\par, \version and \note and \author. If any of these items exist we store the details
in separate variables. We also keep a copy of the entire comment block in the oldheader
variable as we need to print the comment block out unchanged for MODULE and TYPE. When
parsing the header we ensure that we don't throw any text away.
Once the comment block has been read in we continue reading in the code line by line.
If we don't encounter any procedures then the output file will be identical to the
input file.
However, if we encounter a procedure we then read in the line(s) containing the
definition, e.g.
SUBROUTINE fred(a,b,c)
to an array called @string. We do this by splitting over space, comma, brackets etc. We
also take into account of the fact a subroutine / function definition can extend over multiple
lines via the ampersand (&) character and ampersand variable. The @string array then contains
the type of procedure, its name and the arguments, e.g. for the example above @string would
contain 5 elements: SUBROUTINE, fred, a, b, c.
Once we know the name and arguments of the procedure we loop over the arguments checking
to see whether the comment block contained a match. If it is does we use the existing text,
if no match is found then the standard text detailed above is output. We also check whether
any text exists for the \brief entry and re-use this if available, otherwise the \brief ...
text is added as detailed above. The script can also handle \date, \par, \author, \note and
\version entries if these should be required in future. At present these entries are copied
across unchanged if they exist and otherwise they are not added in.
Finally anything else that was found in the comment block is output and suitably annotated.
For example unmatched procedure arguments are flagged up, lines which begin with !> , !, or
!> \something_or_other are also annotated.
The annotations used for marking up the comment block are as follows:
... Added to \brief and \param only if no existing information is available. Other
commonly occurring entries such as \par, \author, \version, \note and \date if they exist
are passed through unchanged.
UNMATCHED_PROCEDURE_ARGUMENT - gets appended on to any procedure arguments in the comment block
that don't match those in the procedure definition.
UNKNOWN_DOXYGEN_COMMENT - for parts of the comment block which look like a standard Doxygen
block (e.g. lines that look like: "!> \something or other") but not part of the standard
header above.
UNKNOWN_COMMENT - lines that begin !> or ! inside the comment block. These get placed into
a !> \note with UNKNOWN_COMMENT added at the start of the line.
The script also includes checks to ensure that the annotations are not added to a line
multiple times.
****************************
* remove_extra_comments.pl *
****************************
Post-processing script to remove any double lines which begin ! ******
e.g.
! *****************************************************************************
! *****************************************************************************
gets changed to
! *****************************************************************************
This is necessary because occasionally a procedure may be missing the start
or end ! **** line or may have a duplicate one.

59
tools/doxyify/doxyify.sh Executable file
View file

@ -0,0 +1,59 @@
#!/bin/bash
export DEBUG=0 # Set to 0 for no debugging, 1 for debugging
SCRIPTDIR=$(cd $(dirname "$0"); pwd) # Pick up full path to scripts from wherever doxyify.sh lives
for file in "$@"
do
# First apply the pre-processing script to get rid of any double & type lines
if [ $DEBUG == 1 ]
then
$SCRIPTDIR/remove_double_ampersands.pl $file $file.preprocessed 1
else
$SCRIPTDIR/remove_double_ampersands.pl $file $file.preprocessed
fi
# Run the fixcomments.pl script. This adds comment blocks to any subroutine/function
# definitions that don't have any and checks that existing comments are complete,
# fixing these if required.
if [ $DEBUG == 1 ]
then
$SCRIPTDIR/fixcomments.pl $file.preprocessed $file.tmp 1
else
$SCRIPTDIR/fixcomments.pl $file.preprocessed $file.tmp
fi
# After adding comments, remove any double comment header lines
if [ $DEBUG == 1 ]
then
$SCRIPTDIR/remove_extra_comments.pl $file.tmp $file.new 1
else
$SCRIPTDIR/remove_extra_comments.pl $file.tmp $file.new
fi
# DEBUG: dump difference of original and final commented file into diffs.txt so we
# can look at what was changed. Used for debugging and can probably be omitted for
# the final version
# Also runs tkdiff. You only want to run tkdiff on a small number of files
# Change the path to location of tkdiff on your system.
if [ $DEBUG == 1 ]
then
echo "Diff for file $file" >> diffs.txt
diff $file.preprocessed $file.new >> diffs.txt
echo " " >> $diffs.txt
cp $file $file.orig # copy original input to *.orig as and tkdiff this
/Applications/TkDiff.app/Contents/MacOS/tkdiff $file.orig $file &
fi
# Copy the final modified source file on top of the original file
cp $file.new $file
# Remove any uneeded output files
rm -f $file.tmp $file.preprocessed $file.new
if [ $DEBUG == 0 ] # We only remove .orig file if Tkdiff is not used
then
rm -f $file.orig
fi
done

430
tools/doxyify/fixcomments.pl Executable file
View file

@ -0,0 +1,430 @@
#!/usr/bin/env perl
# Script to add the missing comments to CP2K
# We want to be able to add comment blocks to FUNCTION, SUBROUTINE and possibly later on
# MODULE and TYPE.
$DEBUG=$ARGV[2];
if ($DEBUG eq 1) {
print "fixcomments.pl running with INPUT & OUTPUT = ";
print $ARGV[0];
print " ";
print $ARGV[1];
print "\n";
}
open ($INPUT , "<" , $ARGV[0]) or die "Cant open $ARGV[0] $!";
open ($OUTPUT , ">" , $ARGV[1]) or die "Cant create $ARGV[1] $!";
# Initialise toggles to 0 and ensure that the header data is defined globally. If you initialise inside { } then the
# variables are only in scope inside the { }
# param = toggle for whether header contains any data in the \param fields (function or subroutine arguments)
# brief = toggle " " " " " " " " \brief field (description of routine)
# par = toggle " " " " " " " " \par field (history entry)
# version = toggle " " " " " " " " \version field (code version)
# date = toggle " " " " " " " " \date field (date)
# author = toggle " " " " " " " " \author field (author)
# note = toggle " " " " " " " " \note field (notes)
# random = toggle " " " " " " " " random field - text that has a preceeding \ but isn't in our standard header e.g. \version
# remainder = toggle " " " " " " " " remainder field - anything else in the comment block that doesn't have a preceeding \
# ampersand = Variable used to specifiy if the SUBROUTINE/FUNCTION definition contains an &
# insideinterface - determines whether we are in an interface block or not
$param=0;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=0;
$note=0;
$random=0;
$remainder=0;
$ampersand = 0;
$insideinterface=0;
# Variables with s at the end contains the actual text read in from header
%$params = ();
%$matched = ();
$briefs="";
$dates="";
$versions="";
$pars="";
$authors="";
$notes="";
$randoms="";
$remainders="";
$buffer=""; # Used to buffer data
$oldheader=""; # Variable to keep a copy of the old header e.g. for MODULE and TYPE where we just read it in and dump it back out again.
while (<$INPUT>) # While there are still lines to read in our INPUT file
{
$currline = $_; # currline = the line we've just read in
# We've found a procedure header so split it up - starts with !> (^ makes it match from the start, i.e. first column)
if ($currline =~ m/^!>/i) {
# Each time we find a header we need to reset the toggles to 0 and reset their data values
$param=0;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=0;
$note=0;
$random=0;
$remainder=0;
undef %params;
undef %matched;
$briefs="";
$dates="";
$versions="";
$pars="";
$authors="";
$notes="";
$buffer="";
$randoms="";
$remainders="";
$oldheader="";
do {
$oldheader = $oldheader . $currline; # Keep the headers safe, may need them! We use the oldheader variable to
# keep the complete headers for MODULE and TYPE intact such that we
# can just dump them straight back out without making any changes.
# Pick up parameters - matches the word param separated by spaces
if ($currline =~ m/\s*\\param\s+(\S+)\s*/) {
$paramtype = $1; # Contains the param name
if (exists $params{$paramtype}){ # Covers the case where two arguments have the same name
$paramtype=$paramtype . "new";
}
$params{$paramtype}=$currline; # Stores the param into a hash indexed by its name
$matched{$paramtype}=0; # Set matched for this paramtype to zero as we don't have a match in the argument list - yet
$param=1;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=0;
$note=0;
$random=0;
$remainder=0;
}
elsif ($currline =~ m/\s*\\brief\s*/) {
$briefs=$briefs . $currline;
$param=0;
$brief=1;
$par=0;
$date=0;
$version=0;
$author=0;
$note=0;
$random=0;
$remainder=0;
}
elsif ($currline =~ m/\s*\\date*/) {
$dates=$dates . $currline;
$param=0;
$brief=0;
$par=0;
$date=1;
$version=0;
$author=0;
$note=0;
$random=0;
$remainder=0;
}
elsif ($currline =~ m/\s*\\version\s*/) {
$versions=$versions . $currline;
$param=0;
$brief=0;
$par=0;
$date=0;
$version=1;
$author=0;
$note=0;
$random=0;
$remainder=0;
}
elsif ($currline =~ m/\s*\\par\s*/) {
$pars=$pars . $currline;
$param=0;
$brief=0;
$par=1;
$date=0;
$version=0;
$author=0;
$random=0;
$remainder=0;
}
elsif ($currline =~ m/\s*\\author\s*/) {
$authors=$authors . $currline;
$param=0;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=1;
$note=0;
$random=0;
$remainder=0;
}
elsif ($currline =~ m/\s*\\note\s*/) {
$notes=$notes . $currline;
$param=0;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=0;
$note=1;
$random=0;
$remainder=0;
}
elsif ( ($currline =~ m/!>\s*\\\S+/) ) { # randoms contains anything else that looks like a DOXYGEN header. with a \whatever
if (($currline !~ m/UNKNOWN_DOXYGEN_COMMENT/) && ($currline !~ m/UNKNOWN_COMMENT/) && ($currline !~ m/!>\s*\\param\s*\n/) ) { # Must check to see if line has already been commented. We also avoid commenting a blank \param line
$randoms=$randoms . $currline;
chomp($randoms);
$randoms=$randoms . " UNKNOWN_DOXYGEN_COMMENT\n"; # Add on text for output
} else {
$randoms=$randoms . $currline; # Otherwise just add to randoms
}
$param=0;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=0;
$note=0;
$random=1;
$remainder=0;
}
# Handle multi line entries. Append what you find onto the previous one read in until you get to
# another \
# The \brief \param, \par, \author random and remainder entries can all be multi-line.
# The \version and \date entries should be single line and thus we don't have an elsif for them.
elsif ($currline =~ m/^!>\s*/){ # Added a * to the \s in case of missing space in the header entry
if ($param==1){
$params{$paramtype}=$params{$paramtype} . $currline;
}
elsif ($brief==1){
$briefs=$briefs . $currline;
}
elsif ($par==1){
$pars=$pars . $currline;
}
elsif ($author==1){
$authors=$authors . $currline;
}
elsif ($note==1){
$notes=$notes . $currline;
}
elsif ($random==1){
if (($currline !~ m/UNKNOWN_DOXYGEN_COMMENT/) && ($currline !~ m/UNKNOWN_COMMENT/) ) { # Must check to see if line has already been commented
$randoms=$randoms . $currline;
chomp($randoms);
$randoms=$randoms . " UNKNOWN_DOXYGEN_COMMENT\n"; # Add on text for output
} else {
$randoms=$randoms . $currline;
}
} else { # Get any header lines beginning with "!> some text but no \ thus not in DOXYGEN format
$remainder=1;
if ( ($currline !~ m/UNKNOWN_COMMENT/) && ($currline !~ m/!>\s*\n/) ) { # Must check to see if the line has already been commented and also that it's not empty
$currline =~ s/!>/!> \\note UNKNOWN_COMMENT /g; # Add on text for output
$remainders=$remainders . $currline;
} else {
$remainders=$remainders . $currline;
}
}
}
elsif (($currline !~ m/^!\s*\*/) && ($brief==1)) { # If there is more text in the \brief entry that begins with a ! and not !> then make sure this is added on too.
$currline =~ s/!/!>/; # Make sure the line starts with !>
$briefs=$briefs . $currline;
}
elsif ($currline !~ m/^!\s*\*/) { # Finally pick up anything else in header thats not a *** line e.g. a line beginning "! some comment or other"
$currline =~ s/^\s+//;
if ($currline !~ m/UNKNOWN_COMMENT/) { # Must check to see if line has already been commented
$currline =~ s/!/!> \\note UNKNOWN_COMMENT /g; # Add on text for output
$remainders=$remainders . $currline;
} else {
$remainders=$remainders . $currline;
}
}
$currline = <$INPUT>; # Get the next line in the comment block
} while ($currline =~ m/^\s*!/i); # Rule as to when you have finished a header. Currently Anything beginning with !
} # End of if ($currline =~ m/^!>/i) block
# End of header processing
# Are we inside an interface block - if so we don't want to add any comments here - also allows for blank spaces.
if ( $currline =~ m/^\s*INTERFACE\s*\n/ ){
$insideinterface=1;
}
if ( $currline =~ m/^\s*END\s+INTERFACE\s*\n/ ){
$insideinterface=0;
}
if ( ((($currline =~ m/(SUBROUTINE|FUNCTION)\s+\w+\s*\(/ && $currline !~ m/^\!/ && $currline !~ m/!\s*(SUBROUTINE|FUNCTION)/ ) || $ampersand eq 1) && ($insideinterface eq 0) ) || ($currline =~ m/^\s*SUBROUTINE\s*\w+\s*.*/ && $currline !~ m/SUBROUTINE\s+\w+\s*\(/ ) ) { # We only work on lines that contain subroutines/functions.
# Assuming that lines contain SUBROUTINE or FUNCTION followed by space and then the name of the procedure which may have a space before the (
# We don't add comments to code inside an interface block
# We also protect against adding comments to commented out SUBROUTINE/FUNCTION calls
# Need to allow for SUBROUTINE without any arguments or brackets too
if ($ampersand ne 1){
$currline =~ /((\bFUNCTION\b|\bSUBROUTINE\b).+)/; # Remove anything preceeding the SUBROUTINE or FUNCTION definition e.g. RECURSIVE, REAL, INTEGER, (KIND=dp), ELEMENTAL etc etc. output ends up in $1
$tmp=$1; # $1 contains whatever remains after removing anything before the word SUBROUTINE or FUNCTION
$tmp =~ s/\bBIND\b\(\w+\W*\w*\W*\w*\W*\)//; # Remove BIND(*) from the definition as we don't want to
$functionline = $tmp; # functionline contains the procedure definition with any unrequired text stripped off, $currline still contains the actual code
} else { # We also need to check any other lines in subroutine definition for BIND() too, e.g. if the definition extends over more than one line
$tmp =$currline;
$tmp =~ s/\bBIND\b\(\w+\W*\w*\W*\w*\W*\)//; # Remove the BIND(*) text as above
$functionline = $tmp; # Again functionline is the line we'll work with to find out the procedure arguments etc.
}
chomp($functionline); # Strip the newline char from the end
$ampersand = 0;
$lelement = "";
# Split the subroutine or function definition by space, comma, brackets
my @string = split /[(),\s+]+/, $functionline;
foreach(@string) {
$p = $_;
$matched{$p}=1; # Update the matched hash table so that all arguments in subroutine/function header are set as true
# If we encounter an & then it spans multiple lines
if ($p eq "&"){
$ampersand = 1;
$buffer = "$buffer$currline"; # Buffer the line details as we cant print out yet
} elsif ($p !~ m/((\bSUBROUTINE\b|\bFUNCTION\b)|^\z)/i) {
if ($lelement eq "FUNCTION" || $lelement eq "SUBROUTINE") { # If previous element is FUNCTION then this must be the name
if (($briefs ne "") && ($briefs ne "!> \\brief\n")) { # If brief exists and contains text
print $OUTPUT $briefs;
} elsif ($briefs eq "!> \\brief\n") { # If \brief is present but empty still need to add text
print $OUTPUT "! *****************************************************************************\n";
print $OUTPUT "!> \\brief ...\n";
} else { # If brief doesn't exist
print $OUTPUT "! *****************************************************************************\n";
print $OUTPUT "!> \\brief ...\n";
}
} else {
if (exists $params{$p}){
print $OUTPUT $params{$p};
} else {
if (($p ne "RESULT")) { # RESULT gets treated as a parameter but we don't want to print it out so protect against this happening
print $OUTPUT "!> \\param $p ...\n";
}
}
} # End of if $lelement conditional
} # End of if $p eq "&" conditional
$lelement = $p; # Take a note of the array element for comparison
} # End of for loop over @string
# Code to loop over all the elements of matched hash table. If any remain that were not in the function/subroutine header
# we want to make sure we keep this data in the header. It could be a comment or it could refer to old arguments
# that no longer exist. However, we don't want to throw the text away. We only print out if the argument doesn't match one
# of the arguments *and* there is no more of the procedure definition left to read, i.e. ampersand is 0
foreach $paramtype ( sort keys %params ) # We need to sort the keys otherwise the output order of the hash is given in internal order
{
if (($matched{$paramtype} eq 0) && ($ampersand eq 0)) {
if ( $params{$paramtype} !~ m/UNMATCHED_PROCEDURE_ARGUMENT/) { # Must protect against updating an existing comment
chomp($params{$paramtype}); # Get rid of \n so UNMATCHED* text can be appended on.
print $OUTPUT $params{$paramtype} . " UNMATCHED_PROCEDURE_ARGUMENT: please check \n";
} else {
print $OUTPUT $params{$paramtype};
}
}
}
# If after looping through the elements there is no ampersand
# we close off the comment and write out the procedure definition
if ($ampersand ne 1) {
if (($dates eq "") || ($dates eq "!> \\date\n")){ # dates entry empty or exists and contains no text
### print $OUTPUT "!> \\date MISSING_COMMENT: Unknown\n"; # Use this line if you want to add text to the entry
print $OUTPUT $dates;
} else {
print $OUTPUT $dates;
}
if (($pars eq "") || ($pars eq "!> \\par History\n")){ # pars entry empty or exists but contains no text
### print $OUTPUT "!> \\par History\n"; # Use this line if you want to add text to the entry
### print $OUTPUT "!> MISSING_COMMENT: Unknown\n"; # Use this line if you want to add text to the entry
print $OUTPUT $pars;
} else {
print $OUTPUT $pars;
}
if (($authors eq "") || ($authors eq "!> \\author\n") ){ # authors empty or exists but contains no text
### print $OUTPUT "!> \\author MISSING_COMMENT: Unknown\n"; # Use this line if you want to add text to the entry
print $OUTPUT $authors;
} else {
print $OUTPUT $authors;
}
if ($versions ne ""){
print $OUTPUT $versions;
}
if ($randoms ne ""){
print $OUTPUT $randoms;
}
if ($notes ne ""){
print $OUTPUT $notes;
}
if ($remainders ne "") {
print $OUTPUT $remainders; # Dumps out whatever else remainded in the header (e.g. stuff begining !> without a \ or stuff beginning with just a !) for the SUBROUTINE/FUNCTION at the end
}
print $OUTPUT "! *****************************************************************************\n";
print $OUTPUT "$buffer$currline";
# Reset all the variables after writing out the header
$buffer = "";
$param=0;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=0;
$note=0;
$random=0;
$remainder=0;
undef %params;
undef %matched;
$briefs="";
$dates="";
$versions="";
$pars="";
$authors="";
$notes="";
$oldheader="";
$randoms="";
$remainders="";
}
} elsif ( ($oldheader ne "") && ($currline !~ m/^\s*$/) ){ # If it was a MODULE or TYPE header we still need to write it back out to file. We also guard against blank lines here.
if ($currline !~ m/!\s*/){
print $OUTPUT $oldheader;
print $OUTPUT $currline;
# Again reset variables after output
$param=0;
$brief=0;
$par=0;
$date=0;
$version=0;
$author=0;
$note=0;
$random=0;
$remainder=0;
undef %params;
undef %matched;
$briefs="";
$dates="";
$versions="";
$pars="";
$authors="";
$notes="";
$randoms="";
$remainders="";
$oldheader="";
} else {
$oldheader = $oldheader . $currline;
}
} else {
print $OUTPUT $currline; # For all the other lines just write out whatever was read in from file
} # End of the if (($currline is SUBROUTINE or FUNCTION ) block
$lastline=$currline; # Keep a copy of last line
} # End of main while loop
close $OUTPUT;
close $INPUT;
# Perhaps do a second pass to remove any double occurrences of !> *** type lines

View file

@ -0,0 +1,68 @@
#!/usr/bin/perl
# Want to locate any lines where we have an ampersand at the end of a line followed
# by an ampersand at the start of the next line as these causes the fixcomments.pl
# script to break as it uses the ampersand to decide whether there is more data to
# read.
# An example would be (from cp_lbfgs.F):
# SUBROUTINE setulb(n, m, x, l, u, nbd, f, g, factr, pgtol, wa, iwa,&
# & task, iprint, csave, lsave, isave, dsave)
$DEBUG=$ARGV[2];
if ($DEBUG eq 1) {
print "DEBUG = YES \n";
print "remove_double_ampersands.pl running with INPUT & OUTPUT = ";
print $ARGV[0];
print " ";
print $ARGV[1];
print "\n";
}
open ($INPUT , "<" , $ARGV[0]) or die "Cant open $ARGV[0] $!";
open ($OUTPUT , ">" , $ARGV[1]) or die "Cant create $ARGV[1] $!";
$count = 0;
$linesread = 0;
$countampend = 0;
$countampstart = 0;
$firsttime = 1;
while (<$INPUT>) # While there are still lines to read
{
# First time we enter the loop we need to read in two lines
if ($firsttime eq 1) {
$currline = $_; # currline = the line we've just read in
$linesread = $linesread + 1;
$nextline = <$INPUT>; # read in the next line too
$linesread = $linesread + 1;
$firsttime = 0;
} else {
# If not first iteration need to copy nextline into currline and read currline from $_
$currline = $nextline;
$nextline = $_;
$linesread = $linesread + 1;
}
if ( ($currline =~ m/&\s*$/i) && ($nextline =~ m/^\s*&\s*\w+/i) ) {
$nextline =~ s/&/ /;
if ($DEBUG eq 1) { # Only print when debugging the script
print "remove_double_ampersands.pl:: CURRLINE is ",$currline;
print "remove_double_ampersands.pl:: NEXTLINE is ",$nextline;
}
$count = $count + 1;
}
print $OUTPUT $currline; # Write all lines except the last one to file - initial & replaced with space
}
print $OUTPUT $nextline; # Write the last line out to file
if ( $DEBUG eq 1 ) { # Only print when debugging the script
print "remove_double_ampersand.pl:: ", $linesread, " lines read in, found a total of ", $count, " lines with the double ampersand issue in file = ", $ARGV[0], " \n";
}
# Close the files
close $OUTPUT;
close $INPUT;

View file

@ -0,0 +1,50 @@
#!/usr/bin/perl
# Remove any double sets of lines starting ! ******
# E.g. removes the lines
# ! ****
# ! ****
# These extra lines get created by the fixcomments.pl script because it's not
# always guaranteed that a header will have them at the start and end and this
# it will always add in the header lines.
$DEBUG=$ARGV[2];
if ($DEBUG eq 1) {
print "remove_extra_comments.pl running with INPUT & OUTPUT = ";
print $ARGV[0];
print " ";
print $ARGV[1];
print "\n";
}
open ($INPUT , "<" , $ARGV[0]) or die "Cant open $ARGV[0] $!";
open ($OUTPUT , ">" , $ARGV[1]) or die "Cant create $ARGV[1] $!";
$count = 0;
while (<$INPUT>) # While there are still lines to read
{
$currline = $_; # currline = the line we've just read in
# We want to strip out any double sets (i.e. lines next to each other of lines starting ! ****
if ($currline =~ m/^!\s+\*+/i) {
$nextline = <$INPUT>; # If we get a match read in the next line
if ($nextline eq $currline) { # If it's a double line we overwrite $currline and thus it doesn't get written to the OUTPUT file
$currline=$nextline; # Overwrite currline with nextline and output
print $OUTPUT $currline;
$count = $count + 1; # Count up how many lines get stripped out
} else {
print $OUTPUT $currline; # If line starts with ! ** but next line is not a duplicate print the 2 lines out
print $OUTPUT $nextline;
}
} else {
print $OUTPUT $currline; # Print out all the remainder of the file
}
}
if ($DEBUG eq 1) {
print "remove_extra_comments.pl:: removed a total of ", $count, " duplicate comment lines from file = ", $ARGV[0], "\n";
}
close $OUTPUT;
close $INPUT;