File: testfnmatch.pas

package info (click to toggle)
castle-game-engine 5.0.0-3
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 164,776 kB
  • ctags: 30,841
  • sloc: pascal: 168,882; cpp: 1,340; objc: 730; makefile: 492; sh: 477; xml: 434; php: 1
file content (134 lines) | stat: -rw-r--r-- 4,331 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
{
  Copyright 2004-2014 Michalis Kamburelis.

  This file is part of "Castle Game Engine".

  "Castle Game Engine" 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 2 of the License, or
  (at your option) any later version.

  "Castle Game Engine" 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 "Castle Game Engine"; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

  ----------------------------------------------------------------------------
}

{ See FPC web bug 3097 }

unit TestFNMatch;

{$I castleconf.inc}

interface

uses
  Classes, SysUtils, fpcunit, testutils, testregistry;

type
  TTestFNMatch = class(TTestCase)
  published
    procedure TestFNMatch;
  end;

implementation

{$ifdef UNIX}

{ We know UnixUtils is deprecated. We don't actually use it in the engine. }
{$warnings off}
uses UnixUtils;
{$warnings on}

{ Under Linux i386, we could just use Libc unit to get fnmatch definition.
  Unfortunately, Libc unit is only maintained by FPC team for Linux i386,
  e.g. it will not work for Linux x86_64 or other Unixes. }
function LibcFnmatch(__pattern:Pchar; __name:Pchar; __flags:longint):longint;
  cdecl;external 'c' name 'fnmatch';

procedure TTestFNMatch.TestFNMatch;

  procedure CheckMatch(const Pattern, Name: string; GoodResult: boolean);
  var UnixUtilResult, LibcResult: boolean;
  begin
   UnixUtilResult := UnixUtils.FNMatch(Pattern, Name, []);
   LibcResult := LibcFnmatch(PChar(Pattern), PChar(Name), 0) = 0;

   { We have 3 results. All should be equal. }
   Assert(UnixUtilResult = LibcResult);
   Assert(LibcResult = GoodResult);
  end;

begin
 { Those tests fail with original FNMatch code, because FNMatch
   allowed '*x' (for any 'x') to match anything (ending with 'x' or not,
   zero length or not). }
 CheckMatch('*~', 'foo', false);
 CheckMatch('*b', 'foo', false);
 CheckMatch('*?', '', false);
 CheckMatch('???*o', 'foo', false);
 CheckMatch('*???*o', 'foo', false);

 (*This test fails with original FNMatch code, because after line
     'inc(j);{We didn't find one, need to look further}'
   found is still assumed to be true (while it should be false) *)
 CheckMatch('*o', 'blah.ow', false);

 { This fails with original FNMatch code because subsequent tries
   to match char right after '*' (i.e., 'o' in this case) actually
   can miss that 'x' <> 'o' when 'x' is the last char of Name. }
 CheckMatch('*o', 'fox', false);

 { When first error is solved, we can see other problem
   (that was hidden by previous bug):
   When the '?' in Pattern matches last char of Name,
   some problems arise. That's because of original FNMatch code
     '?' : begin
             inc(j);
             Found:=(j <= LenName);
           end;
   Nonsense ?
   This should check FIRST if (j <= LenName).
   If not, if should terminate whole DoFNMatch with false,
   not only the loop labeled
   'find the next character in pattern, different of ? and *'.
   And in that loop, variable i should get a chance to be > LenPat.

   Tests below ensure that these additional fixes are also applied.
   I.e. these tests worked before my fixes were applied AND they
   work after my fixes are applied. But they we're causing trouble
   when I was working on this and my fixes we're applied only partially. }
 CheckMatch('*?', '?', true);
 CheckMatch('*?', 'a', true);

 { Some additional tests, they worked before my fix and they work
   after my fix. Just to be sure that everything is OK now. }
 CheckMatch('*o', 'foo', true);
 CheckMatch('*.~', 'foo', false);
 CheckMatch('*.b', 'foo', false);
 CheckMatch('*.o', 'foo', false);
 CheckMatch('*??*o', 'foo', true);
 CheckMatch('?o', 'foo', false);
 CheckMatch('??o', 'foo', true);
 CheckMatch('?o?', 'foo', true);
 CheckMatch('o??', 'foo', false);
 CheckMatch('*', 'foo', true);
end;

{$else UNIX}

procedure TTestFNMatch.TestFNMatch;
begin
end;

{$endif UNIX}

initialization
 RegisterTest(TTestFNMatch);
end.