From 77381cc8d4e6f4f7d431442257ca60491aa778f1 Mon Sep 17 00:00:00 2001 From: tombo Date: Sun, 22 Jul 2007 14:17:13 +0000 Subject: [PATCH] LCL: implemented TMask, MatchesMask, added Masks docs git-svn-id: trunk@11592 - --- .gitattributes | 4 + docs/xml/lcl/masks.xml | 408 +++++++++++++++++++++++++++++++++++++ lcl/filectrl.pp | 4 +- lcl/fileutil.pas | 1 - lcl/include/fileutil.inc | 105 ---------- lcl/lazhelpintf.pas | 4 +- lcl/lclstrconsts.pas | 3 +- lcl/masks.pas | 373 +++++++++++++++++++++++++++++++++ lcl/tests/test6_1masks.lpi | 122 +++++++++++ lcl/tests/test6_1masks.lpr | 176 ++++++++++++++++ 10 files changed, 1089 insertions(+), 111 deletions(-) create mode 100644 docs/xml/lcl/masks.xml create mode 100644 lcl/masks.pas create mode 100644 lcl/tests/test6_1masks.lpi create mode 100644 lcl/tests/test6_1masks.lpr diff --git a/.gitattributes b/.gitattributes index e33c921d13..25de43dab5 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1051,6 +1051,7 @@ docs/xml/lcl/lmessages.xml svneol=LF#text/xml eol=lf docs/xml/lcl/lresources.xml svneol=LF#text/xml eol=lf docs/xml/lcl/maps.xml svneol=native#text/plain docs/xml/lcl/maskedit.xml svneol=LF#text/xml eol=lf +docs/xml/lcl/masks.xml svneol=LF#text/xml eol=lf docs/xml/lcl/menus.xml svneol=LF#text/xml eol=lf docs/xml/lcl/pairsplitter.xml svneol=LF#text/xml eol=lf docs/xml/lcl/postscriptcanvas.xml svneol=LF#text/xml eol=lf @@ -2845,6 +2846,7 @@ lcl/lmessages.pp svneol=native#text/pascal lcl/lresources.pp svneol=native#text/pascal lcl/maps.pp svneol=native#text/pascal lcl/maskedit.pp svneol=native#text/pascal +lcl/masks.pas svneol=native#text/pascal lcl/menus.pp svneol=native#text/pascal lcl/nonwin32/README.txt svneol=native#text/plain lcl/nonwin32/messages.pp svneol=native#text/pascal @@ -2890,6 +2892,8 @@ lcl/tests/test4_3listview.lpr svneol=native#text/plain lcl/tests/test5_1asyncprocess.lpi svneol=native#text/plain lcl/tests/test5_1asyncprocess.lpr svneol=native#text/plain lcl/tests/test5_1worker.pas svneol=native#text/plain +lcl/tests/test6_1masks.lpi svneol=native#text/plain +lcl/tests/test6_1masks.lpr svneol=native#text/plain lcl/textstrings.pas svneol=native#text/pascal lcl/themes.pas svneol=native#text/pascal lcl/tmschema.pas svneol=native#text/pascal diff --git a/docs/xml/lcl/masks.xml b/docs/xml/lcl/masks.xml new file mode 100644 index 0000000000..10ccd4603a --- /dev/null +++ b/docs/xml/lcl/masks.xml @@ -0,0 +1,408 @@ + + + + + + + +This unit contains classes for mask matching. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +The TMask class represents a mask. + + + + + + + + + + + + + + + + + + + +Creates new mask for matching. +

Creates new mask for matching. Matching is case-insensitive. The mask consist of literal elements such as:

+
    +
  • characters
    • +
  • character sets - each character set starts with "[" and ends with "]", contains list of single characters or range denoted with "-".
    • +
  • wild cards "?" for any character
    • +
  • wild cards "*" for any string
    • +
+ + + + + + + + + + + + + + + + + + + + + + + + + +If the file name matches the mask. + + + + + + + + + + + + + + + + + + + + +The TMaskList class represents a list of masks. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Creates new list of masks from passed value, each item is seperated by separator. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +If the file name matches at least one of mask list items. + + + + + + + + + + + + + + + + + + + + +The items of mask list. + + + + + + + + + + + + + +If the file name matches the passed mask. + + + + + + + + + + + + + + + + + + + + + + + + + + +If the file name matches at least one of passed masks sepearated by separator. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/lcl/filectrl.pp b/lcl/filectrl.pp index 0d5a58420a..76cf341231 100644 --- a/lcl/filectrl.pp +++ b/lcl/filectrl.pp @@ -35,7 +35,7 @@ interface {$endif} uses - Classes, SysUtils, StdCtrls, FileUtil; + Classes, SysUtils, StdCtrls, FileUtil, Masks; Type @@ -162,7 +162,7 @@ begin faAnyFile, Info)=0 then Repeat - if FileInFilenameMasks(Info.Name,Mask) then begin + if MatchesMaskList(Info.Name,Mask) then begin Added:=false; AddFile(ftReadOnly,faReadOnly); AddFile(ftHidden,faHidden); diff --git a/lcl/fileutil.pas b/lcl/fileutil.pas index 8bf044c158..f448be12d8 100644 --- a/lcl/fileutil.pas +++ b/lcl/fileutil.pas @@ -78,7 +78,6 @@ function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): stri function CreateRelativePath(const Filename, BaseDirectory: string): string; function FileIsInPath(const Filename, Path: string): boolean; function FileIsInDirectory(const Filename, Directory: string): boolean; -function FileInFilenameMasks(const Filename, Masks: string): boolean; // file search type diff --git a/lcl/include/fileutil.inc b/lcl/include/fileutil.inc index 23336f6d33..907da8c136 100644 --- a/lcl/include/fileutil.inc +++ b/lcl/include/fileutil.inc @@ -1046,111 +1046,6 @@ begin and (CompareFilenames(ExpDir,LeftStr(ExpFile,p))=0); end; -{------------------------------------------------------------------------------ - function FileInFilenameMasks(const Filename, Masks: string): boolean; - - Checks if 'Filename' fits to one of the mask in 'Masks'. - Note: It checks the whole Filename. So, for example /somewhere/unit1.pas does - not fit the mask 'unit*.pas', but it will fit '*.pas'. - - Masks is delimited by semicolon. - Masks allows asterisk (*) for arbitrary text and question mark (?) for one - arbitrary character. - Examples: - '*.pas;*.pp;*.inc' - '*.tar.*' - 'lazarus*.xpm' - ------------------------------------------------------------------------------} -function FileInFilenameMasks(const Filename, Masks: string): boolean; -var - TrimmedFile: String; - MasksLen: Integer; - MaskStartPos: Integer; - MaskEndPos: Integer; - MaskPos: LongInt; - FilePos: Integer; - FileLen: Integer; - MaskChar: Char; -begin - Result:=false; - if (Filename='') or (Masks='') then exit; - TrimmedFile:=TrimFilename(Filename); // only cleanup, do not expand - if TrimmedFile='' then exit; - // try each Mask - MasksLen:=length(Masks); - FileLen:=length(TrimmedFile); - MaskEndPos:=1; - repeat - - // find next Mask - MaskStartPos:=MaskEndPos; - while (MaskStartPos<=MasksLen) and (Masks[MaskStartPos]=';') do - inc(MaskStartPos); - if MaskStartPos>MasksLen then exit; // no mask -> end - MaskEndPos:=MaskStartPos+1; - while (MaskEndPos<=MasksLen) and (Masks[MaskEndPos]<>';') do - inc(MaskEndPos); - - // check if mask fits to filename - MaskPos:=MaskStartPos; - FilePos:=1; - while MaskPosFileLen then break; - inc(FilePos); - inc(MaskPos); - end; - - '*': begin - // Anything. Will be handled by the 'else' part below - inc(MaskPos); - if MaskPos=MaskEndPos then - FilePos:=FileLen+1; - end; - - else - begin - if FilePos>FileLen then break; - {$IFDEF WINDOWS} - if UpperCaseTable[byte(MaskChar)] - =UpperCaseTable[byte(TrimmedFile[FilePos])] then - {$ELSE} - if MaskChar=TrimmedFile[FilePos] then - {$ENDIF} - begin - // character fits - inc(MaskPos); - inc(FilePos); - end else begin - //character does not fit - // -> go back to last astersik (*) - while (MaskPos>MaskStartPos) and (Masks[MaskPos-1]<>'*') do begin - dec(MaskPos); - dec(FilePos); - end; - if (MaskPos=MaskStartPos) then begin - // there was no asterisk (*) => the filename does not fit this mask - break; - end else begin - // there is an asterisk (*) => try the next position - inc(FilePos); - end; - end; - end; - end; - end; - if (MaskPos=MaskEndPos) and (FilePos>FileLen) then begin - // found - Result:=true; - exit; - end; - until false; -end; - {------------------------------------------------------------------------------ function CopyFile(const SrcFilename, DestFilename: string): boolean; ------------------------------------------------------------------------------} diff --git a/lcl/lazhelpintf.pas b/lcl/lazhelpintf.pas index 832fb574c9..7bf7ba7cf0 100644 --- a/lcl/lazhelpintf.pas +++ b/lcl/lazhelpintf.pas @@ -30,7 +30,7 @@ interface uses Classes, SysUtils, LCLProc, FileUtil, LCLStrConsts, Dialogs, - LazConfigStorage, HelpIntfs; + LazConfigStorage, HelpIntfs, Masks; type { THelpQueryItem } @@ -2279,7 +2279,7 @@ begin end; //debugln('THelpDBISourceDirectory.FileMatches FileMask="',FileMask,'"'); if (FileMask<>'') - and (not FileInFilenameMasks(ExtractFilename(AFilename),FileMask)) then exit; + and (not MatchesMaskList(ExtractFilename(AFilename),FileMask)) then exit; //debugln('THelpDBISourceDirectory.FileMatches Success'); Result:=true; end; diff --git a/lcl/lclstrconsts.pas b/lcl/lclstrconsts.pas index ae60c3a391..a879f60c22 100644 --- a/lcl/lclstrconsts.pas +++ b/lcl/lclstrconsts.pas @@ -134,7 +134,7 @@ ResourceString // StringHashList, LResource, Menus, ExtCtrls, ImgList, Spin // StdCtrls, Calendar, CustomTimer, Forms, Grids, LCLProc, Controls, ComCtrls, - // ExtDlgs, EditBtn + // ExtDlgs, EditBtn, Masks sInvalidActionRegistration = 'Invalid action registration'; sInvalidActionUnregistration = 'Invalid action unregistration'; sInvalidActionEnumeration = 'Invalid action enumeration'; @@ -147,6 +147,7 @@ ResourceString sInvalidImageSize = 'Invalid image size'; sDuplicateMenus = 'Duplicate menus'; sCannotFocus = 'Cannot focus a disabled or invisible window'; + sInvalidCharSet = 'The char set in mask "%s" is not valid!'; rsListMustBeEmpty = 'List must be empty'; rsInvalidPropertyValue = 'Invalid property value'; diff --git a/lcl/masks.pas b/lcl/masks.pas new file mode 100644 index 0000000000..f19f2b3154 --- /dev/null +++ b/lcl/masks.pas @@ -0,0 +1,373 @@ +{ + /*************************************************************************** + masks.pas + --------- + + ***************************************************************************/ + + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.modifiedLGPL, included in this distribution, * + * for details about the copyright. * + * * + * This program 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. * + * * + ***************************************************************************** +} +unit Masks; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Contnrs; + +type + TMaskCharType = (mcChar, mcCharSet, mcAnyChar, mcAnyText); + + TCharSet = set of Char; + PCharSet = ^TCharSet; + + TMaskChar = record + case CharType: TMaskCharType of + mcChar: (CharValue: Char); + mcCharSet: (Negative: Boolean; SetValue: PCharSet); + mcAnyChar, mcAnyText: (); + end; + + TMaskString = record + MinLength: Integer; + MaxLength: Integer; + Chars: Array of TMaskChar; + end; + + { TMask } + + TMask = class + private + FMask: TMaskString; + public + constructor Create(const AValue: String); + destructor Destroy; override; + + function Matches(const AFileName: String): Boolean; + end; + + { TMaskList } + + TMaskList = class + private + FMasks: TObjectList; + function GetItem(Index: Integer): TMask; + public + constructor Create(const AValue: String; ASeparator: Char = ';'); + destructor Destroy; override; + + function Matches(const AFileName: String): Boolean; + + property Items[Index: Integer]: TMask read GetItem; + end; + +function MatchesMask(const FileName, Mask: String): Boolean; +function MatchesMaskList(const FileName, Mask: String; Separator: Char = ';'): Boolean; + +implementation + +uses LCLProc, LCLStrConsts; + +function MatchesMask(const FileName, Mask: String): Boolean; +var + AMask: TMask; +begin + AMask := TMask.Create(Mask); + try + Result := AMask.Matches(FileName); + finally + AMask.Free; + end; +end; + +function MatchesMaskList(const FileName, Mask: String; Separator: Char): Boolean; +var + AMaskList: TMaskList; +begin + AMaskList := TMaskList.Create(Mask, Separator); + try + Result := AMaskList.Matches(FileName); + finally + AMaskList.Free; + end; +end; + +{ TMask } + +constructor TMask.Create(const AValue: String); +var + I: Integer; + SkipAnyText: Boolean; + + procedure CharSetError; + begin + raise EConvertError.CreateFmt(sInvalidCharSet, [AValue]); + end; + + procedure AddAnyText; + begin + if SkipAnyText then + begin + Inc(I); + Exit; + end; + + SetLength(FMask.Chars, Length(FMask.Chars) + 1); + FMask.Chars[High(FMask.Chars)].CharType := mcAnyText; + + FMask.MaxLength := MaxInt; + SkipAnyText := True; + Inc(I); + end; + + procedure AddAnyChar; + begin + SkipAnyText := False; + + SetLength(FMask.Chars, Length(FMask.Chars) + 1); + FMask.Chars[High(FMask.Chars)].CharType := mcAnyChar; + + Inc(FMask.MinLength); + if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength); + + Inc(I); + end; + + procedure AddCharSet; + var + CharSet: TCharSet; + Valid: Boolean; + C, Last: Char; + begin + SkipAnyText := False; + + SetLength(FMask.Chars, Length(FMask.Chars) + 1); + FMask.Chars[High(FMask.Chars)].CharType := mcCharSet; + + Inc(I); + if (I <= Length(AValue)) and (AValue[I] = '!') then + begin + FMask.Chars[High(FMask.Chars)].Negative := True; + Inc(I); + end + else FMask.Chars[High(FMask.Chars)].Negative := False; + + Last := '-'; + CharSet := []; + Valid := False; + while I <= Length(AValue) do + begin + case AValue[I] of + '-': + begin + if Last = '-' then CharSetError; + Inc(I); + + if (I > Length(AValue)) then CharSetError; + //DebugLn('Set: ' + Last + '-' + UpCase(AValue[I])); + for C := Last to UpCase(AValue[I]) do Include(CharSet, C); + Inc(I); + end; + ']': + begin + Valid := True; + Break; + end; + else + begin + Last := UpCase(AValue[I]); + Include(CharSet, Last); + Inc(I); + end; + end; + end; + + if (not Valid) or (CharSet = []) then CharSetError; + + New(FMask.Chars[High(FMask.Chars)].SetValue); + FMask.Chars[High(FMask.Chars)].SetValue^ := CharSet; + + Inc(FMask.MinLength); + if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength); + + Inc(I); + end; + + procedure AddChar; + begin + SkipAnyText := False; + + SetLength(FMask.Chars, Length(FMask.Chars) + 1); + with FMask.Chars[High(FMask.Chars)] do + begin + CharType := mcChar; + CharValue := UpCase(AValue[I]); + end; + + Inc(FMask.MinLength); + if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength); + + Inc(I); + end; + +begin + SetLength(FMask.Chars, 0); + FMask.MinLength := 0; + FMask.MaxLength := 0; + SkipAnyText := False; + + I := 1; + while I <= Length(AValue) do + begin + case AValue[I] of + '*': AddAnyText; + '?': AddAnyChar; + '[': AddCharSet; + else AddChar; + end; + end; +end; + +destructor TMask.Destroy; +var + I: Integer; +begin + for I := 0 to High(FMask.Chars) do + if FMask.Chars[I].CharType = mcCharSet then + Dispose(FMask.Chars[I].SetValue); + + inherited Destroy; +end; + +function TMask.Matches(const AFileName: String): Boolean; +var + L: Integer; + S: String; + + function MatchToEnd(MaskIndex, CharIndex: Integer): Boolean; + var + I, J: Integer; + begin + Result := False; + + for I := MaskIndex to High(FMask.Chars) do + begin + case FMask.Chars[I].CharType of + mcChar: + begin + if CharIndex > L then Exit; + //DebugLn('Match ' + S[CharIndex] + '' + FMask.Chars[I].CharValue); + if S[CharIndex] <> FMask.Chars[I].CharValue then Exit; + Inc(CharIndex); + end; + mcCharSet: + begin + if CharIndex > L then Exit; + if FMask.Chars[I].Negative xor + (S[CharIndex] in FMask.Chars[I].SetValue^) then Inc(CharIndex) + else Exit; + end; + mcAnyChar: + begin + if CharIndex > L then Exit; + Inc(CharIndex); + end; + mcAnyText: + begin + if I = High(FMask.Chars) then + begin + Result := True; + Exit; + end; + + for J := CharIndex to L do + if MatchToEnd(I + 1, J) then + begin + Result := True; + Exit; + end; + end; + end; + end; + + Result := CharIndex > L; + end; + +begin + Result := False; + L := Length(AFileName); + if L = 0 then + begin + if FMask.MinLength = 0 then Result := True; + Exit; + end; + + if (L < FMask.MinLength) or (L > FMask.MaxLength) then Exit; + + S := UpperCase(AFileName); + Result := MatchToEnd(0, 1); +end; + +{ TMaskList } + +function TMaskList.GetItem(Index: Integer): TMask; +begin + Result := TMask(FMasks.Items[Index]); +end; + +constructor TMaskList.Create(const AValue: String; ASeparator: Char); +var + S: TStringList; + I: Integer; +begin + FMasks := TObjectList.Create(True); + + S := TStringList.Create; + try + S.Delimiter := ASeparator; + S.DelimitedText := AValue; + + for I := 0 to S.Count - 1 do + FMasks.Add(TMask.Create(S[I])); + finally + S.Free; + end; +end; + +destructor TMaskList.Destroy; +begin + FMasks.Free; + + inherited Destroy; +end; + +function TMaskList.Matches(const AFileName: String): Boolean; +var + I: Integer; +begin + Result := False; + + for I := 0 to FMasks.Count - 1 do + begin + if TMask(FMasks.Items[I]).Matches(AFileName) then + begin + Result := True; + Exit; + end; + end; +end; + +end. + diff --git a/lcl/tests/test6_1masks.lpi b/lcl/tests/test6_1masks.lpi new file mode 100644 index 0000000000..cffdd2a4c4 --- /dev/null +++ b/lcl/tests/test6_1masks.lpi @@ -0,0 +1,122 @@ + + + + + + + + + + + <ActiveEditorIndexAtStart Value="0"/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + <Language Value=""/> + <CharSet Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="3"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + <Item2> + <PackageName Value="FPCUnitTestRunner"/> + </Item2> + <Item3> + <PackageName Value="FCL"/> + </Item3> + </RequiredPackages> + <Units Count="7"> + <Unit0> + <Filename Value="test6_1masks.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="test6_1masks"/> + <CursorPos X="21" Y="1"/> + <TopLine Value="1"/> + <EditorIndex Value="0"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + </Unit0> + <Unit1> + <Filename Value="..\..\..\test\TMask\testcase1.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TestCase1"/> + <CursorPos X="1" Y="7"/> + <TopLine Value="1"/> + <UsageCount Value="20"/> + </Unit1> + <Unit2> + <Filename Value="..\..\..\test\TMask\masks.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Masks"/> + <CursorPos X="1" Y="67"/> + <TopLine Value="83"/> + <UsageCount Value="20"/> + </Unit2> + <Unit3> + <Filename Value="..\..\..\fpcbeta\fpcsrc\packages\fcl-fpcunit\src\fpcunit.pp"/> + <UnitName Value="fpcunit"/> + <CursorPos X="3" Y="57"/> + <TopLine Value="43"/> + <UsageCount Value="10"/> + </Unit3> + <Unit4> + <Filename Value="..\..\..\fpcbeta\fpcsrc\rtl\objpas\sysutils\sysutilh.inc"/> + <CursorPos X="48" Y="132"/> + <TopLine Value="122"/> + <UsageCount Value="10"/> + </Unit4> + <Unit5> + <Filename Value="..\..\components\fpcunit\guitestrunner.pas"/> + <ComponentName Value="GUITestRunner"/> + <HasResources Value="True"/> + <UnitName Value="GuiTestRunner"/> + <CursorPos X="8" Y="39"/> + <TopLine Value="25"/> + <UsageCount Value="10"/> + </Unit5> + <Unit6> + <Filename Value="..\masks.pas"/> + <UnitName Value="Masks"/> + <CursorPos X="1" Y="83"/> + <TopLine Value="69"/> + <EditorIndex Value="1"/> + <UsageCount Value="10"/> + <Loaded Value="True"/> + </Unit6> + </Units> + <JumpHistory Count="0" HistoryIndex="-1"/> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <PathDelim Value="\"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="2"> + <Item1> + <Name Value="ECodetoolError"/> + </Item1> + <Item2> + <Name Value="EFOpenError"/> + </Item2> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/lcl/tests/test6_1masks.lpr b/lcl/tests/test6_1masks.lpr new file mode 100644 index 0000000000..cbe9faa215 --- /dev/null +++ b/lcl/tests/test6_1masks.lpr @@ -0,0 +1,176 @@ +{ + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.LCL, included in this distribution, * + * for details about the copyright. * + * * + * This program 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. * + * * + ***************************************************************************** + + LCL Test 6_1 + + Mask creating and matching test. +} +program test6_1masks; + +{$mode objfpc}{$H+} + +uses + Interfaces, Forms, GuiTestRunner, Masks, + Classes, SysUtils, fpcunit, testutils, testregistry; + +type + + { TTestMask } + + TTestMask = class(TTestCase) + private + FS, FMask: String; + procedure Test; + protected + procedure TestMask(const S, Mask: String; Result: Boolean); + procedure TestMaskException(const S, Mask: String; AFail: Boolean); + published + procedure TestNil; + procedure TestAnyText; + procedure TestAnyChar; + procedure TestCharSet; + procedure TestMaskSyntax; + end; + +procedure TTestMask.Test; +begin + MatchesMask(FS, FMask); +end; + +procedure TTestMask.TestMask(const S, Mask: String; Result: Boolean); +begin + AssertEquals(S + ' match ' + Mask + ': ', Result, MatchesMask(S, Mask)); +end; + +procedure TTestMask.TestMaskException(const S, Mask: String; AFail: Boolean); +begin + FS := S; + FMask := Mask; + if AFail then + AssertException('Invalid syntax: ' + S + ' match ' + Mask + ': ', EConvertError, @Test) + else + try + Test; + except + Fail('Invalid syntax: ' + S + ' match ' + Mask); + end; +end; + +procedure TTestMask.TestMaskSyntax; +begin + TestMaskException('', '', False); + TestMaskException('', 'a', False); + TestMaskException('', '?', False); + TestMaskException('', '*', False); + TestMaskException('', '[a]', False); + TestMaskException('', '[a-b]', False); + TestMaskException('', '[!a-b]', False); + TestMaskException('', '[abc]', False); + TestMaskException('', '[abc-fgh]', False); + TestMaskException('', '[a------h]', False); + TestMaskException('', '**', False); + TestMaskException('', 'aa', False); + TestMaskException('', 'a*', False); + TestMaskException('', '*a', False); + TestMaskException('', '*?', False); + + TestMaskException('', '[', True); + TestMaskException('', '[a', True); + TestMaskException('', '[]', True); + TestMaskException('', '[!]', True); + TestMaskException('', '[-]', True); + TestMaskException('', '[a-]', True); + TestMaskException('', '[-a]', True); + TestMaskException('', '[--a]', True); +end; + +procedure TTestMask.TestNil; +begin + TestMask('', '', True); + TestMask('', '*', True); + TestMask('', '?', False); + TestMask('', 'a', False); + TestMask('', '[a]', False); +end; + +procedure TTestMask.TestAnyText; +begin + TestMask('abc', '*', True); + TestMask('abc', 'a*', True); + TestMask('abc', '*c', True); + TestMask('abc', '*a*', True); + TestMask('abc', '*b*', True); + TestMask('abc', '*c*', True); + TestMask('abc', 'a*c', True); + TestMask('abc', '*bc', True); + TestMask('abc', 'ab*', True); + + TestMask('abcde', '*', True); + TestMask('abcde', 'a*e', True); + TestMask('abcde', 'a*b*e', True); + TestMask('abcde', 'a*d*e', True); + TestMask('abcde', 'a*c*e', True); + TestMask('abcde', 'a*b*e', True); + + TestMask('abc', '*b', False); + TestMask('abc', 'b*', False); + TestMask('abc', '*a', False); + TestMask('abc', 'c*', False); + TestMask('abc', 'ab*d', False); + + TestMask('abcde', 'a*d', False); + TestMask('abcde', 'a*c*d', False); + TestMask('abcde', 'b*d*e', False); +end; + +procedure TTestMask.TestAnyChar; +begin + TestMask('abc', '?bc', True); + TestMask('abc', '?b?', True); + TestMask('abc', '???', True); + + TestMask('abc', '?*?', True); + TestMask('abc', '?*??', True); + TestMask('abc', '?*?*?', True); + + TestMask('abc', 'a?', False); + TestMask('abc', 'abc?', False); + TestMask('abc', '?abc', False); + TestMask('abc', '??*??', False); + TestMask('abc', '?*?*??', False); +end; + +procedure TTestMask.TestCharSet; +begin + TestMask('c', '[c]', True); + TestMask('c', '[!b]', True); + TestMask('c', '[a-c]', True); + TestMask('c', '[a-d]', True); + TestMask('c', '[!a-b]', True); + TestMask('c', '[abc]', True); + + TestMask('c', '[a]', False); + TestMask('c', '[!c]', False); + TestMask('c', '[a-b]', False); + TestMask('c', '[abd]', False); +end; + +begin + RegisterTest(TTestMask); + + Application.Initialize; + Application.CreateForm(TGuiTestRunner, TestRunner); + Application.Run; +end. +