From d9f6e9dba3e24befc1e0389996eff52fc9720e6a Mon Sep 17 00:00:00 2001 From: Andrew Benson Date: Mon, 2 Dec 2024 21:30:00 -0800 Subject: [PATCH] fix: Use separate files to store maps between source and preprocessed files This avoids causing changes in preprocessed files due only to changes in the line number maps (which can result in recompilation cascades). --- perl/Galacticus/Build/SourceTree.pm | 66 +++++++++++++++---- .../Build/SourceTree/Parse/Directives.pm | 3 + .../Build/SourceTree/Process/FunctionClass.pm | 6 +- .../Build/SourceTree/Process/Generics.pm | 3 +- scripts/build/buildCode.pl | 19 +++--- scripts/build/postprocess.pl | 42 ++++++------ scripts/build/preprocess.pl | 12 +++- 7 files changed, 107 insertions(+), 44 deletions(-) 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;