Merge pull request #752 from galacticusorg/fixLineMapFiles

Use separate files to store maps between source and preprocessed files
galacticusorg · Dec 3, 2024 · 2b575f3 · 2b575f3
2 parents 3da16df + d9f6e9d
commit 2b575f3
Show file tree

Hide file tree

Showing 7 changed files with 107 additions and 44 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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;