Skip to content

Commit 94208b4

Browse files
authored
WI #2026 #2027 Avoid FileCompiler leaks in LanguageServer (#2030)
* WI #2027 Avoid FileCompiler leaks in Workspace * WI #2027 Fix LSR test * WI #2026 Remove static END_OF_FILE token (#2031)
1 parent fc2429b commit 94208b4

File tree

12 files changed

+75
-68
lines changed

12 files changed

+75
-68
lines changed

TypeCobol.LanguageServer.Test/LSRTests/ProcedureCompletionNoParam/input/ProcedureCompletionNoParam.tlsp

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -98,10 +98,6 @@
9898
"category": 0,
9999
"message": "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/didSave\",\"params\":{\"textDocument\":{\"version\":0,\"uri\":\"file:/C:/Users/LANOYDO/AppData/Local/Temp/1/tcbl/DVZZDLY1103830253336368444.cee\"},\"text\":\" IDENTIFICATION DIVISION.\\r\\n PROGRAM-ID. DVZZBCO0.\\r\\n DATA DIVISION.\\r\\n WORKING-STORAGE SECTION.\\r\\n PROCEDURE DIVISION.\\r\\n call DVZZSTKD::Foo\\r\\n .\\r\\n END PROGRAM DVZZBCO0.\\r\\n\\r\\n IDENTIFICATION DIVISION.\\r\\n PROGRAM-ID. DVZZSTKD.\\r\\n PROCEDURE DIVISION.\\r\\n declare procedure Foo public.\\r\\n procedure division.\\r\\n goback.\\r\\n end-declare.\\r\\n\\r\\n END PROGRAM DVZZSTKD.\"}}"
100100
},
101-
{
102-
"category": 1,
103-
"message": "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/publishDiagnostics\",\"params\":{\"uri\":\"file:///C:/Users/LANOYDO/AppData/Local/Temp/1/tcbl/DVZZDLY1103830253336368444.cee\",\"diagnostics\":[]}}"
104-
},
105101
{
106102
"category": 1,
107103
"message": "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/publishDiagnostics\",\"params\":{\"uri\":\"file:///C:/Users/LANOYDO/AppData/Local/Temp/1/tcbl/DVZZDLY1103830253336368444.cee\",\"diagnostics\":[]}}"

TypeCobol.LanguageServer/Workspace.cs

Lines changed: 40 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ public class Workspace
4545

4646
internal CompilationProject CompilationProject { get; private set; }
4747

48-
private List<FileCompiler> _fileCompilerWaittingForNodePhase;
48+
private List<FileCompiler> _fileCompilerWaitingForNodePhase;
4949
public TypeCobolConfiguration Configuration { get; private set; }
5050
public event EventHandler<DiagnosticEvent> DiagnosticsEvent;
5151
public event EventHandler<EventArgs> DocumentModifiedEvent;
@@ -162,7 +162,7 @@ public Workspace(string rootDirectoryFullName, string workspaceName, Queue<Messa
162162
MessagesActionsQueue = messagesActionsQueue;
163163
Configuration = new TypeCobolConfiguration();
164164
_openedDocuments = new Dictionary<Uri, DocumentContext>();
165-
_fileCompilerWaittingForNodePhase = new List<FileCompiler>();
165+
_fileCompilerWaitingForNodePhase = new List<FileCompiler>();
166166
_Logger = logger;
167167

168168
this._rootDirectoryFullName = rootDirectoryFullName;
@@ -234,22 +234,22 @@ private FileCompiler OpenTextDocument(DocumentContext docContext, string sourceT
234234
#else
235235
fileCompiler = new FileCompiler(initialTextDocumentLines, CompilationProject.SourceFileProvider, CompilationProject, CompilationProject.CompilationOptions, _customSymbols, CompilationProject);
236236
#endif
237-
//Set Any Language Server Connection Options.
238-
docContext.FileCompiler = fileCompiler;
239-
docContext.LanguageServerConnection(true);
240-
241-
fileCompiler.CompilationResultsForProgram.UpdateTokensLines();
242237

243238
lock (_lockForOpenedDocuments)
244239
{
245240
if (_openedDocuments.ContainsKey(docContext.Uri))
246241
CloseSourceFile(docContext.Uri); //Close and remove the previous opened file.
247242

248243
_openedDocuments.Add(docContext.Uri, docContext);
249-
fileCompiler.CompilationResultsForProgram.CodeAnalysisCompleted += FinalCompilationStepCompleted;
250244
}
251245

246+
//Set Any Language Server Connection Options.
247+
docContext.FileCompiler = fileCompiler;
248+
docContext.LanguageServerConnection(true);
249+
252250
fileCompiler.CompilationResultsForProgram.SetOwnerThread(Thread.CurrentThread);
251+
fileCompiler.CompilationResultsForProgram.CodeAnalysisCompleted += FinalCompilationStepCompleted;
252+
fileCompiler.CompilationResultsForProgram.UpdateTokensLines();
253253

254254
if (lsrOptions != LsrTestingOptions.LsrSourceDocumentTesting)
255255
{
@@ -325,14 +325,14 @@ public void UpdateSourceFile(Uri fileUri, TextChangedEvent textChangedEvent)
325325
{
326326
if (!_timerDisabled) //If TimerDisabled is false, create a timer to automatically launch Node phase
327327
{
328-
lock (_fileCompilerWaittingForNodePhase)
328+
lock (_fileCompilerWaitingForNodePhase)
329329
{
330-
if (!_fileCompilerWaittingForNodePhase.Contains(fileCompilerToUpdate))
331-
_fileCompilerWaittingForNodePhase.Add(fileCompilerToUpdate); //Store that this fileCompiler will soon need a Node Phase
330+
if (!_fileCompilerWaitingForNodePhase.Contains(fileCompilerToUpdate))
331+
_fileCompilerWaitingForNodePhase.Add(fileCompilerToUpdate); //Store that this fileCompiler will soon need a Node Phase
332332
}
333333

334334
_semanticUpdaterTimer = new System.Timers.Timer(750);
335-
_semanticUpdaterTimer.Elapsed += (sender, e) => TimerEvent(sender, e, fileCompilerToUpdate);
335+
_semanticUpdaterTimer.Elapsed += (sender, e) => TimerEvent(fileUri);
336336
_semanticUpdaterTimer.Start();
337337
}
338338
}
@@ -392,23 +392,29 @@ private void ExecutionStepEventHandler(object oFileCompiler, ExecutionStepEventA
392392
/// <param name="sender"></param>
393393
/// <param name="eventArgs"></param>
394394
/// <param name="fileCompiler"></param>
395-
private void TimerEvent(object sender, ElapsedEventArgs eventArgs, FileCompiler fileCompiler)
395+
private void TimerEvent(Uri fileUri)
396396
{
397397
try
398398
{
399399
_semanticUpdaterTimer.Stop();
400-
Action nodeRefreshAction = () => { RefreshSyntaxTree(fileCompiler, SyntaxTreeRefreshLevel.RebuildNodesAndPerformQualityCheck); };
401400
lock (MessagesActionsQueue)
402401
{
403-
MessagesActionsQueue.Enqueue(new MessageActionWrapper(nodeRefreshAction));
402+
MessagesActionsQueue.Enqueue(new MessageActionWrapper(Refresh));
404403
}
405404
}
406405
catch (Exception e)
407406
{
408407
//In case Timer Thread crash
409408
ExceptionTriggered(null, new ThreadExceptionEventArgs(e));
410409
}
411-
410+
411+
void Refresh()
412+
{
413+
if (TryGetOpenedDocumentContext(fileUri, out var docContext))
414+
{
415+
RefreshSyntaxTree(docContext.FileCompiler, SyntaxTreeRefreshLevel.RebuildNodesAndPerformQualityCheck);
416+
}
417+
}
412418
}
413419

414420
/// <summary>
@@ -446,12 +452,12 @@ public void RefreshSyntaxTree(FileCompiler fileCompiler, SyntaxTreeRefreshLevel
446452
{
447453
if (refreshLevel == SyntaxTreeRefreshLevel.NoRefresh) return; //nothing to do
448454

449-
lock (_fileCompilerWaittingForNodePhase)
455+
lock (_fileCompilerWaitingForNodePhase)
450456
{
451-
var fileCompilerNeedsRefresh = _fileCompilerWaittingForNodePhase.Contains(fileCompiler);
457+
var fileCompilerNeedsRefresh = _fileCompilerWaitingForNodePhase.Contains(fileCompiler);
452458
if (fileCompilerNeedsRefresh)
453459
{
454-
_fileCompilerWaittingForNodePhase.Remove(fileCompiler);
460+
_fileCompilerWaitingForNodePhase.Remove(fileCompiler);
455461
}
456462
else
457463
{
@@ -495,16 +501,27 @@ void RefreshCodeAnalysisResults()
495501
/// </summary>
496502
public void CloseSourceFile(Uri fileUri)
497503
{
504+
FileCompiler fileCompilerToClose = null;
505+
506+
//Remove from opened documents dictionary
498507
lock (_lockForOpenedDocuments)
499508
{
500-
if (_openedDocuments.ContainsKey(fileUri))
509+
if (_openedDocuments.TryGetValue(fileUri, out var contextToClose))
501510
{
502-
var contextToClose = _openedDocuments[fileUri];
503-
FileCompiler fileCompilerToClose = contextToClose.FileCompiler;
511+
fileCompilerToClose = contextToClose.FileCompiler;
504512
_openedDocuments.Remove(fileUri);
505513
fileCompilerToClose.CompilationResultsForProgram.CodeAnalysisCompleted -= FinalCompilationStepCompleted;
506514
}
507-
}
515+
}
516+
517+
//Remove from pending semantic analysis list
518+
if (fileCompilerToClose != null)
519+
{
520+
lock (_fileCompilerWaitingForNodePhase)
521+
{
522+
_fileCompilerWaitingForNodePhase.Remove(fileCompilerToClose);
523+
}
524+
}
508525
}
509526

510527
/// <summary>

TypeCobol.Test/Parser/Preprocessor/PreprocessorUtils.cs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ private static string ProcessTokensDocument(ProcessedTokensDocument processedDoc
7373
StringBuilder sbTokens = new StringBuilder();
7474
ITokensLinesIterator tokens = processedDoc.GetProcessedTokensIterator();
7575
Token token = tokens.NextToken();
76-
if (token != Token.END_OF_FILE)
76+
if (token.TokenType != TokenType.EndOfFile)
7777
{
7878
string documentPath = null;
7979
int lineIndex = -1;
@@ -91,7 +91,7 @@ private static string ProcessTokensDocument(ProcessedTokensDocument processedDoc
9191
}
9292
sbTokens.AppendLine(token.ToString());
9393
}
94-
while ((token = tokens.NextToken()) != Token.END_OF_FILE);
94+
while ((token = tokens.NextToken()).TokenType != TokenType.EndOfFile);
9595
}
9696

9797
// Errors

TypeCobol/Compiler/AntlrUtils/AntlrPerformanceProfiler.cs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -101,8 +101,8 @@ public void BeginParsingFile(TextSourceInfo textSourceInfo, ITokensLinesIterator
101101
if (tokensCountIterator != null)
102102
{
103103
ITokensLine lastLine = null;
104-
Token token = null;
105-
while ((token = tokensCountIterator.NextToken()) != Token.END_OF_FILE)
104+
Token token;
105+
while ((token = tokensCountIterator.NextToken()).TokenType != TokenType.EndOfFile)
106106
{
107107
CurrentFileInfo.TokensCount++;
108108
if (token.TokensLine != lastLine)

TypeCobol/Compiler/AntlrUtils/TokensLinesTokenStream.cs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -61,15 +61,15 @@ public void SeekToToken(IToken searchedToken)
6161
}
6262

6363
/// <summary>
64-
/// Start monitoring if the token stream reached a specific token which marks the end of an instersting section
64+
/// Start monitoring if the token stream reached a specific token which marks the end of an interesting section
6565
/// </summary>
6666
public void StartLookingForStopToken(Token stopToken)
6767
{
6868
ResetStopTokenLookup();
6969
if (stopToken != null)
7070
{
7171
StopToken = stopToken;
72-
stopTokenReplacedByEOF = new ReplacedToken(Token.END_OF_FILE, stopToken);
72+
stopTokenReplacedByEOF = new ReplacedToken(Token.EndOfFile(), stopToken);
7373
StreamReachedStopToken = false;
7474
}
7575
}

TypeCobol/Compiler/CupCommon/CobolWordsTokenizer.cs

Lines changed: 8 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -233,7 +233,7 @@ public void LeaveAnyTokenMode(bool bAllMode = false)
233233
public void ConsumeNextTokenOnTheSameLine(TokenType nextTokenType)
234234
{
235235
Token currentToken = base.CurrentToken;
236-
if (currentToken == Token.END_OF_FILE)
236+
if (currentToken != null && currentToken.TokenType == TokenType.EndOfFile)
237237
return;//Ignore if end of file
238238
Token nextToken = base.NextToken();
239239
if (nextToken != null && currentToken != null &&
@@ -258,21 +258,6 @@ public void ConsumeNextTokenOnTheSameLineAndStop(TokenType nextTokenType)
258258
EnterStopScanningMode();
259259
}
260260

261-
/// <summary>
262-
/// Enter in the Stop Scanning Mode if the current is not of the given type
263-
/// </summary>
264-
/// <param name="tokenType">The Token type to check</param>
265-
public void EnterStopScanningModeIfNotToken(TokenType tokenType)
266-
{
267-
Token currentToken = base.CurrentToken;
268-
if (currentToken == null)
269-
return;
270-
if (currentToken == Token.END_OF_FILE)
271-
return;//Ignore if end of file
272-
if (currentToken.TokenType != tokenType)
273-
EnterStopScanningMode();
274-
}
275-
276261
/// <summary>
277262
/// Enter in the Stop Scanning Mode if the next is not of the given type
278263
/// </summary>
@@ -282,7 +267,7 @@ public void EnterStopScanningModeIfNextNotToken(TokenType nextTokenType)
282267
Token currentToken = base.CurrentToken;
283268
if (currentToken == null)
284269
return;
285-
if (currentToken == Token.END_OF_FILE)
270+
if (currentToken.TokenType == TokenType.EndOfFile)
286271
return;//Ignore if end of file
287272
Token nextToken = base.NextToken();
288273
base.PreviousToken();
@@ -326,11 +311,12 @@ private bool BasicAnyTokenMode(Token token, Symbol symbol)
326311
/// </summary>
327312
/// <param name="expected">The expected next token</param>
328313
/// <param name="resulting">The resulting token if matching</param>
329-
/// <param name="defaultToken">The defualt token if no matching</param>
314+
/// <param name="defaultToken">The default token if no matching</param>
330315
/// <returns></returns>
331316
private int TryMatchNextToken(TokenType expected, int resulting, int defaultToken)
332317
{
333-
if (base.CurrentToken == Token.END_OF_FILE)
318+
var currentToken = base.CurrentToken;
319+
if (currentToken != null && currentToken.TokenType == TokenType.EndOfFile)
334320
return defaultToken;
335321
Token nextToken = base.NextToken();
336322
if (nextToken != null)
@@ -350,11 +336,11 @@ private int TryMatchNextToken(TokenType expected, int resulting, int defaultToke
350336
/// </summary>
351337
/// <param name="expected">The expected next token</param>
352338
/// <param name="resulting">The resulting token if matching</param>
353-
/// <param name="defaultToken">The defualt token if no matching</param>
339+
/// <param name="defaultToken">The default token if no matching</param>
354340
/// <returns></returns>
355341
private int TryMatchPrevToken(TokenType expected, int resulting, int defaultToken)
356342
{
357-
if (base.CurrentToken == Token.END_OF_FILE)
343+
if (base.CurrentToken == null)
358344
return defaultToken;
359345
Token prevToken = base.PreviousToken();
360346
if (prevToken != null)
@@ -436,7 +422,7 @@ public IEnumerator<Symbol> GetEnumerator()
436422
FirstToken = null;
437423
LastToken = null;
438424
Token token = null;
439-
while ((token = base.NextToken()) != Token.END_OF_FILE)
425+
while ((token = base.NextToken()).TokenType != TokenType.EndOfFile)
440426
{
441427
if (FirstToken == null)
442428
{

TypeCobol/Compiler/Parser/CodeElementsLinesTokenSource.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -103,7 +103,7 @@ public IToken NextToken()
103103
}
104104
}
105105

106-
return Token.END_OF_FILE;
106+
return Token.EndOfFile();
107107
}
108108

109109
public string SourceName

TypeCobol/Compiler/Preprocessor/CopyTokensLinesIterator.cs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -254,15 +254,16 @@ public Token NextToken()
254254
// If the document is empty or after end of file, immediately return EndOfFile
255255
if (currentLine == null)
256256
{
257-
currentPosition.CurrentToken = Token.END_OF_FILE;
258-
return Token.END_OF_FILE;
257+
var eof = Token.EndOfFile();
258+
currentPosition.CurrentToken = eof;
259+
return eof;
259260
}
260261

261262
// If the iterator is positioned in an imported document, return the next imported token
262263
if(currentPosition.ImportedDocumentIterator != null)
263264
{
264265
Token nextImportedToken = currentPosition.ImportedDocumentIterator.NextToken();
265-
if(nextImportedToken == Token.END_OF_FILE)
266+
if(nextImportedToken.TokenType == TokenType.EndOfFile)
266267
{
267268
currentPosition.ImportedDocumentIterator = null;
268269
currentPosition.ImportedDocumentIteratorPosition = null;
@@ -297,8 +298,9 @@ public Token NextToken()
297298
{
298299
// return EndOfFile
299300
currentLine = null;
300-
currentPosition.CurrentToken = Token.END_OF_FILE;
301-
return Token.END_OF_FILE;
301+
var eof = Token.EndOfFile();
302+
currentPosition.CurrentToken = eof;
303+
return eof;
302304
}
303305
}
304306
// Check if the next token found matches the filter criteria or is a COPY compiler directive or is a REPLACE directive
@@ -322,7 +324,7 @@ public Token NextToken()
322324

323325
// No suitable next token found in the imported document
324326
// -> get next token in the main document
325-
if (nextTokenCandidate == Token.END_OF_FILE)
327+
if (nextTokenCandidate.TokenType == TokenType.EndOfFile)
326328
{
327329
return NextToken();
328330
}

TypeCobol/Compiler/Scanner/ITokensLinesIterator.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ public interface ITokensLinesIterator
5151
/// <summary>
5252
/// Get next token or EndOfFile
5353
/// </summary>
54-
Token NextToken();
54+
Token NextToken();
5555

5656
/// <summary>
5757
/// Get null (before the first call to NextToken()), current token, or EndOfFile

TypeCobol/Compiler/Scanner/Token.cs

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -413,8 +413,14 @@ public int TokenIndex
413413
get { return -1; }
414414
}
415415

416-
// Common token for End of file
417-
public static Token END_OF_FILE = new Token(TokenType.EndOfFile, 0, -1, TypeCobol.Compiler.Scanner.TokensLine.CreateVirtualLineForInsertedToken(-1, String.Empty));
416+
/// <summary>
417+
/// Creates a new instance of special end-of-file Token.
418+
/// </summary>
419+
/// <returns>New Token instance with EndOfFile TokenType</returns>
420+
public static Token EndOfFile()
421+
{
422+
return new Token(TokenType.EndOfFile, 0, -1, Compiler.Scanner.TokensLine.CreateVirtualLineForInsertedToken(-1, string.Empty));
423+
}
418424

419425
// --- Token comparison for REPLACE directive ---
420426

0 commit comments

Comments
 (0)