diff --git a/.gitattributes b/.gitattributes index 4929cde4cd..1782d3ea39 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1049,6 +1049,7 @@ components/codetools/tests/testctxmlfixfragments.pas svneol=native#text/pascal components/codetools/tests/testfinddeclaration.pas svneol=native#text/plain components/codetools/tests/testglobals.pas svneol=native#text/plain components/codetools/tests/testmethodjumptool.pas svneol=native#text/plain +components/codetools/tests/testpascalparser.pas svneol=native#text/plain components/codetools/tests/testrefactoring.pas svneol=native#text/plain components/codetools/tests/teststdcodetools.pas svneol=native#text/plain components/codetools/unitdictionary.pas svneol=native#text/plain diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index f925145844..64761c6a0b 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -130,6 +130,7 @@ type FWriteLockCount: integer;// Set/Unset counter FWriteLockStep: integer; // current write lock ID FHandlers: array[TCodeToolManagerHandler] of TMethodList; + FErrorDbgMsg: string; procedure DoOnRescanFPCDirectoryCache(Sender: TObject); function GetBeautifier: TBeautifyCodeOptions; inline; function DoOnScannerGetInitValues(Scanner: TLinkScanner; Code: Pointer; @@ -277,6 +278,7 @@ type property ErrorLine: integer read fErrorLine; property ErrorMessage: string read fErrorMsg; property ErrorTopLine: integer read fErrorTopLine; + property ErrorDbgMsg: string read FErrorDbgMsg; property Abortable: boolean read FAbortable write SetAbortable; property OnCheckAbort: TOnCodeToolCheckAbort read FOnCheckAbort write FOnCheckAbort; @@ -1850,11 +1852,11 @@ end; procedure TCodeToolManager.WriteError; begin if FWriteExceptions then begin - DbgOut('### TCodeToolManager.HandleException: "'+ErrorMessage+'"'); - if ErrorLine>0 then DbgOut(' at Line=',DbgS(ErrorLine)); - if ErrorColumn>0 then DbgOut(' Col=',DbgS(ErrorColumn)); - if ErrorCode<>nil then DbgOut(' in "',ErrorCode.Filename,'"'); - DebugLn(''); + FErrorDbgMsg:='### TCodeToolManager.HandleException: "'+ErrorMessage+'"'; + if ErrorLine>0 then FErrorDbgMsg+=' at Line='+DbgS(ErrorLine); + if ErrorColumn>0 then FErrorDbgMsg+=' Col='+DbgS(ErrorColumn); + if ErrorCode<>nil then FErrorDbgMsg+=' in "'+ErrorCode.Filename+'"'; + Debugln(FErrorDbgMsg); {$IFDEF CTDEBUG} WriteDebugReport(true,false,false,false,false,false); {$ENDIF} diff --git a/components/codetools/tests/runtestscodetools.lpi b/components/codetools/tests/runtestscodetools.lpi index 060aa776f6..a0c5b79c86 100644 --- a/components/codetools/tests/runtestscodetools.lpi +++ b/components/codetools/tests/runtestscodetools.lpi @@ -1,7 +1,7 @@ - + @@ -37,7 +37,7 @@ - + @@ -45,7 +45,7 @@ - + @@ -93,6 +93,11 @@ + + + + + diff --git a/components/codetools/tests/runtestscodetools.lpr b/components/codetools/tests/runtestscodetools.lpr index 38f8e1e596..38bcfff31a 100644 --- a/components/codetools/tests/runtestscodetools.lpr +++ b/components/codetools/tests/runtestscodetools.lpr @@ -14,6 +14,12 @@ at . You can also obtain it by writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + Abstract: + Testsuites for codetools. + + Usage: + } program runtestscodetools; @@ -24,7 +30,7 @@ uses CodeToolManager, CodeToolsConfig, TestGlobals, TestBasicCodetools, TestCTRangeScan, TestMethodJumpTool, TestStdCodetools, - TestFinddeclaration, TestCompleteBlock, TestRefactoring, + TestFindDeclaration, TestCompleteBlock, TestRefactoring, // non Pascal TestCfgScript, TestCTH2Pas, TestCTXMLFixFragments, // compile test files to make sure they are valid Pascal @@ -36,7 +42,7 @@ uses {$IFDEF Darwin} fdt_objccategory, fdt_objcclass, {$ENDIF} - fdt_classof, fdt_with, rt_explodewith, fdt_generics; + fdt_classof, fdt_with, rt_explodewith, fdt_generics, TestPascalParser; const ConfigFilename = 'codetools.config'; diff --git a/components/codetools/tests/testbasiccodetools.pas b/components/codetools/tests/testbasiccodetools.pas index eb124f0261..d51c425f19 100644 --- a/components/codetools/tests/testbasiccodetools.pas +++ b/components/codetools/tests/testbasiccodetools.pas @@ -572,7 +572,7 @@ begin end; initialization - AddToBasicTestSuite(TTestBasicCodeTools); + AddToPascalTestSuite(TTestBasicCodeTools); end. diff --git a/components/codetools/tests/testcompleteblock.pas b/components/codetools/tests/testcompleteblock.pas index da9cce39d7..9a40dc332f 100644 --- a/components/codetools/tests/testcompleteblock.pas +++ b/components/codetools/tests/testcompleteblock.pas @@ -1,15 +1,15 @@ { Test all with: - ./runtests --format=plain --suite=TTestCodetoolsCompleteBlock + ./runtests --format=plain --suite=TTestCodetoolsCompleteBlock Test specific with: - ./runtests --format=plain --suite=TestCompleteBlockClassStart - ./runtests --format=plain --suite=TestCompleteBlockBegin - ./runtests --format=plain --suite=TestCompleteBlockRepeat - ./runtests --format=plain --suite=TestCompleteBlockCase - ./runtests --format=plain --suite=TestCompleteBlockTry - ./runtests --format=plain --suite=TestCompleteBlockAsm - ./runtests --format=plain --suite=TestCompleteBlockIf + ./runtests --format=plain --suite=TestCompleteBlockClassStart + ./runtests --format=plain --suite=TestCompleteBlockBegin + ./runtests --format=plain --suite=TestCompleteBlockRepeat + ./runtests --format=plain --suite=TestCompleteBlockCase + ./runtests --format=plain --suite=TestCompleteBlockTry + ./runtests --format=plain --suite=TestCompleteBlockAsm + ./runtests --format=plain --suite=TestCompleteBlockIf } unit TestCompleteBlock; @@ -418,7 +418,7 @@ begin end; initialization - AddToRefactoringTestSuite(TTestCodetoolsCompleteBlock); + AddToPascalTestSuite(TTestCodetoolsCompleteBlock); end. diff --git a/components/codetools/tests/testctrangescan.pas b/components/codetools/tests/testctrangescan.pas index 97b13657c5..dc362032a6 100644 --- a/components/codetools/tests/testctrangescan.pas +++ b/components/codetools/tests/testctrangescan.pas @@ -392,7 +392,7 @@ begin end; initialization - AddToFindDeclarationTestSuite(TTestCodetoolsRangeScan); + AddToPascalTestSuite(TTestCodetoolsRangeScan); end. diff --git a/components/codetools/tests/testfinddeclaration.pas b/components/codetools/tests/testfinddeclaration.pas index 2109664e25..0d522d3610 100644 --- a/components/codetools/tests/testfinddeclaration.pas +++ b/components/codetools/tests/testfinddeclaration.pas @@ -21,7 +21,7 @@ ./testcodetools --format=plain --suite=TestFindDeclaration_LazTests --filemask=t*.pp ./testcodetools --format=plain --suite=TestFindDeclaration_LazTests --filemask=tdefaultproperty1.pp } -unit TestFinddeclaration; +unit TestFindDeclaration; {$mode objfpc}{$H+} @@ -58,10 +58,6 @@ type procedure TestFindDeclaration_LazTests; end; -var - BugsTestSuite: TTestSuite; - FindDeclarationTestSuite: TTestSuite; - implementation { TTestFindDeclaration } @@ -445,6 +441,6 @@ begin end; initialization - AddToFindDeclarationTestSuite(TTestFindDeclaration); + AddToPascalTestSuite(TTestFindDeclaration); end. diff --git a/components/codetools/tests/testglobals.pas b/components/codetools/tests/testglobals.pas index 7ad7a906bc..ba2a5b62af 100644 --- a/components/codetools/tests/testglobals.pas +++ b/components/codetools/tests/testglobals.pas @@ -9,40 +9,21 @@ uses classes, sysutils, process; var - BasicTestSuite: TTestSuite; - FindDeclararionTestSuite: TTestSuite; - StdToolsTestSuite: TTestSuite; - RefactoringTestSuite: TTestSuite; + PascalTestSuite: TTestSuite; NonPascalTestSuite: TTestSuite; BugsTestSuite: TTestSuite; -procedure AddToBasicTestSuite(ATestClass: TClass); -procedure AddToFindDeclarationTestSuite(ATestClass: TClass); -procedure AddToStdToolsTestSuite(ATestClass: TClass); -procedure AddToRefactoringTestSuite(ATestClass: TClass); +procedure AddToPascalTestSuite(ATestClass: TClass); procedure AddToNonPascalTestSuite(ATestClass: TClass); procedure AddToBugsTestSuite(ATest: TTest); +function LinesToStr(Args: array of const): string; + implementation -procedure AddToBasicTestSuite(ATestClass: TClass); +procedure AddToPascalTestSuite(ATestClass: TClass); begin - BasicTestSuite.AddTestSuiteFromClass(ATestClass); -end; - -procedure AddToFindDeclarationTestSuite(ATestClass: TClass); -begin - FindDeclararionTestSuite.AddTestSuiteFromClass(ATestClass); -end; - -procedure AddToStdToolsTestSuite(ATestClass: TClass); -begin - StdToolsTestSuite.AddTestSuiteFromClass(ATestClass); -end; - -procedure AddToRefactoringTestSuite(ATestClass: TClass); -begin - RefactoringTestSuite.AddTestSuiteFromClass(ATestClass); + PascalTestSuite.AddTestSuiteFromClass(ATestClass); end; procedure AddToNonPascalTestSuite(ATestClass: TClass); @@ -55,16 +36,30 @@ begin BugsTestSuite.AddTest(ATest); end; +function LinesToStr(Args: array of const): string; +var + s: String; + i: Integer; +begin + s:=''; + for i:=Low(Args) to High(Args) do + case Args[i].VType of + vtChar: s += Args[i].VChar+LineEnding; + vtString: s += Args[i].VString^+LineEnding; + vtPChar: s += Args[i].VPChar+LineEnding; + vtWideChar: s += AnsiString(Args[i].VWideChar)+LineEnding; + vtPWideChar: s += AnsiString(Args[i].VPWideChar)+LineEnding; + vtAnsiString: s += AnsiString(Args[i].VAnsiString)+LineEnding; + vtWidestring: s += AnsiString(WideString(Args[i].VWideString))+LineEnding; + vtUnicodeString:s += AnsiString(UnicodeString(Args[i].VUnicodeString))+LineEnding; + end; + Result:=s; +end; + initialization GetTestRegistry.TestName := 'All tests'; - BasicTestSuite := TTestSuite.Create('Basic tests'); - GetTestRegistry.AddTest(BasicTestSuite); - FindDeclararionTestSuite := TTestSuite.Create('FindDeclaration tests'); - GetTestRegistry.AddTest(FindDeclararionTestSuite); - StdToolsTestSuite := TTestSuite.Create('StdTools tests'); - GetTestRegistry.AddTest(StdToolsTestSuite); - RefactoringTestSuite := TTestSuite.Create('Refactoring tests'); - GetTestRegistry.AddTest(RefactoringTestSuite); + PascalTestSuite := TTestSuite.Create('Pascal tests'); + GetTestRegistry.AddTest(PascalTestSuite); NonPascalTestSuite := TTestSuite.Create('No Pascal tests'); GetTestRegistry.AddTest(NonPascalTestSuite); BugsTestSuite := TTestSuite.Create('Bugs'); diff --git a/components/codetools/tests/testmethodjumptool.pas b/components/codetools/tests/testmethodjumptool.pas index 15cdbeab8f..9467aa5d34 100644 --- a/components/codetools/tests/testmethodjumptool.pas +++ b/components/codetools/tests/testmethodjumptool.pas @@ -120,7 +120,7 @@ begin end; initialization - AddToStdToolsTestSuite(TTestCTMethodJumpTool); + AddToPascalTestSuite(TTestCTMethodJumpTool); end. diff --git a/components/codetools/tests/testpascalparser.pas b/components/codetools/tests/testpascalparser.pas new file mode 100644 index 0000000000..4d204b6d45 --- /dev/null +++ b/components/codetools/tests/testpascalparser.pas @@ -0,0 +1,122 @@ +{ + Test all with: + ./runtests --format=plain --suite=TTestPascalParser + + Test specific with: + ./runtests --format=plain --suite=TestRecord_ClassOperators +} +unit TestPascalParser; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, CodeToolManager, CodeCache, + LazLogger, fpcunit, testregistry, TestGlobals; + +type + + { TTestPascalParser } + + TTestPascalParser = class(TTestCase) + private + FCode: TCodeBuffer; + protected + procedure SetUp; override; + procedure TearDown; override; + public + procedure Add(const s: string); + procedure Add(Args: array of const); + procedure StartUnit; + procedure StartProgram; + procedure ParseModule; + property Code: TCodeBuffer read FCode; + published + procedure TestRecord_ClassOperators; + end; + +implementation + +{ TTestPascalParser } + +procedure TTestPascalParser.SetUp; +begin + inherited SetUp; + FCode:=CodeToolBoss.CreateFile('test1.pas'); +end; + +procedure TTestPascalParser.TearDown; +begin + inherited TearDown; +end; + +procedure TTestPascalParser.Add(const s: string); +begin + FCode.Source:=FCode.Source+s+LineEnding; +end; + +procedure TTestPascalParser.Add(Args: array of const); +begin + FCode.Source:=FCode.Source+LinesToStr(Args); +end; + +procedure TTestPascalParser.StartUnit; +begin + Add('unit test1;'); + Add(''); + Add('{$mode objfpc}{$H+}'); + Add(''); + Add('interface'); + Add(''); +end; + +procedure TTestPascalParser.StartProgram; +begin + Add('program test1;'); + Add(''); + Add('{$mode objfpc}{$H+}'); + Add(''); +end; + +procedure TTestPascalParser.ParseModule; +var + Tool: TCodeTool; + Cnt, i: Integer; +begin + Add('end.'); + if not CodeToolBoss.Explore(Code,Tool,true) then begin + debugln(Code.Filename+'------------------------------------------'); + if CodeToolBoss.ErrorLine>0 then + Cnt:=CodeToolBoss.ErrorLine + else + Cnt:=Code.LineCount; + for i:=1 to Cnt do + debugln(Format('%:4d: ',[i]),Code.GetLine(i-1,false)); + debugln('Error: '+CodeToolBoss.ErrorDbgMsg); + Fail('PascalParser failed: '+CodeToolBoss.ErrorMessage); + end; +end; + +procedure TTestPascalParser.TestRecord_ClassOperators; +begin + StartProgram; + Add([ + 'type', + ' TMyRecord = record', + ' class operator Implicit(t: TMyRecord): TMyRecord;', + ' end;', + '', + 'class operator TMyRecord.Implicit(t: TMyRecord): TMyRecord;', + 'begin end;', + '', + 'begin' + ]); + ParseModule; +end; + +initialization + AddToPascalTestSuite(TTestPascalParser); + +end. + diff --git a/components/codetools/tests/teststdcodetools.pas b/components/codetools/tests/teststdcodetools.pas index 6141aa6279..3b4123ecad 100644 --- a/components/codetools/tests/teststdcodetools.pas +++ b/components/codetools/tests/teststdcodetools.pas @@ -197,7 +197,7 @@ begin end; initialization - AddToStdToolsTestSuite(TTestCTStdCodetools); + AddToPascalTestSuite(TTestCTStdCodetools); end.