[Lost] [Patch] Fix für FilenameMatches

[Kevin Wolf <mail@xxxxxxxxxxxxx>]

Am Dienstag, 11. März 2008 11:45:59 schrieb Andreas Freimuth:
> so sollte jetzt auch ein * am Ende funktionieren

Das war etwas zu optimistisch gedacht. ;-) Aber danke für das Aufspüren des 
Fehlers (oder besser gesagt: eines Fehlers von mehreren). Meine neue Version 
sollte es jetzt wirklich tun - ich habe es dieses Mal nicht bei der Theorie 
belassen, sondern gleich einen ganzen Haufen Testfälle durchprobiert.

Falls jemand noch mehr Fälle vorschlagen oder probieren möchte, kopiere ich 
hier das benutzte Testprogramm rein:


{$MODE ObjFPC}
{$R+}
{$S+}
{$H+}
uses crt, sysutils;

procedure DoTest(pattern, filename: String; result: boolean);
var
    msg: String;
begin
    msg := '';
    try
        if FilenameMatches(filename, pattern) = result then begin
            Write('OK     ');
        end else begin
            Write('FAIL   ');
        end;
    except 
        on e: Exception do begin
            Write('EXCEPT ');
            msg := e.message;
        end;
    end;

    Write(result : 6, ' "', filename, '"  in  "', pattern, '"');

    if msg <> '' then begin
        TextColor(12);
        Write(' ', msg);
        TextColor(7);
    end;
    WriteLn;
end;

begin
    DoTest('foo', 'foo', true);
    DoTest('foo', 'bar', false);
    DoTest('foo', 'foobar', false);
    DoTest('foobar', 'foo', false);

    DoTest('foo*', 'foo', true);
    DoTest('foo*', 'foobar', true);
    DoTest('foo*', 'bar', false);
    
    DoTest('*foo', 'foo', true);
    DoTest('*foo', 'foobar', false);
    DoTest('*foo', 'barfoo', true);

    DoTest('*', '', true);    
    DoTest('*', 'foobar', true);    
    
    DoTest('fo*o', 'foo', true);
    DoTest('fo*o', 'foto', true);
    DoTest('fo*o', 'fox', false);
    DoTest('fo*o', 'fotos', false);
    
    DoTest('f*o*o', 'foo', true);
    DoTest('f*o*o', 'foto', true);
    DoTest('f*o*o', 'ftoo', true);
    DoTest('f*o*o', 'ftoxo', true);
    DoTest('f*o*o', 'fooo', true);
    DoTest('f*o*o', 'footos', false);
    DoTest('f*o*o', 'ftos', false);
    DoTest('f*o*o', 'fto*', false);
    
    DoTest('f?o', 'foo', true);
    DoTest('f?o', 'bar', false);
    DoTest('f??o', 'fxyo', true);

    DoTest('f?*?*?', 'foo', false);
    DoTest('f?*?*?', 'foo!', true);
    DoTest('f?*?*?', 'foobar!!!!1111111111', true);
end.

Index: src/modules/pas/lib/dos/dos.pas
===================================================================
--- src/modules/pas/lib/dos/dos.pas	(Revision 725)
+++ src/modules/pas/lib/dos/dos.pas	(Arbeitskopie)
@@ -144,36 +144,64 @@
     subname: String;
     j: integer;
 begin
-    // TODO FilenameMatches
-    WriteLn('FilenameMatches: '+filename+' = '+pattern);
     i_pattern := 0;
     i_file := 1;
+
+    // Zeichenweise das Pattern durchgehen und pruefen, ob das Zeichen
+    // uebereinstimmt
     while i_pattern < length(pattern) do begin
         Inc(i_pattern);
 
+        // Falls wir mit dem Dateinamen schon am Ende sind, duerfen im
+        // Pattern ab jetzt nur noch beliebig viele * kommen
+        if i_file > length(filename) then begin
+            while (i_pattern <= length(pattern)) 
+                and (pattern[i_pattern] = '*') do 
+            begin
+                Inc(i_pattern);
+            end;
+            exit(i_pattern = length(pattern) + 1);
+        end;
+
         case pattern[i_pattern] of
             '?':
-                begin
+                // Ein ? ist leicht zu parsen: Passt, naechstes Zeichen
+                begin                
                     Inc(i_file);
                 end;
 
             '*':
+                // Ein * dagegen ist etwas schwieriger zu pruefen. Der Trick
+                // besteht darin, auszuprobieren, ob der Rest passen wuerde,
+                // wenn der * das naechste, die naechsten zwei, usw. Zeichen
+                // des Dateinamens abdeckt. Die Pruefung, ob der Rest passt,
+                // wird durch rekursiven Aufruf von FilenameMatches erledigt.
                 begin
-                    while pattern[i_pattern] = '*' do begin
+                    // Wenn mehrere * aufeinander folgen, koennen bis auf
+                    // einen alle ignoriert werden
+                    while (i_pattern <= length(pattern)) 
+                        and (pattern[i_pattern] = '*') do 
+                    begin
                         Inc(i_pattern);
                     end;
-
+                    
+                    // Jede moegliche Ersetzung fuer das * durchprobieren, 
+                    // angefangen beim leeren String bis zur Ersetzung des
+                    // kompletten restlichen Dateinamens
                     pattern := Copy(pattern, i_pattern, length(pattern));
-                    for j := i_file to length(filename) do begin
+                    for j := length(filename) + 1 downto i_file do begin                        
                         subname := Copy(filename, j, length(filename));
                         if FilenameMatches(subname, pattern) then begin
                             exit(true);
                         end;
                     end;
+
                     exit(false);
                 end;
 
             else
+                // Ansonsten sind wir im trivialen Fall: Das Zeichen in 
+                // Dateiname und Pattern muss uebereinstimmen
                 begin
                     if pattern[i_pattern] <> filename[i_file] then begin
                         exit(false);
@@ -181,22 +209,14 @@
                     Inc(i_file);
                 end;
         end;
-
-        if i_file > length(filename) then begin
-            exit(false);
-        end;
     end;
+    
+    // Wenn wir hier landen, ist das Pattern abgearbeitet. An dieser Stelle
+    // muss dann auch der Dateiname zu Ende sein.
+    exit(i_file = length(filename) + 1);
+end;
 
-    exit(i_file = length(filename));
-{    
-    if pattern = '*' then begin
-        exit(true);
-    end;
 
-    exit (filename = pattern);
-}    
-end;
-
 Procedure FindFirst (const Path: pathstr; Attr: word; var F: SearchRec);
 var
     dir, name, ext: String;