diff --git a/perl/Galacticus/Build/SourceTree.pm b/perl/Galacticus/Build/SourceTree.pm index 3cbd46a358..a62dd61185 100644 --- a/perl/Galacticus/Build/SourceTree.pm +++ b/perl/Galacticus/Build/SourceTree.pm @@ -6,6 +6,7 @@ use warnings; use utf8; use Cwd; use lib $ENV{'GALACTICUS_EXEC_PATH'}."/perl"; +use Encode; use Data::Dumper; use Scalar::Util qw(reftype); use Fortran::Utils; @@ -516,30 +517,69 @@ sub ReplaceNode { sub Serialize { my $node = shift(); my (%options) = @_; - $options{'annotate'} = 1 - unless ( exists($options{'annotate'}) ); - my $serialization; - my $currentNode = $node; + $options{'annotate' } = 1 + unless ( exists($options{'annotate' }) ); + $options{'stripMappings'} = 0 + unless ( exists($options{'stripMappings'}) ); + my %optionsChild = %options; + $optionsChild{'stripMappings'} = 0; + # Walk the tree, serializing code. + my $lineNumber = 0 ; + my $serialization ; + my $mappings ; + my $currentNode = $node ; while ( $currentNode ) { - $serialization .= "!--> ".$currentNode->{'line'}." \"".$currentNode->{'source'}."\"\n" - if ( exists($currentNode->{'source'}) && exists($currentNode->{'line'}) && $options{'annotate'} ); + # Generate a line number mapping from the original file to the pre-processed file. + if ( exists($currentNode->{'source'}) && exists($currentNode->{'line'}) && $options{'annotate'} ) { + my $mapping = "!--> ".$currentNode->{'line'}." ".$lineNumber." \"".$currentNode->{'source'}."\"\n"; + if ( $options{'stripMappings'} ) { + $mappings .= $mapping; + } else { + ++$lineNumber; + $serialization .= $mapping; + } + } + # Serialize the current node. + my $serializationNode = ""; if ( $currentNode->{'type'} eq "code" ) { - $serialization .= $currentNode->{'content'} + $serializationNode .= $currentNode->{'content'}; } else { - $serialization .= $currentNode->{'opener'} - if ( exists($currentNode->{'opener'}) ); - $serialization .= &Serialize($currentNode->{'firstChild'},%options) - if ( $currentNode->{'firstChild'} ); - $serialization .= $currentNode->{'closer'} + $serializationNode .= $currentNode->{'opener'} + if ( exists($currentNode->{'opener'}) ); + if ( $currentNode->{'firstChild'} ) { + (my $serializationChild) = &Serialize($currentNode->{'firstChild'},%optionsChild); + $serializationNode .= $serializationChild; + } + $serializationNode .= $currentNode->{'closer'} if ( exists($currentNode->{'closer'}) ); } + # Strip out any line number mappings from the serialization. + if ( $options{'stripMappings'} ) { + my $serializationNodeStripped = ""; + my $serializationNodeEncoded = encode(q{utf8},$serializationNode); + open(my $code, q{<:utf8}, \$serializationNodeEncoded); + while ( my $line = <$code> ) { + if ( $line =~ m/^!\-\->\s+(\d+)\s+(\d+)\s+"(.+)"/ ) { + $mappings .= "!--> ".$1." ".($lineNumber+1)." \"".$3."\"\n"; + } else { + ++$lineNumber; + $serializationNodeStripped .= $line; + } + } + close($code); + $serializationNode = $serializationNodeStripped; + } else { + $lineNumber += $serializationNode =~ tr/\n//; + } + # Accumulate the serialization. + $serialization .= $serializationNode; if ( $currentNode->{'sibling' } ) { $currentNode = $currentNode->{'sibling'}; } else { undef($currentNode); } } - return $serialization; + return $serialization, $mappings; } sub InsertAfterNode { diff --git a/perl/Galacticus/Build/SourceTree/Parse/Directives.pm b/perl/Galacticus/Build/SourceTree/Parse/Directives.pm index ca83e63fe8..d7c0818bb1 100644 --- a/perl/Galacticus/Build/SourceTree/Parse/Directives.pm +++ b/perl/Galacticus/Build/SourceTree/Parse/Directives.pm @@ -70,6 +70,9 @@ sub Parse_Directives { $rawCode .= $line; } elsif ( $line =~ m/^\s*!!\[/ ) { $rawOpener = $line; + } else { + $rawCodeLine = $lineNumber+1; + $rawDirectiveLine = $lineNumber+1; } # Process code and directive blocks as necessary. if ( ( $inDirective == 1 || eof($code) ) && $rawCode ) { diff --git a/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm b/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm index 3f5f9f5072..0ba430ec14 100644 --- a/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm +++ b/perl/Galacticus/Build/SourceTree/Process/FunctionClass.pm @@ -2789,10 +2789,14 @@ CODE &Galacticus::Build::SourceTree::PrependChildToNode($submodule,$codeContent->{'submodule'}->{$className}->{'preContains' }); &Galacticus::Build::SourceTree::InsertPostContains($submodule,$codeContent->{'submodule'}->{$className}->{'postContains'}); # Write the submodule to a temporary file, and update the actual file only if it has changed (to avoid recompilation cascades). + (my $submoduleContent, my $submoduleMappings) = &Galacticus::Build::SourceTree::Serialize($file, stripMappings => 1); open(my $submoduleFile,">",$codeContent->{'submodule'}->{$className}->{'fileName'}.".tmp"); - print $submoduleFile &Galacticus::Build::SourceTree::Serialize($file); + print $submoduleFile $submoduleContent; close($submoduleFile); &File::Changes::Update($codeContent->{'submodule'}->{$className}->{'fileName'},$codeContent->{'submodule'}->{$className}->{'fileName'}.".tmp", proveUpdate => "yes"); + open(my $mappingFile,">",$codeContent->{'submodule'}->{$className}->{'fileName'}.".lmap"); + print $mappingFile $submoduleMappings; + close($mappingFile); } } $node = &Galacticus::Build::SourceTree::Walk_Tree($node,\$depth); diff --git a/perl/Galacticus/Build/SourceTree/Process/Generics.pm b/perl/Galacticus/Build/SourceTree/Process/Generics.pm index a726d98ed6..6b1540cb24 100644 --- a/perl/Galacticus/Build/SourceTree/Process/Generics.pm +++ b/perl/Galacticus/Build/SourceTree/Process/Generics.pm @@ -83,7 +83,8 @@ sub Process_Generics { $copyNode = &Galacticus::Build::SourceTree::Walk_Tree($copyNode,\$copyDepth); } # Reparse the new content. - my $copyReparsed = &Galacticus::Build::SourceTree::ParseCode(&Galacticus::Build::SourceTree::Serialize($copy),$tree->{'name'}, instrument => 0 ,reinstateBlocks => 1); + (my $copySerialized ) = &Galacticus::Build::SourceTree::Serialize($copy); + my $copyReparsed = &Galacticus::Build::SourceTree::ParseCode($copySerialized,$tree->{'name'}, instrument => 0 ,reinstateBlocks => 1); # Push copy to list of copies. push(@copies,$copyReparsed); } diff --git a/scripts/build/buildCode.pl b/scripts/build/buildCode.pl index 70ddc5e57e..493cafdcd4 100755 --- a/scripts/build/buildCode.pl +++ b/scripts/build/buildCode.pl @@ -213,16 +213,17 @@ # Generate output. For Fortran source we run the code through the processor first. Otherwise it is simply output. open(my $outputFile,">",$build->{'fileName'}.".tmp"); # Parse Fortran files, simply output other files. -print $outputFile - $build->{'fileName'} =~ m/\.Inc$/ - ? - &Galacticus::Build::SourceTree::Serialize( - &Galacticus::Build::SourceTree::ProcessTree( +if ( $build->{'fileName'} =~ m/\.Inc$/ ) { + (my $codePreprocessed) = + &Galacticus::Build::SourceTree::Serialize( + &Galacticus::Build::SourceTree::ProcessTree( &Galacticus::Build::SourceTree::ParseCode($build->{'content'},$build->{'fileName'}) - ) - ) - : - $build->{'content'}; + ) + ); + print $outputFile $codePreprocessed; +} else { + print $outputFile $build->{'content'}; +} close($outputFile); &File::Changes::Update($build->{'fileName'},$build->{'fileName'}.".tmp", proveUpdate => "yes"); exit; diff --git a/scripts/build/postprocess.pl b/scripts/build/postprocess.pl index 593f2b5689..56016a4a02 100755 --- a/scripts/build/postprocess.pl +++ b/scripts/build/postprocess.pl @@ -4,6 +4,7 @@ use lib $ENV{'GALACTICUS_EXEC_PATH'}."/perl"; use Data::Dumper; use Fortran::Utils; +use File::Slurp qw(slurp); use utf8; use open ":std", ":encoding(UTF-8)"; my $haveColor = eval @@ -23,9 +24,6 @@ # Determine if interactive. $haveColor = -t STDOUT ? $haveColor : 0; -# Initalize a map. -my @map; - # Initialize a hash of (possibly) unused functions. my %unusedFunctions; @@ -41,30 +39,36 @@ # Initialize a structure for interoperable variables. my $interoperableVariables; -# Open and read the file. -my $lineNumber = 0; -my $unitName; -push( - @map, - { - source => $preprocessedSourceName, - line => 1, - lineOriginal => 1 - } +# Parse the map of line numbers. +my @map = + ( + { + source => $preprocessedSourceName, + line => 1, + lineOriginal => 1 + } ); -open(my $file,$preprocessedSourceName); -while ( my $line = <$file> ) { - ++$lineNumber; - if ( $line =~ m/^\!\-\-\>\s+(\d+)\s+\"([a-zA-Z0-9_\-\.\/\(\):]+)\"\s*$/ ) { +open(my $mapFile,$preprocessedSourceName.".lmap"); +while ( my $line = <$mapFile> ) { + if ( $line =~ m/^\!\-\-\>\s+(\d+)\s+(\d+)\s+\"([a-zA-Z0-9_\-\.\/\(\):]+)\"\s*$/ ) { push( @map, { - source => $2, + source => $3, line => $1, - lineOriginal => $lineNumber+1 # We add 1 here because the line marker actually refers to the next line in the file. + lineOriginal => $2 } ); } +} +close($mapFile); + +# Open and read the file. +my $lineNumber = 0; +my $unitName; +open(my $file,$preprocessedSourceName); +while ( my $line = <$file> ) { + ++$lineNumber; # Detect functions/subroutines/submodule procedure. foreach my $type ( 'subroutine', 'function', 'moduleProcedure' ) { if ( my @matches = ( $line =~ $Fortran::Utils::unitOpeners{$type}->{'regEx'} ) ) { diff --git a/scripts/build/preprocess.pl b/scripts/build/preprocess.pl index e939eb56a0..0ef7df4d6a 100755 --- a/scripts/build/preprocess.pl +++ b/scripts/build/preprocess.pl @@ -5,6 +5,8 @@ use lib $ENV{'GALACTICUS_EXEC_PATH'}."/perl"; use Galacticus::Build::SourceTree; use File::Changes; +use utf8; +use open ":std", ":encoding(UTF-8)"; # Preprocess a Galacticus Fortran source file. # Andrew Benson (17-April-2015) @@ -25,10 +27,18 @@ &Galacticus::Build::SourceTree::AnalyzeTree($tree) if ( exists($ENV{'GALACTICUS_PREPROCESSOR_ANALYZE'}) && $ENV{'GALACTICUS_PREPROCESSOR_ANALYZE'} eq "yes" ); +# Get the serialized source code. +(my $codeSerialized, my $mappings) = &Galacticus::Build::SourceTree::Serialize($tree, stripMappings => 1); + # Serialize back to source code. open(my $outputFile,">:raw",$outputFileName.".tmp"); -print $outputFile &Galacticus::Build::SourceTree::Serialize($tree); +print $outputFile $codeSerialized; close($outputFile); &File::Changes::Update($outputFileName,$outputFileName.".tmp", proveUpdate => "yes"); +# Output line number mappings. +open(my $lineMapFile,">",$outputFileName.".lmap"); +print $lineMapFile $mappings; +close($lineMapFile); + exit;