mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-11-04 03:39:48 +01:00 
			
		
		
		
	test: added codetools tests
git-svn-id: trunk@29294 -
This commit is contained in:
		
							parent
							
								
									a7c6e1a13f
								
							
						
					
					
						commit
						c39c47fd60
					
				
							
								
								
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							@ -5643,6 +5643,7 @@ test/bugs/bug8432.pas svneol=native#text/plain
 | 
			
		||||
test/bugs/testfileproc.pas svneol=native#text/plain
 | 
			
		||||
test/bugs/testfileutil.pas svneol=native#text/plain
 | 
			
		||||
test/bugtestcase.pas svneol=native#text/plain
 | 
			
		||||
test/codetoolstests/testbasiccodetools.pas svneol=native#text/plain
 | 
			
		||||
test/codetoolstests/testcompleteblock.pas svneol=native#text/plain
 | 
			
		||||
test/hello.ahk svneol=native#text/plain
 | 
			
		||||
test/lcltests/testpen.pas svneol=native#text/plain
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										61
									
								
								test/codetoolstests/testbasiccodetools.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										61
									
								
								test/codetoolstests/testbasiccodetools.pas
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,61 @@
 | 
			
		||||
{
 | 
			
		||||
 Test with:
 | 
			
		||||
     ./runtests --format=plain --suite=TestFindLineEndOrCodeInFrontOfPosition
 | 
			
		||||
}
 | 
			
		||||
unit TestBasicCodetools;
 | 
			
		||||
 | 
			
		||||
{$mode objfpc}{$H+}
 | 
			
		||||
 | 
			
		||||
interface
 | 
			
		||||
 | 
			
		||||
uses
 | 
			
		||||
  fpcunit, Classes, SysUtils, testglobals, FileProcs, BasicCodeTools;
 | 
			
		||||
 | 
			
		||||
type
 | 
			
		||||
  { TTestBasicCodeTools }
 | 
			
		||||
 | 
			
		||||
  TTestBasicCodeTools = class(TTestCase)
 | 
			
		||||
  protected
 | 
			
		||||
  published
 | 
			
		||||
    procedure TestFindLineEndOrCodeInFrontOfPosition;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
implementation
 | 
			
		||||
 | 
			
		||||
{ TTestBasicCodeTools }
 | 
			
		||||
 | 
			
		||||
procedure TTestBasicCodeTools.TestFindLineEndOrCodeInFrontOfPosition;
 | 
			
		||||
 | 
			
		||||
  procedure t(Src: string; SkipSemicolonComma: boolean = true;
 | 
			
		||||
    StopAtDirectives: boolean = true;
 | 
			
		||||
    SkipEmptyLines: boolean = false; NestedComments: boolean = true);
 | 
			
		||||
  var
 | 
			
		||||
    Position: integer;
 | 
			
		||||
    Expected: integer;
 | 
			
		||||
    Actual: LongInt;
 | 
			
		||||
    OrigSrc: String;
 | 
			
		||||
  begin
 | 
			
		||||
    OrigSrc:=Src;
 | 
			
		||||
    Expected:=Pos('$',Src);
 | 
			
		||||
    if Expected<1 then
 | 
			
		||||
      raise Exception.Create('TTestBasicCodeTools.TestFindLineEndOrCodeInFrontOfPosition missing # expected position');
 | 
			
		||||
    Delete(Src,Expected,1);
 | 
			
		||||
    Position:=Pos('|',Src);
 | 
			
		||||
    if Position<1 then
 | 
			
		||||
      raise Exception.Create('TTestBasicCodeTools.TestFindLineEndOrCodeInFrontOfPosition missing | start position');
 | 
			
		||||
    Delete(Src,Position,1);
 | 
			
		||||
    Actual:=FindLineEndOrCodeInFrontOfPosition(Src,Position,1,NestedComments,
 | 
			
		||||
      StopAtDirectives,SkipSemicolonComma,SkipEmptyLines);
 | 
			
		||||
    AssertEquals('['+dbgstr(OrigSrc)+']',Expected,Actual);
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  writeln('TTestBasicCodeTools.TestFindLineEndOrCodeInFrontOfPosition ');
 | 
			
		||||
  t(' $'#10'|a:=1;');
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
initialization
 | 
			
		||||
  AddToCodetoolsTestSuite(TTestBasicCodeTools);
 | 
			
		||||
 | 
			
		||||
end.
 | 
			
		||||
 | 
			
		||||
@ -9,7 +9,7 @@
 | 
			
		||||
  Test that ScrollBox with AutoScroll computes correct Visible and Range.
 | 
			
		||||
     ./runtests --format=plain --suite=TestScrollBoxRange
 | 
			
		||||
}
 | 
			
		||||
unit testpreferredsize;
 | 
			
		||||
unit TestPreferredSize;
 | 
			
		||||
 | 
			
		||||
{$mode objfpc}{$H+}
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -39,7 +39,7 @@
 | 
			
		||||
        <PackageName Value="LCL"/>
 | 
			
		||||
      </Item4>
 | 
			
		||||
    </RequiredPackages>
 | 
			
		||||
    <Units Count="8">
 | 
			
		||||
    <Units Count="10">
 | 
			
		||||
      <Unit0>
 | 
			
		||||
        <Filename Value="runtests.lpr"/>
 | 
			
		||||
        <IsPartOfProject Value="True"/>
 | 
			
		||||
@ -80,13 +80,23 @@
 | 
			
		||||
        <IsPartOfProject Value="True"/>
 | 
			
		||||
        <UnitName Value="testpreferredsize"/>
 | 
			
		||||
      </Unit7>
 | 
			
		||||
      <Unit8>
 | 
			
		||||
        <Filename Value="codetoolstests\testbasiccodetools.pas"/>
 | 
			
		||||
        <IsPartOfProject Value="True"/>
 | 
			
		||||
        <UnitName Value="TestBasicCodetools"/>
 | 
			
		||||
      </Unit8>
 | 
			
		||||
      <Unit9>
 | 
			
		||||
        <Filename Value="codetoolstests\testcompleteblock.pas"/>
 | 
			
		||||
        <IsPartOfProject Value="True"/>
 | 
			
		||||
        <UnitName Value="TestCompleteBlock"/>
 | 
			
		||||
      </Unit9>
 | 
			
		||||
    </Units>
 | 
			
		||||
  </ProjectOptions>
 | 
			
		||||
  <CompilerOptions>
 | 
			
		||||
    <Version Value="9"/>
 | 
			
		||||
    <Version Value="10"/>
 | 
			
		||||
    <PathDelim Value="\"/>
 | 
			
		||||
    <SearchPaths>
 | 
			
		||||
      <OtherUnitFiles Value="bugs;lcltests"/>
 | 
			
		||||
      <OtherUnitFiles Value="bugs;lcltests;codetoolstests"/>
 | 
			
		||||
    </SearchPaths>
 | 
			
		||||
    <Parsing>
 | 
			
		||||
      <SyntaxOptions>
 | 
			
		||||
 | 
			
		||||
@ -24,7 +24,7 @@ uses
 | 
			
		||||
  Classes, consoletestrunner,
 | 
			
		||||
  testglobals, testunits, dom,
 | 
			
		||||
  {Unit needed to set the LCL version and widget set name}
 | 
			
		||||
  LCLVersion, InterfaceBase, Interfaces, testpreferredsize;
 | 
			
		||||
  LCLVersion, InterfaceBase, Interfaces;
 | 
			
		||||
  
 | 
			
		||||
type
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
@ -30,12 +30,14 @@ var
 | 
			
		||||
  Compiler: string;
 | 
			
		||||
  PrimaryConfigPath: string;
 | 
			
		||||
  BugsTestSuite: TTestSuite;
 | 
			
		||||
  CodetoolsTestSuite: TTestSuite;
 | 
			
		||||
  LCLTestSuite: TTestSuite;
 | 
			
		||||
  SemiAutoTestSuite: TTestSuite;
 | 
			
		||||
 | 
			
		||||
// reads the output from a process and puts it in a memory stream
 | 
			
		||||
function ReadOutput(AProcess:TProcess): TStringList;
 | 
			
		||||
procedure AddToBugsTestSuite(ATest: TTest);
 | 
			
		||||
procedure AddToCodetoolsTestSuite(ATestClass: TClass);
 | 
			
		||||
procedure AddToLCLTestSuite(ATestClass: TClass);
 | 
			
		||||
procedure AddToSemiAutoTestSuite(ATestClass: TClass);
 | 
			
		||||
 | 
			
		||||
@ -95,6 +97,11 @@ begin
 | 
			
		||||
  BugsTestSuite.AddTest(ATest);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
procedure AddToCodetoolsTestSuite(ATestClass: TClass);
 | 
			
		||||
begin
 | 
			
		||||
  CodetoolsTestSuite.AddTestSuiteFromClass(ATestClass);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
procedure AddToLCLTestSuite(ATestClass: TClass);
 | 
			
		||||
begin
 | 
			
		||||
  LCLTestSuite.AddTestSuiteFromClass(ATestClass);
 | 
			
		||||
@ -109,6 +116,8 @@ initialization
 | 
			
		||||
  GetTestRegistry.TestName := 'All tests';
 | 
			
		||||
  BugsTestSuite := TTestSuite.Create('Bugs');
 | 
			
		||||
  GetTestRegistry.AddTest(BugsTestSuite);
 | 
			
		||||
  CodetoolsTestSuite := TTestSuite.Create('Codetools tests');
 | 
			
		||||
  GetTestRegistry.AddTest(CodetoolsTestSuite);
 | 
			
		||||
  LCLTestSuite := TTestSuite.Create('LCL tests');
 | 
			
		||||
  GetTestRegistry.AddTest(LCLTestSuite);
 | 
			
		||||
  SemiAutoTestSuite := TTestSuite.Create('Semi Automatic tests');
 | 
			
		||||
 | 
			
		||||
@ -29,8 +29,10 @@ interface
 | 
			
		||||
uses
 | 
			
		||||
  TestLpi, BugTestCase,
 | 
			
		||||
  bug8432, testfileutil, testfileproc,
 | 
			
		||||
  // codetools
 | 
			
		||||
  TestBasicCodetools,
 | 
			
		||||
  // lcltests
 | 
			
		||||
  testunicode, testpen
 | 
			
		||||
  testunicode, testpen, TestPreferredSize
 | 
			
		||||
  {$IFNDEF NoSemiAutomatedTests}
 | 
			
		||||
  // semi-automatic tests
 | 
			
		||||
  , semiautotest, idesemiautotests, lclsemiautotests
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user