From 66eacf022efd4664d902d1cc189da463f2cdfdc1 Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Thu, 25 Dec 2025 22:55:44 +0800 Subject: [PATCH 1/8] Add hierarchical DocumentSymbol support (LSP 3.10) Implement dual-mode DocumentSymbol provider supporting both LSP 2.x flat mode (SymbolInformation) and LSP 3.x hierarchical mode (DocumentSymbol with children). Changes: - Add TSymbolMode enum and TSymbolBuilder class for dual-mode building - Detect client hierarchicalDocumentSymbolSupport capability during init - Build hierarchical structure with parent-child relationships - Return DocumentSymbol (with range/children) or SymbolInformation (with location/containerName) based on client capability Benefits: - Better IDE integration (Outline view shows proper nesting in VS Code) - Enables hierarchical navigation and symbol search (Class/Method paths) - Backward compatible with clients not supporting hierarchical mode - Compliant with LSP 3.10+ specification Tested with VS Code and Serena MCP, both working correctly in hierarchical mode with proper symbol nesting. --- src/protocol/LSP.Capabilities.pas | 68 ++++++ src/protocol/LSP.DocumentSymbol.pas | 18 ++ src/serverprotocol/PasLS.General.pas | 8 + src/serverprotocol/PasLS.Symbols.pas | 326 +++++++++++++++++++++++++-- 4 files changed, 402 insertions(+), 18 deletions(-) diff --git a/src/protocol/LSP.Capabilities.pas b/src/protocol/LSP.Capabilities.pas index 0083502..7b259d8 100644 --- a/src/protocol/LSP.Capabilities.pas +++ b/src/protocol/LSP.Capabilities.pas @@ -88,9 +88,30 @@ TWorkspaceServerCapabilities = class(TLSPStreamable) property workspaceFolders: TWorkspaceFoldersServerCapabilities read fWorkspaceFolders write SetWorkspaceFolders; end; + { TDocumentSymbolClientCapabilities } + + TDocumentSymbolClientCapabilities = class(TLSPStreamable) + private + fHierarchicalDocumentSymbolSupport: boolean; + Public + Procedure Assign(Source : TPersistent); override; + published + // The client supports hierarchical document symbols. + property hierarchicalDocumentSymbolSupport: boolean read fHierarchicalDocumentSymbolSupport write fHierarchicalDocumentSymbolSupport; + end; + { TTextDocumentClientCapabilities } TTextDocumentClientCapabilities = class(TLSPStreamable) + private + fDocumentSymbol: TDocumentSymbolClientCapabilities; + procedure SetDocumentSymbol(AValue: TDocumentSymbolClientCapabilities); + Public + constructor Create; override; + destructor Destroy; override; + Procedure Assign(Source : TPersistent); override; + published + property documentSymbol: TDocumentSymbolClientCapabilities read fDocumentSymbol write SetDocumentSymbol; end; { TClientCapabilities } @@ -159,6 +180,53 @@ TServerCapabilities = class(TLSPStreamable) implementation +{ TDocumentSymbolClientCapabilities } + +procedure TDocumentSymbolClientCapabilities.Assign(Source : TPersistent); +var + Src : TDocumentSymbolClientCapabilities absolute Source; +begin + if Source is TDocumentSymbolClientCapabilities then + begin + HierarchicalDocumentSymbolSupport := Src.HierarchicalDocumentSymbolSupport; + end + else + inherited Assign(Source); +end; + +{ TTextDocumentClientCapabilities } + +procedure TTextDocumentClientCapabilities.SetDocumentSymbol( + AValue: TDocumentSymbolClientCapabilities); +begin + if fDocumentSymbol=AValue then Exit; + fDocumentSymbol.Assign(AValue); +end; + +constructor TTextDocumentClientCapabilities.Create; +begin + Inherited; + fDocumentSymbol := TDocumentSymbolClientCapabilities.Create; +end; + +destructor TTextDocumentClientCapabilities.Destroy; +begin + FreeAndNil(fDocumentSymbol); + inherited Destroy; +end; + +procedure TTextDocumentClientCapabilities.Assign(Source : TPersistent); +var + Src : TTextDocumentClientCapabilities absolute Source; +begin + if Source is TTextDocumentClientCapabilities then + begin + DocumentSymbol := Src.DocumentSymbol; + end + else + inherited Assign(Source); +end; + { TWorkspaceClientCapabilities } procedure TWorkspaceClientCapabilities.Assign(Source : TPersistent); diff --git a/src/protocol/LSP.DocumentSymbol.pas b/src/protocol/LSP.DocumentSymbol.pas index bd6fa25..369c654 100644 --- a/src/protocol/LSP.DocumentSymbol.pas +++ b/src/protocol/LSP.DocumentSymbol.pas @@ -150,6 +150,24 @@ TSymbolInformation = class(TCollectionItem) TSymbolInformationItems = specialize TGenericCollection; + { TDocumentSymbolEx } + + { Extended DocumentSymbol with additional fields for pasls-specific needs } + + TSymbolFlag = (sfForwardDeclaration, sfDeprecated); + TSymbolFlags = set of TSymbolFlag; + + TDocumentSymbolEx = class(TDocumentSymbol) + private + fRawJSON: String; + fFlags: TSymbolFlags; + public + property RawJSON: String read fRawJSON write fRawJSON; + property Flags: TSymbolFlags read fFlags write fFlags; + end; + + TDocumentSymbolExItems = specialize TGenericCollection; + { TDocumentSymbolParams } TDocumentSymbolParams = class(TLSPStreamable) diff --git a/src/serverprotocol/PasLS.General.pas b/src/serverprotocol/PasLS.General.pas index 45e98de..28bde25 100644 --- a/src/serverprotocol/PasLS.General.pas +++ b/src/serverprotocol/PasLS.General.pas @@ -384,6 +384,14 @@ function TInitialize.Process(var Params : TLSPInitializeParams): TInitializeResu ServerSettings.Assign(Params.initializationOptions); PasLS.Settings.ClientInfo.Assign(Params.ClientInfo); + // Detect hierarchical document symbol support + if Assigned(Params.capabilities) and + Assigned(Params.capabilities.textDocument) and + Assigned(Params.capabilities.textDocument.documentSymbol) then + SetClientCapabilities(Params.capabilities.textDocument.documentSymbol.hierarchicalDocumentSymbolSupport) + else + SetClientCapabilities(false); + // replace macros in server settings Macros.Add('tmpdir', GetTempDir(true)); Macros.Add('root', URIToPath(Params.rootUri)); diff --git a/src/serverprotocol/PasLS.Symbols.pas b/src/serverprotocol/PasLS.Symbols.pas index ace357c..9803afd 100644 --- a/src/serverprotocol/PasLS.Symbols.pas +++ b/src/serverprotocol/PasLS.Symbols.pas @@ -78,6 +78,45 @@ TSymbolTableEntry = class property RawJSON: String read GetRawJSON; end; + { TSymbolBuilder } + + { Dual-mode symbol builder supporting both flat (SymbolInformation) + and hierarchical (DocumentSymbol) output } + + TSymbolMode = (smFlat, smHierarchical); + + TSymbolBuilder = class + private + FMode: TSymbolMode; + FEntry: TSymbolTableEntry; + FTool: TCodeTool; + + // For hierarchical mode: map className -> TDocumentSymbolEx + FClassMap: TFPHashObjectList; + FRootSymbols: TDocumentSymbolExItems; + + // For tracking current hierarchy + FCurrentClass: TDocumentSymbolEx; + + function FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode): TDocumentSymbolEx; + procedure SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTreeNode); + public + constructor Create(AEntry: TSymbolTableEntry; ATool: TCodeTool; AMode: TSymbolMode); + destructor Destroy; override; + + // Add symbols based on mode + function AddClass(Node: TCodeTreeNode; const Name: String): TSymbol; + function AddMethod(Node: TCodeTreeNode; const AClassName, AMethodName: String): TSymbol; + function AddGlobalFunction(Node: TCodeTreeNode; const Name: String): TSymbol; + + // Serialization + procedure SerializeSymbols; + + property Mode: TSymbolMode read FMode; + property CurrentClass: TDocumentSymbolEx read FCurrentClass write FCurrentClass; + property RootSymbols: TDocumentSymbolExItems read FRootSymbols; + end; + { TSymbolExtractor } TSymbolExtractor = class @@ -85,6 +124,7 @@ TSymbolExtractor = class Code: TCodeBuffer; Tool: TCodeTool; Entry: TSymbolTableEntry; + Builder: TSymbolBuilder; OverloadMap: TFPHashList; RelatedFiles: TFPHashList; IndentLevel: integer; @@ -185,6 +225,13 @@ TSymbolManager = class var SymbolManager: TSymbolManager = nil; +// Client capabilities storage +var + ClientSupportsHierarchicalSymbols: boolean = false; + +function GetSymbolMode: TSymbolMode; +procedure SetClientCapabilities(SupportsHierarchical: boolean); + implementation uses { RTL } @@ -195,6 +242,19 @@ implementation { Protocol } PasLS.Settings; +function GetSymbolMode: TSymbolMode; +begin + if ClientSupportsHierarchicalSymbols then + Result := smHierarchical + else + Result := smFlat; +end; + +procedure SetClientCapabilities(SupportsHierarchical: boolean); +begin + ClientSupportsHierarchicalSymbols := SupportsHierarchical; +end; + function GetFileKey(Path: String): ShortString; begin result := ExtractFileName(Path); @@ -236,6 +296,202 @@ constructor TSymbol.Create; Create(nil); end; +{ TSymbolBuilder } + +constructor TSymbolBuilder.Create(AEntry: TSymbolTableEntry; ATool: TCodeTool; AMode: TSymbolMode); +begin + FEntry := AEntry; + FTool := ATool; + FMode := AMode; + FCurrentClass := nil; + + if FMode = smHierarchical then + begin + FClassMap := TFPHashObjectList.Create(False); // Don't own objects - they're owned by FRootSymbols + FRootSymbols := TDocumentSymbolExItems.Create; + end; +end; + +destructor TSymbolBuilder.Destroy; +begin + if FMode = smHierarchical then + begin + FreeAndNil(FClassMap); + FreeAndNil(FRootSymbols); + end; + inherited; +end; + +procedure TSymbolBuilder.SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTreeNode); +var + StartPos, EndPos: TCodeXYPosition; +begin + if (FTool = nil) or (Symbol = nil) or (Node = nil) then + Exit; + + FTool.CleanPosToCaret(Node.StartPos, StartPos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + + Symbol.range.SetRange(StartPos.Y - 1, StartPos.X - 1, EndPos.Y - 1, EndPos.X - 1); + Symbol.selectionRange.SetRange(StartPos.Y - 1, StartPos.X - 1, StartPos.Y - 1, StartPos.X - 1); +end; + +function TSymbolBuilder.FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode): TDocumentSymbolEx; +begin + Result := nil; + + if FMode <> smHierarchical then + Exit; + + // Check if class already exists + Result := TDocumentSymbolEx(FClassMap.Find(AClassName)); + + if Result = nil then + begin + // Create new class symbol in FRootSymbols + Result := FRootSymbols.Add; + Result.name := AClassName; + Result.kind := TSymbolKind._Class; + + // Set ranges using the node + if Node <> nil then + SetNodeRange(Result, Node); + + // Add reference to the FRootSymbols item in class map + // Note: FClassMap doesn't own objects - they're owned by FRootSymbols + FClassMap.Add(AClassName, Result); + end; +end; + +function TSymbolBuilder.AddClass(Node: TCodeTreeNode; const Name: String): TSymbol; +var + CodePos, EndPos: TCodeXYPosition; +begin + case FMode of + smFlat: + begin + // Use existing flat mode: add to Entry.Symbols + if (FTool <> nil) and (Node <> nil) then + begin + FTool.CleanPosToCaret(Node.StartPos, CodePos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + Result := FEntry.AddSymbol(Name, TSymbolKind._Class, + CodePos.Code.FileName, + CodePos.Y, CodePos.X, + EndPos.Y, EndPos.X); + end + else + Result := nil; + end; + + smHierarchical: + begin + // For hierarchical mode, we don't add duplicate class symbols + // Classes are created on-demand when methods reference them + FCurrentClass := FindOrCreateClass(Name, Node); + Result := nil; // Hierarchical classes are not TSymbol + end; + end; +end; + +function TSymbolBuilder.AddMethod(Node: TCodeTreeNode; const AClassName, AMethodName: String): TSymbol; +var + ClassSymbol: TDocumentSymbolEx; + MethodSymbol: TDocumentSymbolEx; + CodePos, EndPos: TCodeXYPosition; +begin + case FMode of + smFlat: + begin + // Flat mode: add method with containerName + if (FTool <> nil) and (Node <> nil) then + begin + FTool.CleanPosToCaret(Node.StartPos, CodePos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + Result := FEntry.AddSymbol(AMethodName, TSymbolKind._Function, + CodePos.Code.FileName, + CodePos.Y, CodePos.X, + EndPos.Y, EndPos.X); + if Result <> nil then + Result.containerName := AClassName; + end + else + Result := nil; + end; + + smHierarchical: + begin + // Hierarchical mode: add method to class's children + ClassSymbol := FindOrCreateClass(AClassName, Node); + if ClassSymbol <> nil then + begin + MethodSymbol := TDocumentSymbolEx.Create(ClassSymbol.children); + MethodSymbol.name := AMethodName; + MethodSymbol.kind := TSymbolKind._Function; + SetNodeRange(MethodSymbol, Node); + end; + Result := nil; // Hierarchical symbols are not TSymbol + end; + end; +end; + +function TSymbolBuilder.AddGlobalFunction(Node: TCodeTreeNode; const Name: String): TSymbol; +var + GlobalSymbol: TDocumentSymbolEx; + CodePos, EndPos: TCodeXYPosition; +begin + case FMode of + smFlat: + begin + if (FTool <> nil) and (Node <> nil) then + begin + FTool.CleanPosToCaret(Node.StartPos, CodePos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + Result := FEntry.AddSymbol(Name, TSymbolKind._Function, + CodePos.Code.FileName, + CodePos.Y, CodePos.X, + EndPos.Y, EndPos.X); + end + else + Result := nil; + end; + + smHierarchical: + begin + // Add to root level (not under any class) + GlobalSymbol := TDocumentSymbolEx.Create(FRootSymbols); + GlobalSymbol.name := Name; + GlobalSymbol.kind := TSymbolKind._Function; + SetNodeRange(GlobalSymbol, Node); + Result := nil; // Hierarchical symbols are not TSymbol + end; + end; +end; + +procedure TSymbolBuilder.SerializeSymbols; +var + SerializedItems: TJSONArray; +begin + case FMode of + smFlat: + begin + // Use existing serialization + FEntry.SerializeSymbols; + end; + + smHierarchical: + begin + // Serialize DocumentSymbol hierarchy + SerializedItems := specialize TLSPStreaming.ToJSON(FRootSymbols) as TJSONArray; + try + FEntry.fRawJSON := SerializedItems.AsJSON; + finally + SerializedItems.Free; + end; + end; + end; +end; + { TSymbolTableEntry } function TSymbolTableEntry.GetRawJSON: String; @@ -488,9 +744,10 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod end; end; -procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNode); +procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNode); var Child: TCodeTreeNode; + TypeName: String; begin while Node <> nil do begin @@ -499,7 +756,8 @@ procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNod case Node.Desc of ctnClass,ctnClassHelper,ctnRecordHelper,ctnTypeHelper: begin - AddSymbol(TypeDefNode, TSymbolKind._Class); + TypeName := GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true); + Builder.AddClass(TypeDefNode, TypeName); end; ctnObject,ctnRecordType: begin @@ -508,7 +766,8 @@ procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNod ctnObjCClass,ctnObjCCategory,ctnObjCProtocol: begin // todo: ignore forward defs! - AddSymbol(TypeDefNode, TSymbolKind._Class); + TypeName := GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true); + Builder.AddClass(TypeDefNode, TypeName); Inc(IndentLevel); ExtractObjCClassMethods(TypeDefNode, Node.FirstChild); Dec(IndentLevel); @@ -517,7 +776,8 @@ procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNod begin // todo: is this a class/record??? PrintNodeDebug(Node.FirstChild, true); - AddSymbol(TypeDefNode, TSymbolKind._Class); + TypeName := GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true); + Builder.AddClass(TypeDefNode, TypeName); end; ctnEnumerationType: begin @@ -579,8 +839,13 @@ function TSymbolExtractor.ExtractProcedure(ParentNode, Node: TCodeTreeNode):TSym end; end; - Symbol := AddSymbol(Node, TSymbolKind._Function, Name); - Symbol.containerName:=containerName; + // Create symbol for overload tracking metadata only + // Builder will handle actual addition to Entry.Symbols or FRootSymbols + Symbol := TSymbol.Create(nil); + Symbol.name := Name; + Symbol.kind := TSymbolKind._Function; + Symbol.containerName := containerName; + OverloadMap.Add(Key, Symbol); // recurse into procedures to find nested procedures @@ -688,16 +953,36 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); Symbol:= ExtractProcedure(nil, Node); - if (Symbol<>nil) and (Symbol.containerName<>'') then + if (Symbol<>nil) then begin - if (LastClassSymbol=nil) or (Symbol.containerName<>LastClassSymbol.name) then - begin - LastClassSymbol:=AddSymbol(Node,TSymbolKind._Class,Symbol.containerName); - end - else - begin - LastClassSymbol.location.range.&end:=Symbol.location.range.&end; - end; + // Use Builder to add methods or global functions based on containerName + if Symbol.containerName<>'' then + begin + // This is a class method + Builder.AddMethod(Node, Symbol.containerName, Symbol.name); + + // In flat mode, we also need to track class symbols for range updates + if Builder.Mode = smFlat then + begin + if (LastClassSymbol=nil) or (Symbol.containerName<>LastClassSymbol.name) then + LastClassSymbol:=AddSymbol(Node,TSymbolKind._Class,Symbol.containerName) + else + LastClassSymbol.location.range.&end:=Symbol.location.range.&end; + end; + end + else + begin + // This is a global function + // In hierarchical mode, skip interface declarations + // to avoid duplicates - only show implementations + if (Builder.Mode = smHierarchical) and + (CodeSection = ctnInterface) then + begin + // Skip interface declaration - will be added from implementation + end + else + Builder.AddGlobalFunction(Node, Symbol.name); + end; end; end; @@ -712,12 +997,15 @@ constructor TSymbolExtractor.Create(_Entry: TSymbolTableEntry; _Code: TCodeBuffe Entry := _Entry; Code := _Code; Tool := _Tool; + Builder := TSymbolBuilder.Create(Entry, Tool, GetSymbolMode); OverloadMap := TFPHashList.Create; RelatedFiles := TFPHashList.Create; end; -destructor TSymbolExtractor.Destroy; +destructor TSymbolExtractor.Destroy; begin + Builder.SerializeSymbols; + Builder.Free; OverloadMap.Free; RelatedFiles.Free; inherited; @@ -1223,10 +1511,12 @@ procedure TSymbolManager.Reload(Code: TCodeBuffer; Always: Boolean = false); try Extractor.ExtractCodeSection(Tool.Tree.Root); finally - Extractor.Free; + Extractor.Free; // This calls Builder.SerializeSymbols in the destructor end; - Entry.SerializeSymbols; + // Note: Entry.fRawJSON is already set by Builder.SerializeSymbols in Extractor.Destroy + // Don't call Entry.SerializeSymbols here as it would overwrite with flat format! + DoLog('Reloaded %s in %d ms', [Code.FileName, MilliSecondsBetween(Now,StartTime)]); end; From fee619260e0c8bab64874dac29e8a620ce4e456d Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Sat, 27 Dec 2025 02:37:41 +0800 Subject: [PATCH 2/8] Improve hierarchical DocumentSymbol for breadcrumb support - Reintroduce interface/implementation namespaces in hierarchical mode for proper breadcrumb navigation (flat mode unchanged) - Add nested function/procedure support in symbol hierarchy - Support program files (.lpr/.dpr) with separate symbols for type declarations and method implementation containers - Add Python integration tests for breadcrumb and Outline validation --- src/serverprotocol/PasLS.Symbols.pas | 274 ++++++++++-- src/tests/test_breadcrumb.py | 628 +++++++++++++++++++++++++++ src/tests/test_program.lpr | 126 ++++++ src/tests/test_symbols.pas | 131 ++++++ 4 files changed, 1128 insertions(+), 31 deletions(-) create mode 100644 src/tests/test_breadcrumb.py create mode 100644 src/tests/test_program.lpr create mode 100644 src/tests/test_symbols.pas diff --git a/src/serverprotocol/PasLS.Symbols.pas b/src/serverprotocol/PasLS.Symbols.pas index 9803afd..bcf5218 100644 --- a/src/serverprotocol/PasLS.Symbols.pas +++ b/src/serverprotocol/PasLS.Symbols.pas @@ -97,17 +97,32 @@ TSymbolBuilder = class // For tracking current hierarchy FCurrentClass: TDocumentSymbolEx; + // Last added function/method (for nested function support) + FLastAddedFunction: TDocumentSymbolEx; - function FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode): TDocumentSymbolEx; + // For Interface/Implementation namespaces (hierarchical mode) + FInterfaceSymbol: TDocumentSymbolEx; + FImplementationSymbol: TDocumentSymbolEx; + FCurrentSectionSymbol: TDocumentSymbolEx; + + function FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode; IsImplementationContainer: Boolean = False): TDocumentSymbolEx; procedure SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTreeNode); + function GetCurrentContainer: TDocumentSymbolExItems; public constructor Create(AEntry: TSymbolTableEntry; ATool: TCodeTool; AMode: TSymbolMode); destructor Destroy; override; + // Section management (hierarchical mode) + procedure BeginInterfaceSection(Node: TCodeTreeNode); + procedure BeginImplementationSection(Node: TCodeTreeNode); + // Add symbols based on mode function AddClass(Node: TCodeTreeNode; const Name: String): TSymbol; function AddMethod(Node: TCodeTreeNode; const AClassName, AMethodName: String): TSymbol; function AddGlobalFunction(Node: TCodeTreeNode; const Name: String): TSymbol; + function AddStruct(Node: TCodeTreeNode; const Name: String): TSymbol; + // Add nested function as child of parent (hierarchical mode only) + function AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name: String): TDocumentSymbolEx; // Serialization procedure SerializeSymbols; @@ -115,6 +130,7 @@ TSymbolBuilder = class property Mode: TSymbolMode read FMode; property CurrentClass: TDocumentSymbolEx read FCurrentClass write FCurrentClass; property RootSymbols: TDocumentSymbolExItems read FRootSymbols; + property LastAddedFunction: TDocumentSymbolEx read FLastAddedFunction; end; { TSymbolExtractor } @@ -135,6 +151,7 @@ TSymbolExtractor = class function AddSymbol(Node: TCodeTreeNode; Kind: TSymbolKind; Name: String; Container: String = ''): TSymbol; overload; procedure ExtractCodeSection(Node: TCodeTreeNode); function ExtractProcedure(ParentNode, Node: TCodeTreeNode):TSymbol; + procedure ProcessNestedFunctions(Node: TCodeTreeNode; ParentSymbol: TDocumentSymbolEx); procedure ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNode); procedure ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNode); public @@ -336,20 +353,76 @@ procedure TSymbolBuilder.SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTree Symbol.selectionRange.SetRange(StartPos.Y - 1, StartPos.X - 1, StartPos.Y - 1, StartPos.X - 1); end; -function TSymbolBuilder.FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode): TDocumentSymbolEx; +function TSymbolBuilder.GetCurrentContainer: TDocumentSymbolExItems; +begin + // In hierarchical mode, return the current section's children if available + if (FMode = smHierarchical) and (FCurrentSectionSymbol <> nil) then + Result := TDocumentSymbolExItems(FCurrentSectionSymbol.children) + else + Result := FRootSymbols; +end; + +procedure TSymbolBuilder.BeginInterfaceSection(Node: TCodeTreeNode); +begin + if FMode <> smHierarchical then + Exit; + + // Create interface namespace symbol + FInterfaceSymbol := TDocumentSymbolEx.Create(FRootSymbols); + FInterfaceSymbol.name := kSymbolName_Interface; + FInterfaceSymbol.kind := TSymbolKind._Namespace; + SetNodeRange(FInterfaceSymbol, Node); + FCurrentSectionSymbol := FInterfaceSymbol; +end; + +procedure TSymbolBuilder.BeginImplementationSection(Node: TCodeTreeNode); +begin + if FMode <> smHierarchical then + Exit; + + // Create implementation namespace symbol + FImplementationSymbol := TDocumentSymbolEx.Create(FRootSymbols); + FImplementationSymbol.name := kSymbolName_Implementation; + FImplementationSymbol.kind := TSymbolKind._Namespace; + SetNodeRange(FImplementationSymbol, Node); + FCurrentSectionSymbol := FImplementationSymbol; +end; + +function TSymbolBuilder.FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode; IsImplementationContainer: Boolean = False): TDocumentSymbolEx; +var + Container: TDocumentSymbolExItems; + Key: String; begin Result := nil; if FMode <> smHierarchical then Exit; - // Check if class already exists - Result := TDocumentSymbolEx(FClassMap.Find(AClassName)); + // F1 Scheme: Classes exist in both Interface and Implementation namespaces + // Use section-specific key to distinguish between interface declaration and implementation methods + // Note: Must check for nil first, otherwise nil = nil is True for program files + if (FInterfaceSymbol <> nil) and (FCurrentSectionSymbol = FInterfaceSymbol) then + Key := 'interface.' + AClassName + else if (FImplementationSymbol <> nil) and (FCurrentSectionSymbol = FImplementationSymbol) then + Key := 'implementation.' + AClassName + else + begin + // Program files: distinguish between declaration and implementation container + if IsImplementationContainer then + Key := AClassName + '.impl' + else + Key := AClassName; + end; + + // Check if class already exists in current section + Result := TDocumentSymbolEx(FClassMap.Find(Key)); if Result = nil then begin - // Create new class symbol in FRootSymbols - Result := FRootSymbols.Add; + // Create class in current section's namespace + Container := GetCurrentContainer; + + Result := TDocumentSymbolEx.Create(Container); Result.name := AClassName; Result.kind := TSymbolKind._Class; @@ -357,9 +430,8 @@ function TSymbolBuilder.FindOrCreateClass(const AClassName: String; Node: TCodeT if Node <> nil then SetNodeRange(Result, Node); - // Add reference to the FRootSymbols item in class map - // Note: FClassMap doesn't own objects - they're owned by FRootSymbols - FClassMap.Add(AClassName, Result); + // Add reference to class map for lookup with section-specific key + FClassMap.Add(Key, Result); end; end; @@ -386,8 +458,9 @@ function TSymbolBuilder.AddClass(Node: TCodeTreeNode; const Name: String): TSymb smHierarchical: begin - // For hierarchical mode, we don't add duplicate class symbols - // Classes are created on-demand when methods reference them + // F1 Scheme: Create class in current section's namespace + // - Interface section: class declaration + // - Implementation section: class with method implementations (rare) FCurrentClass := FindOrCreateClass(Name, Node); Result := nil; // Hierarchical classes are not TSymbol end; @@ -421,14 +494,45 @@ function TSymbolBuilder.AddMethod(Node: TCodeTreeNode; const AClassName, AMethod smHierarchical: begin - // Hierarchical mode: add method to class's children - ClassSymbol := FindOrCreateClass(AClassName, Node); + // F1 Scheme: Add method as child of class in current section + // - Interface section: methods are just declarations (rarely used) + // - Implementation section: methods are implementations under Implementation namespace + // - Program files: methods go into implementation container (separate from type declaration) + ClassSymbol := FindOrCreateClass(AClassName, nil, True); if ClassSymbol <> nil then begin MethodSymbol := TDocumentSymbolEx.Create(ClassSymbol.children); MethodSymbol.name := AMethodName; MethodSymbol.kind := TSymbolKind._Function; SetNodeRange(MethodSymbol, Node); + FLastAddedFunction := MethodSymbol; + + // Initialize or extend class range to include method + // In implementation section, class has no declaration node, + // so we use methods' ranges to define the class range + if (ClassSymbol.range.start.line = 0) and (ClassSymbol.range.&end.line = 0) then + begin + // First method - initialize class range + ClassSymbol.range.start.line := MethodSymbol.range.start.line; + ClassSymbol.range.start.character := MethodSymbol.range.start.character; + ClassSymbol.range.&end.line := MethodSymbol.range.&end.line; + ClassSymbol.range.&end.character := MethodSymbol.range.&end.character; + ClassSymbol.selectionRange := ClassSymbol.range; + end + else + begin + // Extend class range to include this method + if MethodSymbol.range.start.line < ClassSymbol.range.start.line then + begin + ClassSymbol.range.start.line := MethodSymbol.range.start.line; + ClassSymbol.range.start.character := MethodSymbol.range.start.character; + end; + if MethodSymbol.range.&end.line > ClassSymbol.range.&end.line then + begin + ClassSymbol.range.&end.line := MethodSymbol.range.&end.line; + ClassSymbol.range.&end.character := MethodSymbol.range.&end.character; + end; + end; end; Result := nil; // Hierarchical symbols are not TSymbol end; @@ -458,16 +562,65 @@ function TSymbolBuilder.AddGlobalFunction(Node: TCodeTreeNode; const Name: Strin smHierarchical: begin - // Add to root level (not under any class) - GlobalSymbol := TDocumentSymbolEx.Create(FRootSymbols); + // Add to current container (Interface or Implementation namespace) + GlobalSymbol := TDocumentSymbolEx.Create(GetCurrentContainer); GlobalSymbol.name := Name; GlobalSymbol.kind := TSymbolKind._Function; SetNodeRange(GlobalSymbol, Node); + FLastAddedFunction := GlobalSymbol; + Result := nil; // Hierarchical symbols are not TSymbol + end; + end; +end; + +function TSymbolBuilder.AddStruct(Node: TCodeTreeNode; const Name: String): TSymbol; +var + StructSymbol: TDocumentSymbolEx; + CodePos, EndPos: TCodeXYPosition; +begin + case FMode of + smFlat: + begin + if (FTool <> nil) and (Node <> nil) then + begin + FTool.CleanPosToCaret(Node.StartPos, CodePos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + Result := FEntry.AddSymbol(Name, TSymbolKind._Struct, + CodePos.Code.FileName, + CodePos.Y, CodePos.X, + EndPos.Y, EndPos.X); + end + else + Result := nil; + end; + + smHierarchical: + begin + // Add struct to current container (Interface or Implementation namespace) + StructSymbol := TDocumentSymbolEx.Create(GetCurrentContainer); + StructSymbol.name := Name; + StructSymbol.kind := TSymbolKind._Struct; + SetNodeRange(StructSymbol, Node); Result := nil; // Hierarchical symbols are not TSymbol end; end; end; +function TSymbolBuilder.AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name: String): TDocumentSymbolEx; +begin + Result := nil; + if FMode <> smHierarchical then + Exit; + if Parent = nil then + Exit; + + // Create nested function as child of parent + Result := TDocumentSymbolEx.Create(Parent.children); + Result.name := Name; + Result.kind := TSymbolKind._Function; + SetNodeRange(Result, Node); +end; + procedure TSymbolBuilder.SerializeSymbols; var SerializedItems: TJSONArray; @@ -744,6 +897,20 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod end; end; +// Helper to clean type name - removes trailing operators like '=' from 'TMyClass=' +function CleanTypeName(const AName: String): String; +var + Len: Integer; +const + OpChars = ['+', '*', '-', '/', '<', '>', '=', ':']; +begin + Result := AName; + Len := Length(Result); + while (Len > 0) and (Result[Len] in OpChars) do + Dec(Len); + SetLength(Result, Len); +end; + procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNode); var Child: TCodeTreeNode; @@ -756,17 +923,18 @@ procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNod case Node.Desc of ctnClass,ctnClassHelper,ctnRecordHelper,ctnTypeHelper: begin - TypeName := GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true); + TypeName := CleanTypeName(GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true)); Builder.AddClass(TypeDefNode, TypeName); end; ctnObject,ctnRecordType: begin - AddSymbol(TypeDefNode, TSymbolKind._Struct); + TypeName := CleanTypeName(GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true)); + Builder.AddStruct(TypeDefNode, TypeName); end; ctnObjCClass,ctnObjCCategory,ctnObjCProtocol: begin // todo: ignore forward defs! - TypeName := GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true); + TypeName := CleanTypeName(GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true)); Builder.AddClass(TypeDefNode, TypeName); Inc(IndentLevel); ExtractObjCClassMethods(TypeDefNode, Node.FirstChild); @@ -776,7 +944,7 @@ procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNod begin // todo: is this a class/record??? PrintNodeDebug(Node.FirstChild, true); - TypeName := GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true); + TypeName := CleanTypeName(GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true)); Builder.AddClass(TypeDefNode, TypeName); end; ctnEnumerationType: @@ -868,6 +1036,39 @@ function TSymbolExtractor.ExtractProcedure(ParentNode, Node: TCodeTreeNode):TSym result := Symbol; end; +procedure TSymbolExtractor.ProcessNestedFunctions(Node: TCodeTreeNode; ParentSymbol: TDocumentSymbolEx); +var + Child: TCodeTreeNode; + NestedSymbol: TDocumentSymbolEx; + Name: String; +begin + // Only process in hierarchical mode + if Builder.Mode <> smHierarchical then + Exit; + if ParentSymbol = nil then + Exit; + + // Skip forward/external declarations + if Tool.ProcNodeHasSpecifier(Node, psForward) or + Tool.ProcNodeHasSpecifier(Node, psExternal) then + Exit; + + // Find nested procedures in the node's children + Child := Node.FirstChild; + while Child <> nil do + begin + if Child.Desc = ctnProcedure then + begin + Name := Tool.ExtractProcName(Child, [phpWithoutClassName]); + NestedSymbol := Builder.AddNestedFunction(ParentSymbol, Child, Name); + // Recursively process nested functions within this nested function + if NestedSymbol <> nil then + ProcessNestedFunctions(Child, NestedSymbol); + end; + Child := Child.NextBrother; + end; +end; + procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); var Symbol,LastClassSymbol: TSymbol; @@ -901,9 +1102,21 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); begin case Node.Desc of ctnInterface: - AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Interface); - //ctnImplementation: - // AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Implementation); + begin + // For hierarchical mode, create Interface namespace + Builder.BeginInterfaceSection(Node); + // For flat mode, add namespace symbol + if Builder.Mode = smFlat then + AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Interface); + end; + ctnImplementation: + begin + // For hierarchical mode, create Implementation namespace + Builder.BeginImplementationSection(Node); + // For flat mode, optionally add namespace symbol (currently disabled) + //if Builder.Mode = smFlat then + // AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Implementation); + end; end; CodeSection := Node.Desc; Inc(IndentLevel); @@ -960,6 +1173,8 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); begin // This is a class method Builder.AddMethod(Node, Symbol.containerName, Symbol.name); + // Process nested functions (hierarchical mode only) + ProcessNestedFunctions(Node, Builder.LastAddedFunction); // In flat mode, we also need to track class symbols for range updates if Builder.Mode = smFlat then @@ -973,15 +1188,12 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); else begin // This is a global function - // In hierarchical mode, skip interface declarations - // to avoid duplicates - only show implementations - if (Builder.Mode = smHierarchical) and - (CodeSection = ctnInterface) then - begin - // Skip interface declaration - will be added from implementation - end - else - Builder.AddGlobalFunction(Node, Symbol.name); + // F1 Scheme: Add to current section's namespace + // - Interface section: function declaration + // - Implementation section: function implementation + Builder.AddGlobalFunction(Node, Symbol.name); + // Process nested functions (hierarchical mode only) + ProcessNestedFunctions(Node, Builder.LastAddedFunction); end; end; diff --git a/src/tests/test_breadcrumb.py b/src/tests/test_breadcrumb.py new file mode 100644 index 0000000..e1fc157 --- /dev/null +++ b/src/tests/test_breadcrumb.py @@ -0,0 +1,628 @@ +#!/usr/bin/env python3 +""" +Test script for LSP DocumentSymbol breadcrumb functionality. + +This script tests the Pascal Language Server's hierarchical DocumentSymbol +support by verifying that the breadcrumb path is correct for various +cursor positions in test_symbols.pas. +""" + +import json +import subprocess +import sys +import os +from pathlib import Path +from typing import Optional + +# Path configuration +SCRIPT_DIR = Path(__file__).parent +PASLS_EXE = SCRIPT_DIR.parent / "standard" / "lib" / "i386-win32" / "pasls.exe" +TEST_FILE = SCRIPT_DIR / "test_symbols.pas" +TEST_PROGRAM_FILE = SCRIPT_DIR / "test_program.lpr" + + +class LSPClient: + """Simple LSP client for testing.""" + + def __init__(self, server_path: str): + self.server_path = server_path + self.process: Optional[subprocess.Popen] = None + self.request_id = 0 + + def start(self): + """Start the LSP server.""" + self.process = subprocess.Popen( + [str(self.server_path)], + stdin=subprocess.PIPE, + stdout=subprocess.PIPE, + stderr=subprocess.PIPE, + ) + + def stop(self): + """Stop the LSP server.""" + if self.process: + self.process.terminate() + self.process.wait() + + def send_request(self, method: str, params: dict) -> dict: + """Send an LSP request and wait for response.""" + self.request_id += 1 + request = { + "jsonrpc": "2.0", + "id": self.request_id, + "method": method, + "params": params + } + return self._send_message(request) + + def send_notification(self, method: str, params: dict): + """Send an LSP notification (no response expected).""" + notification = { + "jsonrpc": "2.0", + "method": method, + "params": params + } + self._write_message(notification) + + def _write_message(self, message: dict): + """Write a message to the server.""" + content = json.dumps(message) + header = f"Content-Length: {len(content)}\r\n\r\n" + self.process.stdin.write(header.encode('utf-8')) + self.process.stdin.write(content.encode('utf-8')) + self.process.stdin.flush() + + def _read_message(self) -> dict: + """Read a message from the server.""" + # Read headers + headers = {} + while True: + line = self.process.stdout.readline().decode('utf-8') + if line == '\r\n' or line == '\n': + break + if ':' in line: + key, value = line.split(':', 1) + headers[key.strip()] = value.strip() + + # Read content + content_length = int(headers.get('Content-Length', 0)) + if content_length > 0: + content = self.process.stdout.read(content_length).decode('utf-8') + return json.loads(content) + return {} + + def _send_message(self, message: dict) -> dict: + """Send a message and read response.""" + self._write_message(message) + + # Read responses until we get one matching our request id + while True: + response = self._read_message() + if response.get('id') == message.get('id'): + return response + # Skip notifications + + +def find_outline_path(symbols: list, line: int, parent_path: list = None) -> list: + """ + Find the outline path for a given line number (for Outline view testing). + + This uses parent-child relationships regardless of range containment. + In Pascal, class declarations and method implementations are separate, + so we search all children regardless of parent range. + """ + if parent_path is None: + parent_path = [] + + best_match = None + best_match_size = float('inf') # Smaller range = more specific match + + for symbol in symbols: + start_line = symbol['range']['start']['line'] + end_line = symbol['range']['end']['line'] + current_path = parent_path + [symbol['name']] + + # Always check children first (they might contain the line even if parent doesn't) + children = symbol.get('children', []) + if children: + child_path = find_outline_path(children, line, current_path) + if child_path and len(child_path) > len(current_path): + # Found a match in children + child_symbol = None + for c in children: + if c['name'] == child_path[len(current_path)]: + child_symbol = c + break + if child_symbol: + child_size = child_symbol['range']['end']['line'] - child_symbol['range']['start']['line'] + if child_size < best_match_size: + best_match = child_path + best_match_size = child_size + + # Check if line is within this symbol's range + if start_line <= line <= end_line: + range_size = end_line - start_line + if range_size < best_match_size: + best_match = current_path + best_match_size = range_size + + return best_match + + +def find_breadcrumb_by_range(symbols: list, line: int) -> list: + """ + Find the breadcrumb path based on range containment only (VS Code behavior). + + VS Code shows breadcrumb based on which symbol ranges contain the cursor. + This traverses the symbol tree hierarchy directly, building a chain of + symbols whose ranges contain the line. + + Note: This handles duplicate symbol names correctly by using the actual + tree structure rather than flattening and matching by name path. + """ + def find_containing_path(symbols_list, target_line): + """Recursively find the deepest path of symbols containing the line.""" + for symbol in symbols_list: + start_line = symbol['range']['start']['line'] + end_line = symbol['range']['end']['line'] + + if start_line <= target_line <= end_line: + # This symbol contains the line, start building path + path = [symbol['name']] + + # Check children for a more specific (deeper) match + children = symbol.get('children', []) + if children: + child_path = find_containing_path(children, target_line) + if child_path: + path.extend(child_path) + + return path + + return None + + # Try each top-level symbol and find the longest matching path + best_result = None + + for symbol in symbols: + result = find_containing_path([symbol], line) + if result and (best_result is None or len(result) > len(best_result)): + best_result = result + + return best_result + + +def run_tests(): + """Run all tests for Outline and Breadcrumb functionality.""" + + # Test cases: (line_number, expected_path, is_critical) + # Line numbers are 1-based (will be converted to 0-based for LSP) + # is_critical: True = must pass for overall success, False = known limitation + # + # F1 Scheme: Interface and Implementation as namespaces + # - Interface section: class declarations → interface > ClassName + # - Implementation section: method implementations → implementation > ClassName > MethodName + # - Implementation section: global functions → implementation > FunctionName + test_cases = [ + # Type declarations in interface section - CRITICAL + (22, ['interface', 'TTestClassA'], True), # Inside TTestClassA declaration + (32, ['interface', 'TTestClassB'], True), # Inside TTestClassB declaration + (41, ['interface', 'TTestRecord'], True), # Inside TTestRecord + + # Global function declarations in interface section - CRITICAL + (45, ['interface', 'GlobalFunction1'], True), # GlobalFunction1 declaration + (46, ['interface', 'GlobalFunction2'], True), # GlobalFunction2 declaration + + # Class methods (implementation section) - CRITICAL + # F1 Scheme: implementation > ClassName > MethodName + (77, ['implementation', 'TTestClassA', 'MethodA1'], True), # Test point 1: inside MethodA1 + (84, ['implementation', 'TTestClassA', 'MethodA2'], True), # Test point 2: inside MethodA2 + (90, ['implementation', 'TTestClassA', 'MethodA3'], True), # Test point 3: inside MethodA3 + (98, ['implementation', 'TTestClassB', 'MethodB1'], True), # Test point 4: inside MethodB1 + (104, ['implementation', 'TTestClassB', 'MethodB2'], True), # Test point 5: inside MethodB2 + + # Nested functions in class methods - CRITICAL + (59, ['implementation', 'TTestClassA', 'MethodA1', 'NestedProc1'], True), # Inside NestedProc1 + (72, ['implementation', 'TTestClassA', 'MethodA1', 'NestedFunc2'], True), # Inside NestedFunc2 + (68, ['implementation', 'TTestClassA', 'MethodA1', 'NestedFunc2', 'DeeplyNested'], True), # Inside DeeplyNested + + # Global functions - under Implementation namespace (F1 scheme) + (117, ['implementation', 'GlobalFunction1', 'NestedInGlobal'], True), # Inside NestedInGlobal + (121, ['implementation', 'GlobalFunction1'], True), # Test point 6: inside GlobalFunction1 + (127, ['implementation', 'GlobalFunction2'], True), # Test point 7: inside GlobalFunction2 + ] + + print("=" * 70) + print("LSP DocumentSymbol Test (Outline & Breadcrumb)") + print("=" * 70) + print(f"Server: {PASLS_EXE}") + print(f"Test file: {TEST_FILE}") + print() + + # Check if server exists + if not PASLS_EXE.exists(): + print(f"ERROR: Server not found: {PASLS_EXE}") + return False + + if not TEST_FILE.exists(): + print(f"ERROR: Test file not found: {TEST_FILE}") + return False + + # Start LSP client + client = LSPClient(str(PASLS_EXE)) + + try: + print("Starting LSP server...") + client.start() + + # Initialize + print("Sending initialize request...") + init_response = client.send_request("initialize", { + "processId": os.getpid(), + "capabilities": { + "textDocument": { + "documentSymbol": { + "hierarchicalDocumentSymbolSupport": True + } + } + }, + "rootUri": f"file:///{TEST_FILE.parent.as_posix()}", + "workspaceFolders": None + }) + + if 'error' in init_response: + print(f"ERROR: Initialize failed: {init_response['error']}") + return False + + # Send initialized notification + client.send_notification("initialized", {}) + + # Open document + print("Opening test document...") + with open(TEST_FILE, 'r', encoding='utf-8') as f: + content = f.read() + + file_uri = f"file:///{TEST_FILE.as_posix()}" + client.send_notification("textDocument/didOpen", { + "textDocument": { + "uri": file_uri, + "languageId": "pascal", + "version": 1, + "text": content + } + }) + + # Get document symbols + print("Requesting document symbols...") + symbols_response = client.send_request("textDocument/documentSymbol", { + "textDocument": { + "uri": file_uri + } + }) + + if 'error' in symbols_response: + print(f"ERROR: documentSymbol failed: {symbols_response['error']}") + return False + + symbols = symbols_response.get('result', []) + + if not symbols: + print("ERROR: No symbols returned") + return False + + print(f"Received {len(symbols)} top-level symbols") + print() + + # Print symbol tree for debugging + print("Symbol tree:") + print("-" * 40) + print_symbol_tree(symbols) + print("-" * 40) + print() + + # ==================== OUTLINE TESTS ==================== + print("=" * 70) + print("OUTLINE TESTS (parent-child hierarchy)") + print("=" * 70) + + outline_passed = 0 + outline_failed = 0 + outline_critical_failed = 0 + + for line, expected, is_critical in test_cases: + lsp_line = line - 1 + actual = find_outline_path(symbols, lsp_line) + + if actual == expected: + status = "PASS" + outline_passed += 1 + else: + status = "FAIL" if is_critical else "WARN" + outline_failed += 1 + if is_critical: + outline_critical_failed += 1 + + expected_str = " > ".join(expected) if expected else "(none)" + actual_str = " > ".join(actual) if actual else "(none)" + + print(f"Line {line:3d}: {status}") + print(f" Expected: {expected_str}") + print(f" Actual: {actual_str}") + if status == "FAIL": + print(f" *** CRITICAL MISMATCH ***") + elif status == "WARN": + print(f" (known limitation)") + print() + + print("-" * 70) + print(f"Outline Results: {outline_passed} passed, {outline_failed} failed ({outline_critical_failed} critical)") + + # ==================== BREADCRUMB TESTS ==================== + print() + print("=" * 70) + print("BREADCRUMB TESTS (range containment - VS Code behavior)") + print("=" * 70) + + breadcrumb_passed = 0 + breadcrumb_failed = 0 + breadcrumb_critical_failed = 0 + + for line, expected, is_critical in test_cases: + lsp_line = line - 1 + actual = find_breadcrumb_by_range(symbols, lsp_line) + + if actual == expected: + status = "PASS" + breadcrumb_passed += 1 + else: + status = "FAIL" if is_critical else "WARN" + breadcrumb_failed += 1 + if is_critical: + breadcrumb_critical_failed += 1 + + expected_str = " > ".join(expected) if expected else "(none)" + actual_str = " > ".join(actual) if actual else "(none)" + + print(f"Line {line:3d}: {status}") + print(f" Expected: {expected_str}") + print(f" Actual: {actual_str}") + if status == "FAIL": + print(f" *** CRITICAL MISMATCH ***") + elif status == "WARN": + print(f" (known limitation)") + print() + + print("-" * 70) + print(f"Breadcrumb Results: {breadcrumb_passed} passed, {breadcrumb_failed} failed ({breadcrumb_critical_failed} critical)") + + # ==================== SUMMARY ==================== + print() + print("=" * 70) + print("SUMMARY") + print("=" * 70) + print(f"Outline: {outline_passed}/{len(test_cases)} passed ({outline_critical_failed} critical failures)") + print(f"Breadcrumb: {breadcrumb_passed}/{len(test_cases)} passed ({breadcrumb_critical_failed} critical failures)") + if outline_critical_failed == 0 and breadcrumb_critical_failed == 0: + print("All critical tests PASSED!") + print("=" * 70) + + # Only critical failures count for overall success + return outline_critical_failed == 0 and breadcrumb_critical_failed == 0 + + except Exception as e: + print(f"ERROR: {e}") + import traceback + traceback.print_exc() + return False + + finally: + print("Stopping LSP server...") + client.stop() + + +def print_symbol_tree(symbols: list, indent: int = 0): + """Print the symbol tree for debugging.""" + for symbol in symbols: + name = symbol['name'] + kind = symbol.get('kind', '?') + start = symbol['range']['start']['line'] + 1 + end = symbol['range']['end']['line'] + 1 + print(f"{' ' * indent}{name} (kind={kind}, lines {start}-{end})") + + children = symbol.get('children', []) + if children: + print_symbol_tree(children, indent + 1) + + +def run_program_tests(): + """Run tests for program files (.lpr/.dpr) without interface/implementation.""" + + # Test cases for program files: (line_number, expected_path, is_critical) + # In program files, there are no interface/implementation namespaces + # F1 Scheme: Two symbols per class - declaration + implementation container + test_cases = [ + # Type declarations - CRITICAL + (18, ['TTestClass'], True), # Inside TTestClass declaration + (27, ['TTestClass2'], True), # Inside TTestClass2 declaration + (35, ['TTestRecord'], True), # Inside TTestRecord declaration + + # TTestClass methods - CRITICAL (under TTestClass implementation container) + (50, ['TTestClass', 'TestMethod1'], True), # Inside TestMethod1 + (56, ['TTestClass', 'TestMethod2'], True), # Inside TestMethod2 + + # Nested function in TTestClass method - CRITICAL + (46, ['TTestClass', 'TestMethod1', 'NestedProc'], True), # Inside NestedProc + + # TTestClass2 methods - CRITICAL (under TTestClass2 implementation container) + (64, ['TTestClass2', 'MethodA'], True), # Inside MethodA + (78, ['TTestClass2', 'MethodB'], True), # Inside MethodB + + # Nested function in TTestClass2 method - CRITICAL + (74, ['TTestClass2', 'MethodB', 'NestedFunc'], True), # Inside NestedFunc + + # Global functions - CRITICAL + (95, ['GlobalProc'], True), # Inside GlobalProc + (101, ['GlobalFunc'], True), # Inside GlobalFunc + + # Nested function in global function - CRITICAL + (91, ['GlobalProc', 'NestedInGlobal'], True), # Inside NestedInGlobal + ] + + print("=" * 70) + print("LSP DocumentSymbol Test - PROGRAM FILES (.lpr/.dpr)") + print("=" * 70) + print(f"Server: {PASLS_EXE}") + print(f"Test file: {TEST_PROGRAM_FILE}") + print() + + # Check if server exists + if not PASLS_EXE.exists(): + print(f"ERROR: Server not found: {PASLS_EXE}") + return False + + if not TEST_PROGRAM_FILE.exists(): + print(f"ERROR: Test file not found: {TEST_PROGRAM_FILE}") + return False + + # Start LSP client + client = LSPClient(str(PASLS_EXE)) + + try: + print("Starting LSP server...") + client.start() + + # Initialize + print("Sending initialize request...") + init_response = client.send_request("initialize", { + "processId": os.getpid(), + "capabilities": { + "textDocument": { + "documentSymbol": { + "hierarchicalDocumentSymbolSupport": True + } + } + }, + "rootUri": f"file:///{TEST_PROGRAM_FILE.parent.as_posix()}", + "workspaceFolders": None + }) + + if 'error' in init_response: + print(f"ERROR: Initialize failed: {init_response['error']}") + return False + + # Send initialized notification + client.send_notification("initialized", {}) + + # Open document + print("Opening test document...") + with open(TEST_PROGRAM_FILE, 'r', encoding='utf-8') as f: + content = f.read() + + file_uri = f"file:///{TEST_PROGRAM_FILE.as_posix()}" + client.send_notification("textDocument/didOpen", { + "textDocument": { + "uri": file_uri, + "languageId": "pascal", + "version": 1, + "text": content + } + }) + + # Get document symbols + print("Requesting document symbols...") + symbols_response = client.send_request("textDocument/documentSymbol", { + "textDocument": { + "uri": file_uri + } + }) + + if 'error' in symbols_response: + print(f"ERROR: documentSymbol failed: {symbols_response['error']}") + return False + + symbols = symbols_response.get('result', []) + + if not symbols: + print("ERROR: No symbols returned") + return False + + print(f"Received {len(symbols)} top-level symbols") + print() + + # Print symbol tree for debugging + print("Symbol tree:") + print("-" * 40) + print_symbol_tree(symbols) + print("-" * 40) + print() + + # Run breadcrumb tests + print("=" * 70) + print("BREADCRUMB TESTS (range containment - VS Code behavior)") + print("=" * 70) + + breadcrumb_passed = 0 + breadcrumb_failed = 0 + breadcrumb_critical_failed = 0 + + for line, expected, is_critical in test_cases: + lsp_line = line - 1 + actual = find_breadcrumb_by_range(symbols, lsp_line) + + if actual == expected: + status = "PASS" + breadcrumb_passed += 1 + else: + status = "FAIL" if is_critical else "WARN" + breadcrumb_failed += 1 + if is_critical: + breadcrumb_critical_failed += 1 + + expected_str = " > ".join(expected) if expected else "(none)" + actual_str = " > ".join(actual) if actual else "(none)" + + print(f"Line {line:3d}: {status}") + print(f" Expected: {expected_str}") + print(f" Actual: {actual_str}") + if status == "FAIL": + print(f" *** CRITICAL MISMATCH ***") + elif status == "WARN": + print(f" (known limitation)") + print() + + print("-" * 70) + print(f"Breadcrumb Results: {breadcrumb_passed} passed, {breadcrumb_failed} failed ({breadcrumb_critical_failed} critical)") + + # Summary + print() + print("=" * 70) + print("SUMMARY") + print("=" * 70) + print(f"Program file tests: {breadcrumb_passed}/{len(test_cases)} passed ({breadcrumb_critical_failed} critical failures)") + if breadcrumb_critical_failed == 0: + print("All critical tests PASSED!") + print("=" * 70) + + return breadcrumb_critical_failed == 0 + + except Exception as e: + print(f"ERROR: {e}") + import traceback + traceback.print_exc() + return False + + finally: + print("Stopping LSP server...") + client.stop() + + +if __name__ == '__main__': + # Run unit file tests + success_unit = run_tests() + print("\n\n") + + # Run program file tests + success_program = run_program_tests() + + # Overall success if both pass + sys.exit(0 if (success_unit and success_program) else 1) diff --git a/src/tests/test_program.lpr b/src/tests/test_program.lpr new file mode 100644 index 0000000..22d6558 --- /dev/null +++ b/src/tests/test_program.lpr @@ -0,0 +1,126 @@ +program test_program; + +// ============================================================================= +// Test file for LSP DocumentSymbol in program files (.lpr/.dpr) +// Program files don't have interface/implementation sections +// ============================================================================= + +{$mode objfpc}{$H+} + +uses + SysUtils, Classes; + +type + { TTestClass } + TTestClass = class + private + FValue: Integer; + public + procedure TestMethod1; + function TestMethod2: Integer; + end; + + { TTestClass2 - Second test class } + TTestClass2 = class + private + FName: String; + public + procedure MethodA; + procedure MethodB; + end; + + { TTestRecord - Test record type } + TTestRecord = record + X, Y: Integer; + Name: String; + end; + +{ TTestClass } + +procedure TTestClass.TestMethod1; +var + LocalVar: Integer; + + procedure NestedProc; + begin + LocalVar := 1; + end; + +begin + // Test point 1: cursor here should show breadcrumb: TTestClass > TestMethod1 + NestedProc; +end; + +function TTestClass.TestMethod2: Integer; +begin + // Test point 2: cursor here should show breadcrumb: TTestClass > TestMethod2 + Result := FValue; +end; + +{ TTestClass2 } + +procedure TTestClass2.MethodA; +begin + // Test point 3: cursor here should show breadcrumb: TTestClass2 > MethodA + FName := 'Hello'; +end; + +procedure TTestClass2.MethodB; +var + Temp: Integer; + + function NestedFunc: Integer; + begin + Result := 42; + end; + +begin + // Test point 4: cursor here should show breadcrumb: TTestClass2 > MethodB + Temp := NestedFunc; + FName := FName + IntToStr(Temp); +end; + +{ Global Functions } + +procedure GlobalProc; +var + I: Integer; + + procedure NestedInGlobal; + begin + I := 42; + end; + +begin + // Test point 5: cursor here should show breadcrumb: GlobalProc + NestedInGlobal; +end; + +function GlobalFunc(Value: Integer): Integer; +begin + // Test point 6: cursor here should show breadcrumb: GlobalFunc + Result := Value * 2; +end; + +var + TestObj: TTestClass; + TestObj2: TTestClass2; + TestRec: TTestRecord; + +begin + TestObj := TTestClass.Create; + TestObj2 := TTestClass2.Create; + try + TestObj.TestMethod1; + WriteLn(TestObj.TestMethod2); + TestObj2.MethodA; + TestObj2.MethodB; + GlobalProc; + WriteLn(GlobalFunc(10)); + TestRec.X := 1; + TestRec.Y := 2; + finally + TestObj.Free; + TestObj2.Free; + end; +end. diff --git a/src/tests/test_symbols.pas b/src/tests/test_symbols.pas new file mode 100644 index 0000000..bf523b9 --- /dev/null +++ b/src/tests/test_symbols.pas @@ -0,0 +1,131 @@ +unit test_symbols; + +// ============================================================================= +// Test file for LSP DocumentSymbol breadcrumb functionality +// +// This file is used to test the breadcrumb (symbol navigation bar) feature +// in LSP client IDEs such as VS Code, when using the Pascal Language Server. +// +// Test scenarios: +// 1. Class method breadcrumb: cursor in method body should show ClassName > MethodName +// 2. Nested functions: should appear in Outline view under their parent function +// 3. Class names: should not have trailing '=' character +// 4. Global functions: should appear at root level in Outline +// ============================================================================= + +{$mode objfpc}{$H+} + +interface + +type + { TTestClassA - Test class A } + TTestClassA = class + private + FValue: Integer; + public + procedure MethodA1; + procedure MethodA2; + function MethodA3: Integer; + end; + + { TTestClassB - Test class B } + TTestClassB = class + private + FName: String; + public + procedure MethodB1; + procedure MethodB2; + end; + + { TTestRecord - Test record type } + TTestRecord = record + X, Y: Integer; + end; + +procedure GlobalFunction1; +function GlobalFunction2(Value: Integer): Integer; + +implementation + +{ TTestClassA } + +procedure TTestClassA.MethodA1; +var + LocalVar: Integer; + + // Nested procedure 1 + procedure NestedProc1; + begin + LocalVar := 1; + end; + + // Nested function 2 + function NestedFunc2: Integer; + + // Deeply nested procedure + procedure DeeplyNested; + begin + LocalVar := 3; + end; + + begin + DeeplyNested; + Result := LocalVar; + end; + +begin + // Test point 1: cursor here should show breadcrumb: TTestClassA > MethodA1 + NestedProc1; + LocalVar := NestedFunc2; +end; + +procedure TTestClassA.MethodA2; +begin + // Test point 2: cursor here should show breadcrumb: TTestClassA > MethodA2 + FValue := 100; +end; + +function TTestClassA.MethodA3: Integer; +begin + // Test point 3: cursor here should show breadcrumb: TTestClassA > MethodA3 + Result := FValue; +end; + +{ TTestClassB } + +procedure TTestClassB.MethodB1; +begin + // Test point 4: cursor here should show breadcrumb: TTestClassB > MethodB1 + FName := 'Test'; +end; + +procedure TTestClassB.MethodB2; +begin + // Test point 5: cursor here should show breadcrumb: TTestClassB > MethodB2 + FName := FName + '!'; +end; + +{ Global Functions } + +procedure GlobalFunction1; +var + I: Integer; + + // Nested function inside global function + procedure NestedInGlobal; + begin + I := 42; + end; + +begin + // Test point 6: cursor here should show breadcrumb: GlobalFunction1 + NestedInGlobal; +end; + +function GlobalFunction2(Value: Integer): Integer; +begin + // Test point 7: cursor here should show breadcrumb: GlobalFunction2 + Result := Value * 2; +end; + +end. From 16e0957d1058630de865c0c4825e156060ebbf1a Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Sun, 28 Dec 2025 00:28:26 +0800 Subject: [PATCH 3/8] Fix workspace/symbol returning incomplete results with database In hierarchical mode, SerializeSymbols did not call InsertSymbols, causing symbols to not be inserted into the database. - Add InsertSymbols call in hierarchical mode - Populate Entry.Symbols in Add* methods for both modes - Add SymbolManager.Transport assignment --- src/serverprotocol/PasLS.General.pas | 1 + src/serverprotocol/PasLS.Symbols.pas | 64 ++++++++++++++++++++++++-- src/serverprotocol/PasLS.Workspace.pas | 1 - 3 files changed, 60 insertions(+), 6 deletions(-) diff --git a/src/serverprotocol/PasLS.General.pas b/src/serverprotocol/PasLS.General.pas index 28bde25..8ba95e0 100644 --- a/src/serverprotocol/PasLS.General.pas +++ b/src/serverprotocol/PasLS.General.pas @@ -435,6 +435,7 @@ function TInitialize.Process(var Params : TLSPInitializeParams): TInitializeResu if ServerSettings.documentSymbols or ServerSettings.workspaceSymbols then begin SymbolManager := TSymbolManager.Create; + SymbolManager.Transport := Transport; Result.capabilities.documentSymbolProvider:=True; Result.capabilities.workspaceSymbolProvider := ServerSettings.CanProvideWorkspaceSymbols; end; diff --git a/src/serverprotocol/PasLS.Symbols.pas b/src/serverprotocol/PasLS.Symbols.pas index bcf5218..9c3a4b7 100644 --- a/src/serverprotocol/PasLS.Symbols.pas +++ b/src/serverprotocol/PasLS.Symbols.pas @@ -108,6 +108,7 @@ TSymbolBuilder = class function FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode; IsImplementationContainer: Boolean = False): TDocumentSymbolEx; procedure SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTreeNode); function GetCurrentContainer: TDocumentSymbolExItems; + function AddFlatSymbol(Node: TCodeTreeNode; const Name: String; Kind: TSymbolKind): TSymbol; public constructor Create(AEntry: TSymbolTableEntry; ATool: TCodeTool; AMode: TSymbolMode); destructor Destroy; override; @@ -362,6 +363,22 @@ function TSymbolBuilder.GetCurrentContainer: TDocumentSymbolExItems; Result := FRootSymbols; end; +function TSymbolBuilder.AddFlatSymbol(Node: TCodeTreeNode; const Name: String; Kind: TSymbolKind): TSymbol; +var + CodePos, EndPos: TCodeXYPosition; +begin + Result := nil; + if (FTool <> nil) and (Node <> nil) then + begin + FTool.CleanPosToCaret(Node.StartPos, CodePos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + Result := FEntry.AddSymbol(Name, Kind, + CodePos.Code.FileName, + CodePos.Y, CodePos.X, + EndPos.Y, EndPos.X); + end; +end; + procedure TSymbolBuilder.BeginInterfaceSection(Node: TCodeTreeNode); begin if FMode <> smHierarchical then @@ -462,7 +479,7 @@ function TSymbolBuilder.AddClass(Node: TCodeTreeNode; const Name: String): TSymb // - Interface section: class declaration // - Implementation section: class with method implementations (rare) FCurrentClass := FindOrCreateClass(Name, Node); - Result := nil; // Hierarchical classes are not TSymbol + Result := AddFlatSymbol(Node, Name, TSymbolKind._Class); end; end; end; @@ -534,7 +551,10 @@ function TSymbolBuilder.AddMethod(Node: TCodeTreeNode; const AClassName, AMethod end; end; end; - Result := nil; // Hierarchical symbols are not TSymbol + + Result := AddFlatSymbol(Node, AMethodName, TSymbolKind._Function); + if Result <> nil then + Result.containerName := AClassName; end; end; end; @@ -568,7 +588,7 @@ function TSymbolBuilder.AddGlobalFunction(Node: TCodeTreeNode; const Name: Strin GlobalSymbol.kind := TSymbolKind._Function; SetNodeRange(GlobalSymbol, Node); FLastAddedFunction := GlobalSymbol; - Result := nil; // Hierarchical symbols are not TSymbol + Result := AddFlatSymbol(Node, Name, TSymbolKind._Function); end; end; end; @@ -601,7 +621,7 @@ function TSymbolBuilder.AddStruct(Node: TCodeTreeNode; const Name: String): TSym StructSymbol.name := Name; StructSymbol.kind := TSymbolKind._Struct; SetNodeRange(StructSymbol, Node); - Result := nil; // Hierarchical symbols are not TSymbol + Result := AddFlatSymbol(Node, Name, TSymbolKind._Struct); end; end; end; @@ -619,11 +639,16 @@ function TSymbolBuilder.AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCode Result.name := Name; Result.kind := TSymbolKind._Function; SetNodeRange(Result, Node); + AddFlatSymbol(Node, Name, TSymbolKind._Function); end; procedure TSymbolBuilder.SerializeSymbols; +const + BATCH_COUNT = 1000; var SerializedItems: TJSONArray; + i, Start, Next, Total: Integer; + Symbol: TSymbol; begin case FMode of smFlat: @@ -634,13 +659,42 @@ procedure TSymbolBuilder.SerializeSymbols; smHierarchical: begin - // Serialize DocumentSymbol hierarchy + // Serialize DocumentSymbol hierarchy for textDocument/documentSymbol SerializedItems := specialize TLSPStreaming.ToJSON(FRootSymbols) as TJSONArray; try FEntry.fRawJSON := SerializedItems.AsJSON; finally SerializedItems.Free; end; + + // Serialize flat SymbolInformation[] for database insertion + SerializedItems := specialize TLSPStreaming.ToJSON(FEntry.Symbols) as TJSONArray; + try + // Set RawJSON for each symbol (needed for database insertion) + for i := 0 to SerializedItems.Count - 1 do + begin + Symbol := FEntry.Symbols.Items[i]; + Symbol.RawJSON := SerializedItems[i].AsJson; + end; + + // Insert symbols into database if available + if SymbolManager.Database <> nil then + begin + Next := 0; + Start := 0; + Total := SerializedItems.Count; + while Start < Total do + begin + Next := Start + BATCH_COUNT; + if Next >= Total then + Next := Total - 1; + SymbolManager.Database.InsertSymbols(FEntry.Symbols, Start, Next); + Start := Next + 1; + end; + end; + finally + SerializedItems.Free; + end; end; end; end; diff --git a/src/serverprotocol/PasLS.Workspace.pas b/src/serverprotocol/PasLS.Workspace.pas index 55a6246..7bfb692 100644 --- a/src/serverprotocol/PasLS.Workspace.pas +++ b/src/serverprotocol/PasLS.Workspace.pas @@ -81,7 +81,6 @@ procedure TDidChangeWorkspaceFolders.Process(var Params : TDidChangeWorkspaceFol function TWorkspaceSymbolRequest.DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData; var Input: TWorkspaceSymbolParams; - begin Input := specialize TLSPStreaming.ToObject(Params); Result := SymbolManager.FindWorkspaceSymbols(Input.query); From c65464a405f26d421caa0079b85cb5210a6aa711 Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Sun, 28 Dec 2025 15:06:17 +0800 Subject: [PATCH 4/8] Add Property and Field symbol extraction to DocumentSymbol - Add AddProperty and AddField methods to TSymbolBuilder - Extract properties (ctnProperty) and fields (ctnVarDefinition) in ExtractObjCClassMethods - Recurse into class visibility sections to find properties/fields - Support both flat (SymbolInformation) and hierarchical (DocumentSymbol) modes - Add unit tests for Property/Field extraction --- src/serverprotocol/PasLS.Symbols.pas | 125 ++++++++++++++++- src/tests/TestClassWithProperty.pas | 31 +++++ src/tests/Tests.DocumentSymbol.pas | 201 +++++++++++++++++++++++++++ src/tests/testlsp.lpi | 4 + src/tests/testlsp.lpr | 2 +- 5 files changed, 361 insertions(+), 2 deletions(-) create mode 100644 src/tests/TestClassWithProperty.pas create mode 100644 src/tests/Tests.DocumentSymbol.pas diff --git a/src/serverprotocol/PasLS.Symbols.pas b/src/serverprotocol/PasLS.Symbols.pas index 9c3a4b7..952bfcc 100644 --- a/src/serverprotocol/PasLS.Symbols.pas +++ b/src/serverprotocol/PasLS.Symbols.pas @@ -122,6 +122,8 @@ TSymbolBuilder = class function AddMethod(Node: TCodeTreeNode; const AClassName, AMethodName: String): TSymbol; function AddGlobalFunction(Node: TCodeTreeNode; const Name: String): TSymbol; function AddStruct(Node: TCodeTreeNode; const Name: String): TSymbol; + function AddProperty(Node: TCodeTreeNode; const AClassName, APropertyName: String): TSymbol; + function AddField(Node: TCodeTreeNode; const AClassName, AFieldName: String): TSymbol; // Add nested function as child of parent (hierarchical mode only) function AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name: String): TDocumentSymbolEx; @@ -626,6 +628,92 @@ function TSymbolBuilder.AddStruct(Node: TCodeTreeNode; const Name: String): TSym end; end; +function TSymbolBuilder.AddProperty(Node: TCodeTreeNode; const AClassName, APropertyName: String): TSymbol; +var + ClassSymbol: TDocumentSymbolEx; + PropertySymbol: TDocumentSymbolEx; + CodePos, EndPos: TCodeXYPosition; +begin + case FMode of + smFlat: + begin + // Flat mode: add property with containerName + if (FTool <> nil) and (Node <> nil) then + begin + FTool.CleanPosToCaret(Node.StartPos, CodePos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + Result := FEntry.AddSymbol(APropertyName, TSymbolKind._Property, + CodePos.Code.FileName, + CodePos.Y, CodePos.X, + EndPos.Y, EndPos.X); + if Result <> nil then + Result.containerName := AClassName; + end + else + Result := nil; + end; + + smHierarchical: + begin + // Hierarchical mode: add property to class's children + ClassSymbol := FindOrCreateClass(AClassName, Node); + if ClassSymbol <> nil then + begin + PropertySymbol := TDocumentSymbolEx.Create(ClassSymbol.children); + PropertySymbol.name := APropertyName; + PropertySymbol.kind := TSymbolKind._Property; + SetNodeRange(PropertySymbol, Node); + end; + Result := AddFlatSymbol(Node, APropertyName, TSymbolKind._Property); + if Result <> nil then + Result.containerName := AClassName; + end; + end; +end; + +function TSymbolBuilder.AddField(Node: TCodeTreeNode; const AClassName, AFieldName: String): TSymbol; +var + ClassSymbol: TDocumentSymbolEx; + FieldSymbol: TDocumentSymbolEx; + CodePos, EndPos: TCodeXYPosition; +begin + case FMode of + smFlat: + begin + // Flat mode: add field with containerName + if (FTool <> nil) and (Node <> nil) then + begin + FTool.CleanPosToCaret(Node.StartPos, CodePos); + FTool.CleanPosToCaret(Node.EndPos, EndPos); + Result := FEntry.AddSymbol(AFieldName, TSymbolKind._Field, + CodePos.Code.FileName, + CodePos.Y, CodePos.X, + EndPos.Y, EndPos.X); + if Result <> nil then + Result.containerName := AClassName; + end + else + Result := nil; + end; + + smHierarchical: + begin + // Hierarchical mode: add field to class's children + ClassSymbol := FindOrCreateClass(AClassName, Node); + if ClassSymbol <> nil then + begin + FieldSymbol := TDocumentSymbolEx.Create(ClassSymbol.children); + FieldSymbol.name := AFieldName; + FieldSymbol.kind := TSymbolKind._Field; + SetNodeRange(FieldSymbol, Node); + end; + Result := AddFlatSymbol(Node, AFieldName, TSymbolKind._Field); + if Result <> nil then + Result.containerName := AClassName; + end; + end; +end; + function TSymbolBuilder.AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name: String): TDocumentSymbolEx; begin Result := nil; @@ -904,7 +992,8 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod var Child: TCodeTreeNode; ExternalClass: boolean = false; - TypeName: String; + TypeName, PropertyName, FieldName: String; + i: Integer; begin while Node <> nil do begin @@ -929,6 +1018,30 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod begin AddSymbol(Node, TSymbolKind._Method, Tool.ExtractProcName(Node, [])); end; + ctnProperty: + begin + // For property, skip the "property" keyword to get the actual property name + Tool.MoveCursorToCleanPos(Node.StartPos); + Tool.ReadNextAtom; // Skip "property" keyword + Tool.ReadNextAtom; // Move to property name + TypeName := GetIdentifierAtPos(Tool, ClassNode.StartPos, true, true); + // Extract property name from current atom + PropertyName := Copy(Tool.Scanner.CleanedSrc, Tool.CurPos.StartPos, + Tool.CurPos.EndPos - Tool.CurPos.StartPos); + Builder.AddProperty(Node, TypeName, PropertyName); + end; + ctnVarDefinition: + begin + // Extract field (class member variable) + TypeName := GetIdentifierAtPos(Tool, ClassNode.StartPos, true, true); + // For field, extract identifier without the colon + FieldName := GetIdentifierAtPos(Tool, Node.StartPos, true, true); + // Remove trailing colon if present + i := Pos(':', FieldName); + if i > 0 then + FieldName := Copy(FieldName, 1, i - 1); + Builder.AddField(Node, TypeName, FieldName); + end; ctnClassPublic,ctnClassPublished,ctnClassPrivate,ctnClassProtected, ctnClassRequired,ctnClassOptional: if ExternalClass then @@ -944,6 +1057,13 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod AddSymbol(Node, TSymbolKind._Method, TypeName+'.'+Tool.ExtractProcName(Child, [])); Child := Child.NextBrother; end; + end + else + begin + // For regular Pascal classes, recurse into visibility sections + Inc(IndentLevel); + ExtractObjCClassMethods(ClassNode, Node.FirstChild); + Dec(IndentLevel); end; end; @@ -979,6 +1099,9 @@ procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNod begin TypeName := CleanTypeName(GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true)); Builder.AddClass(TypeDefNode, TypeName); + Inc(IndentLevel); + ExtractObjCClassMethods(TypeDefNode, Node.FirstChild); + Dec(IndentLevel); end; ctnObject,ctnRecordType: begin diff --git a/src/tests/TestClassWithProperty.pas b/src/tests/TestClassWithProperty.pas new file mode 100644 index 0000000..ab1a8e1 --- /dev/null +++ b/src/tests/TestClassWithProperty.pas @@ -0,0 +1,31 @@ +unit TestClassWithProperty; + +{$mode objfpc}{$H+} + +interface + +type + TUser = class + private + FName: String; + FAge: Integer; + public + property Name: String read FName write FName; + property Age: Integer read FAge write FAge; + procedure PrintInfo; + function GetFullName: String; + end; + +implementation + +procedure TUser.PrintInfo; +begin + writeln('User: ', FName, ', Age: ', FAge); +end; + +function TUser.GetFullName: String; +begin + Result := FName; +end; + +end. diff --git a/src/tests/Tests.DocumentSymbol.pas b/src/tests/Tests.DocumentSymbol.pas new file mode 100644 index 0000000..f3c7b91 --- /dev/null +++ b/src/tests/Tests.DocumentSymbol.pas @@ -0,0 +1,201 @@ +unit Tests.DocumentSymbol; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, + CodeToolManager, CodeCache, + PasLS.Symbols; + +type + + { TTestDocumentSymbol } + + TTestDocumentSymbol = class(TTestCase) + private + FTestCode: TCodeBuffer; + FTestFile: String; + procedure CreateTestFile(const AContent: String); + procedure CleanupTestFile; + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestSymbolExtractionHierarchical; + procedure TestSymbolExtractionFlat; + end; + +implementation + +const + TEST_UNIT_WITH_PROPERTY_AND_FIELD = + 'unit TestUnit;' + LineEnding + + '' + LineEnding + + '{$mode objfpc}{$H+}' + LineEnding + + '' + LineEnding + + 'interface' + LineEnding + + '' + LineEnding + + 'type' + LineEnding + + ' TUser = class' + LineEnding + + ' private' + LineEnding + + ' FName: String;' + LineEnding + + ' FAge: Integer;' + LineEnding + + ' public' + LineEnding + + ' property Name: String read FName write FName;' + LineEnding + + ' property Age: Integer read FAge write FAge;' + LineEnding + + ' procedure PrintInfo;' + LineEnding + + ' function GetFullName: String;' + LineEnding + + ' end;' + LineEnding + + '' + LineEnding + + 'implementation' + LineEnding + + '' + LineEnding + + 'procedure TUser.PrintInfo;' + LineEnding + + 'begin' + LineEnding + + ' writeln(FName);' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + 'function TUser.GetFullName: String;' + LineEnding + + 'begin' + LineEnding + + ' Result := FName;' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + 'end.'; + +{ TTestDocumentSymbol } + +procedure TTestDocumentSymbol.CreateTestFile(const AContent: String); +var + F: TextFile; +begin + FTestFile := GetTempFileName('', 'testunit'); + FTestFile := ChangeFileExt(FTestFile, '.pas'); + + AssignFile(F, FTestFile); + try + Rewrite(F); + Write(F, AContent); + finally + CloseFile(F); + end; +end; + +procedure TTestDocumentSymbol.CleanupTestFile; +begin + if FileExists(FTestFile) then + DeleteFile(FTestFile); + FTestFile := ''; +end; + +procedure TTestDocumentSymbol.SetUp; +begin + inherited SetUp; + FTestCode := nil; + FTestFile := ''; + + // Ensure SymbolManager is initialized + if SymbolManager = nil then + SymbolManager := TSymbolManager.Create; + + // Set hierarchical mode for tests + SetClientCapabilities(True); +end; + +procedure TTestDocumentSymbol.TearDown; +begin + CleanupTestFile; + FTestCode := nil; + inherited TearDown; +end; + +procedure TTestDocumentSymbol.TestSymbolExtractionHierarchical; +var + RawJSON: String; +begin + // Ensure hierarchical mode + SetClientCapabilities(True); + + // Create test file + CreateTestFile(TEST_UNIT_WITH_PROPERTY_AND_FIELD); + + // Load code buffer + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + + // Use SymbolManager to reload and extract symbols (public API) + SymbolManager.Reload(FTestCode, True); + + // Get the raw JSON from SymbolManager + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // Verify we extracted symbols + AssertTrue('Should have extracted symbols', RawJSON <> ''); + + // Verify the extracted symbols contain our expected names + AssertTrue('JSON should contain TUser class', Pos('"TUser"', RawJSON) > 0); + AssertTrue('JSON should contain FName field', Pos('FName', RawJSON) > 0); + AssertTrue('JSON should contain FAge field', Pos('FAge', RawJSON) > 0); + AssertTrue('JSON should contain Name property', Pos('"Name"', RawJSON) > 0); + AssertTrue('JSON should contain Age property', Pos('"Age"', RawJSON) > 0); + AssertTrue('JSON should contain PrintInfo method', Pos('PrintInfo', RawJSON) > 0); + AssertTrue('JSON should contain GetFullName method', Pos('GetFullName', RawJSON) > 0); + + // Check for hierarchical structure (children array) + AssertTrue('Should have children in hierarchical mode', Pos('"children"', RawJSON) > 0); + + // Check for correct symbol kinds (note: JSON has spaces around colons) + AssertTrue('Should have Class kind (5)', Pos('"kind" : 5', RawJSON) > 0); + AssertTrue('Should have Field kind (8)', Pos('"kind" : 8', RawJSON) > 0); + AssertTrue('Should have Property kind (7)', Pos('"kind" : 7', RawJSON) > 0); + AssertTrue('Should have Function/Method kind (12)', Pos('"kind" : 12', RawJSON) > 0); +end; + +procedure TTestDocumentSymbol.TestSymbolExtractionFlat; +var + RawJSON: String; +begin + // Ensure flat mode + SetClientCapabilities(False); + + // Create test file + CreateTestFile(TEST_UNIT_WITH_PROPERTY_AND_FIELD); + + // Load code buffer + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + + // Use SymbolManager to reload and extract symbols (public API) + SymbolManager.Reload(FTestCode, True); + + // Get the raw JSON from SymbolManager + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // Verify we extracted symbols + AssertTrue('Should have extracted symbols', RawJSON <> ''); + + // Verify the extracted symbols contain our expected names + AssertTrue('JSON should contain TUser class', Pos('"TUser"', RawJSON) > 0); + AssertTrue('JSON should contain FName field', Pos('FName', RawJSON) > 0); + AssertTrue('JSON should contain FAge field', Pos('FAge', RawJSON) > 0); + AssertTrue('JSON should contain Name property', Pos('"Name"', RawJSON) > 0); + AssertTrue('JSON should contain Age property', Pos('"Age"', RawJSON) > 0); + AssertTrue('JSON should contain PrintInfo method', Pos('PrintInfo', RawJSON) > 0); + AssertTrue('JSON should contain GetFullName method', Pos('GetFullName', RawJSON) > 0); + + // In flat mode, should NOT have children array + AssertTrue('Should NOT have children in flat mode', Pos('"children"', RawJSON) = 0); + + // In flat mode, should have containerName for properties and fields + AssertTrue('Should have containerName in flat mode', Pos('"containerName"', RawJSON) > 0); + + // Check for correct symbol kinds (note: JSON has spaces around colons) + AssertTrue('Should have Class kind (5)', Pos('"kind" : 5', RawJSON) > 0); + AssertTrue('Should have Field kind (8)', Pos('"kind" : 8', RawJSON) > 0); + AssertTrue('Should have Property kind (7)', Pos('"kind" : 7', RawJSON) > 0); + AssertTrue('Should have Function/Method kind (12)', Pos('"kind" : 12', RawJSON) > 0); +end; + +initialization + RegisterTest(TTestDocumentSymbol); +end. diff --git a/src/tests/testlsp.lpi b/src/tests/testlsp.lpi index f669640..d3b79a1 100644 --- a/src/tests/testlsp.lpi +++ b/src/tests/testlsp.lpi @@ -38,6 +38,10 @@ + + + + diff --git a/src/tests/testlsp.lpr b/src/tests/testlsp.lpr index 7d2d157..36a8ea3 100644 --- a/src/tests/testlsp.lpr +++ b/src/tests/testlsp.lpr @@ -3,7 +3,7 @@ {$mode objfpc}{$H+} uses - Classes, consoletestrunner, Tests.Basic; + Classes, consoletestrunner, Tests.Basic, Tests.DocumentSymbol; type From edd918cf9307bf749d7d80749d6219ae9cb9dcf4 Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Sun, 28 Dec 2025 17:59:25 +0800 Subject: [PATCH 5/8] Fix symbol table not updating on file content changes - Enable SymbolManager.FileModified notification in didChange handler - This was intentionally commented out in 2021 for performance, but caused symbols to become stale during editing (before save) - The deferred reload mechanism still provides good performance by only triggering actual parsing when symbols are requested - Remove Python test script (test_breadcrumb.py) from repository --- src/serverprotocol/PasLS.Synchronization.pas | 4 +- src/tests/test_breadcrumb.py | 628 ------------------- 2 files changed, 2 insertions(+), 630 deletions(-) delete mode 100644 src/tests/test_breadcrumb.py diff --git a/src/serverprotocol/PasLS.Synchronization.pas b/src/serverprotocol/PasLS.Synchronization.pas index a854a3f..a5fd216 100644 --- a/src/serverprotocol/PasLS.Synchronization.pas +++ b/src/serverprotocol/PasLS.Synchronization.pas @@ -90,8 +90,8 @@ procedure TDidChangeTextDocument.Process(var Params : TDidChangeTextDocumentPara // Ryan, uncomment this to have a syntax check at // CheckSyntax(Self.Transport,Code); - //if SymbolManager <> nil then - // SymbolManager.FileModified(Code); + if SymbolManager <> nil then + SymbolManager.FileModified(Code); end; // DoLog( 'Synched text in %d ms',[MilliSecondsBetween(Now, StartTime)]); end; diff --git a/src/tests/test_breadcrumb.py b/src/tests/test_breadcrumb.py deleted file mode 100644 index e1fc157..0000000 --- a/src/tests/test_breadcrumb.py +++ /dev/null @@ -1,628 +0,0 @@ -#!/usr/bin/env python3 -""" -Test script for LSP DocumentSymbol breadcrumb functionality. - -This script tests the Pascal Language Server's hierarchical DocumentSymbol -support by verifying that the breadcrumb path is correct for various -cursor positions in test_symbols.pas. -""" - -import json -import subprocess -import sys -import os -from pathlib import Path -from typing import Optional - -# Path configuration -SCRIPT_DIR = Path(__file__).parent -PASLS_EXE = SCRIPT_DIR.parent / "standard" / "lib" / "i386-win32" / "pasls.exe" -TEST_FILE = SCRIPT_DIR / "test_symbols.pas" -TEST_PROGRAM_FILE = SCRIPT_DIR / "test_program.lpr" - - -class LSPClient: - """Simple LSP client for testing.""" - - def __init__(self, server_path: str): - self.server_path = server_path - self.process: Optional[subprocess.Popen] = None - self.request_id = 0 - - def start(self): - """Start the LSP server.""" - self.process = subprocess.Popen( - [str(self.server_path)], - stdin=subprocess.PIPE, - stdout=subprocess.PIPE, - stderr=subprocess.PIPE, - ) - - def stop(self): - """Stop the LSP server.""" - if self.process: - self.process.terminate() - self.process.wait() - - def send_request(self, method: str, params: dict) -> dict: - """Send an LSP request and wait for response.""" - self.request_id += 1 - request = { - "jsonrpc": "2.0", - "id": self.request_id, - "method": method, - "params": params - } - return self._send_message(request) - - def send_notification(self, method: str, params: dict): - """Send an LSP notification (no response expected).""" - notification = { - "jsonrpc": "2.0", - "method": method, - "params": params - } - self._write_message(notification) - - def _write_message(self, message: dict): - """Write a message to the server.""" - content = json.dumps(message) - header = f"Content-Length: {len(content)}\r\n\r\n" - self.process.stdin.write(header.encode('utf-8')) - self.process.stdin.write(content.encode('utf-8')) - self.process.stdin.flush() - - def _read_message(self) -> dict: - """Read a message from the server.""" - # Read headers - headers = {} - while True: - line = self.process.stdout.readline().decode('utf-8') - if line == '\r\n' or line == '\n': - break - if ':' in line: - key, value = line.split(':', 1) - headers[key.strip()] = value.strip() - - # Read content - content_length = int(headers.get('Content-Length', 0)) - if content_length > 0: - content = self.process.stdout.read(content_length).decode('utf-8') - return json.loads(content) - return {} - - def _send_message(self, message: dict) -> dict: - """Send a message and read response.""" - self._write_message(message) - - # Read responses until we get one matching our request id - while True: - response = self._read_message() - if response.get('id') == message.get('id'): - return response - # Skip notifications - - -def find_outline_path(symbols: list, line: int, parent_path: list = None) -> list: - """ - Find the outline path for a given line number (for Outline view testing). - - This uses parent-child relationships regardless of range containment. - In Pascal, class declarations and method implementations are separate, - so we search all children regardless of parent range. - """ - if parent_path is None: - parent_path = [] - - best_match = None - best_match_size = float('inf') # Smaller range = more specific match - - for symbol in symbols: - start_line = symbol['range']['start']['line'] - end_line = symbol['range']['end']['line'] - current_path = parent_path + [symbol['name']] - - # Always check children first (they might contain the line even if parent doesn't) - children = symbol.get('children', []) - if children: - child_path = find_outline_path(children, line, current_path) - if child_path and len(child_path) > len(current_path): - # Found a match in children - child_symbol = None - for c in children: - if c['name'] == child_path[len(current_path)]: - child_symbol = c - break - if child_symbol: - child_size = child_symbol['range']['end']['line'] - child_symbol['range']['start']['line'] - if child_size < best_match_size: - best_match = child_path - best_match_size = child_size - - # Check if line is within this symbol's range - if start_line <= line <= end_line: - range_size = end_line - start_line - if range_size < best_match_size: - best_match = current_path - best_match_size = range_size - - return best_match - - -def find_breadcrumb_by_range(symbols: list, line: int) -> list: - """ - Find the breadcrumb path based on range containment only (VS Code behavior). - - VS Code shows breadcrumb based on which symbol ranges contain the cursor. - This traverses the symbol tree hierarchy directly, building a chain of - symbols whose ranges contain the line. - - Note: This handles duplicate symbol names correctly by using the actual - tree structure rather than flattening and matching by name path. - """ - def find_containing_path(symbols_list, target_line): - """Recursively find the deepest path of symbols containing the line.""" - for symbol in symbols_list: - start_line = symbol['range']['start']['line'] - end_line = symbol['range']['end']['line'] - - if start_line <= target_line <= end_line: - # This symbol contains the line, start building path - path = [symbol['name']] - - # Check children for a more specific (deeper) match - children = symbol.get('children', []) - if children: - child_path = find_containing_path(children, target_line) - if child_path: - path.extend(child_path) - - return path - - return None - - # Try each top-level symbol and find the longest matching path - best_result = None - - for symbol in symbols: - result = find_containing_path([symbol], line) - if result and (best_result is None or len(result) > len(best_result)): - best_result = result - - return best_result - - -def run_tests(): - """Run all tests for Outline and Breadcrumb functionality.""" - - # Test cases: (line_number, expected_path, is_critical) - # Line numbers are 1-based (will be converted to 0-based for LSP) - # is_critical: True = must pass for overall success, False = known limitation - # - # F1 Scheme: Interface and Implementation as namespaces - # - Interface section: class declarations → interface > ClassName - # - Implementation section: method implementations → implementation > ClassName > MethodName - # - Implementation section: global functions → implementation > FunctionName - test_cases = [ - # Type declarations in interface section - CRITICAL - (22, ['interface', 'TTestClassA'], True), # Inside TTestClassA declaration - (32, ['interface', 'TTestClassB'], True), # Inside TTestClassB declaration - (41, ['interface', 'TTestRecord'], True), # Inside TTestRecord - - # Global function declarations in interface section - CRITICAL - (45, ['interface', 'GlobalFunction1'], True), # GlobalFunction1 declaration - (46, ['interface', 'GlobalFunction2'], True), # GlobalFunction2 declaration - - # Class methods (implementation section) - CRITICAL - # F1 Scheme: implementation > ClassName > MethodName - (77, ['implementation', 'TTestClassA', 'MethodA1'], True), # Test point 1: inside MethodA1 - (84, ['implementation', 'TTestClassA', 'MethodA2'], True), # Test point 2: inside MethodA2 - (90, ['implementation', 'TTestClassA', 'MethodA3'], True), # Test point 3: inside MethodA3 - (98, ['implementation', 'TTestClassB', 'MethodB1'], True), # Test point 4: inside MethodB1 - (104, ['implementation', 'TTestClassB', 'MethodB2'], True), # Test point 5: inside MethodB2 - - # Nested functions in class methods - CRITICAL - (59, ['implementation', 'TTestClassA', 'MethodA1', 'NestedProc1'], True), # Inside NestedProc1 - (72, ['implementation', 'TTestClassA', 'MethodA1', 'NestedFunc2'], True), # Inside NestedFunc2 - (68, ['implementation', 'TTestClassA', 'MethodA1', 'NestedFunc2', 'DeeplyNested'], True), # Inside DeeplyNested - - # Global functions - under Implementation namespace (F1 scheme) - (117, ['implementation', 'GlobalFunction1', 'NestedInGlobal'], True), # Inside NestedInGlobal - (121, ['implementation', 'GlobalFunction1'], True), # Test point 6: inside GlobalFunction1 - (127, ['implementation', 'GlobalFunction2'], True), # Test point 7: inside GlobalFunction2 - ] - - print("=" * 70) - print("LSP DocumentSymbol Test (Outline & Breadcrumb)") - print("=" * 70) - print(f"Server: {PASLS_EXE}") - print(f"Test file: {TEST_FILE}") - print() - - # Check if server exists - if not PASLS_EXE.exists(): - print(f"ERROR: Server not found: {PASLS_EXE}") - return False - - if not TEST_FILE.exists(): - print(f"ERROR: Test file not found: {TEST_FILE}") - return False - - # Start LSP client - client = LSPClient(str(PASLS_EXE)) - - try: - print("Starting LSP server...") - client.start() - - # Initialize - print("Sending initialize request...") - init_response = client.send_request("initialize", { - "processId": os.getpid(), - "capabilities": { - "textDocument": { - "documentSymbol": { - "hierarchicalDocumentSymbolSupport": True - } - } - }, - "rootUri": f"file:///{TEST_FILE.parent.as_posix()}", - "workspaceFolders": None - }) - - if 'error' in init_response: - print(f"ERROR: Initialize failed: {init_response['error']}") - return False - - # Send initialized notification - client.send_notification("initialized", {}) - - # Open document - print("Opening test document...") - with open(TEST_FILE, 'r', encoding='utf-8') as f: - content = f.read() - - file_uri = f"file:///{TEST_FILE.as_posix()}" - client.send_notification("textDocument/didOpen", { - "textDocument": { - "uri": file_uri, - "languageId": "pascal", - "version": 1, - "text": content - } - }) - - # Get document symbols - print("Requesting document symbols...") - symbols_response = client.send_request("textDocument/documentSymbol", { - "textDocument": { - "uri": file_uri - } - }) - - if 'error' in symbols_response: - print(f"ERROR: documentSymbol failed: {symbols_response['error']}") - return False - - symbols = symbols_response.get('result', []) - - if not symbols: - print("ERROR: No symbols returned") - return False - - print(f"Received {len(symbols)} top-level symbols") - print() - - # Print symbol tree for debugging - print("Symbol tree:") - print("-" * 40) - print_symbol_tree(symbols) - print("-" * 40) - print() - - # ==================== OUTLINE TESTS ==================== - print("=" * 70) - print("OUTLINE TESTS (parent-child hierarchy)") - print("=" * 70) - - outline_passed = 0 - outline_failed = 0 - outline_critical_failed = 0 - - for line, expected, is_critical in test_cases: - lsp_line = line - 1 - actual = find_outline_path(symbols, lsp_line) - - if actual == expected: - status = "PASS" - outline_passed += 1 - else: - status = "FAIL" if is_critical else "WARN" - outline_failed += 1 - if is_critical: - outline_critical_failed += 1 - - expected_str = " > ".join(expected) if expected else "(none)" - actual_str = " > ".join(actual) if actual else "(none)" - - print(f"Line {line:3d}: {status}") - print(f" Expected: {expected_str}") - print(f" Actual: {actual_str}") - if status == "FAIL": - print(f" *** CRITICAL MISMATCH ***") - elif status == "WARN": - print(f" (known limitation)") - print() - - print("-" * 70) - print(f"Outline Results: {outline_passed} passed, {outline_failed} failed ({outline_critical_failed} critical)") - - # ==================== BREADCRUMB TESTS ==================== - print() - print("=" * 70) - print("BREADCRUMB TESTS (range containment - VS Code behavior)") - print("=" * 70) - - breadcrumb_passed = 0 - breadcrumb_failed = 0 - breadcrumb_critical_failed = 0 - - for line, expected, is_critical in test_cases: - lsp_line = line - 1 - actual = find_breadcrumb_by_range(symbols, lsp_line) - - if actual == expected: - status = "PASS" - breadcrumb_passed += 1 - else: - status = "FAIL" if is_critical else "WARN" - breadcrumb_failed += 1 - if is_critical: - breadcrumb_critical_failed += 1 - - expected_str = " > ".join(expected) if expected else "(none)" - actual_str = " > ".join(actual) if actual else "(none)" - - print(f"Line {line:3d}: {status}") - print(f" Expected: {expected_str}") - print(f" Actual: {actual_str}") - if status == "FAIL": - print(f" *** CRITICAL MISMATCH ***") - elif status == "WARN": - print(f" (known limitation)") - print() - - print("-" * 70) - print(f"Breadcrumb Results: {breadcrumb_passed} passed, {breadcrumb_failed} failed ({breadcrumb_critical_failed} critical)") - - # ==================== SUMMARY ==================== - print() - print("=" * 70) - print("SUMMARY") - print("=" * 70) - print(f"Outline: {outline_passed}/{len(test_cases)} passed ({outline_critical_failed} critical failures)") - print(f"Breadcrumb: {breadcrumb_passed}/{len(test_cases)} passed ({breadcrumb_critical_failed} critical failures)") - if outline_critical_failed == 0 and breadcrumb_critical_failed == 0: - print("All critical tests PASSED!") - print("=" * 70) - - # Only critical failures count for overall success - return outline_critical_failed == 0 and breadcrumb_critical_failed == 0 - - except Exception as e: - print(f"ERROR: {e}") - import traceback - traceback.print_exc() - return False - - finally: - print("Stopping LSP server...") - client.stop() - - -def print_symbol_tree(symbols: list, indent: int = 0): - """Print the symbol tree for debugging.""" - for symbol in symbols: - name = symbol['name'] - kind = symbol.get('kind', '?') - start = symbol['range']['start']['line'] + 1 - end = symbol['range']['end']['line'] + 1 - print(f"{' ' * indent}{name} (kind={kind}, lines {start}-{end})") - - children = symbol.get('children', []) - if children: - print_symbol_tree(children, indent + 1) - - -def run_program_tests(): - """Run tests for program files (.lpr/.dpr) without interface/implementation.""" - - # Test cases for program files: (line_number, expected_path, is_critical) - # In program files, there are no interface/implementation namespaces - # F1 Scheme: Two symbols per class - declaration + implementation container - test_cases = [ - # Type declarations - CRITICAL - (18, ['TTestClass'], True), # Inside TTestClass declaration - (27, ['TTestClass2'], True), # Inside TTestClass2 declaration - (35, ['TTestRecord'], True), # Inside TTestRecord declaration - - # TTestClass methods - CRITICAL (under TTestClass implementation container) - (50, ['TTestClass', 'TestMethod1'], True), # Inside TestMethod1 - (56, ['TTestClass', 'TestMethod2'], True), # Inside TestMethod2 - - # Nested function in TTestClass method - CRITICAL - (46, ['TTestClass', 'TestMethod1', 'NestedProc'], True), # Inside NestedProc - - # TTestClass2 methods - CRITICAL (under TTestClass2 implementation container) - (64, ['TTestClass2', 'MethodA'], True), # Inside MethodA - (78, ['TTestClass2', 'MethodB'], True), # Inside MethodB - - # Nested function in TTestClass2 method - CRITICAL - (74, ['TTestClass2', 'MethodB', 'NestedFunc'], True), # Inside NestedFunc - - # Global functions - CRITICAL - (95, ['GlobalProc'], True), # Inside GlobalProc - (101, ['GlobalFunc'], True), # Inside GlobalFunc - - # Nested function in global function - CRITICAL - (91, ['GlobalProc', 'NestedInGlobal'], True), # Inside NestedInGlobal - ] - - print("=" * 70) - print("LSP DocumentSymbol Test - PROGRAM FILES (.lpr/.dpr)") - print("=" * 70) - print(f"Server: {PASLS_EXE}") - print(f"Test file: {TEST_PROGRAM_FILE}") - print() - - # Check if server exists - if not PASLS_EXE.exists(): - print(f"ERROR: Server not found: {PASLS_EXE}") - return False - - if not TEST_PROGRAM_FILE.exists(): - print(f"ERROR: Test file not found: {TEST_PROGRAM_FILE}") - return False - - # Start LSP client - client = LSPClient(str(PASLS_EXE)) - - try: - print("Starting LSP server...") - client.start() - - # Initialize - print("Sending initialize request...") - init_response = client.send_request("initialize", { - "processId": os.getpid(), - "capabilities": { - "textDocument": { - "documentSymbol": { - "hierarchicalDocumentSymbolSupport": True - } - } - }, - "rootUri": f"file:///{TEST_PROGRAM_FILE.parent.as_posix()}", - "workspaceFolders": None - }) - - if 'error' in init_response: - print(f"ERROR: Initialize failed: {init_response['error']}") - return False - - # Send initialized notification - client.send_notification("initialized", {}) - - # Open document - print("Opening test document...") - with open(TEST_PROGRAM_FILE, 'r', encoding='utf-8') as f: - content = f.read() - - file_uri = f"file:///{TEST_PROGRAM_FILE.as_posix()}" - client.send_notification("textDocument/didOpen", { - "textDocument": { - "uri": file_uri, - "languageId": "pascal", - "version": 1, - "text": content - } - }) - - # Get document symbols - print("Requesting document symbols...") - symbols_response = client.send_request("textDocument/documentSymbol", { - "textDocument": { - "uri": file_uri - } - }) - - if 'error' in symbols_response: - print(f"ERROR: documentSymbol failed: {symbols_response['error']}") - return False - - symbols = symbols_response.get('result', []) - - if not symbols: - print("ERROR: No symbols returned") - return False - - print(f"Received {len(symbols)} top-level symbols") - print() - - # Print symbol tree for debugging - print("Symbol tree:") - print("-" * 40) - print_symbol_tree(symbols) - print("-" * 40) - print() - - # Run breadcrumb tests - print("=" * 70) - print("BREADCRUMB TESTS (range containment - VS Code behavior)") - print("=" * 70) - - breadcrumb_passed = 0 - breadcrumb_failed = 0 - breadcrumb_critical_failed = 0 - - for line, expected, is_critical in test_cases: - lsp_line = line - 1 - actual = find_breadcrumb_by_range(symbols, lsp_line) - - if actual == expected: - status = "PASS" - breadcrumb_passed += 1 - else: - status = "FAIL" if is_critical else "WARN" - breadcrumb_failed += 1 - if is_critical: - breadcrumb_critical_failed += 1 - - expected_str = " > ".join(expected) if expected else "(none)" - actual_str = " > ".join(actual) if actual else "(none)" - - print(f"Line {line:3d}: {status}") - print(f" Expected: {expected_str}") - print(f" Actual: {actual_str}") - if status == "FAIL": - print(f" *** CRITICAL MISMATCH ***") - elif status == "WARN": - print(f" (known limitation)") - print() - - print("-" * 70) - print(f"Breadcrumb Results: {breadcrumb_passed} passed, {breadcrumb_failed} failed ({breadcrumb_critical_failed} critical)") - - # Summary - print() - print("=" * 70) - print("SUMMARY") - print("=" * 70) - print(f"Program file tests: {breadcrumb_passed}/{len(test_cases)} passed ({breadcrumb_critical_failed} critical failures)") - if breadcrumb_critical_failed == 0: - print("All critical tests PASSED!") - print("=" * 70) - - return breadcrumb_critical_failed == 0 - - except Exception as e: - print(f"ERROR: {e}") - import traceback - traceback.print_exc() - return False - - finally: - print("Stopping LSP server...") - client.stop() - - -if __name__ == '__main__': - # Run unit file tests - success_unit = run_tests() - print("\n\n") - - # Run program file tests - success_program = run_program_tests() - - # Overall success if both pass - sys.exit(0 if (success_unit and success_program) else 1) From 3032b7829a1d3cbf1e15e3484f2e7d182b437bf3 Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Mon, 29 Dec 2025 02:42:16 +0800 Subject: [PATCH 6/8] Skip forward class declarations in DocumentSymbol extraction Forward declarations like "TMyClass = class;" should not appear in symbol tables. Use ctnsForwardDeclaration flag from CodeTools to detect and skip them, keeping only full class declarations. Added test case to verify forward declarations are skipped while full declarations with members are preserved. --- src/serverprotocol/PasLS.Symbols.pas | 8 +++ src/tests/Tests.DocumentSymbol.pas | 101 +++++++++++++++++++++++++++ 2 files changed, 109 insertions(+) diff --git a/src/serverprotocol/PasLS.Symbols.pas b/src/serverprotocol/PasLS.Symbols.pas index 952bfcc..f725517 100644 --- a/src/serverprotocol/PasLS.Symbols.pas +++ b/src/serverprotocol/PasLS.Symbols.pas @@ -1097,6 +1097,14 @@ procedure TSymbolExtractor.ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNod case Node.Desc of ctnClass,ctnClassHelper,ctnRecordHelper,ctnTypeHelper: begin + // Skip forward declarations (e.g., "TMyClass = class;") + // Use ctnsForwardDeclaration flag, not FirstChild check + // (empty class "TMyClass = class end;" has no children but is NOT forward) + if (Node.SubDesc and ctnsForwardDeclaration) > 0 then + begin + Node := Node.NextBrother; + continue; + end; TypeName := CleanTypeName(GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true)); Builder.AddClass(TypeDefNode, TypeName); Inc(IndentLevel); diff --git a/src/tests/Tests.DocumentSymbol.pas b/src/tests/Tests.DocumentSymbol.pas index f3c7b91..3f888b7 100644 --- a/src/tests/Tests.DocumentSymbol.pas +++ b/src/tests/Tests.DocumentSymbol.pas @@ -25,6 +25,7 @@ TTestDocumentSymbol = class(TTestCase) published procedure TestSymbolExtractionHierarchical; procedure TestSymbolExtractionFlat; + procedure TestForwardDeclarationSkipped; end; implementation @@ -63,11 +64,62 @@ ' TUser = class' + LineEnding + '' + LineEnding + 'end.'; + // Test case for forward declarations - should be skipped in symbol extraction + TEST_UNIT_WITH_FORWARD_DECLARATION = + 'unit TestForward;' + LineEnding + + '' + LineEnding + + '{$mode objfpc}{$H+}' + LineEnding + + '' + LineEnding + + 'interface' + LineEnding + + '' + LineEnding + + 'type' + LineEnding + + ' // Forward class declaration - should be SKIPPED' + LineEnding + + ' TMySymbol = class;' + LineEnding + + '' + LineEnding + + ' // Helper class using the forward declared class' + LineEnding + + ' TSymbolHelper = class' + LineEnding + + ' private' + LineEnding + + ' FItem: TMySymbol;' + LineEnding + + ' public' + LineEnding + + ' procedure DoSomething;' + LineEnding + + ' end;' + LineEnding + + '' + LineEnding + + ' // Full class declaration - should be INCLUDED' + LineEnding + + ' TMySymbol = class' + LineEnding + + ' private' + LineEnding + + ' FName: String;' + LineEnding + + ' FKind: Integer;' + LineEnding + + ' public' + LineEnding + + ' property Name: String read FName write FName;' + LineEnding + + ' property Kind: Integer read FKind write FKind;' + LineEnding + + ' procedure Initialize;' + LineEnding + + ' end;' + LineEnding + + '' + LineEnding + + 'implementation' + LineEnding + + '' + LineEnding + + '{ TSymbolHelper }' + LineEnding + + '' + LineEnding + + 'procedure TSymbolHelper.DoSomething;' + LineEnding + + 'begin' + LineEnding + + ' FItem := nil;' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + '{ TMySymbol }' + LineEnding + + '' + LineEnding + + 'procedure TMySymbol.Initialize;' + LineEnding + + 'begin' + LineEnding + + ' FName := '''';' + LineEnding + + ' FKind := 0;' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + 'end.'; + { TTestDocumentSymbol } procedure TTestDocumentSymbol.CreateTestFile(const AContent: String); var F: TextFile; + ExistingBuffer: TCodeBuffer; begin FTestFile := GetTempFileName('', 'testunit'); FTestFile := ChangeFileExt(FTestFile, '.pas'); @@ -79,6 +131,13 @@ procedure TTestDocumentSymbol.CreateTestFile(const AContent: String); finally CloseFile(F); end; + + // Force CodeToolBoss to reload from disk if buffer already exists + // This is necessary because GetTempFileName may reuse same filename + // after previous test deleted the file + ExistingBuffer := CodeToolBoss.FindFile(FTestFile); + if ExistingBuffer <> nil then + ExistingBuffer.Revert; end; procedure TTestDocumentSymbol.CleanupTestFile; @@ -196,6 +255,48 @@ procedure TTestDocumentSymbol.TestSymbolExtractionFlat; AssertTrue('Should have Function/Method kind (12)', Pos('"kind" : 12', RawJSON) > 0); end; +procedure TTestDocumentSymbol.TestForwardDeclarationSkipped; +var + RawJSON: String; +begin + // Test forward declarations are skipped + // Forward declaration "TMySymbol = class;" at line 8 should NOT appear + // Full declaration "TMySymbol = class" at line 19 SHOULD appear + + SetClientCapabilities(True); // hierarchical mode + + // Create test file with forward declarations + CreateTestFile(TEST_UNIT_WITH_FORWARD_DECLARATION); + + // Load code buffer + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + + // Use SymbolManager to reload and extract symbols + SymbolManager.Reload(FTestCode, True); + + // Get the raw JSON from SymbolManager + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // Verify we extracted symbols + AssertTrue('Should have extracted symbols', RawJSON <> ''); + + // Forward declaration is at line 8 (0-indexed) + // If forward declaration was NOT skipped, we'd see "line" : 8 for TMySymbol + // Check that line 8 does NOT appear in the JSON (no symbol starts at that line) + AssertTrue('Forward declaration at line 8 should be skipped', + Pos('"start" : { "character" : 2, "line" : 8', RawJSON) = 0); + + // Full declaration is at line 19, should appear + AssertTrue('Full declaration at line 19 should be present', + Pos('"start" : { "character" : 2, "line" : 19', RawJSON) > 0); + + // Verify child members exist (proves full declaration was extracted, not forward) + AssertTrue('Should contain FName field', Pos('FName', RawJSON) > 0); + AssertTrue('Should contain FKind field', Pos('FKind', RawJSON) > 0); + AssertTrue('Should contain Name property', Pos('"Name"', RawJSON) > 0); +end; + initialization RegisterTest(TTestDocumentSymbol); end. From df9707df0fe25ba76d89cfd83a21d6120508b7c6 Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Wed, 31 Dec 2025 03:30:50 +0800 Subject: [PATCH 7/8] Make containerName optional for better Sublime Text compatibility in smFlat mode Features: - Add nested function extraction with proper hierarchy in DocumentSymbol - Support nested functions inside methods and global functions Bug fixes: - Fix selectionRange pointing to "procedure" keyword instead of method name (use MoveCursorToProcName to locate actual name position) - Fix single-line symbol range incorrectly extending to next line - Fix range.end not including trailing semicolon (LSP exclusive end) - Add AdjustEndPositionForLSP for consistent range adjustment Tests: - Add TestMethodSelectionRangePointsToName for selectionRange validation - Add TestHierarchicalModeFullValidation with exact position checks - Add TestFlatModeFullValidation with exact position checks - Add TestSingleLineSymbolRangeStaysOnSameLine - Add TestProcedureRangeIncludesSemicolon - Add TestFlatModeRangeIncludesSemicolon --- src/protocol/LSP.DocumentSymbol.pas | 15 +- src/serverprotocol/PasLS.General.pas | 5 + src/serverprotocol/PasLS.Settings.pas | 6 + src/serverprotocol/PasLS.Symbols.pas | 375 ++++---- src/tests/Tests.DocumentSymbol.pas | 1233 ++++++++++++++++++++++++- 5 files changed, 1441 insertions(+), 193 deletions(-) diff --git a/src/protocol/LSP.DocumentSymbol.pas b/src/protocol/LSP.DocumentSymbol.pas index 369c654..645dcf5 100644 --- a/src/protocol/LSP.DocumentSymbol.pas +++ b/src/protocol/LSP.DocumentSymbol.pas @@ -118,7 +118,7 @@ TSymbolInformation = class(TCollectionItem) fKind: TSymbolKind; fDeprecated: TOptionalBoolean; fLocation: TLocation; - fContainerName: string; + fContainerName: TOptionalString; procedure SetLocation(AValue: TLocation); Public constructor Create(ACollection: TCollection); override; @@ -145,7 +145,7 @@ TSymbolInformation = class(TCollectionItem) // user interface purposes (e.g. to render a qualifier in the user interface // if necessary). It can't be used to re-infer a hierarchy for the document // symbols. - property containerName: string read fContainerName write fContainerName; + property containerName: TOptionalString read fContainerName write fContainerName; end; TSymbolInformationItems = specialize TGenericCollection; @@ -330,6 +330,7 @@ destructor TSymbolInformation.Destroy; begin FreeAndNil(fLocation); FreeAndNil(fDeprecated); + FreeAndNil(fContainerName); inherited Destroy; end; @@ -351,7 +352,15 @@ procedure TSymbolInformation.Assign(Source: TPersistent); else FreeAndNil(fDeprecated); Location:=Src.Location; - ContainerName:=Src.ContainerName; + if Assigned(Src.containerName) then + begin + if not assigned(fContainerName) then + fContainerName:=TOptionalString.Create(Src.containerName.Value) + else + fContainerName.Value:=Src.containerName.Value; + end + else + FreeAndNil(fContainerName); end else inherited Assign(Source); diff --git a/src/serverprotocol/PasLS.General.pas b/src/serverprotocol/PasLS.General.pas index 8ba95e0..937334b 100644 --- a/src/serverprotocol/PasLS.General.pas +++ b/src/serverprotocol/PasLS.General.pas @@ -270,6 +270,7 @@ procedure TInitialize.ShowConfigStatus(Params : TInitializeParams; CodeToolsOpti DoLog( kStatusPrefix+'FPCPath: ' + CodeToolsOptions.FPCPath); DoLog( kStatusPrefix+'FPCSrcDir: ' + CodeToolsOptions.FPCSrcDir); + DoLog( kStatusPrefix+'LazarusSrcDir: ' + CodeToolsOptions.LazarusSrcDir); DoLog( kStatusPrefix+'TargetOS: ' + CodeToolsOptions.TargetOS); DoLog( kStatusPrefix+'TargetProcessor: '+ CodeToolsOptions.TargetProcessor); @@ -305,6 +306,10 @@ procedure TInitialize.ShowConfigStatus(Params : TInitializeParams; CodeToolsOpti DoLog(' ► publishDiagnostics: ', ServerSettings.publishDiagnostics); DoLog(' ► workspaceSymbols: ', ServerSettings.workspaceSymbols); DoLog(' ► documentSymbols: ', ServerSettings.documentSymbols); + if ServerSettings.symbolMode <> '' then + DoLog(' ► symbolMode: %s', [ServerSettings.symbolMode]) + else + DoLog(' ► symbolMode: auto'); DoLog(' ► minimalisticCompletions: ', ServerSettings.minimalisticCompletions); DoLog(' ► showSyntaxErrors: ', ServerSettings.showSyntaxErrors); end; diff --git a/src/serverprotocol/PasLS.Settings.pas b/src/serverprotocol/PasLS.Settings.pas index 67e9385..fbeea2c 100644 --- a/src/serverprotocol/PasLS.Settings.pas +++ b/src/serverprotocol/PasLS.Settings.pas @@ -47,6 +47,7 @@ TServerSettings = class(TInitializationOptions) fBooleans: array[0..32] of Boolean; fProgram: String; fSymbolDatabase: String; + fSymbolMode: String; fFPCOptions: TStrings; fExcludeWorkspaceFolders: TStrings; fCodeToolsConfig: String; @@ -61,6 +62,9 @@ TServerSettings = class(TInitializationOptions) property &program: String read fProgram write fProgram; // Path to SQLite3 database for symbols property symbolDatabase: String read fSymbolDatabase write fSymbolDatabase; + // Symbol mode: "flat", "hierarchical", or "auto" (default, based on client capability) + // For backward compatibility: "symbolInformation" maps to "flat", "documentSymbol" maps to "hierarchical" + property symbolMode: String read fSymbolMode write fSymbolMode; // FPC compiler options (passed to Code Tools) property fpcOptions: TStrings read fFPCOptions write SetFPCOptions; // Optional codetools.config file to load settings from @@ -225,6 +229,7 @@ procedure TServerSettings.Assign(aSource : TPersistent); fBooleans:=Src.FBooleans; fProgram:=Src.fProgram;; SymbolDatabase:=Src.SymbolDatabase; + SymbolMode:=Src.SymbolMode; FPCOptions:=Src.fpcOptions; ExcludeWorkspaceFolders:=Src.ExcludeWorkspaceFolders; CodeToolsConfig:=Src.CodeToolsConfig; @@ -260,6 +265,7 @@ class function TServerSettings.GetPropertyDescription(const PropName: String): S case PropName of 'program': Result := 'Path to the main program file for resolving references'; 'symbolDatabase': Result := 'Path to SQLite3 database for symbols'; + 'symbolMode': Result := 'Symbol mode: "flat", "hierarchical", or "auto" (default)'; 'fpcOptions': Result := 'FPC compiler options (passed to Code Tools)'; 'codeToolsConfig': Result := 'Optional codetools.config file to load settings from'; 'maximumCompletions': Result := 'Maximum number of completion items to be returned'; diff --git a/src/serverprotocol/PasLS.Symbols.pas b/src/serverprotocol/PasLS.Symbols.pas index f725517..8852171 100644 --- a/src/serverprotocol/PasLS.Symbols.pas +++ b/src/serverprotocol/PasLS.Symbols.pas @@ -80,10 +80,15 @@ TSymbolTableEntry = class { TSymbolBuilder } - { Dual-mode symbol builder supporting both flat (SymbolInformation) - and hierarchical (DocumentSymbol) output } + { Dual-mode symbol builder supporting both SymbolInformation (legacy) + and DocumentSymbol (LSP 3.10+) output formats } - TSymbolMode = (smFlat, smHierarchical); + TSymbolMode = ( + smFlat, // Output SymbolInformation[] with Class.Method naming (Lazarus style) + smHierarchical // Output DocumentSymbol[] with nested children (LSP 3.10+) + ); + +type TSymbolBuilder = class private @@ -108,7 +113,7 @@ TSymbolBuilder = class function FindOrCreateClass(const AClassName: String; Node: TCodeTreeNode; IsImplementationContainer: Boolean = False): TDocumentSymbolEx; procedure SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTreeNode); function GetCurrentContainer: TDocumentSymbolExItems; - function AddFlatSymbol(Node: TCodeTreeNode; const Name: String; Kind: TSymbolKind): TSymbol; + function AddFlatSymbol(Node: TCodeTreeNode; const Name: String; Kind: TSymbolKind; const ContainerName: String = ''): TSymbol; public constructor Create(AEntry: TSymbolTableEntry; ATool: TCodeTool; AMode: TSymbolMode); destructor Destroy; override; @@ -124,8 +129,8 @@ TSymbolBuilder = class function AddStruct(Node: TCodeTreeNode; const Name: String): TSymbol; function AddProperty(Node: TCodeTreeNode; const AClassName, APropertyName: String): TSymbol; function AddField(Node: TCodeTreeNode; const AClassName, AFieldName: String): TSymbol; - // Add nested function as child of parent (hierarchical mode only) - function AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name: String): TDocumentSymbolEx; + // Add nested function as child of parent + function AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name, ParentPath: String): TDocumentSymbolEx; // Serialization procedure SerializeSymbols; @@ -150,11 +155,12 @@ TSymbolExtractor = class CodeSection: TCodeTreeNodeDesc; private procedure PrintNodeDebug(Node: TCodeTreeNode; Deep: boolean = false); + procedure AdjustEndPosition(Node: TCodeTreeNode; var EndPos: TCodeXYPosition); function AddSymbol(Node: TCodeTreeNode; Kind: TSymbolKind): TSymbol; overload; function AddSymbol(Node: TCodeTreeNode; Kind: TSymbolKind; Name: String; Container: String = ''): TSymbol; overload; procedure ExtractCodeSection(Node: TCodeTreeNode); function ExtractProcedure(ParentNode, Node: TCodeTreeNode):TSymbol; - procedure ProcessNestedFunctions(Node: TCodeTreeNode; ParentSymbol: TDocumentSymbolEx); + procedure ProcessNestedFunctions(Node: TCodeTreeNode; ParentSymbol: TDocumentSymbolEx; const ParentPath: String); procedure ExtractTypeDefinition(TypeDefNode, Node: TCodeTreeNode); procedure ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNode); public @@ -245,12 +251,17 @@ TSymbolManager = class var SymbolManager: TSymbolManager = nil; -// Client capabilities storage +// Client capabilities and configuration storage var - ClientSupportsHierarchicalSymbols: boolean = false; + ClientSupportsDocumentSymbol: Boolean = False; function GetSymbolMode: TSymbolMode; -procedure SetClientCapabilities(SupportsHierarchical: boolean); +procedure SetClientCapabilities(SupportsDocumentSymbol: Boolean); + +{ Adjusts EndPos for LSP Range specification (end position must be exclusive). + For section nodes, moves back one line to not include next section. + For other nodes, moves forward one character to make end exclusive. } +procedure AdjustEndPositionForLSP(Node: TCodeTreeNode; var EndPos: TCodeXYPosition); implementation uses @@ -263,16 +274,68 @@ implementation PasLS.Settings; function GetSymbolMode: TSymbolMode; +var + ModeStr: String; begin - if ClientSupportsHierarchicalSymbols then + // Check if symbolMode is explicitly set in initializationOptions + ModeStr := LowerCase(ServerSettings.symbolMode); + + // Explicit mode values + if ModeStr = 'flat' then + Result := smFlat + else if ModeStr = 'hierarchical' then Result := smHierarchical else - Result := smFlat; + begin + // Auto mode (default): Use hierarchical format only if: + // 1. Client supports hierarchical document symbols, AND + // 2. Server settings has documentSymbols enabled (not disabled in initializationOptions) + if ClientSupportsDocumentSymbol and ServerSettings.documentSymbols then + Result := smHierarchical + else + Result := smFlat; + end; end; -procedure SetClientCapabilities(SupportsHierarchical: boolean); +procedure SetClientCapabilities(SupportsDocumentSymbol: Boolean); begin - ClientSupportsHierarchicalSymbols := SupportsHierarchical; + ClientSupportsDocumentSymbol := SupportsDocumentSymbol; +end; + +procedure AdjustEndPositionForLSP(Node: TCodeTreeNode; var EndPos: TCodeXYPosition); +var + LineText: String; +begin + if Node.Desc in AllCodeSections then + begin + // For section nodes (interface/implementation), CodeTools EndPos points to + // the start of the NEXT section (or end of file). We need to move back + // one line so we don't include the next section's first line. + if EndPos.Y > 1 then + begin + Dec(EndPos.Y); + // Set X to end of the previous line (past last char for exclusive end) + if (EndPos.Code <> nil) and (EndPos.Y <= EndPos.Code.LineCount) then + EndPos.X := Length(EndPos.Code.GetLine(EndPos.Y - 1, false)) + 1 + else + EndPos.X := 1; + end; + end + else + begin + // For non-section nodes, move EndPos one position forward to make it exclusive + if (EndPos.Code <> nil) and (EndPos.Y > 0) and (EndPos.Y <= EndPos.Code.LineCount) then + begin + LineText := EndPos.Code.GetLine(EndPos.Y - 1, false); + if EndPos.X <= Length(LineText) then + Inc(EndPos.X) + else + // EndPos.X already points past the last character on this line. + // Keep it on the same line - don't move to next line. + // This prevents single-line symbols from having range extend to next line. + EndPos.X := Length(LineText) + 1; + end; + end; end; function GetFileKey(Path: String): ShortString; @@ -299,13 +362,13 @@ function TSymbol.Path: String; function TSymbol.IsGlobal: boolean; begin - result := containerName <> ''; + result := Assigned(containerName) and (containerName.Value <> ''); end; function TSymbol.GetFullName: String; begin - if containerName <> '' then - Result := containerName+'.'+Name + if Assigned(containerName) and (containerName.Value <> '') then + Result := containerName.Value+'.'+Name else Result := Name; end; @@ -344,7 +407,7 @@ destructor TSymbolBuilder.Destroy; procedure TSymbolBuilder.SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTreeNode); var - StartPos, EndPos: TCodeXYPosition; + StartPos, EndPos, NamePos: TCodeXYPosition; begin if (FTool = nil) or (Symbol = nil) or (Node = nil) then Exit; @@ -352,8 +415,22 @@ procedure TSymbolBuilder.SetNodeRange(Symbol: TDocumentSymbolEx; Node: TCodeTree FTool.CleanPosToCaret(Node.StartPos, StartPos); FTool.CleanPosToCaret(Node.EndPos, EndPos); + // Use shared adjustment logic for LSP Range specification + AdjustEndPositionForLSP(Node, EndPos); + Symbol.range.SetRange(StartPos.Y - 1, StartPos.X - 1, EndPos.Y - 1, EndPos.X - 1); - Symbol.selectionRange.SetRange(StartPos.Y - 1, StartPos.X - 1, StartPos.Y - 1, StartPos.X - 1); + + // For procedure/function nodes, find the actual name position + // Node.StartPos points to keyword ("procedure"/"function"), but we need + // the name position for selectionRange to highlight correctly in editors + if Node.Desc = ctnProcedure then + begin + FTool.MoveCursorToProcName(Node, True); // True = skip className prefix + FTool.CleanPosToCaret(FTool.CurPos.StartPos, NamePos); + Symbol.selectionRange.SetRange(NamePos.Y - 1, NamePos.X - 1, NamePos.Y - 1, NamePos.X - 1 + Length(Symbol.name)); + end + else + Symbol.selectionRange.SetRange(StartPos.Y - 1, StartPos.X - 1, StartPos.Y - 1, StartPos.X - 1 + Length(Symbol.name)); end; function TSymbolBuilder.GetCurrentContainer: TDocumentSymbolExItems; @@ -365,7 +442,7 @@ function TSymbolBuilder.GetCurrentContainer: TDocumentSymbolExItems; Result := FRootSymbols; end; -function TSymbolBuilder.AddFlatSymbol(Node: TCodeTreeNode; const Name: String; Kind: TSymbolKind): TSymbol; +function TSymbolBuilder.AddFlatSymbol(Node: TCodeTreeNode; const Name: String; Kind: TSymbolKind; const ContainerName: String = ''): TSymbol; var CodePos, EndPos: TCodeXYPosition; begin @@ -374,10 +451,15 @@ function TSymbolBuilder.AddFlatSymbol(Node: TCodeTreeNode; const Name: String; K begin FTool.CleanPosToCaret(Node.StartPos, CodePos); FTool.CleanPosToCaret(Node.EndPos, EndPos); + // Adjust EndPos for LSP Range specification (end position must be exclusive) + AdjustEndPositionForLSP(Node, EndPos); Result := FEntry.AddSymbol(Name, Kind, CodePos.Code.FileName, CodePos.Y, CodePos.X, EndPos.Y, EndPos.X); + // Set containerName for LSP semantics in workspace/symbol + if (Result <> nil) and (ContainerName <> '') then + Result.containerName := TOptionalString.Create(ContainerName); end; end; @@ -455,32 +537,21 @@ function TSymbolBuilder.FindOrCreateClass(const AClassName: String; Node: TCodeT end; function TSymbolBuilder.AddClass(Node: TCodeTreeNode; const Name: String): TSymbol; -var - CodePos, EndPos: TCodeXYPosition; begin case FMode of smFlat: begin - // Use existing flat mode: add to Entry.Symbols - if (FTool <> nil) and (Node <> nil) then - begin - FTool.CleanPosToCaret(Node.StartPos, CodePos); - FTool.CleanPosToCaret(Node.EndPos, EndPos); - Result := FEntry.AddSymbol(Name, TSymbolKind._Class, - CodePos.Code.FileName, - CodePos.Y, CodePos.X, - EndPos.Y, EndPos.X); - end - else - Result := nil; + // Flat mode: add class to Entry.Symbols + Result := AddFlatSymbol(Node, Name, TSymbolKind._Class); end; smHierarchical: begin - // F1 Scheme: Create class in current section's namespace + // Hierarchical mode: Create class in current section's namespace // - Interface section: class declaration // - Implementation section: class with method implementations (rare) FCurrentClass := FindOrCreateClass(Name, Node); + // Also add to flat symbol list for database/workspace symbol Result := AddFlatSymbol(Node, Name, TSymbolKind._Class); end; end; @@ -490,45 +561,27 @@ function TSymbolBuilder.AddMethod(Node: TCodeTreeNode; const AClassName, AMethod var ClassSymbol: TDocumentSymbolEx; MethodSymbol: TDocumentSymbolEx; - CodePos, EndPos: TCodeXYPosition; begin case FMode of smFlat: begin - // Flat mode: add method with containerName - if (FTool <> nil) and (Node <> nil) then - begin - FTool.CleanPosToCaret(Node.StartPos, CodePos); - FTool.CleanPosToCaret(Node.EndPos, EndPos); - Result := FEntry.AddSymbol(AMethodName, TSymbolKind._Function, - CodePos.Code.FileName, - CodePos.Y, CodePos.X, - EndPos.Y, EndPos.X); - if Result <> nil then - Result.containerName := AClassName; - end - else - Result := nil; + // Flat mode: Class.Method naming, no containerName (Lazarus style) + Result := AddFlatSymbol(Node, AClassName + '.' + AMethodName, TSymbolKind._Method); end; smHierarchical: begin - // F1 Scheme: Add method as child of class in current section - // - Interface section: methods are just declarations (rarely used) - // - Implementation section: methods are implementations under Implementation namespace - // - Program files: methods go into implementation container (separate from type declaration) + // Hierarchical mode: Add method as child of class ClassSymbol := FindOrCreateClass(AClassName, nil, True); if ClassSymbol <> nil then begin MethodSymbol := TDocumentSymbolEx.Create(ClassSymbol.children); MethodSymbol.name := AMethodName; - MethodSymbol.kind := TSymbolKind._Function; + MethodSymbol.kind := TSymbolKind._Method; SetNodeRange(MethodSymbol, Node); FLastAddedFunction := MethodSymbol; // Initialize or extend class range to include method - // In implementation section, class has no declaration node, - // so we use methods' ranges to define the class range if (ClassSymbol.range.start.line = 0) and (ClassSymbol.range.&end.line = 0) then begin // First method - initialize class range @@ -554,9 +607,9 @@ function TSymbolBuilder.AddMethod(Node: TCodeTreeNode; const AClassName, AMethod end; end; - Result := AddFlatSymbol(Node, AMethodName, TSymbolKind._Function); - if Result <> nil then - Result.containerName := AClassName; + // Add to flat symbol list for database/workspace symbol with LSP semantics + // name=MethodName, containerName=ClassName + Result := AddFlatSymbol(Node, AMethodName, TSymbolKind._Method, AClassName); end; end; end; @@ -564,32 +617,23 @@ function TSymbolBuilder.AddMethod(Node: TCodeTreeNode; const AClassName, AMethod function TSymbolBuilder.AddGlobalFunction(Node: TCodeTreeNode; const Name: String): TSymbol; var GlobalSymbol: TDocumentSymbolEx; - CodePos, EndPos: TCodeXYPosition; begin case FMode of smFlat: begin - if (FTool <> nil) and (Node <> nil) then - begin - FTool.CleanPosToCaret(Node.StartPos, CodePos); - FTool.CleanPosToCaret(Node.EndPos, EndPos); - Result := FEntry.AddSymbol(Name, TSymbolKind._Function, - CodePos.Code.FileName, - CodePos.Y, CodePos.X, - EndPos.Y, EndPos.X); - end - else - Result := nil; + // Flat mode: add function to Entry.Symbols + Result := AddFlatSymbol(Node, Name, TSymbolKind._Function); end; smHierarchical: begin - // Add to current container (Interface or Implementation namespace) + // Hierarchical mode: Add to current container (Interface or Implementation namespace) GlobalSymbol := TDocumentSymbolEx.Create(GetCurrentContainer); GlobalSymbol.name := Name; GlobalSymbol.kind := TSymbolKind._Function; SetNodeRange(GlobalSymbol, Node); FLastAddedFunction := GlobalSymbol; + // Also add to flat symbol list for database/workspace symbol Result := AddFlatSymbol(Node, Name, TSymbolKind._Function); end; end; @@ -598,31 +642,22 @@ function TSymbolBuilder.AddGlobalFunction(Node: TCodeTreeNode; const Name: Strin function TSymbolBuilder.AddStruct(Node: TCodeTreeNode; const Name: String): TSymbol; var StructSymbol: TDocumentSymbolEx; - CodePos, EndPos: TCodeXYPosition; begin case FMode of smFlat: begin - if (FTool <> nil) and (Node <> nil) then - begin - FTool.CleanPosToCaret(Node.StartPos, CodePos); - FTool.CleanPosToCaret(Node.EndPos, EndPos); - Result := FEntry.AddSymbol(Name, TSymbolKind._Struct, - CodePos.Code.FileName, - CodePos.Y, CodePos.X, - EndPos.Y, EndPos.X); - end - else - Result := nil; + // Flat mode: add struct to Entry.Symbols + Result := AddFlatSymbol(Node, Name, TSymbolKind._Struct); end; smHierarchical: begin - // Add struct to current container (Interface or Implementation namespace) + // Hierarchical mode: Add struct to current container StructSymbol := TDocumentSymbolEx.Create(GetCurrentContainer); StructSymbol.name := Name; StructSymbol.kind := TSymbolKind._Struct; SetNodeRange(StructSymbol, Node); + // Also add to flat symbol list for database/workspace symbol Result := AddFlatSymbol(Node, Name, TSymbolKind._Struct); end; end; @@ -632,25 +667,12 @@ function TSymbolBuilder.AddProperty(Node: TCodeTreeNode; const AClassName, AProp var ClassSymbol: TDocumentSymbolEx; PropertySymbol: TDocumentSymbolEx; - CodePos, EndPos: TCodeXYPosition; begin case FMode of smFlat: begin - // Flat mode: add property with containerName - if (FTool <> nil) and (Node <> nil) then - begin - FTool.CleanPosToCaret(Node.StartPos, CodePos); - FTool.CleanPosToCaret(Node.EndPos, EndPos); - Result := FEntry.AddSymbol(APropertyName, TSymbolKind._Property, - CodePos.Code.FileName, - CodePos.Y, CodePos.X, - EndPos.Y, EndPos.X); - if Result <> nil then - Result.containerName := AClassName; - end - else - Result := nil; + // Flat mode: Class.Property naming, no containerName (Lazarus style) + Result := AddFlatSymbol(Node, AClassName + '.' + APropertyName, TSymbolKind._Property); end; smHierarchical: @@ -664,9 +686,8 @@ function TSymbolBuilder.AddProperty(Node: TCodeTreeNode; const AClassName, AProp PropertySymbol.kind := TSymbolKind._Property; SetNodeRange(PropertySymbol, Node); end; - Result := AddFlatSymbol(Node, APropertyName, TSymbolKind._Property); - if Result <> nil then - Result.containerName := AClassName; + // Add to flat symbol list with LSP semantics + Result := AddFlatSymbol(Node, APropertyName, TSymbolKind._Property, AClassName); end; end; end; @@ -675,25 +696,12 @@ function TSymbolBuilder.AddField(Node: TCodeTreeNode; const AClassName, AFieldNa var ClassSymbol: TDocumentSymbolEx; FieldSymbol: TDocumentSymbolEx; - CodePos, EndPos: TCodeXYPosition; begin case FMode of smFlat: begin - // Flat mode: add field with containerName - if (FTool <> nil) and (Node <> nil) then - begin - FTool.CleanPosToCaret(Node.StartPos, CodePos); - FTool.CleanPosToCaret(Node.EndPos, EndPos); - Result := FEntry.AddSymbol(AFieldName, TSymbolKind._Field, - CodePos.Code.FileName, - CodePos.Y, CodePos.X, - EndPos.Y, EndPos.X); - if Result <> nil then - Result.containerName := AClassName; - end - else - Result := nil; + // Flat mode: Class.Field naming, no containerName (Lazarus style) + Result := AddFlatSymbol(Node, AClassName + '.' + AFieldName, TSymbolKind._Field); end; smHierarchical: @@ -707,27 +715,42 @@ function TSymbolBuilder.AddField(Node: TCodeTreeNode; const AClassName, AFieldNa FieldSymbol.kind := TSymbolKind._Field; SetNodeRange(FieldSymbol, Node); end; - Result := AddFlatSymbol(Node, AFieldName, TSymbolKind._Field); - if Result <> nil then - Result.containerName := AClassName; + // Add to flat symbol list with LSP semantics + Result := AddFlatSymbol(Node, AFieldName, TSymbolKind._Field, AClassName); end; end; end; -function TSymbolBuilder.AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name: String): TDocumentSymbolEx; +function TSymbolBuilder.AddNestedFunction(Parent: TDocumentSymbolEx; Node: TCodeTreeNode; const Name, ParentPath: String): TDocumentSymbolEx; +var + FullPath: String; begin Result := nil; - if FMode <> smHierarchical then - Exit; - if Parent = nil then - Exit; + FullPath := ParentPath + '.' + Name; + + case FMode of + smFlat: + begin + // Flat mode: full path name, no containerName (Lazarus style) + AddFlatSymbol(Node, FullPath, TSymbolKind._Function); + end; + + smHierarchical: + begin + if Parent = nil then + Exit; - // Create nested function as child of parent - Result := TDocumentSymbolEx.Create(Parent.children); - Result.name := Name; - Result.kind := TSymbolKind._Function; - SetNodeRange(Result, Node); - AddFlatSymbol(Node, Name, TSymbolKind._Function); + // Create nested function as child of parent + Result := TDocumentSymbolEx.Create(Parent.children); + Result.name := Name; + Result.kind := TSymbolKind._Function; + SetNodeRange(Result, Node); + + // Add to flat symbol list with LSP semantics + // name=NestedName, containerName=ParentPath + AddFlatSymbol(Node, Name, TSymbolKind._Function, ParentPath); + end; + end; end; procedure TSymbolBuilder.SerializeSymbols; @@ -741,7 +764,7 @@ procedure TSymbolBuilder.SerializeSymbols; case FMode of smFlat: begin - // Use existing serialization + // Use existing serialization for flat SymbolInformation[] FEntry.SerializeSymbols; end; @@ -755,7 +778,7 @@ procedure TSymbolBuilder.SerializeSymbols; SerializedItems.Free; end; - // Serialize flat SymbolInformation[] for database insertion + // Serialize flat SymbolInformation[] for database insertion and workspace/symbol SerializedItems := specialize TLSPStreaming.ToJSON(FEntry.Symbols) as TJSONArray; try // Set RawJSON for each symbol (needed for database insertion) @@ -942,34 +965,25 @@ function TSymbolExtractor.AddSymbol(Node: TCodeTreeNode; Kind: TSymbolKind): TSy result := AddSymbol(Node, Kind, GetIdentifierAtPos(Tool, Node.StartPos, true, true)); end; +procedure TSymbolExtractor.AdjustEndPosition(Node: TCodeTreeNode; var EndPos: TCodeXYPosition); +begin + AdjustEndPositionForLSP(Node, EndPos); +end; + function TSymbolExtractor.AddSymbol(Node: TCodeTreeNode; Kind: TSymbolKind; Name: String; Container: String): TSymbol; var - CodePos,EndPos: TCodeXYPosition; + CodePos, EndPos: TCodeXYPosition; FileName: String; - LineText: String; begin {$ifdef SYMBOL_DEBUG} writeln(IndentLevelString(IndentLevel + 1), '* ', Name); {$endif} Tool.CleanPosToCaret(Node.StartPos, CodePos); - Tool.CleanPosToCaret(Node.EndPos,EndPos); + Tool.CleanPosToCaret(Node.EndPos, EndPos); - // Fix for LSP Range specification: end position must be exclusive - // Move EndPos one position forward to make it exclusive - if (EndPos.Code <> nil) and (EndPos.Y > 0) and (EndPos.Y <= EndPos.Code.LineCount) then - begin - LineText := EndPos.Code.GetLine(EndPos.Y - 1, false); - // X is 1-based, so X <= Length means we're within the line - if EndPos.X <= Length(LineText) then - Inc(EndPos.X) - else - begin - // Move to next line if already past end of current line (use 1-based indexing) - Inc(EndPos.Y); - EndPos.X := 1; - end; - end; + // Adjust EndPos for LSP Range specification (end position must be exclusive) + AdjustEndPosition(Node, EndPos); // clear existing symbols in symbol database // we don't know which include files are associated @@ -1016,7 +1030,9 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod end; ctnProcedure: begin - AddSymbol(Node, TSymbolKind._Method, Tool.ExtractProcName(Node, [])); + // Use Builder.AddMethod for consistent handling in both modes + TypeName := GetIdentifierAtPos(Tool, ClassNode.StartPos, true, true); + Builder.AddMethod(Node, TypeName, Tool.ExtractProcName(Node, [])); end; ctnProperty: begin @@ -1197,7 +1213,8 @@ function TSymbolExtractor.ExtractProcedure(ParentNode, Node: TCodeTreeNode):TSym Symbol := TSymbol.Create(nil); Symbol.name := Name; Symbol.kind := TSymbolKind._Function; - Symbol.containerName := containerName; + if containerName <> '' then + Symbol.containerName := TOptionalString.Create(containerName); OverloadMap.Add(Key, Symbol); @@ -1221,16 +1238,14 @@ function TSymbolExtractor.ExtractProcedure(ParentNode, Node: TCodeTreeNode):TSym result := Symbol; end; -procedure TSymbolExtractor.ProcessNestedFunctions(Node: TCodeTreeNode; ParentSymbol: TDocumentSymbolEx); +procedure TSymbolExtractor.ProcessNestedFunctions(Node: TCodeTreeNode; ParentSymbol: TDocumentSymbolEx; const ParentPath: String); var Child: TCodeTreeNode; NestedSymbol: TDocumentSymbolEx; - Name: String; + Name, NestedPath: String; begin - // Only process in hierarchical mode - if Builder.Mode <> smHierarchical then - Exit; - if ParentSymbol = nil then + // In hierarchical mode, we need a parent symbol for hierarchy + if (Builder.Mode = smHierarchical) and (ParentSymbol = nil) then Exit; // Skip forward/external declarations @@ -1245,18 +1260,18 @@ procedure TSymbolExtractor.ProcessNestedFunctions(Node: TCodeTreeNode; ParentSym if Child.Desc = ctnProcedure then begin Name := Tool.ExtractProcName(Child, [phpWithoutClassName]); - NestedSymbol := Builder.AddNestedFunction(ParentSymbol, Child, Name); + NestedSymbol := Builder.AddNestedFunction(ParentSymbol, Child, Name, ParentPath); // Recursively process nested functions within this nested function - if NestedSymbol <> nil then - ProcessNestedFunctions(Child, NestedSymbol); + NestedPath := ParentPath + '.' + Name; + ProcessNestedFunctions(Child, NestedSymbol, NestedPath); end; Child := Child.NextBrother; end; end; -procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); +procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); var - Symbol,LastClassSymbol: TSymbol; + Symbol, MethodSymbol, LastClassSymbol: TSymbol; Child: TCodeTreeNode; Scanner: TLinkScanner; LinkIndex: Integer; @@ -1298,9 +1313,9 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); begin // For hierarchical mode, create Implementation namespace Builder.BeginImplementationSection(Node); - // For flat mode, optionally add namespace symbol (currently disabled) - //if Builder.Mode = smFlat then - // AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Implementation); + // For flat mode, add namespace symbol + if Builder.Mode = smFlat then + AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Implementation); end; end; CodeSection := Node.Desc; @@ -1354,20 +1369,22 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); if (Symbol<>nil) then begin // Use Builder to add methods or global functions based on containerName - if Symbol.containerName<>'' then + if Assigned(Symbol.containerName) then begin // This is a class method - Builder.AddMethod(Node, Symbol.containerName, Symbol.name); - // Process nested functions (hierarchical mode only) - ProcessNestedFunctions(Node, Builder.LastAddedFunction); + // Capture result to get the actual symbol with proper location + MethodSymbol := Builder.AddMethod(Node, Symbol.containerName.Value, Symbol.name); + // Process nested functions - parent path is ClassName.MethodName + ProcessNestedFunctions(Node, Builder.LastAddedFunction, + Symbol.containerName.Value + '.' + Symbol.name); // In flat mode, we also need to track class symbols for range updates if Builder.Mode = smFlat then begin - if (LastClassSymbol=nil) or (Symbol.containerName<>LastClassSymbol.name) then - LastClassSymbol:=AddSymbol(Node,TSymbolKind._Class,Symbol.containerName) - else - LastClassSymbol.location.range.&end:=Symbol.location.range.&end; + if (LastClassSymbol=nil) or (Symbol.containerName.Value<>LastClassSymbol.name) then + LastClassSymbol:=AddSymbol(Node,TSymbolKind._Class,Symbol.containerName.Value) + else if MethodSymbol <> nil then + LastClassSymbol.location.range.&end:=MethodSymbol.location.range.&end; end; end else @@ -1377,8 +1394,8 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); // - Interface section: function declaration // - Implementation section: function implementation Builder.AddGlobalFunction(Node, Symbol.name); - // Process nested functions (hierarchical mode only) - ProcessNestedFunctions(Node, Builder.LastAddedFunction); + // Process nested functions - parent path is function name + ProcessNestedFunctions(Node, Builder.LastAddedFunction, Symbol.name); end; end; diff --git a/src/tests/Tests.DocumentSymbol.pas b/src/tests/Tests.DocumentSymbol.pas index 3f888b7..0a2fba8 100644 --- a/src/tests/Tests.DocumentSymbol.pas +++ b/src/tests/Tests.DocumentSymbol.pas @@ -5,7 +5,7 @@ interface uses - Classes, SysUtils, fpcunit, testregistry, + Classes, SysUtils, fpcunit, testregistry, fpjson, jsonparser, CodeToolManager, CodeCache, PasLS.Symbols; @@ -26,6 +26,16 @@ TTestDocumentSymbol = class(TTestCase) procedure TestSymbolExtractionHierarchical; procedure TestSymbolExtractionFlat; procedure TestForwardDeclarationSkipped; + procedure TestSelectionRangeHasNonZeroWidth; + procedure TestRangeValidity; + procedure TestSectionRangeExcludesNextSection; + procedure TestSymbolRangeExclusivity; + procedure TestProcedureRangeIncludesSemicolon; + procedure TestFlatModeRangeIncludesSemicolon; + procedure TestSingleLineSymbolRangeStaysOnSameLine; + procedure TestMethodSelectionRangePointsToName; + procedure TestHierarchicalModeFullValidation; + procedure TestFlatModeFullValidation; end; implementation @@ -64,6 +74,54 @@ ' TUser = class' + LineEnding + '' + LineEnding + 'end.'; + // Full test file for comprehensive position validation + // Based on test_symbols.pas structure + TEST_FULL_VALIDATION_FILE = + 'unit test_symbols;' + LineEnding + // line 0 + '' + LineEnding + // line 1 + '// Test file' + LineEnding + // line 2 + '' + LineEnding + // line 3 + '{$mode objfpc}{$H+}' + LineEnding + // line 4 + '' + LineEnding + // line 5 + 'interface' + LineEnding + // line 6 + '' + LineEnding + // line 7 + 'type' + LineEnding + // line 8 + ' TTestClassA = class' + LineEnding + // line 9: "TTestClassA" at 2-12 + ' private' + LineEnding + // line 10 + ' FValue: Integer;' + LineEnding + // line 11: "FValue" at 4-9 + ' public' + LineEnding + // line 12 + ' procedure MethodA1;' + LineEnding + // line 13: "MethodA1" at 14-21 + ' function MethodA2: Integer;' + LineEnding + // line 14: "MethodA2" at 13-20 + ' end;' + LineEnding + // line 15 + '' + LineEnding + // line 16 + 'procedure GlobalProc;' + LineEnding + // line 17: "GlobalProc" at 10-19 + '' + LineEnding + // line 18 + 'implementation' + LineEnding + // line 19 + '' + LineEnding + // line 20 + 'procedure TTestClassA.MethodA1;' + LineEnding + // line 21: "MethodA1" at 22-29 + 'var' + LineEnding + // line 22 + ' X: Integer;' + LineEnding + // line 23 + '' + LineEnding + // line 24 + ' procedure NestedProc;' + LineEnding + // line 25: "NestedProc" at 12-21 + ' begin' + LineEnding + // line 26 + ' X := 1;' + LineEnding + // line 27 + ' end;' + LineEnding + // line 28 + '' + LineEnding + // line 29 + 'begin' + LineEnding + // line 30 + ' NestedProc;' + LineEnding + // line 31 + 'end;' + LineEnding + // line 32 + '' + LineEnding + // line 33 + 'function TTestClassA.MethodA2: Integer;' + LineEnding + // line 34: "MethodA2" at 21-28 + 'begin' + LineEnding + // line 35 + ' Result := FValue;' + LineEnding + // line 36 + 'end;' + LineEnding + // line 37 + '' + LineEnding + // line 38 + 'procedure GlobalProc;' + LineEnding + // line 39: "GlobalProc" at 10-19 + 'begin' + LineEnding + // line 40 + 'end;' + LineEnding + // line 41 + '' + LineEnding + // line 42 + 'end.'; // line 43 + // Test case for forward declarations - should be skipped in symbol extraction TEST_UNIT_WITH_FORWARD_DECLARATION = 'unit TestForward;' + LineEnding + @@ -207,7 +265,7 @@ procedure TTestDocumentSymbol.TestSymbolExtractionHierarchical; AssertTrue('Should have Class kind (5)', Pos('"kind" : 5', RawJSON) > 0); AssertTrue('Should have Field kind (8)', Pos('"kind" : 8', RawJSON) > 0); AssertTrue('Should have Property kind (7)', Pos('"kind" : 7', RawJSON) > 0); - AssertTrue('Should have Function/Method kind (12)', Pos('"kind" : 12', RawJSON) > 0); + AssertTrue('Should have Method kind (6)', Pos('"kind" : 6', RawJSON) > 0); end; procedure TTestDocumentSymbol.TestSymbolExtractionFlat; @@ -234,25 +292,26 @@ procedure TTestDocumentSymbol.TestSymbolExtractionFlat; AssertTrue('Should have extracted symbols', RawJSON <> ''); // Verify the extracted symbols contain our expected names + // In flat mode (smFlat), symbols use Class.Member naming (e.g., "TUser.Name") AssertTrue('JSON should contain TUser class', Pos('"TUser"', RawJSON) > 0); - AssertTrue('JSON should contain FName field', Pos('FName', RawJSON) > 0); - AssertTrue('JSON should contain FAge field', Pos('FAge', RawJSON) > 0); - AssertTrue('JSON should contain Name property', Pos('"Name"', RawJSON) > 0); - AssertTrue('JSON should contain Age property', Pos('"Age"', RawJSON) > 0); - AssertTrue('JSON should contain PrintInfo method', Pos('PrintInfo', RawJSON) > 0); - AssertTrue('JSON should contain GetFullName method', Pos('GetFullName', RawJSON) > 0); + AssertTrue('JSON should contain TUser.FName field', Pos('TUser.FName', RawJSON) > 0); + AssertTrue('JSON should contain TUser.FAge field', Pos('TUser.FAge', RawJSON) > 0); + AssertTrue('JSON should contain TUser.Name property', Pos('TUser.Name', RawJSON) > 0); + AssertTrue('JSON should contain TUser.Age property', Pos('TUser.Age', RawJSON) > 0); + AssertTrue('JSON should contain TUser.PrintInfo method', Pos('TUser.PrintInfo', RawJSON) > 0); + AssertTrue('JSON should contain TUser.GetFullName method', Pos('TUser.GetFullName', RawJSON) > 0); // In flat mode, should NOT have children array AssertTrue('Should NOT have children in flat mode', Pos('"children"', RawJSON) = 0); - // In flat mode, should have containerName for properties and fields - AssertTrue('Should have containerName in flat mode', Pos('"containerName"', RawJSON) > 0); + // In flat mode (smFlat), should NOT have containerName (uses Class.Member naming instead) + AssertTrue('Should NOT have containerName in flat mode', Pos('"containerName"', RawJSON) = 0); // Check for correct symbol kinds (note: JSON has spaces around colons) AssertTrue('Should have Class kind (5)', Pos('"kind" : 5', RawJSON) > 0); AssertTrue('Should have Field kind (8)', Pos('"kind" : 8', RawJSON) > 0); AssertTrue('Should have Property kind (7)', Pos('"kind" : 7', RawJSON) > 0); - AssertTrue('Should have Function/Method kind (12)', Pos('"kind" : 12', RawJSON) > 0); + AssertTrue('Should have Method kind (6)', Pos('"kind" : 6', RawJSON) > 0); end; procedure TTestDocumentSymbol.TestForwardDeclarationSkipped; @@ -297,6 +356,1158 @@ // Full declaration "TMySymbol = class" at line 19 SHOULD appear AssertTrue('Should contain Name property', Pos('"Name"', RawJSON) > 0); end; +procedure TTestDocumentSymbol.TestSelectionRangeHasNonZeroWidth; +var + RawJSON: String; +begin + // Test that selectionRange has non-zero width (end.character > start.character) + // This is required for proper symbol selection in editors like Sublime Text + // See: https://github.com/anthropics/claude-code/issues/XXX + // + // Previously, selectionRange was set to zero-width: + // "selectionRange" : { "start" : { "character" : 2, "line" : 7 }, "end" : { "character" : 2, "line" : 7 } } + // Now it should span the symbol name: + // "selectionRange" : { "start" : { "character" : 2, "line" : 7 }, "end" : { "character" : 7, "line" : 7 } } + // (for a 5-character symbol name like "TUser") + + SetClientCapabilities(True); // hierarchical mode + + // Create test file + CreateTestFile(TEST_UNIT_WITH_PROPERTY_AND_FIELD); + + // Load code buffer + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + + // Use SymbolManager to reload and extract symbols + SymbolManager.Reload(FTestCode, True); + + // Get the raw JSON from SymbolManager + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // TUser is at line 7 (0-indexed), character 2 + // TUser has 5 characters, so selectionRange.end.character should be 2 + 5 = 7 + // Check that selectionRange has proper width (not zero-width) + AssertTrue('TUser selectionRange should have width 5 (end.char=7)', + Pos('"selectionRange" : { "end" : { "character" : 7, "line" : 7 }, "start" : { "character" : 2, "line" : 7 } }', RawJSON) > 0); + + // FName field is at line 9 (0-indexed), character 4 + // FName has 5 characters, so selectionRange.end.character should be 4 + 5 = 9 + AssertTrue('FName selectionRange should have width 5 (end.char=9)', + Pos('"selectionRange" : { "end" : { "character" : 9, "line" : 9 }, "start" : { "character" : 4, "line" : 9 } }', RawJSON) > 0); +end; + +procedure TTestDocumentSymbol.TestRangeValidity; + + function IsValidRange(const RangeObj: TJSONObject): Boolean; + var + StartObj, EndObj: TJSONObject; + StartLine, StartChar, EndLine, EndChar: Integer; + begin + Result := False; + if RangeObj = nil then Exit; + + StartObj := RangeObj.FindPath('start') as TJSONObject; + EndObj := RangeObj.FindPath('end') as TJSONObject; + if (StartObj = nil) or (EndObj = nil) then Exit; + + StartLine := StartObj.Get('line', -1); + StartChar := StartObj.Get('character', -1); + EndLine := EndObj.Get('line', -1); + EndChar := EndObj.Get('character', -1); + + // All values must be non-negative + if (StartLine < 0) or (StartChar < 0) or (EndLine < 0) or (EndChar < 0) then + Exit; + + // End must be >= Start + if EndLine < StartLine then Exit; + if (EndLine = StartLine) and (EndChar < StartChar) then Exit; + + Result := True; + end; + + procedure ValidateSymbolRanges(const SymbolArray: TJSONArray; const Mode: String); + var + I: Integer; + Symbol: TJSONObject; + RangeObj, LocationObj: TJSONObject; + SymbolName: String; + begin + for I := 0 to SymbolArray.Count - 1 do + begin + Symbol := SymbolArray.Items[I] as TJSONObject; + SymbolName := Symbol.Get('name', ''); + + // Hierarchical mode: check 'range' and 'selectionRange' + RangeObj := Symbol.FindPath('range') as TJSONObject; + if RangeObj <> nil then + begin + AssertTrue(Format('%s: Symbol "%s" has invalid range', [Mode, SymbolName]), + IsValidRange(RangeObj)); + end; + + RangeObj := Symbol.FindPath('selectionRange') as TJSONObject; + if RangeObj <> nil then + begin + AssertTrue(Format('%s: Symbol "%s" has invalid selectionRange', [Mode, SymbolName]), + IsValidRange(RangeObj)); + end; + + // Flat mode: check 'location.range' + LocationObj := Symbol.FindPath('location') as TJSONObject; + if LocationObj <> nil then + begin + RangeObj := LocationObj.FindPath('range') as TJSONObject; + if RangeObj <> nil then + begin + AssertTrue(Format('%s: Symbol "%s" has invalid location.range', [Mode, SymbolName]), + IsValidRange(RangeObj)); + end; + end; + + // Recursively check children (hierarchical mode) + if Symbol.FindPath('children') is TJSONArray then + ValidateSymbolRanges(Symbol.FindPath('children') as TJSONArray, Mode); + end; + end; + +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; +begin + // Test hierarchical mode + SetClientCapabilities(True); + CreateTestFile(TEST_UNIT_WITH_FORWARD_DECLARATION); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + ValidateSymbolRanges(SymbolArray, 'Hierarchical'); + finally + JSONData.Free; + end; + + CleanupTestFile; + + // Test flat mode + SetClientCapabilities(False); + CreateTestFile(TEST_UNIT_WITH_FORWARD_DECLARATION); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded (flat)', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array (flat)', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + ValidateSymbolRanges(SymbolArray, 'Flat'); + finally + JSONData.Free; + end; +end; + +procedure TTestDocumentSymbol.TestSectionRangeExcludesNextSection; +{ Test that interface section's range does NOT include the implementation line. + This verifies the fix for SetNodeRange applying section-node adjustment. + Interface range.end.line should be < implementation range.start.line } +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; + I: Integer; + Symbol, RangeObj, EndObj: TJSONObject; + SymbolName: String; + InterfaceFound, ImplementationFound: Boolean; + InterfaceEndLine, ImplementationStartLine: Integer; +begin + // Test hierarchical mode + SetClientCapabilities(True); + CreateTestFile(TEST_UNIT_WITH_FORWARD_DECLARATION); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + + InterfaceFound := False; + ImplementationFound := False; + InterfaceEndLine := -1; + ImplementationStartLine := -1; + + // Find interface and implementation section symbols + for I := 0 to SymbolArray.Count - 1 do + begin + Symbol := SymbolArray.Items[I] as TJSONObject; + SymbolName := Symbol.Get('name', ''); + + if SymbolName = 'interface' then + begin + InterfaceFound := True; + RangeObj := Symbol.FindPath('range') as TJSONObject; + AssertNotNull('Interface should have range', RangeObj); + EndObj := RangeObj.FindPath('end') as TJSONObject; + AssertNotNull('Interface range should have end', EndObj); + InterfaceEndLine := EndObj.Get('line', -1); + end + else if SymbolName = 'implementation' then + begin + ImplementationFound := True; + RangeObj := Symbol.FindPath('range') as TJSONObject; + AssertNotNull('Implementation should have range', RangeObj); + RangeObj := RangeObj.FindPath('start') as TJSONObject; + AssertNotNull('Implementation range should have start', RangeObj); + ImplementationStartLine := RangeObj.Get('line', -1); + end; + end; + + AssertTrue('Interface section should be found', InterfaceFound); + AssertTrue('Implementation section should be found', ImplementationFound); + + // The key assertion: interface end line must be LESS than implementation start line + // This ensures sections don't overlap and interface doesn't include implementation keyword + AssertTrue( + Format('Interface end line (%d) should be < implementation start line (%d)', + [InterfaceEndLine, ImplementationStartLine]), + InterfaceEndLine < ImplementationStartLine); + + finally + JSONData.Free; + end; +end; + +procedure TTestDocumentSymbol.TestProcedureRangeIncludesSemicolon; +{ Test that procedure/function range.end position is correct for LSP. + The range should include the trailing semicolon, meaning: + - range.end points PAST the semicolon (exclusive end) + - The character at (range.end.line, range.end.character - 1) should be ';' + + This test catches the ";;" bug where replace_symbol_body duplicates semicolons + because the range doesn't include the original semicolon. } +const + TEST_SIMPLE_PROCEDURE = + 'unit TestProc;' + LineEnding + // line 0 + '' + LineEnding + // line 1 + 'interface' + LineEnding + // line 2 + '' + LineEnding + // line 3 + 'implementation' + LineEnding + // line 4 + '' + LineEnding + // line 5 + 'procedure DoSomething;' + LineEnding + // line 6 + 'begin' + LineEnding + // line 7 + ' writeln(''test'');' + LineEnding + // line 8 + 'end;' + LineEnding + // line 9: "end;" at cols 0-3, ';' at col 3 + '' + LineEnding + // line 10 + 'end.'; // line 11 +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; + Children: TJSONArray; + I, J: Integer; + Symbol, RangeObj, EndObj: TJSONObject; + SymbolName: String; + EndLine, EndChar: Integer; + SourceLines: TStringList; + LastIncludedChar: Char; + ProcFound: Boolean; +begin + // Test hierarchical mode + SetClientCapabilities(True); + CreateTestFile(TEST_SIMPLE_PROCEDURE); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // Parse source to verify character positions + SourceLines := TStringList.Create; + try + SourceLines.Text := TEST_SIMPLE_PROCEDURE; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + + ProcFound := False; + + // Find the DoSomething procedure (look in implementation children) + for I := 0 to SymbolArray.Count - 1 do + begin + Symbol := SymbolArray.Items[I] as TJSONObject; + SymbolName := Symbol.Get('name', ''); + + // Look for the procedure in implementation section children + if SymbolName = 'implementation' then + begin + Children := Symbol.FindPath('children') as TJSONArray; + if Children <> nil then + for J := 0 to Children.Count - 1 do + begin + Symbol := Children.Items[J] as TJSONObject; + SymbolName := Symbol.Get('name', ''); + if SymbolName = 'DoSomething' then + begin + ProcFound := True; + RangeObj := Symbol.FindPath('range') as TJSONObject; + AssertNotNull('Procedure should have range', RangeObj); + EndObj := RangeObj.FindPath('end') as TJSONObject; + AssertNotNull('Range should have end', EndObj); + EndLine := EndObj.Get('line', -1); + EndChar := EndObj.Get('character', -1); + + // Verify we can access the source line + AssertTrue(Format('EndLine %d should be valid', [EndLine]), + (EndLine >= 0) and (EndLine < SourceLines.Count)); + AssertTrue(Format('EndChar %d should be > 0 for exclusive end', [EndChar]), + EndChar > 0); + + // The character just before the exclusive end should be ';' + // EndChar is 0-indexed, exclusive, so EndChar-1 is the last included char + if EndChar <= Length(SourceLines[EndLine]) then + LastIncludedChar := SourceLines[EndLine][EndChar] // EndChar is 0-indexed, string is 1-indexed + else + // EndChar points past line end, check previous char on same line + LastIncludedChar := SourceLines[EndLine][Length(SourceLines[EndLine])]; + + AssertEquals( + Format('Last included char at line %d, col %d should be semicolon. ' + + 'Line content: "%s"', [EndLine, EndChar-1, SourceLines[EndLine]]), + ';', LastIncludedChar); + + Break; + end; + end; + end; + if ProcFound then Break; + end; + + AssertTrue('DoSomething procedure should be found', ProcFound); + + finally + JSONData.Free; + end; + finally + SourceLines.Free; + end; +end; + +procedure TTestDocumentSymbol.TestFlatModeRangeIncludesSemicolon; +{ Test that SymbolInformation (flat mode) location.range.end includes semicolon. + This is critical for Serena's replace_symbol_body to work correctly. + + Bug history: AddFlatSymbol was not calling AdjustEndPositionForLSP, + causing location.range.end.character to point AT the semicolon instead + of PAST it, resulting in double semicolons when replacing symbol bodies. } +const + TEST_SIMPLE_PROCEDURE = + 'unit TestProc;' + LineEnding + // line 0 + '' + LineEnding + // line 1 + 'interface' + LineEnding + // line 2 + '' + LineEnding + // line 3 + 'implementation' + LineEnding + // line 4 + '' + LineEnding + // line 5 + 'procedure DoSomething;' + LineEnding + // line 6 + 'begin' + LineEnding + // line 7 + ' writeln(''test'');' + LineEnding + // line 8 + 'end;' + LineEnding + // line 9: "end;" at cols 0-3, ';' at col 3 + '' + LineEnding + // line 10 + 'end.'; // line 11 +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; + I: Integer; + Symbol, LocationObj, RangeObj, EndObj: TJSONObject; + SymbolName: String; + EndLine, EndChar: Integer; + SourceLines: TStringList; + LastIncludedChar: Char; + ProcFound: Boolean; +begin + // Test flat mode (SymbolInformation format with location.range) + SetClientCapabilities(False); + CreateTestFile(TEST_SIMPLE_PROCEDURE); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // Parse source to verify character positions + SourceLines := TStringList.Create; + try + SourceLines.Text := TEST_SIMPLE_PROCEDURE; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + + ProcFound := False; + + // In flat mode, symbols are at root level with location.range + for I := 0 to SymbolArray.Count - 1 do + begin + Symbol := SymbolArray.Items[I] as TJSONObject; + SymbolName := Symbol.Get('name', ''); + + // Find DoSomething procedure + if SymbolName = 'DoSomething' then + begin + ProcFound := True; + + // Flat mode uses location.range instead of range + LocationObj := Symbol.FindPath('location') as TJSONObject; + AssertNotNull('Procedure should have location', LocationObj); + RangeObj := LocationObj.FindPath('range') as TJSONObject; + AssertNotNull('Location should have range', RangeObj); + EndObj := RangeObj.FindPath('end') as TJSONObject; + AssertNotNull('Range should have end', EndObj); + EndLine := EndObj.Get('line', -1); + EndChar := EndObj.Get('character', -1); + + // Verify we can access the source line + AssertTrue(Format('EndLine %d should be valid', [EndLine]), + (EndLine >= 0) and (EndLine < SourceLines.Count)); + AssertTrue(Format('EndChar %d should be > 0 for exclusive end', [EndChar]), + EndChar > 0); + + // The character just before the exclusive end should be ';' + // EndChar is 0-indexed, exclusive, so EndChar-1 is the last included char + // In Pascal 1-indexed string: EndChar maps to the last included char + if EndChar <= Length(SourceLines[EndLine]) then + LastIncludedChar := SourceLines[EndLine][EndChar] + else + LastIncludedChar := SourceLines[EndLine][Length(SourceLines[EndLine])]; + + AssertEquals( + Format('Flat mode: Last included char at line %d, col %d should be semicolon. ' + + 'Line content: "%s", EndChar: %d', + [EndLine, EndChar-1, SourceLines[EndLine], EndChar]), + ';', LastIncludedChar); + + Break; + end; + end; + + AssertTrue('DoSomething procedure should be found in flat mode', ProcFound); + + finally + JSONData.Free; + end; + finally + SourceLines.Free; + end; +end; + +procedure TTestDocumentSymbol.TestSingleLineSymbolRangeStaysOnSameLine; +{ Test that single-line symbols (fields, properties, method declarations) + have range.start.line == range.end.line. + + Bug history: AdjustEndPositionForLSP incorrectly moved to next line when + EndPos.X > Length(LineText), causing single-line symbols like "FName: String;" + to have range extending to the next line. This caused incorrect highlighting + in VS Code which uses range (not selectionRange) for symbol highlighting. + + Fix: Keep EndPos on same line by setting EndPos.X := Length(LineText) + 1 + instead of Inc(EndPos.Y); EndPos.X := 1; } + + procedure CheckSingleLineSymbol(const Symbol: TJSONObject; const Mode: String); + var + SymbolName: String; + RangeObj, StartObj, EndObj, LocationObj: TJSONObject; + StartLine, EndLine: Integer; + Children: TJSONArray; + I: Integer; + begin + SymbolName := Symbol.Get('name', ''); + + // Get range (hierarchical mode) or location.range (flat mode) + RangeObj := Symbol.FindPath('range') as TJSONObject; + if RangeObj = nil then + begin + LocationObj := Symbol.FindPath('location') as TJSONObject; + if LocationObj <> nil then + RangeObj := LocationObj.FindPath('range') as TJSONObject; + end; + + if RangeObj <> nil then + begin + StartObj := RangeObj.FindPath('start') as TJSONObject; + EndObj := RangeObj.FindPath('end') as TJSONObject; + if (StartObj <> nil) and (EndObj <> nil) then + begin + StartLine := StartObj.Get('line', -1); + EndLine := EndObj.Get('line', -1); + + // For field symbols (kind=8), they should be single-line + // FName and FAge are fields that must stay on same line + if (SymbolName = 'FName') or (SymbolName = 'FAge') then + begin + AssertEquals( + Format('%s: Field "%s" range must stay on same line', [Mode, SymbolName]), + StartLine, EndLine); + end; + end; + end; + + // Recursively check children + Children := Symbol.FindPath('children') as TJSONArray; + if Children <> nil then + for I := 0 to Children.Count - 1 do + CheckSingleLineSymbol(Children.Items[I] as TJSONObject, Mode); + end; + +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; + I: Integer; +begin + // Test hierarchical mode (the mode where bug was observed) + SetClientCapabilities(True); + CreateTestFile(TEST_UNIT_WITH_PROPERTY_AND_FIELD); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + for I := 0 to SymbolArray.Count - 1 do + CheckSingleLineSymbol(SymbolArray.Items[I] as TJSONObject, 'Hierarchical'); + finally + JSONData.Free; + end; + + CleanupTestFile; + + // Test flat mode as well + SetClientCapabilities(False); + CreateTestFile(TEST_UNIT_WITH_PROPERTY_AND_FIELD); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded (flat)', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array (flat)', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + for I := 0 to SymbolArray.Count - 1 do + CheckSingleLineSymbol(SymbolArray.Items[I] as TJSONObject, 'Flat'); + finally + JSONData.Free; + end; +end; + +procedure TTestDocumentSymbol.TestSymbolRangeExclusivity; +{ Test that range.end is exclusive for all symbol types: + class, method, procedure, function, property, field. + For multi-line symbols: end.line > start.line + For single-line symbols: end.character > start.character + Also verifies selectionRange has non-zero width } + + function GetRangeInfo(const RangeObj: TJSONObject; out StartLine, StartChar, EndLine, EndChar: Integer): Boolean; + var + StartObj, EndObj: TJSONObject; + begin + Result := False; + if RangeObj = nil then Exit; + StartObj := RangeObj.FindPath('start') as TJSONObject; + EndObj := RangeObj.FindPath('end') as TJSONObject; + if (StartObj = nil) or (EndObj = nil) then Exit; + StartLine := StartObj.Get('line', -1); + StartChar := StartObj.Get('character', -1); + EndLine := EndObj.Get('line', -1); + EndChar := EndObj.Get('character', -1); + Result := (StartLine >= 0) and (StartChar >= 0) and (EndLine >= 0) and (EndChar >= 0); + end; + + procedure CheckSymbolRange(const Symbol: TJSONObject; const Mode: String); + var + SymbolName: String; + SymbolKind: Integer; + RangeObj, SelRangeObj, LocationObj: TJSONObject; + StartLine, StartChar, EndLine, EndChar: Integer; + SelStartLine, SelStartChar, SelEndLine, SelEndChar: Integer; + Children: TJSONArray; + I: Integer; + begin + SymbolName := Symbol.Get('name', ''); + SymbolKind := Symbol.Get('kind', 0); + + // Get range (hierarchical mode) or location.range (flat mode) + RangeObj := Symbol.FindPath('range') as TJSONObject; + if RangeObj = nil then + begin + LocationObj := Symbol.FindPath('location') as TJSONObject; + if LocationObj <> nil then + RangeObj := LocationObj.FindPath('range') as TJSONObject; + end; + + if RangeObj <> nil then + begin + if GetRangeInfo(RangeObj, StartLine, StartChar, EndLine, EndChar) then + begin + // Range must have positive extent + if EndLine = StartLine then + AssertTrue(Format('%s: Symbol "%s" (kind %d) range on same line must have end.char > start.char', + [Mode, SymbolName, SymbolKind]), EndChar > StartChar) + else + AssertTrue(Format('%s: Symbol "%s" (kind %d) multi-line range must have end.line >= start.line', + [Mode, SymbolName, SymbolKind]), EndLine >= StartLine); + end; + end; + + // Check selectionRange (hierarchical mode only) + SelRangeObj := Symbol.FindPath('selectionRange') as TJSONObject; + if SelRangeObj <> nil then + begin + if GetRangeInfo(SelRangeObj, SelStartLine, SelStartChar, SelEndLine, SelEndChar) then + begin + // selectionRange should have non-zero width (typically same line) + if SelEndLine = SelStartLine then + AssertTrue(Format('%s: Symbol "%s" selectionRange must have width > 0', + [Mode, SymbolName]), SelEndChar > SelStartChar); + + // selectionRange must be contained within range + if RangeObj <> nil then + begin + AssertTrue(Format('%s: Symbol "%s" selectionRange.start must be >= range.start', + [Mode, SymbolName]), + (SelStartLine > StartLine) or ((SelStartLine = StartLine) and (SelStartChar >= StartChar))); + AssertTrue(Format('%s: Symbol "%s" selectionRange.end must be <= range.end', + [Mode, SymbolName]), + (SelEndLine < EndLine) or ((SelEndLine = EndLine) and (SelEndChar <= EndChar))); + end; + end; + end; + + // Recursively check children + Children := Symbol.FindPath('children') as TJSONArray; + if Children <> nil then + for I := 0 to Children.Count - 1 do + CheckSymbolRange(Children.Items[I] as TJSONObject, Mode); + end; + +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; + I: Integer; +begin + // Test hierarchical mode + SetClientCapabilities(True); + CreateTestFile(TEST_UNIT_WITH_PROPERTY_AND_FIELD); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + for I := 0 to SymbolArray.Count - 1 do + CheckSymbolRange(SymbolArray.Items[I] as TJSONObject, 'Hierarchical'); + finally + JSONData.Free; + end; + + CleanupTestFile; + + // Test flat mode + SetClientCapabilities(False); + CreateTestFile(TEST_UNIT_WITH_PROPERTY_AND_FIELD); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded (flat)', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array (flat)', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + for I := 0 to SymbolArray.Count - 1 do + CheckSymbolRange(SymbolArray.Items[I] as TJSONObject, 'Flat'); + finally + JSONData.Free; + end; +end; + +procedure TTestDocumentSymbol.TestMethodSelectionRangePointsToName; +{ Test that selectionRange for methods points to the method NAME, not the + "procedure"/"function" keyword. + + Bug history: SetNodeRange used Node.StartPos which for procedure nodes + points to the "procedure" keyword. This caused selectionRange to highlight + "procedure" instead of "MethodA1" in editors like Sublime Text. + + Fix: Use MoveCursorToProcName to find the actual name position. } +const + TEST_METHOD_SELECTION = + 'unit TestMethod;' + LineEnding + // line 0 + '' + LineEnding + // line 1 + 'interface' + LineEnding + // line 2 + '' + LineEnding + // line 3 + 'type' + LineEnding + // line 4 + ' TMyClass = class' + LineEnding + // line 5 + ' procedure DoWork;' + LineEnding + // line 6: "procedure" at 4, "DoWork" at 14 + ' function Calculate: Integer;' + LineEnding + // line 7: "function" at 4, "Calculate" at 13 + ' end;' + LineEnding + // line 8 + '' + LineEnding + // line 9 + 'implementation' + LineEnding + // line 10 + '' + LineEnding + // line 11 + 'procedure TMyClass.DoWork;' + LineEnding + // line 12: "procedure" at 0, "DoWork" at 19 + 'begin' + LineEnding + // line 13 + 'end;' + LineEnding + // line 14 + '' + LineEnding + // line 15 + 'function TMyClass.Calculate: Integer;' + LineEnding + // line 16: "function" at 0, "Calculate" at 18 + 'begin' + LineEnding + // line 17 + ' Result := 42;' + LineEnding + // line 18 + 'end;' + LineEnding + // line 19 + '' + LineEnding + // line 20 + 'end.'; // line 21 +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray, Children, ClassChildren: TJSONArray; + I, J, K: Integer; + Symbol, ChildSymbol, MethodSymbol, SelRangeObj, StartObj: TJSONObject; + SymbolName: String; + SelStartChar: Integer; + DoWorkFoundInterface, CalculateFoundInterface: Boolean; + DoWorkFoundImpl, CalculateFoundImpl: Boolean; +begin + // Test hierarchical mode + SetClientCapabilities(True); + CreateTestFile(TEST_METHOD_SELECTION); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + DoWorkFoundInterface := False; + CalculateFoundInterface := False; + DoWorkFoundImpl := False; + CalculateFoundImpl := False; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + + // Find methods in interface (class declaration) and implementation + for I := 0 to SymbolArray.Count - 1 do + begin + Symbol := SymbolArray.Items[I] as TJSONObject; + SymbolName := Symbol.Get('name', ''); + + // Check interface section - class with method declarations + if SymbolName = 'interface' then + begin + Children := Symbol.FindPath('children') as TJSONArray; + if Children <> nil then + for J := 0 to Children.Count - 1 do + begin + ChildSymbol := Children.Items[J] as TJSONObject; + if ChildSymbol.Get('name', '') = 'TMyClass' then + begin + // Find methods inside class + ClassChildren := ChildSymbol.FindPath('children') as TJSONArray; + if ClassChildren <> nil then + for K := 0 to ClassChildren.Count - 1 do + begin + MethodSymbol := ClassChildren.Items[K] as TJSONObject; + SymbolName := MethodSymbol.Get('name', ''); + + SelRangeObj := MethodSymbol.FindPath('selectionRange') as TJSONObject; + if SelRangeObj <> nil then + begin + StartObj := SelRangeObj.FindPath('start') as TJSONObject; + if StartObj <> nil then + begin + SelStartChar := StartObj.Get('character', -1); + + if SymbolName = 'DoWork' then + begin + DoWorkFoundInterface := True; + // Line 6: " procedure DoWork;" + // "DoWork" starts at char 14, not char 4 (where "procedure" starts) + AssertEquals( + 'Interface DoWork selectionRange.start.character should point to name', + 14, SelStartChar); + end + else if SymbolName = 'Calculate' then + begin + CalculateFoundInterface := True; + // Line 7: " function Calculate: Integer;" + // "Calculate" starts at char 13, not char 4 (where "function" starts) + AssertEquals( + 'Interface Calculate selectionRange.start.character should point to name', + 13, SelStartChar); + end; + end; + end; + end; + Break; + end; + end; + end + + // Check implementation section - class method implementations + else if SymbolName = 'implementation' then + begin + Children := Symbol.FindPath('children') as TJSONArray; + if Children <> nil then + for J := 0 to Children.Count - 1 do + begin + ChildSymbol := Children.Items[J] as TJSONObject; + if ChildSymbol.Get('name', '') = 'TMyClass' then + begin + // Find methods inside implementation class container + ClassChildren := ChildSymbol.FindPath('children') as TJSONArray; + if ClassChildren <> nil then + for K := 0 to ClassChildren.Count - 1 do + begin + MethodSymbol := ClassChildren.Items[K] as TJSONObject; + SymbolName := MethodSymbol.Get('name', ''); + + SelRangeObj := MethodSymbol.FindPath('selectionRange') as TJSONObject; + if SelRangeObj <> nil then + begin + StartObj := SelRangeObj.FindPath('start') as TJSONObject; + if StartObj <> nil then + begin + SelStartChar := StartObj.Get('character', -1); + + if SymbolName = 'DoWork' then + begin + DoWorkFoundImpl := True; + // Line 12: "procedure TMyClass.DoWork;" + // "DoWork" starts at char 19, not char 0 (where "procedure" starts) + AssertEquals( + 'Implementation DoWork selectionRange.start.character should point to name', + 19, SelStartChar); + end + else if SymbolName = 'Calculate' then + begin + CalculateFoundImpl := True; + // Line 16: "function TMyClass.Calculate: Integer;" + // "Calculate" starts at char 18, not char 0 (where "function" starts) + AssertEquals( + 'Implementation Calculate selectionRange.start.character should point to name', + 18, SelStartChar); + end; + end; + end; + end; + Break; + end; + end; + end; + end; + + AssertTrue('DoWork should be found in interface', DoWorkFoundInterface); + AssertTrue('Calculate should be found in interface', CalculateFoundInterface); + AssertTrue('DoWork should be found in implementation', DoWorkFoundImpl); + AssertTrue('Calculate should be found in implementation', CalculateFoundImpl); + + finally + JSONData.Free; + end; +end; + +procedure TTestDocumentSymbol.TestHierarchicalModeFullValidation; +{ Comprehensive test for hierarchical mode (DocumentSymbol[]). + Validates exact line and character positions for all symbols. + Uses TEST_FULL_VALIDATION_FILE which has precise position comments. + + Expected symbol hierarchy: + - interface (line 6) + - TTestClassA (line 9) + - FValue (line 11) + - MethodA1 (line 13) + - MethodA2 (line 14) + - GlobalProc (line 17) + - implementation (line 19) + - TTestClassA (container for methods) + - MethodA1 (line 21) + - NestedProc (line 25) + - MethodA2 (line 34) + - GlobalProc (line 39) +} + + procedure CheckSelectionRange(Symbol: TJSONObject; const SymbolName: String; + ExpStartLine, ExpStartChar, ExpEndLine, ExpEndChar: Integer); + var + SelRange, StartObj, EndObj: TJSONObject; + ActStartLine, ActStartChar, ActEndLine, ActEndChar: Integer; + begin + SelRange := Symbol.FindPath('selectionRange') as TJSONObject; + AssertNotNull(Format('%s should have selectionRange', [SymbolName]), SelRange); + + StartObj := SelRange.FindPath('start') as TJSONObject; + EndObj := SelRange.FindPath('end') as TJSONObject; + AssertNotNull(Format('%s selectionRange should have start', [SymbolName]), StartObj); + AssertNotNull(Format('%s selectionRange should have end', [SymbolName]), EndObj); + + ActStartLine := StartObj.Get('line', -1); + ActStartChar := StartObj.Get('character', -1); + ActEndLine := EndObj.Get('line', -1); + ActEndChar := EndObj.Get('character', -1); + + AssertEquals(Format('%s selectionRange.start.line', [SymbolName]), ExpStartLine, ActStartLine); + AssertEquals(Format('%s selectionRange.start.character', [SymbolName]), ExpStartChar, ActStartChar); + AssertEquals(Format('%s selectionRange.end.line', [SymbolName]), ExpEndLine, ActEndLine); + AssertEquals(Format('%s selectionRange.end.character', [SymbolName]), ExpEndChar, ActEndChar); + end; + + function FindSymbolByName(Arr: TJSONArray; const Name: String): TJSONObject; + var + I: Integer; + Obj: TJSONObject; + begin + Result := nil; + if Arr = nil then Exit; + for I := 0 to Arr.Count - 1 do + begin + Obj := Arr.Items[I] as TJSONObject; + if Obj.Get('name', '') = Name then + Exit(Obj); + end; + end; + +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray, InterfaceChildren, ImplChildren, ClassChildren, MethodChildren: TJSONArray; + InterfaceSymbol, ImplSymbol, ClassSymbol, MethodSymbol, NestedSymbol: TJSONObject; +begin + // Test hierarchical mode + SetClientCapabilities(True); + CreateTestFile(TEST_FULL_VALIDATION_FILE); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + + // Find interface section + InterfaceSymbol := FindSymbolByName(SymbolArray, 'interface'); + AssertNotNull('Interface symbol should exist', InterfaceSymbol); + // "interface" at line 6, char 0-8 (length 9) + CheckSelectionRange(InterfaceSymbol, 'interface', 6, 0, 6, 9); + + // Check interface children + InterfaceChildren := InterfaceSymbol.FindPath('children') as TJSONArray; + AssertNotNull('Interface should have children', InterfaceChildren); + + // TTestClassA in interface at line 9 + // " TTestClassA = class" -> "TTestClassA" at char 2-12 (length 11) + ClassSymbol := FindSymbolByName(InterfaceChildren, 'TTestClassA'); + AssertNotNull('TTestClassA should exist in interface', ClassSymbol); + CheckSelectionRange(ClassSymbol, 'interface.TTestClassA', 9, 2, 9, 13); + + ClassChildren := ClassSymbol.FindPath('children') as TJSONArray; + AssertNotNull('TTestClassA should have children', ClassChildren); + + // FValue at line 11: " FValue: Integer;" -> "FValue" at char 4-9 (length 6) + MethodSymbol := FindSymbolByName(ClassChildren, 'FValue'); + AssertNotNull('FValue should exist', MethodSymbol); + CheckSelectionRange(MethodSymbol, 'FValue', 11, 4, 11, 10); + + // MethodA1 at line 13: " procedure MethodA1;" -> "MethodA1" at char 14-21 (length 8) + MethodSymbol := FindSymbolByName(ClassChildren, 'MethodA1'); + AssertNotNull('MethodA1 should exist in interface', MethodSymbol); + CheckSelectionRange(MethodSymbol, 'interface.MethodA1', 13, 14, 13, 22); + + // MethodA2 at line 14: " function MethodA2: Integer;" -> "MethodA2" at char 13-20 (length 8) + MethodSymbol := FindSymbolByName(ClassChildren, 'MethodA2'); + AssertNotNull('MethodA2 should exist in interface', MethodSymbol); + CheckSelectionRange(MethodSymbol, 'interface.MethodA2', 14, 13, 14, 21); + + // GlobalProc at line 17: "procedure GlobalProc;" -> "GlobalProc" at char 10-19 (length 10) + MethodSymbol := FindSymbolByName(InterfaceChildren, 'GlobalProc'); + AssertNotNull('GlobalProc should exist in interface', MethodSymbol); + CheckSelectionRange(MethodSymbol, 'interface.GlobalProc', 17, 10, 17, 20); + + // Find implementation section + ImplSymbol := FindSymbolByName(SymbolArray, 'implementation'); + AssertNotNull('Implementation symbol should exist', ImplSymbol); + // "implementation" at line 19, char 0-13 (length 14) + CheckSelectionRange(ImplSymbol, 'implementation', 19, 0, 19, 14); + + ImplChildren := ImplSymbol.FindPath('children') as TJSONArray; + AssertNotNull('Implementation should have children', ImplChildren); + + // TTestClassA container in implementation + ClassSymbol := FindSymbolByName(ImplChildren, 'TTestClassA'); + AssertNotNull('TTestClassA should exist in implementation', ClassSymbol); + + ClassChildren := ClassSymbol.FindPath('children') as TJSONArray; + AssertNotNull('TTestClassA impl should have children', ClassChildren); + + // MethodA1 implementation at line 21: "procedure TTestClassA.MethodA1;" + // "MethodA1" at char 22-29 (length 8) + MethodSymbol := FindSymbolByName(ClassChildren, 'MethodA1'); + AssertNotNull('MethodA1 should exist in implementation', MethodSymbol); + CheckSelectionRange(MethodSymbol, 'impl.MethodA1', 21, 22, 21, 30); + + // Check nested function: NestedProc at line 25 + // " procedure NestedProc;" -> "NestedProc" at char 12-21 (length 10) + MethodChildren := MethodSymbol.FindPath('children') as TJSONArray; + AssertNotNull('MethodA1 should have children (nested)', MethodChildren); + NestedSymbol := FindSymbolByName(MethodChildren, 'NestedProc'); + AssertNotNull('NestedProc should exist', NestedSymbol); + CheckSelectionRange(NestedSymbol, 'NestedProc', 25, 12, 25, 22); + + // MethodA2 implementation at line 34: "function TTestClassA.MethodA2: Integer;" + // "MethodA2" at char 21-28 (length 8) + MethodSymbol := FindSymbolByName(ClassChildren, 'MethodA2'); + AssertNotNull('MethodA2 should exist in implementation', MethodSymbol); + CheckSelectionRange(MethodSymbol, 'impl.MethodA2', 34, 21, 34, 29); + + // GlobalProc implementation at line 39: "procedure GlobalProc;" + // "GlobalProc" at char 10-19 (length 10) + MethodSymbol := FindSymbolByName(ImplChildren, 'GlobalProc'); + AssertNotNull('GlobalProc should exist in implementation', MethodSymbol); + CheckSelectionRange(MethodSymbol, 'impl.GlobalProc', 39, 10, 39, 20); + + finally + JSONData.Free; + end; +end; + +procedure TTestDocumentSymbol.TestFlatModeFullValidation; +{ Comprehensive test for flat mode (SymbolInformation[]). + Validates exact line and character positions for all symbols via location.range. + Uses TEST_FULL_VALIDATION_FILE which has precise position comments. + + In flat mode, symbols have location.range (not range/selectionRange). + The range should span from symbol start to end (inclusive of semicolon). +} + + procedure CheckLocationRange(Symbol: TJSONObject; const SymbolName: String; + ExpStartLine, ExpStartChar: Integer); + var + Location, RangeObj, StartObj: TJSONObject; + ActStartLine, ActStartChar: Integer; + begin + Location := Symbol.FindPath('location') as TJSONObject; + AssertNotNull(Format('%s should have location', [SymbolName]), Location); + + RangeObj := Location.FindPath('range') as TJSONObject; + AssertNotNull(Format('%s location should have range', [SymbolName]), RangeObj); + + StartObj := RangeObj.FindPath('start') as TJSONObject; + AssertNotNull(Format('%s range should have start', [SymbolName]), StartObj); + + ActStartLine := StartObj.Get('line', -1); + ActStartChar := StartObj.Get('character', -1); + + AssertEquals(Format('%s location.range.start.line', [SymbolName]), ExpStartLine, ActStartLine); + AssertEquals(Format('%s location.range.start.character', [SymbolName]), ExpStartChar, ActStartChar); + end; + + function FindSymbolByName(Arr: TJSONArray; const Name: String): TJSONObject; + var + I: Integer; + Obj: TJSONObject; + begin + Result := nil; + if Arr = nil then Exit; + for I := 0 to Arr.Count - 1 do + begin + Obj := Arr.Items[I] as TJSONObject; + if Obj.Get('name', '') = Name then + Exit(Obj); + end; + end; + +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; + Symbol: TJSONObject; +begin + // Test flat mode + SetClientCapabilities(False); + CreateTestFile(TEST_FULL_VALIDATION_FILE); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + + // In flat mode, symbols use ClassName.MemberName naming + // Check interface section symbol + Symbol := FindSymbolByName(SymbolArray, 'interface'); + AssertNotNull('interface symbol should exist', Symbol); + CheckLocationRange(Symbol, 'interface', 6, 0); + + // TTestClassA at line 9 + Symbol := FindSymbolByName(SymbolArray, 'TTestClassA'); + AssertNotNull('TTestClassA should exist', Symbol); + CheckLocationRange(Symbol, 'TTestClassA', 9, 2); + + // TTestClassA.FValue at line 11 (flat mode uses Class.Member naming) + Symbol := FindSymbolByName(SymbolArray, 'TTestClassA.FValue'); + AssertNotNull('TTestClassA.FValue should exist', Symbol); + CheckLocationRange(Symbol, 'TTestClassA.FValue', 11, 4); + + // TTestClassA.MethodA1 at line 13 (interface declaration) + Symbol := FindSymbolByName(SymbolArray, 'TTestClassA.MethodA1'); + AssertNotNull('TTestClassA.MethodA1 should exist', Symbol); + CheckLocationRange(Symbol, 'TTestClassA.MethodA1', 13, 4); + + // TTestClassA.MethodA2 at line 14 (interface declaration) + Symbol := FindSymbolByName(SymbolArray, 'TTestClassA.MethodA2'); + AssertNotNull('TTestClassA.MethodA2 should exist', Symbol); + CheckLocationRange(Symbol, 'TTestClassA.MethodA2', 14, 4); + + // GlobalProc at line 17 + Symbol := FindSymbolByName(SymbolArray, 'GlobalProc'); + AssertNotNull('GlobalProc should exist', Symbol); + CheckLocationRange(Symbol, 'GlobalProc', 17, 0); + + // implementation section symbol + Symbol := FindSymbolByName(SymbolArray, 'implementation'); + AssertNotNull('implementation symbol should exist', Symbol); + CheckLocationRange(Symbol, 'implementation', 19, 0); + + // Note: In flat mode, implementation methods have different positions + // because they start with "procedure TClassName.MethodName" + // MethodA1 at line 21 is now a method (not TTestClassA.MethodA1 duplicate) + // The overloadPolicy setting determines how duplicates are handled + + finally + JSONData.Free; + end; +end; + initialization RegisterTest(TTestDocumentSymbol); end. From 1dd706642658277ba90b24aff9a1e6b9c709946d Mon Sep 17 00:00:00 2001 From: zen010101 <60574100+zen010101@users.noreply.github.com> Date: Thu, 1 Jan 2026 18:45:06 +0800 Subject: [PATCH 8/8] feat: add client profile system for editor-specific feature configuration Introduce TClientProfile mechanism to manage editor-specific feature toggles, replacing the previous symbolMode setting with a more flexible feature-based approach. Changes: - Add TClientFeature enum with feature flags: - cfFlatSymbolMode: Use flat SymbolInformation instead of hierarchical - cfExcludeSectionContainers: Exclude interface/implementation namespace symbols (only effective when cfFlatSymbolMode is enabled) - cfExcludeInterfaceMethodDecls: Exclude interface method declarations (only effective when cfFlatSymbolMode is enabled) - cfExcludeImplClassDefs: Exclude implementation class definitions (only effective when cfFlatSymbolMode is enabled) - cfNullDocumentVersion: Use nil instead of 0 for document version (migrated from existing Sublime Text handling in ApplyEdit) - cfFilterTextOnly: Only set filterText in completion, not label (migrated from existing Sublime Text handling in Completion) - Add TClientProfile class with profile registry: - Auto-detection based on clientInfo.name from initialize request - Built-in profiles: - Default (vscode): No features enabled, uses LSP defaults - Sublime Text LSP: cfFlatSymbolMode, cfExcludeSectionContainers, cfExcludeInterfaceMethodDecls, cfExcludeImplClassDefs, cfNullDocumentVersion, cfFilterTextOnly - User feature customization via initializationOptions: - clientProfileEnableFeatures: Comma-separated list of features to enable - clientProfileDisableFeatures: Comma-separated list of features to disable - User settings are applied on top of the detected profile VSCode example (settings.json): "pascalLanguageServer.initializationOptions.clientProfileEnableFeatures": "FlatSymbolMode", "pascalLanguageServer.initializationOptions.clientProfileDisableFeatures": "CompletionAddBrackets" Sublime Text example (LSP.sublime-settings): "initializationOptions": { "clientProfileEnableFeatures": "FlatSymbolMode", "clientProfileDisableFeatures": "FilterTextOnly" } - Refactor existing code to use profile system: - PasLS.Symbols: Use feature flags for symbol filtering - PasLS.Completion: Migrate Sublime Text check to cfFilterTextOnly - PasLS.ApplyEdit: Migrate Sublime Text check to cfNullDocumentVersion - Remove deprecated symbolMode configuration option - Add comprehensive tests: - Tests.ClientProfile: Unit tests for profile mechanism - Tests.SublimeProfile: Integration tests for Sublime Text profile --- src/serverprotocol/PasLS.ApplyEdit.pas | 4 +- src/serverprotocol/PasLS.ClientProfile.pas | 217 +++++++ src/serverprotocol/PasLS.Completion.pas | 25 +- src/serverprotocol/PasLS.General.pas | 16 +- src/serverprotocol/PasLS.Settings.pas | 35 +- src/serverprotocol/PasLS.Symbols.pas | 74 ++- src/serverprotocol/lspserver.lpk | 4 + src/serverprotocol/lspserver.pas | 2 +- src/tests/Tests.ClientProfile.pas | 261 ++++++++ src/tests/Tests.SublimeProfile.pas | 659 +++++++++++++++++++++ src/tests/testlsp.lpr | 3 +- 11 files changed, 1238 insertions(+), 62 deletions(-) create mode 100644 src/serverprotocol/PasLS.ClientProfile.pas create mode 100644 src/tests/Tests.ClientProfile.pas create mode 100644 src/tests/Tests.SublimeProfile.pas diff --git a/src/serverprotocol/PasLS.ApplyEdit.pas b/src/serverprotocol/PasLS.ApplyEdit.pas index b88bb59..74c5b10 100644 --- a/src/serverprotocol/PasLS.ApplyEdit.pas +++ b/src/serverprotocol/PasLS.ApplyEdit.pas @@ -34,7 +34,7 @@ implementation Uses { LSP } - PasLS.Settings, + PasLS.ClientProfile, LSP.BaseTypes, LSP.WorkSpace, PasLS.WorkSpace; @@ -58,7 +58,7 @@ procedure DoApplyEdit(aTransport: TMessageTransport; DocumentURI, Text: String; // but ideally you're supposed to provided correct versions. // See `OptionalVersionedTextDocumentIdentifier` from // https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#versionedTextDocumentIdentifier - if ClientInfo.name = TClients.SublimeTextLSP then + if TClientProfile.Current.HasFeature(cfNullDocumentVersion) then TextDocumentEdit.textDocument.version := nil else TextDocumentEdit.textDocument.version := 0; diff --git a/src/serverprotocol/PasLS.ClientProfile.pas b/src/serverprotocol/PasLS.ClientProfile.pas new file mode 100644 index 0000000..ce841bc --- /dev/null +++ b/src/serverprotocol/PasLS.ClientProfile.pas @@ -0,0 +1,217 @@ +// Pascal Language Server +// Copyright 2020 Ryan Joseph + +// This file is part of Pascal Language Server. + +// Pascal Language Server is free software: you can redistribute it +// and/or modify it under the terms of the GNU General Public License +// as published by the Free Software Foundation, either version 3 of +// the License, or (at your option) any later version. + +// Pascal Language Server is distributed in the hope that it will be +// useful, but WITHOUT ANY WARRANTY; without even the implied warranty +// of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. + +// You should have received a copy of the GNU General Public License +// along with Pascal Language Server. If not, see +// . +unit PasLS.ClientProfile; + +{$mode objfpc}{$H+} + +interface + +uses + { RTL } + Classes, SysUtils, Contnrs; + +type + { Feature flags for client-specific behaviors } + TClientFeature = ( + cfFlatSymbolMode, // Force flat symbol mode (SymbolInformation[]) + cfExcludeSectionContainers, // Don't include interface/implementation section containers + cfExcludeInterfaceMethodDecls, // Don't include method/function/procedure declarations from interface section + cfExcludeImplClassDefs, // Don't include class definitions from implementation section + cfNullDocumentVersion, // Use nil instead of 0 for document version + cfFilterTextOnly // Only set filterText in completion, not label + ); + TClientFeatures = set of TClientFeature; + + { Client profile class } + TClientProfile = class + private + FName: string; + FFeatures: TClientFeatures; + class var FCurrent: TClientProfile; + class var FDefault: TClientProfile; + class var FRegistry: TFPHashObjectList; + public + constructor Create(const AName: string; AFeatures: TClientFeatures); + + { Feature query - primary API } + function HasFeature(F: TClientFeature): Boolean; inline; + + { Properties } + property Name: string read FName; + property Features: TClientFeatures read FFeatures write FFeatures; + + { Class methods for profile management } + class procedure RegisterProfile(Profile: TClientProfile); + class procedure SelectProfile(const ClientName: string); + class procedure ApplyOverrides(EnableFeatures, DisableFeatures: TStrings); + class function Current: TClientProfile; + class procedure Finalize; + end; + +{ Helper function for string-to-feature conversion } +function TryStrToFeature(const S: string; out F: TClientFeature): Boolean; +function FeatureToStr(F: TClientFeature): string; + +implementation + +const + { Feature name mapping for configuration } + FeatureNames: array[TClientFeature] of string = ( + 'flatSymbolMode', + 'excludeSectionContainers', + 'excludeInterfaceMethodDecls', + 'excludeImplClassDefs', + 'nullDocumentVersion', + 'filterTextOnly' + ); + +function TryStrToFeature(const S: string; out F: TClientFeature): Boolean; +var + I: TClientFeature; +begin + Result := False; + for I := Low(TClientFeature) to High(TClientFeature) do + if SameText(S, FeatureNames[I]) then + begin + F := I; + Exit(True); + end; +end; + +function FeatureToStr(F: TClientFeature): string; +begin + Result := FeatureNames[F]; +end; + +{ TClientProfile } + +constructor TClientProfile.Create(const AName: string; AFeatures: TClientFeatures); +begin + inherited Create; + FName := AName; + FFeatures := AFeatures; +end; + +function TClientProfile.HasFeature(F: TClientFeature): Boolean; +begin + Result := F in FFeatures; +end; + +class procedure TClientProfile.RegisterProfile(Profile: TClientProfile); +begin + if FRegistry = nil then + FRegistry := TFPHashObjectList.Create(True); // Owns objects + FRegistry.Add(Profile.Name, Profile); +end; + +class procedure TClientProfile.SelectProfile(const ClientName: string); +begin + // Free previous copied profile if exists (not in registry and not FDefault) + if (FCurrent <> nil) and (FCurrent <> FDefault) then + if (FRegistry = nil) or (FRegistry.Find(FCurrent.Name) <> FCurrent) then + FreeAndNil(FCurrent); + + FCurrent := nil; + if FRegistry <> nil then + FCurrent := TClientProfile(FRegistry.Find(ClientName)); + if FCurrent = nil then + FCurrent := FDefault; +end; + +class procedure TClientProfile.ApplyOverrides(EnableFeatures, DisableFeatures: TStrings); +var + I: Integer; + Feature: TClientFeature; + OriginalProfile: TClientProfile; + OldCurrent: TClientProfile; +begin + if FCurrent = nil then Exit; + + // Check if we need to create a mutable copy + OriginalProfile := nil; + if FRegistry <> nil then + OriginalProfile := TClientProfile(FRegistry.Find(FCurrent.Name)); + + // Need to create a copy if: + // - FCurrent is the registered profile (OriginalProfile = FCurrent), OR + // - FCurrent is FDefault (check by object identity, not name lookup) + if (FCurrent = FDefault) or (FCurrent = OriginalProfile) then + begin + OldCurrent := FCurrent; + // Create a copy so we don't modify the registered or default profile + FCurrent := TClientProfile.Create(OldCurrent.Name, OldCurrent.Features); + // Note: We don't free OldCurrent here as it's owned by registry or is FDefault + end; + + // Apply enable overrides + if EnableFeatures <> nil then + for I := 0 to EnableFeatures.Count - 1 do + if TryStrToFeature(EnableFeatures[I], Feature) then + Include(FCurrent.FFeatures, Feature); + + // Apply disable overrides (takes precedence) + if DisableFeatures <> nil then + for I := 0 to DisableFeatures.Count - 1 do + if TryStrToFeature(DisableFeatures[I], Feature) then + Exclude(FCurrent.FFeatures, Feature); +end; + +class function TClientProfile.Current: TClientProfile; +begin + if FCurrent = nil then + FCurrent := FDefault; + Result := FCurrent; +end; + +class procedure TClientProfile.Finalize; +begin + // Free FCurrent if it's a copy (not in registry and not FDefault) + if (FCurrent <> nil) and (FCurrent <> FDefault) then + begin + if (FRegistry = nil) or (FRegistry.Find(FCurrent.Name) <> FCurrent) then + FreeAndNil(FCurrent); + end; + FCurrent := nil; + FreeAndNil(FRegistry); + FreeAndNil(FDefault); +end; + +initialization + // Create default profile (LSP-compliant, no special behaviors) + TClientProfile.FDefault := TClientProfile.Create('Default', []); + + // Register Sublime Text LSP profile + TClientProfile.RegisterProfile( + TClientProfile.Create('Sublime Text LSP', [ + cfFlatSymbolMode, + cfExcludeSectionContainers, + cfExcludeInterfaceMethodDecls, + cfExcludeImplClassDefs, + cfNullDocumentVersion, + cfFilterTextOnly + ])); + + // Register VS Code profile (uses LSP defaults) + TClientProfile.RegisterProfile( + TClientProfile.Create('vscode', [])); + +finalization + TClientProfile.Finalize; + +end. diff --git a/src/serverprotocol/PasLS.Completion.pas b/src/serverprotocol/PasLS.Completion.pas index b8eec00..ed7f43d 100644 --- a/src/serverprotocol/PasLS.Completion.pas +++ b/src/serverprotocol/PasLS.Completion.pas @@ -55,32 +55,19 @@ implementation uses SysUtils, Contnrs, - PasLS.CodeUtils, PasLS.Diagnostics, PasLS.Settings, LSP.Messages; + PasLS.CodeUtils, PasLS.Diagnostics, PasLS.Settings, PasLS.ClientProfile; procedure TCompletionItemHelper.SetPrimaryText(text: string); - begin - if ClientInfo.name = TClients.SublimeTextLSP then - begin - filterText := text; - end - else - begin - filterText := text; - &label := text; - end; + filterText := text; + if not TClientProfile.Current.HasFeature(cfFilterTextOnly) then + &label := text; end; procedure TCompletionItemHelper.SetSecondaryText(text: string); begin - if ClientInfo.name = TClients.SublimeTextLSP then - begin - &label := text; - end - else - begin - // todo: append to details? - end; + if not TClientProfile.Current.HasFeature(cfFilterTextOnly) then + &label := text; end; diff --git a/src/serverprotocol/PasLS.General.pas b/src/serverprotocol/PasLS.General.pas index 937334b..82d811a 100644 --- a/src/serverprotocol/PasLS.General.pas +++ b/src/serverprotocol/PasLS.General.pas @@ -100,7 +100,7 @@ TCancel = class(specialize TLSPNotification) implementation uses - SysUtils, RegExpr, IdentCompletionTool, DefineTemplates; + SysUtils, RegExpr, IdentCompletionTool, DefineTemplates, PasLS.ClientProfile; const @@ -306,10 +306,6 @@ procedure TInitialize.ShowConfigStatus(Params : TInitializeParams; CodeToolsOpti DoLog(' ► publishDiagnostics: ', ServerSettings.publishDiagnostics); DoLog(' ► workspaceSymbols: ', ServerSettings.workspaceSymbols); DoLog(' ► documentSymbols: ', ServerSettings.documentSymbols); - if ServerSettings.symbolMode <> '' then - DoLog(' ► symbolMode: %s', [ServerSettings.symbolMode]) - else - DoLog(' ► symbolMode: auto'); DoLog(' ► minimalisticCompletions: ', ServerSettings.minimalisticCompletions); DoLog(' ► showSyntaxErrors: ', ServerSettings.showSyntaxErrors); end; @@ -389,6 +385,16 @@ function TInitialize.Process(var Params : TLSPInitializeParams): TInitializeResu ServerSettings.Assign(Params.initializationOptions); PasLS.Settings.ClientInfo.Assign(Params.ClientInfo); + // Select client profile based on client name + TClientProfile.SelectProfile(Params.ClientInfo.name); + + // Apply user overrides from initializationOptions + if (ServerSettings.clientProfileEnableFeatures.Count > 0) or + (ServerSettings.clientProfileDisableFeatures.Count > 0) then + TClientProfile.ApplyOverrides( + ServerSettings.clientProfileEnableFeatures, + ServerSettings.clientProfileDisableFeatures); + // Detect hierarchical document symbol support if Assigned(Params.capabilities) and Assigned(Params.capabilities.textDocument) and diff --git a/src/serverprotocol/PasLS.Settings.pas b/src/serverprotocol/PasLS.Settings.pas index fbeea2c..4457976 100644 --- a/src/serverprotocol/PasLS.Settings.pas +++ b/src/serverprotocol/PasLS.Settings.pas @@ -47,24 +47,24 @@ TServerSettings = class(TInitializationOptions) fBooleans: array[0..32] of Boolean; fProgram: String; fSymbolDatabase: String; - fSymbolMode: String; fFPCOptions: TStrings; fExcludeWorkspaceFolders: TStrings; fCodeToolsConfig: String; fMaximumCompletions: Integer; fOverloadPolicy: TOverloadPolicy; fConfig: String; + fClientProfileEnableFeatures: TStrings; + fClientProfileDisableFeatures: TStrings; procedure SetFPCOptions(AValue: TStrings); procedure SetExcludeWorkspaceFolders(AValue: TStrings); + procedure SetClientProfileEnableFeatures(AValue: TStrings); + procedure SetClientProfileDisableFeatures(AValue: TStrings); published // Path to the main program file for resolving references // if not available the path of the current document will be used property &program: String read fProgram write fProgram; // Path to SQLite3 database for symbols property symbolDatabase: String read fSymbolDatabase write fSymbolDatabase; - // Symbol mode: "flat", "hierarchical", or "auto" (default, based on client capability) - // For backward compatibility: "symbolInformation" maps to "flat", "documentSymbol" maps to "hierarchical" - property symbolMode: String read fSymbolMode write fSymbolMode; // FPC compiler options (passed to Code Tools) property fpcOptions: TStrings read fFPCOptions write SetFPCOptions; // Optional codetools.config file to load settings from @@ -103,6 +103,11 @@ TServerSettings = class(TInitializationOptions) property config: String read fConfig write fConfig; // Check inactive regions property checkInactiveRegions : Boolean read fBooleans[11] write fBooleans[11]; + // Client profile feature overrides + property clientProfileEnableFeatures: TStrings + read fClientProfileEnableFeatures write SetClientProfileEnableFeatures; + property clientProfileDisableFeatures: TStrings + read fClientProfileDisableFeatures write SetClientProfileDisableFeatures; public constructor Create; override; Destructor Destroy; override; @@ -229,13 +234,14 @@ procedure TServerSettings.Assign(aSource : TPersistent); fBooleans:=Src.FBooleans; fProgram:=Src.fProgram;; SymbolDatabase:=Src.SymbolDatabase; - SymbolMode:=Src.SymbolMode; FPCOptions:=Src.fpcOptions; ExcludeWorkspaceFolders:=Src.ExcludeWorkspaceFolders; CodeToolsConfig:=Src.CodeToolsConfig; MaximumCompletions:=Src.MaximumCompletions; OverloadPolicy:=Src.OverloadPolicy; Config:=Src.Config; + ClientProfileEnableFeatures := Src.ClientProfileEnableFeatures; + ClientProfileDisableFeatures := Src.ClientProfileDisableFeatures; end else inherited Assign(aSource); @@ -253,6 +259,18 @@ procedure TServerSettings.SetExcludeWorkspaceFolders(AValue: TStrings); fExcludeWorkspaceFolders.Assign(AValue); end; +procedure TServerSettings.SetClientProfileEnableFeatures(AValue: TStrings); +begin + if fClientProfileEnableFeatures = AValue then Exit; + fClientProfileEnableFeatures.Assign(AValue); +end; + +procedure TServerSettings.SetClientProfileDisableFeatures(AValue: TStrings); +begin + if fClientProfileDisableFeatures = AValue then Exit; + fClientProfileDisableFeatures.Assign(AValue); +end; + function TServerSettings.CanProvideWorkspaceSymbols: boolean; begin result := workspaceSymbols and @@ -265,7 +283,6 @@ class function TServerSettings.GetPropertyDescription(const PropName: String): S case PropName of 'program': Result := 'Path to the main program file for resolving references'; 'symbolDatabase': Result := 'Path to SQLite3 database for symbols'; - 'symbolMode': Result := 'Symbol mode: "flat", "hierarchical", or "auto" (default)'; 'fpcOptions': Result := 'FPC compiler options (passed to Code Tools)'; 'codeToolsConfig': Result := 'Optional codetools.config file to load settings from'; 'maximumCompletions': Result := 'Maximum number of completion items to be returned'; @@ -284,6 +301,8 @@ class function TServerSettings.GetPropertyDescription(const PropName: String): S 'ignoreTextCompletions': Result := 'Ignores completion items like "begin" and "var"'; 'config': Result := 'Config file or directory to read settings from'; 'checkInactiveRegions': Result := 'Check inactive regions'; + 'clientProfileEnableFeatures': Result := 'List of features to force-enable regardless of client profile'; + 'clientProfileDisableFeatures': Result := 'List of features to force-disable regardless of client profile'; else Result := ''; end; @@ -295,6 +314,8 @@ constructor TServerSettings.Create; fFPCOptions := TStringList.Create; fExcludeWorkspaceFolders := TStringList.Create; + fClientProfileEnableFeatures := TStringList.Create; + fClientProfileDisableFeatures := TStringList.Create; // default settings symbolDatabase := ''; @@ -320,6 +341,8 @@ destructor TServerSettings.Destroy; begin FreeAndNil(fFPCOptions); FreeAndNil(fExcludeWorkspaceFolders); + FreeAndNil(fClientProfileEnableFeatures); + FreeAndNil(fClientProfileDisableFeatures); inherited Destroy; end; diff --git a/src/serverprotocol/PasLS.Symbols.pas b/src/serverprotocol/PasLS.Symbols.pas index 8852171..77d3313 100644 --- a/src/serverprotocol/PasLS.Symbols.pas +++ b/src/serverprotocol/PasLS.Symbols.pas @@ -153,6 +153,8 @@ TSymbolExtractor = class RelatedFiles: TFPHashList; IndentLevel: integer; CodeSection: TCodeTreeNodeDesc; + function ShouldExcludeInterfaceDecl: Boolean; + function ShouldExcludeImplClass: Boolean; private procedure PrintNodeDebug(Node: TCodeTreeNode; Deep: boolean = false); procedure AdjustEndPosition(Node: TCodeTreeNode; var EndPos: TCodeXYPosition); @@ -266,35 +268,24 @@ procedure AdjustEndPositionForLSP(Node: TCodeTreeNode; var EndPos: TCodeXYPositi implementation uses { RTL } - SysUtils, FileUtil, DateUtils, fpjsonrtti, + SysUtils, FileUtil, DateUtils, fpjsonrtti, { Code Tools } CodeAtom, FindDeclarationTool, KeywordFuncLists,PascalParserTool, { Protocol } - PasLS.Settings; + PasLS.Settings, PasLS.ClientProfile; function GetSymbolMode: TSymbolMode; -var - ModeStr: String; begin - // Check if symbolMode is explicitly set in initializationOptions - ModeStr := LowerCase(ServerSettings.symbolMode); + // Priority 1: Client profile forces flat mode + if TClientProfile.Current.HasFeature(cfFlatSymbolMode) then + Exit(smFlat); - // Explicit mode values - if ModeStr = 'flat' then - Result := smFlat - else if ModeStr = 'hierarchical' then + // Priority 2: Auto mode - use hierarchical if client supports it and server enables it + if ClientSupportsDocumentSymbol and ServerSettings.documentSymbols then Result := smHierarchical else - begin - // Auto mode (default): Use hierarchical format only if: - // 1. Client supports hierarchical document symbols, AND - // 2. Server settings has documentSymbols enabled (not disabled in initializationOptions) - if ClientSupportsDocumentSymbol and ServerSettings.documentSymbols then - Result := smHierarchical - else - Result := smFlat; - end; + Result := smFlat; end; procedure SetClientCapabilities(SupportsDocumentSymbol: Boolean); @@ -970,6 +961,20 @@ procedure TSymbolExtractor.AdjustEndPosition(Node: TCodeTreeNode; var EndPos: TC AdjustEndPositionForLSP(Node, EndPos); end; +function TSymbolExtractor.ShouldExcludeInterfaceDecl: Boolean; +begin + Result := (Builder.Mode = smFlat) and + (CodeSection = ctnInterface) and + TClientProfile.Current.HasFeature(cfExcludeInterfaceMethodDecls); +end; + +function TSymbolExtractor.ShouldExcludeImplClass: Boolean; +begin + Result := (Builder.Mode = smFlat) and + (CodeSection = ctnImplementation) and + TClientProfile.Current.HasFeature(cfExcludeImplClassDefs); +end; + function TSymbolExtractor.AddSymbol(Node: TCodeTreeNode; Kind: TSymbolKind; Name: String; Container: String): TSymbol; var CodePos, EndPos: TCodeXYPosition; @@ -1029,6 +1034,7 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod end; end; ctnProcedure: + if not ShouldExcludeInterfaceDecl then begin // Use Builder.AddMethod for consistent handling in both modes TypeName := GetIdentifierAtPos(Tool, ClassNode.StartPos, true, true); @@ -1070,7 +1076,8 @@ procedure TSymbolExtractor.ExtractObjCClassMethods(ClassNode, Node: TCodeTreeNod while Child <> nil do begin PrintNodeDebug(Child); - AddSymbol(Node, TSymbolKind._Method, TypeName+'.'+Tool.ExtractProcName(Child, [])); + if not ShouldExcludeInterfaceDecl then + AddSymbol(Node, TSymbolKind._Method, TypeName+'.'+Tool.ExtractProcName(Child, [])); Child := Child.NextBrother; end; end @@ -1121,6 +1128,12 @@ // (empty class "TMyClass = class end;" has no children but is NOT f Node := Node.NextBrother; continue; end; + // Skip implementation class definitions when filter is enabled (smFlat mode only) + if ShouldExcludeImplClass then + begin + Node := Node.NextBrother; + continue; + end; TypeName := CleanTypeName(GetIdentifierAtPos(Tool, TypeDefNode.StartPos, true, true)); Builder.AddClass(TypeDefNode, TypeName); Inc(IndentLevel); @@ -1305,17 +1318,19 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); begin // For hierarchical mode, create Interface namespace Builder.BeginInterfaceSection(Node); - // For flat mode, add namespace symbol + // For flat mode, add namespace symbol (unless filtered) if Builder.Mode = smFlat then - AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Interface); + if not TClientProfile.Current.HasFeature(cfExcludeSectionContainers) then + AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Interface); end; ctnImplementation: begin // For hierarchical mode, create Implementation namespace Builder.BeginImplementationSection(Node); - // For flat mode, add namespace symbol + // For flat mode, add namespace symbol (unless filtered) if Builder.Mode = smFlat then - AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Implementation); + if not TClientProfile.Current.HasFeature(cfExcludeSectionContainers) then + AddSymbol(Node, TSymbolKind._Namespace, kSymbolName_Implementation); end; end; CodeSection := Node.Desc; @@ -1379,7 +1394,7 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); Symbol.containerName.Value + '.' + Symbol.name); // In flat mode, we also need to track class symbols for range updates - if Builder.Mode = smFlat then + if (Builder.Mode = smFlat) and not ShouldExcludeImplClass then begin if (LastClassSymbol=nil) or (Symbol.containerName.Value<>LastClassSymbol.name) then LastClassSymbol:=AddSymbol(Node,TSymbolKind._Class,Symbol.containerName.Value) @@ -1393,9 +1408,12 @@ procedure TSymbolExtractor.ExtractCodeSection(Node: TCodeTreeNode); // F1 Scheme: Add to current section's namespace // - Interface section: function declaration // - Implementation section: function implementation - Builder.AddGlobalFunction(Node, Symbol.name); - // Process nested functions - parent path is function name - ProcessNestedFunctions(Node, Builder.LastAddedFunction, Symbol.name); + if not ShouldExcludeInterfaceDecl then + begin + Builder.AddGlobalFunction(Node, Symbol.name); + // Process nested functions - parent path is function name + ProcessNestedFunctions(Node, Builder.LastAddedFunction, Symbol.name); + end; end; end; diff --git a/src/serverprotocol/lspserver.lpk b/src/serverprotocol/lspserver.lpk index 332b634..8d9bf2f 100644 --- a/src/serverprotocol/lspserver.lpk +++ b/src/serverprotocol/lspserver.lpk @@ -138,6 +138,10 @@ + + + + diff --git a/src/serverprotocol/lspserver.pas b/src/serverprotocol/lspserver.pas index 1a0fb6c..f36114c 100644 --- a/src/serverprotocol/lspserver.pas +++ b/src/serverprotocol/lspserver.pas @@ -18,7 +18,7 @@ interface PasLS.DocumentSymbol, PasLS.Commands, PasLS.Formatter, PasLS.ExecuteCommand, PasLS.CodeUtils, PasLS.InvertAssign, PasLS.LazConfig, PasLS.Parser, PasLS.Symbols, PasLS.CheckInactiveRegions, PasLS.InactiveRegions, - LazarusPackageIntf; + PasLS.ClientProfile, LazarusPackageIntf; implementation diff --git a/src/tests/Tests.ClientProfile.pas b/src/tests/Tests.ClientProfile.pas new file mode 100644 index 0000000..13796a7 --- /dev/null +++ b/src/tests/Tests.ClientProfile.pas @@ -0,0 +1,261 @@ +unit Tests.ClientProfile; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, + PasLS.ClientProfile; + +type + TTestClientProfile = class(TTestCase) + protected + procedure TearDown; override; + published + procedure TestTryStrToFeatureValidName; + procedure TestTryStrToFeatureInvalidName; + procedure TestFeatureToStr; + procedure TestAllFeaturesHaveNames; + procedure TestDefaultProfileHasNoFeatures; + procedure TestProfileWithFeatures; + procedure TestHasFeature; + procedure TestSelectRegisteredProfile; + procedure TestSelectUnknownProfileUsesDefault; + procedure TestCurrentReturnsDefault; + procedure TestApplyOverridesEnable; + procedure TestApplyOverridesDisable; + procedure TestApplyOverridesBothEnableAndDisable; + procedure TestApplyOverridesDoesNotModifyRegistry; + procedure TestSublimeTextHasExcludeSectionContainers; + procedure TestSublimeTextHasExcludeInterfaceMethodDecls; + procedure TestSublimeTextHasExcludeImplClassDefs; + end; + +implementation + +procedure TTestClientProfile.TestTryStrToFeatureValidName; +var + F: TClientFeature; +begin + AssertTrue('flatSymbolMode should parse', TryStrToFeature('flatSymbolMode', F)); + AssertEquals('flatSymbolMode parses to cfFlatSymbolMode', Ord(cfFlatSymbolMode), Ord(F)); + + AssertTrue('nullDocumentVersion should parse', TryStrToFeature('nullDocumentVersion', F)); + AssertEquals('nullDocumentVersion parses to cfNullDocumentVersion', Ord(cfNullDocumentVersion), Ord(F)); + + // Case insensitive + AssertTrue('FLATSYMBOLMODE should parse (case insensitive)', TryStrToFeature('FLATSYMBOLMODE', F)); + AssertEquals('Case insensitive parse', Ord(cfFlatSymbolMode), Ord(F)); +end; + +procedure TTestClientProfile.TestTryStrToFeatureInvalidName; +var + F: TClientFeature; +begin + AssertFalse('invalidFeature should not parse', TryStrToFeature('invalidFeature', F)); + AssertFalse('empty string should not parse', TryStrToFeature('', F)); + AssertFalse('random text should not parse', TryStrToFeature('someRandomText', F)); +end; + +procedure TTestClientProfile.TestFeatureToStr; +begin + AssertEquals('cfFlatSymbolMode', 'flatSymbolMode', FeatureToStr(cfFlatSymbolMode)); + AssertEquals('cfNullDocumentVersion', 'nullDocumentVersion', FeatureToStr(cfNullDocumentVersion)); + AssertEquals('cfFilterTextOnly', 'filterTextOnly', FeatureToStr(cfFilterTextOnly)); +end; + +procedure TTestClientProfile.TestAllFeaturesHaveNames; +var + F: TClientFeature; + ParsedFeature: TClientFeature; +begin + // Verify round-trip for all features + for F := Low(TClientFeature) to High(TClientFeature) do + begin + AssertTrue('Feature ' + IntToStr(Ord(F)) + ' should have parseable name', + TryStrToFeature(FeatureToStr(F), ParsedFeature)); + AssertEquals('Round-trip for feature ' + IntToStr(Ord(F)), + Ord(F), Ord(ParsedFeature)); + end; +end; + +procedure TTestClientProfile.TestDefaultProfileHasNoFeatures; +var + Profile: TClientProfile; +begin + Profile := TClientProfile.Create('TestDefault', []); + try + AssertEquals('Name should be TestDefault', 'TestDefault', Profile.Name); + AssertFalse('Empty profile has no cfFlatSymbolMode', Profile.HasFeature(cfFlatSymbolMode)); + AssertFalse('Empty profile has no cfNullDocumentVersion', Profile.HasFeature(cfNullDocumentVersion)); + finally + Profile.Free; + end; +end; + +procedure TTestClientProfile.TestProfileWithFeatures; +var + Profile: TClientProfile; +begin + Profile := TClientProfile.Create('TestWithFeatures', [cfFlatSymbolMode, cfNullDocumentVersion]); + try + AssertTrue('Profile has cfFlatSymbolMode', Profile.HasFeature(cfFlatSymbolMode)); + AssertTrue('Profile has cfNullDocumentVersion', Profile.HasFeature(cfNullDocumentVersion)); + AssertFalse('Profile does not have cfFilterTextOnly', Profile.HasFeature(cfFilterTextOnly)); + finally + Profile.Free; + end; +end; + +procedure TTestClientProfile.TestHasFeature; +var + Profile: TClientProfile; + F: TClientFeature; +begin + // Test with all features enabled + Profile := TClientProfile.Create('AllFeatures', [cfFlatSymbolMode..cfFilterTextOnly]); + try + for F := Low(TClientFeature) to High(TClientFeature) do + AssertTrue('All features should be present', Profile.HasFeature(F)); + finally + Profile.Free; + end; +end; + +procedure TTestClientProfile.TearDown; +begin + TClientProfile.SelectProfile(''); +end; + +procedure TTestClientProfile.TestSelectRegisteredProfile; +begin + // Sublime Text LSP is registered in initialization + TClientProfile.SelectProfile('Sublime Text LSP'); + AssertEquals('Selected Sublime Text profile', 'Sublime Text LSP', TClientProfile.Current.Name); + AssertTrue('Sublime has cfFlatSymbolMode', TClientProfile.Current.HasFeature(cfFlatSymbolMode)); +end; + +procedure TTestClientProfile.TestSelectUnknownProfileUsesDefault; +begin + TClientProfile.SelectProfile('UnknownClient'); + AssertEquals('Unknown client uses Default', 'Default', TClientProfile.Current.Name); + AssertFalse('Default has no cfFlatSymbolMode', TClientProfile.Current.HasFeature(cfFlatSymbolMode)); +end; + +procedure TTestClientProfile.TestCurrentReturnsDefault; +begin + // Reset by selecting empty string + TClientProfile.SelectProfile(''); + AssertNotNull('Current should not be nil', TClientProfile.Current); + AssertEquals('Current should be Default', 'Default', TClientProfile.Current.Name); +end; + +procedure TTestClientProfile.TestApplyOverridesEnable; +var + EnableList: TStringList; +begin + TClientProfile.SelectProfile('vscode'); + AssertFalse('VSCode has no cfFlatSymbolMode by default', + TClientProfile.Current.HasFeature(cfFlatSymbolMode)); + + EnableList := TStringList.Create; + try + EnableList.Add('flatSymbolMode'); + TClientProfile.ApplyOverrides(EnableList, nil); + AssertTrue('VSCode now has cfFlatSymbolMode after override', + TClientProfile.Current.HasFeature(cfFlatSymbolMode)); + finally + EnableList.Free; + end; +end; + +procedure TTestClientProfile.TestApplyOverridesDisable; +var + DisableList: TStringList; +begin + TClientProfile.SelectProfile('Sublime Text LSP'); + AssertTrue('Sublime has cfFlatSymbolMode by default', + TClientProfile.Current.HasFeature(cfFlatSymbolMode)); + + DisableList := TStringList.Create; + try + DisableList.Add('flatSymbolMode'); + TClientProfile.ApplyOverrides(nil, DisableList); + AssertFalse('Sublime no longer has cfFlatSymbolMode after override', + TClientProfile.Current.HasFeature(cfFlatSymbolMode)); + finally + DisableList.Free; + end; +end; + +procedure TTestClientProfile.TestApplyOverridesBothEnableAndDisable; +var + EnableList, DisableList: TStringList; +begin + TClientProfile.SelectProfile('vscode'); + + EnableList := TStringList.Create; + DisableList := TStringList.Create; + try + EnableList.Add('flatSymbolMode'); + EnableList.Add('nullDocumentVersion'); + DisableList.Add('flatSymbolMode'); // Disable takes precedence + + TClientProfile.ApplyOverrides(EnableList, DisableList); + + AssertFalse('Disable takes precedence over enable', + TClientProfile.Current.HasFeature(cfFlatSymbolMode)); + AssertTrue('nullDocumentVersion should be enabled', + TClientProfile.Current.HasFeature(cfNullDocumentVersion)); + finally + EnableList.Free; + DisableList.Free; + end; +end; + +procedure TTestClientProfile.TestApplyOverridesDoesNotModifyRegistry; +var + EnableList: TStringList; +begin + // First apply override + TClientProfile.SelectProfile('vscode'); + EnableList := TStringList.Create; + try + EnableList.Add('flatSymbolMode'); + TClientProfile.ApplyOverrides(EnableList, nil); + finally + EnableList.Free; + end; + + // Re-select the same profile - should get original features + TClientProfile.SelectProfile('vscode'); + AssertFalse('Re-selected profile should have original features', + TClientProfile.Current.HasFeature(cfFlatSymbolMode)); +end; + +procedure TTestClientProfile.TestSublimeTextHasExcludeSectionContainers; +begin + TClientProfile.SelectProfile('Sublime Text LSP'); + AssertTrue('Sublime has cfExcludeSectionContainers', + TClientProfile.Current.HasFeature(cfExcludeSectionContainers)); +end; + +procedure TTestClientProfile.TestSublimeTextHasExcludeInterfaceMethodDecls; +begin + TClientProfile.SelectProfile('Sublime Text LSP'); + AssertTrue('Sublime has cfExcludeInterfaceMethodDecls', + TClientProfile.Current.HasFeature(cfExcludeInterfaceMethodDecls)); +end; + +procedure TTestClientProfile.TestSublimeTextHasExcludeImplClassDefs; +begin + TClientProfile.SelectProfile('Sublime Text LSP'); + AssertTrue('Sublime has cfExcludeImplClassDefs', + TClientProfile.Current.HasFeature(cfExcludeImplClassDefs)); +end; + +initialization + RegisterTest(TTestClientProfile); + +end. diff --git a/src/tests/Tests.SublimeProfile.pas b/src/tests/Tests.SublimeProfile.pas new file mode 100644 index 0000000..09cee85 --- /dev/null +++ b/src/tests/Tests.SublimeProfile.pas @@ -0,0 +1,659 @@ +unit Tests.SublimeProfile; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, fpjson, jsonparser, + CodeToolManager, CodeCache, + PasLS.Symbols, PasLS.ClientProfile; + +type + + { TTestSublimeProfile } + + TTestSublimeProfile = class(TTestCase) + private + FTestFile: String; + FTestCode: TCodeBuffer; + procedure CreateTestFile(const AContent: String); + procedure CleanupTestFile; + function GetSymbolNames(const RawJSON: String): TStringList; + function HasSymbol(const Names: TStringList; const SymbolName: String): Boolean; + function CountSymbol(const Names: TStringList; const SymbolName: String): Integer; + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestFlatModeHasLocation; + procedure TestFlatModeNoChildren; + procedure TestFlatModeMethodNaming; + procedure TestFlatModeNoContainerName; + procedure TestNoInterfaceContainer; + procedure TestNoImplementationContainer; + procedure TestClassesAtTopLevel; + procedure TestNoInterfaceMethodDecls; + procedure TestPreservesInterfaceClassDefs; + procedure TestNoInterfaceGlobalFuncDecl; + procedure TestNoImplClassDefs; + procedure TestNoDuplicateClasses; + procedure TestNoForwardDeclarations; + procedure TestImplClassMethodsPreserved; + procedure TestCompareWithDefault; + procedure TestGlobalFuncPreserved; + procedure TestNestedProcPreserved; + end; + +implementation + +const + TEST_SUBLIME_UNIT = + 'unit TestUnit;' + LineEnding + + '' + LineEnding + + '{$mode objfpc}{$H+}' + LineEnding + + '' + LineEnding + + 'interface' + LineEnding + // line 4 + '' + LineEnding + + 'type' + LineEnding + + ' TForward = class;' + LineEnding + // line 7: forward declaration + '' + LineEnding + + ' TMyClass = class' + LineEnding + // line 9 + ' procedure MethodA;' + LineEnding + // line 10 + ' function MethodB: Integer;' + LineEnding + // line 11 + ' end;' + LineEnding + + '' + LineEnding + + ' TMyRecord = record' + LineEnding + // line 14 + ' Field1: Integer;' + LineEnding + + ' end;' + LineEnding + + '' + LineEnding + + 'function GlobalFunc: Boolean;' + LineEnding + // line 18 + '' + LineEnding + + 'implementation' + LineEnding + // line 20 + '' + LineEnding + + 'type' + LineEnding + + ' TImplOnlyClass = class' + LineEnding + // line 23: impl-only class + ' procedure ImplMethod;' + LineEnding + + ' end;' + LineEnding + + '' + LineEnding + + '{ TMyClass }' + LineEnding + + '' + LineEnding + + 'procedure TMyClass.MethodA;' + LineEnding + // line 29 + '' + LineEnding + + ' procedure NestedProc;' + LineEnding + // line 31 + ' begin' + LineEnding + + ' end;' + LineEnding + + '' + LineEnding + + 'begin' + LineEnding + + ' NestedProc;' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + 'function TMyClass.MethodB: Integer;' + LineEnding + // line 39 + 'begin' + LineEnding + + ' Result := 0;' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + '{ TImplOnlyClass }' + LineEnding + + '' + LineEnding + + 'procedure TImplOnlyClass.ImplMethod;' + LineEnding + // line 46 + 'begin' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + '{ Global }' + LineEnding + + '' + LineEnding + + 'function GlobalFunc: Boolean;' + LineEnding + // line 52 + 'begin' + LineEnding + + ' Result := True;' + LineEnding + + 'end;' + LineEnding + + '' + LineEnding + + 'end.'; + +{ TTestSublimeProfile } + +procedure TTestSublimeProfile.CreateTestFile(const AContent: String); +var + F: TextFile; + ExistingBuffer: TCodeBuffer; +begin + FTestFile := GetTempFileName('', 'testunit'); + FTestFile := ChangeFileExt(FTestFile, '.pas'); + + AssignFile(F, FTestFile); + try + Rewrite(F); + Write(F, AContent); + finally + CloseFile(F); + end; + + ExistingBuffer := CodeToolBoss.FindFile(FTestFile); + if ExistingBuffer <> nil then + ExistingBuffer.Revert; +end; + +procedure TTestSublimeProfile.CleanupTestFile; +begin + if FileExists(FTestFile) then + DeleteFile(FTestFile); + FTestFile := ''; +end; + +procedure TTestSublimeProfile.SetUp; +begin + inherited SetUp; + FTestCode := nil; + FTestFile := ''; + + if SymbolManager = nil then + SymbolManager := TSymbolManager.Create; +end; + +procedure TTestSublimeProfile.TearDown; +begin + CleanupTestFile; + TClientProfile.SelectProfile(''); // Reset to default + inherited TearDown; +end; + +function TTestSublimeProfile.GetSymbolNames(const RawJSON: String): TStringList; + + procedure CollectNames(const Arr: TJSONArray; Names: TStringList); + var + I: Integer; + Obj: TJSONObject; + Children: TJSONArray; + SymbolName: String; + begin + for I := 0 to Arr.Count - 1 do + begin + Obj := Arr.Items[I] as TJSONObject; + SymbolName := Obj.Get('name', ''); + if SymbolName <> '' then + Names.Add(SymbolName); + + // Check for hierarchical children + if Obj.FindPath('children') is TJSONArray then + begin + Children := Obj.FindPath('children') as TJSONArray; + CollectNames(Children, Names); + end; + end; + end; + +var + JSONData: TJSONData; +begin + Result := TStringList.Create; + Result.Sorted := True; + Result.Duplicates := dupAccept; + + JSONData := GetJSON(RawJSON); + try + if JSONData is TJSONArray then + CollectNames(JSONData as TJSONArray, Result); + finally + JSONData.Free; + end; +end; + +function TTestSublimeProfile.HasSymbol(const Names: TStringList; const SymbolName: String): Boolean; +begin + Result := Names.IndexOf(SymbolName) >= 0; +end; + +function TTestSublimeProfile.CountSymbol(const Names: TStringList; const SymbolName: String): Integer; +var + I: Integer; +begin + Result := 0; + for I := 0 to Names.Count - 1 do + if Names[I] = SymbolName then + Inc(Result); +end; + +procedure TTestSublimeProfile.TestFlatModeHasLocation; +var + RawJSON: String; +begin + // F1.1: Sublime profile uses SymbolInformation[] with location field + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // SymbolInformation has "location" field, DocumentSymbol has "range" + AssertTrue('Should have location field (flat mode)', + Pos('"location"', RawJSON) > 0); +end; + +procedure TTestSublimeProfile.TestFlatModeNoChildren; +var + RawJSON: String; +begin + // F1.2: Flat mode should NOT have children field + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + AssertTrue('Should NOT have children field in flat mode', + Pos('"children"', RawJSON) = 0); +end; + +procedure TTestSublimeProfile.TestFlatModeMethodNaming; +var + RawJSON: String; + Names: TStringList; +begin + // F1.3: Methods should be named as "ClassName.MethodName" + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + AssertTrue('Should have TMyClass.MethodA', + HasSymbol(Names, 'TMyClass.MethodA')); + AssertTrue('Should have TMyClass.MethodB', + HasSymbol(Names, 'TMyClass.MethodB')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestFlatModeNoContainerName; +var + RawJSON: String; +begin + // F1.4: Flat mode should NOT have containerName field (Lazarus style) + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // SymbolInformation typically has containerName, but Lazarus style uses + // ClassName.MethodName in the name field instead + AssertTrue('Should NOT have containerName field', + Pos('"containerName"', RawJSON) = 0); +end; + +procedure TTestSublimeProfile.TestNoInterfaceContainer; +var + RawJSON: String; + Names: TStringList; +begin + // S1.1: Sublime profile excludes "interface" container symbol + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + AssertFalse('Should NOT have "interface" container', + HasSymbol(Names, 'interface')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestNoImplementationContainer; +var + RawJSON: String; + Names: TStringList; +begin + // S1.2: Sublime profile excludes "implementation" container symbol + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + AssertFalse('Should NOT have "implementation" container', + HasSymbol(Names, 'implementation')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestClassesAtTopLevel; +var + RawJSON: String; + JSONData: TJSONData; + SymbolArray: TJSONArray; + I: Integer; + Obj: TJSONObject; + FoundTMyClass: Boolean; +begin + // S1.3: Classes should appear at top level (not nested under section containers) + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + JSONData := GetJSON(RawJSON); + try + AssertTrue('Result should be an array', JSONData is TJSONArray); + SymbolArray := JSONData as TJSONArray; + + // TMyClass should be directly in the top-level array + FoundTMyClass := False; + for I := 0 to SymbolArray.Count - 1 do + begin + Obj := SymbolArray.Items[I] as TJSONObject; + if Obj.Get('name', '') = 'TMyClass' then + begin + FoundTMyClass := True; + Break; + end; + end; + + AssertTrue('TMyClass should be at top level (not nested)', FoundTMyClass); + finally + JSONData.Free; + end; +end; + +procedure TTestSublimeProfile.TestNoInterfaceMethodDecls; +var + RawJSON: String; + Names: TStringList; +begin + // M1.1: Sublime profile excludes interface method declarations + // But keeps the implementation methods (TMyClass.MethodA, TMyClass.MethodB) + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // Should have implementation methods + AssertTrue('Should have TMyClass.MethodA (impl)', + HasSymbol(Names, 'TMyClass.MethodA')); + AssertTrue('Should have TMyClass.MethodB (impl)', + HasSymbol(Names, 'TMyClass.MethodB')); + + // In flat mode with cfExcludeInterfaceMethodDecls: + // Interface declarations (bare MethodA, MethodB) should not appear + // Only the implementation versions (TMyClass.MethodA) should exist + // Count how many times the method appears - should be exactly once + // (the implementation version, not the interface declaration) + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestPreservesInterfaceClassDefs; +var + RawJSON: String; + Names: TStringList; +begin + // M1.2: Sublime profile keeps interface class definitions + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + AssertTrue('Should have TMyClass (interface class)', + HasSymbol(Names, 'TMyClass')); + AssertTrue('Should have TMyRecord (interface record)', + HasSymbol(Names, 'TMyRecord')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestNoInterfaceGlobalFuncDecl; +var + RawJSON: String; + Names: TStringList; +begin + // M1.4: Interface GlobalFunc declaration should be excluded + // Only the implementation version should exist (exactly 1 occurrence) + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // GlobalFunc should appear exactly once (implementation only) + // Not twice (interface declaration + implementation) + AssertEquals('GlobalFunc should appear exactly once', + 1, CountSymbol(Names, 'GlobalFunc')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestNoImplClassDefs; +var + RawJSON: String; + Names: TStringList; +begin + // C1.1: Sublime profile excludes implementation-only class definitions + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // TImplOnlyClass is defined only in implementation section + // It should NOT appear as a class symbol + AssertFalse('TImplOnlyClass should NOT exist (impl-only class)', + HasSymbol(Names, 'TImplOnlyClass')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestNoDuplicateClasses; +var + RawJSON: String; + Names: TStringList; +begin + // C1.4: Each class should appear exactly once (no duplicates) + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // TMyClass should appear exactly once + // (not twice from interface + implementation) + AssertEquals('TMyClass should appear exactly once', + 1, CountSymbol(Names, 'TMyClass')); + + // TMyRecord should appear exactly once + AssertEquals('TMyRecord should appear exactly once', + 1, CountSymbol(Names, 'TMyRecord')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestNoForwardDeclarations; +var + RawJSON: String; + Names: TStringList; +begin + // C1.5: Forward declarations should be excluded + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // TForward is a forward declaration at line 7 + AssertFalse('TForward should NOT exist (forward declaration)', + HasSymbol(Names, 'TForward')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestImplClassMethodsPreserved; +var + RawJSON: String; + Names: TStringList; +begin + // C1.6: Methods of impl-only classes should still appear + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // TImplOnlyClass.ImplMethod should exist even though + // TImplOnlyClass class symbol is excluded + AssertTrue('TImplOnlyClass.ImplMethod should exist', + HasSymbol(Names, 'TImplOnlyClass.ImplMethod')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestCompareWithDefault; +var + SublimeJSON, DefaultJSON: String; + SublimeNames, DefaultNames: TStringList; +begin + // Compare Sublime profile output with Default profile + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + + // Get Sublime profile symbols + TClientProfile.SelectProfile('Sublime Text LSP'); + SymbolManager.Reload(FTestCode, True); + SublimeJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + // Get Default profile symbols (hierarchical mode) + TClientProfile.SelectProfile(''); // Reset to default + SetClientCapabilities(True); // Hierarchical mode + SymbolManager.Reload(FTestCode, True); + DefaultJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + SublimeNames := GetSymbolNames(SublimeJSON); + DefaultNames := GetSymbolNames(DefaultJSON); + try + // Default has section containers, Sublime doesn't + AssertTrue('Default has interface', HasSymbol(DefaultNames, 'interface')); + AssertFalse('Sublime has no interface', HasSymbol(SublimeNames, 'interface')); + + AssertTrue('Default has implementation', HasSymbol(DefaultNames, 'implementation')); + AssertFalse('Sublime has no implementation', HasSymbol(SublimeNames, 'implementation')); + + // Default has hierarchical children, Sublime doesn't + AssertTrue('Default JSON has children', Pos('"children"', DefaultJSON) > 0); + AssertTrue('Sublime JSON has no children', Pos('"children"', SublimeJSON) = 0); + finally + SublimeNames.Free; + DefaultNames.Free; + end; +end; + +procedure TTestSublimeProfile.TestGlobalFuncPreserved; +var + RawJSON: String; + Names: TStringList; +begin + // Global functions in implementation should be preserved + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // GlobalFunc implementation at line 52 should exist + AssertTrue('GlobalFunc should exist (implementation)', + HasSymbol(Names, 'GlobalFunc')); + finally + Names.Free; + end; +end; + +procedure TTestSublimeProfile.TestNestedProcPreserved; +var + RawJSON: String; + Names: TStringList; +begin + // Nested procedures should be preserved with proper naming + TClientProfile.SelectProfile('Sublime Text LSP'); + + CreateTestFile(TEST_SUBLIME_UNIT); + FTestCode := CodeToolBoss.LoadFile(FTestFile, True, False); + AssertNotNull('Code buffer should be loaded', FTestCode); + SymbolManager.Reload(FTestCode, True); + RawJSON := SymbolManager.FindDocumentSymbols(FTestFile).AsJSON; + + Names := GetSymbolNames(RawJSON); + try + // NestedProc inside TMyClass.MethodA should exist + // In flat mode: TMyClass.MethodA.NestedProc + AssertTrue('TMyClass.MethodA.NestedProc should exist', + HasSymbol(Names, 'TMyClass.MethodA.NestedProc')); + finally + Names.Free; + end; +end; + +initialization + RegisterTest(TTestSublimeProfile); + +end. diff --git a/src/tests/testlsp.lpr b/src/tests/testlsp.lpr index 36a8ea3..88be367 100644 --- a/src/tests/testlsp.lpr +++ b/src/tests/testlsp.lpr @@ -3,7 +3,8 @@ {$mode objfpc}{$H+} uses - Classes, consoletestrunner, Tests.Basic, Tests.DocumentSymbol; + Classes, consoletestrunner, Tests.Basic, Tests.ClientProfile, Tests.DocumentSymbol, + Tests.SublimeProfile; type