Browse Source

* fixed off-by-one error in the optimised rawbytestring/unicodestring
dodirseparators() routines + added test (only testable under Windows)

git-svn-id: branches/cpstrrtl@25089 -

Jonas Maebe 12 years ago
parent
commit
0ef0206417
2 changed files with 32 additions and 3 deletions
  1. 2 2
      rtl/inc/system.inc
  2. 30 1
      tests/test/units/system/tdir.pp

+ 2 - 2
rtl/inc/system.inc

@@ -1451,7 +1451,7 @@ begin
             p:=pchar(ps);
             unique:=true;
           end;
-        p[i]:=DirectorySeparator;
+        p[i-1]:=DirectorySeparator;
       end;
 end;
 
@@ -1471,7 +1471,7 @@ begin
             p:=pwidechar(ps);
             unique:=true;
           end;
-        p[i]:=DirectorySeparator;
+        p[i-1]:=DirectorySeparator;
       end;
 end;
 

+ 30 - 1
tests/test/units/system/tdir.pp

@@ -46,7 +46,36 @@ Begin
    test(IOResult, 0);
    WriteLn('Passed!');
 
-   Write('removing directory ...');
+   Write('making subdirectory /testdir3...');
+   mkdir('testdir2/testdir3');
+   test(IOResult, 0);
+   WriteLn('Passed!');
+
+{$ifdef mswindows}
+   Write('making subdirectory \testdir4...');
+   mkdir('testdir2\testdir4');
+   test(IOResult, 0);
+   WriteLn('Passed!');
+
+   Write('removing directory /testdir3 ...');
+   rmdir('testdir2\testdir3');
+   test(IOResult, 0);
+   WriteLn('Passed!');
+
+   Write('removing directory \testdir4 ...');
+   rmdir('testdir2/testdir4');
+   test(IOResult, 0);
+   WriteLn('Passed!');
+{$else}
+   { Unix platforms do not translate \ into / in the system unit *dir functions,
+     regardless of the allowdirectoryseparators setting -> no \ testing }
+   Write('removing directory /testdir3 ...');
+   rmdir('testdir2/testdir3');
+   test(IOResult, 0);
+   WriteLn('Passed!');
+{$endif}
+
+   Write('removing directory 3 ...');
    rmdir('testdir2');
    test(IOResult, 0);
    WriteLn('Passed!');