paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 06:55:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: test for default property

Browse Source 
git-svn-id: trunk@50079 -
This commit is contained in:
mattias 2015-10-16 08:09:57 +00:00
parent b083361b7a
commit 1125a0b930
3 changed files with 70 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1011,6 +1011,7 @@ components/codetools/tests/fpctests/tchlp53.pp svneol=native#text/plain
components/codetools/tests/fpctests/tchlp6.pp svneol=native#text/plain
components/codetools/tests/fpctests/tchlp7.pp svneol=native#text/plain
components/codetools/tests/laztests/README.txt svneol=native#text/plain
components/codetools/tests/laztests/tdefaultproperty1.pas svneol=native#text/plain
components/codetools/tests/parsertbase.pas svneol=native#text/plain
components/codetools/tests/parsertest.lpi svneol=native#text/plain
components/codetools/tests/parsertest.lpr svneol=native#text/plain

53
components/codetools/tests/fdtbase.pas
View File

@ -39,6 +39,7 @@ type
TTestFindDeclaration = class(TTestCase)
private
procedure FindDeclarations(Filename: string);
procedure TestFiles(Directory: string);
published
procedure TestFindDeclaration_Basic;
procedure TestFindDeclaration_With;
@ -48,6 +49,7 @@ type
procedure TestFindDeclaration_ObjCClass;
procedure TestFindDeclaration_ObjCCategory;
procedure TestFindDeclaration_FPCTests;
procedure TestFindDeclaration_LazTests;
end;
var
@ -236,6 +238,32 @@ begin
end;
end;
procedure TTestFindDeclaration.TestFiles(Directory: string);
const
fmparam = '--filemask=';
var
Info: TSearchRec;
aFilename, Param, aFileMask: String;
i: Integer;
begin
aFileMask:='t*.p*';
for i:=1 to ParamCount do begin
Param:=ParamStr(i);
if LeftStr(Param,length(fmparam))=fmparam then
aFileMask:=copy(Param,length(fmparam)+1,100);
end;
Directory:=AppendPathDelim(Directory);
if FindFirstUTF8(Directory+aFileMask,faAnyFile,Info)=0 then begin
repeat
if faDirectory and Info.Attr>0 then continue;
aFilename:=Info.Name;
if not FilenameIsPascalUnit(aFilename) then continue;
FindDeclarations(Directory+aFilename);
until FindNextUTF8(Info)<>0;
end;
end;
procedure TTestFindDeclaration.TestFindDeclaration_Basic;
begin
FindDeclarations('fdt_basic.pas');
@ -272,28 +300,13 @@ begin
end;
procedure TTestFindDeclaration.TestFindDeclaration_FPCTests;
const
fmparam = '--filemask=';
var
Info: TSearchRec;
aFilename, Param, aFileMask: String;
i: Integer;
begin
aFileMask:='t*.p*';
for i:=1 to ParamCount do begin
Param:=ParamStr(i);
if LeftStr(Param,length(fmparam))=fmparam then
aFileMask:=copy(Param,length(fmparam)+1,100);
end;
TestFiles('fpctests');
end;
if FindFirstUTF8('fpctests'+PathDelim+aFileMask,faAnyFile,Info)=0 then begin
repeat
if faDirectory and Info.Attr>0 then continue;
aFilename:=Info.Name;
if not FilenameIsPascalUnit(aFilename) then continue;
FindDeclarations('fpctests'+PathDelim+aFilename);
until FindNextUTF8(Info)<>0;
end;
procedure TTestFindDeclaration.TestFindDeclaration_LazTests;
begin
TestFiles('laztests');
end;
initialization

36
components/codetools/tests/laztests/tdefaultproperty1.pas Normal file
View File

@ -0,0 +1,36 @@
unit tdefaultproperty1;
{$mode objfpc}{$H+}
interface
type
TNamedObj = class
public
Name: string;
end;
{ TBaseObject }
TBaseObject = class
private
function GetObject(Index: Integer): TNamedObj;
public
property Objects[Index: Integer]: TNamedObj read GetObject; default;
end;
implementation
{ TBaseObject }
function TBaseObject.GetObject(Index: Integer): TNamedObj;
var
I: Integer;
begin
Self.Objects{declaration:tdefaultproperty1.TBaseObject.Objects}[I].Name{declaration:tdefaultproperty1.TNamedObj.Name}:='';
Self[I].Name{declaration:tdefaultproperty1.TNamedObj.Name}:='';
end;
end.