Browse Source

* return 0 for length(pchar(0)), like Kylix does (using corrected and
multi-platform version of patch in r12461, which caused the i386 version
of fpc_pchar_length to return 0 in all cases, which used tabs, and did
not include a test case)

git-svn-id: trunk@12464 -

Jonas Maebe 16 years ago
parent
commit
22aacd2a60
6 changed files with 26 additions and 2 deletions
  1. 1 0
      .gitattributes
  2. 3 0
      rtl/arm/arm.inc
  3. 3 0
      rtl/i386/i386.inc
  4. 4 1
      rtl/inc/cgeneric.inc
  5. 3 1
      rtl/inc/generic.inc
  6. 12 0
      tests/test/units/system/tpchlen.pp

+ 1 - 0
.gitattributes

@@ -8083,6 +8083,7 @@ tests/test/units/system/tjmp.pp svneol=native#text/plain
 tests/test/units/system/tmem.pp svneol=native#text/plain
 tests/test/units/system/tmem.pp svneol=native#text/plain
 tests/test/units/system/todd.pp svneol=native#text/plain
 tests/test/units/system/todd.pp svneol=native#text/plain
 tests/test/units/system/tparam.pp svneol=native#text/plain
 tests/test/units/system/tparam.pp svneol=native#text/plain
+tests/test/units/system/tpchlen.pp svneol=native#text/plain
 tests/test/units/system/tpi.pp svneol=native#text/plain
 tests/test/units/system/tpi.pp svneol=native#text/plain
 tests/test/units/system/trandom.pp svneol=native#text/plain
 tests/test/units/system/trandom.pp svneol=native#text/plain
 tests/test/units/system/trdtxt01.pp svneol=native#text/plain
 tests/test/units/system/trdtxt01.pp svneol=native#text/plain

+ 3 - 0
rtl/arm/arm.inc

@@ -439,7 +439,9 @@ end;
 function fpc_Pchar_length(p:Pchar):longint;assembler;nostackframe;[public,alias:'FPC_PCHAR_LENGTH'];compilerproc;
 function fpc_Pchar_length(p:Pchar):longint;assembler;nostackframe;[public,alias:'FPC_PCHAR_LENGTH'];compilerproc;
 
 
 asm
 asm
+    cmp r0,#0
     mov r1,r0
     mov r1,r0
+    beq .Ldone
 .Lnextchar:
 .Lnextchar:
     (*Are we aligned?*)
     (*Are we aligned?*)
     tst r1,#3
     tst r1,#3
@@ -462,6 +464,7 @@ asm
     (*Dirty trick: we need to subtract 1 extra because we have counted the
     (*Dirty trick: we need to subtract 1 extra because we have counted the
       terminating 0, due to the known carry flag sbc can do this.*)
       terminating 0, due to the known carry flag sbc can do this.*)
     sbc r0,r1,r0
     sbc r0,r1,r0
+.Ldone:
     mov pc,lr
     mov pc,lr
 .L01010101:
 .L01010101:
     .long 0x01010101
     .long 0x01010101

+ 3 - 0
rtl/i386/i386.inc

@@ -1037,12 +1037,15 @@ asm
 {$endif}
 {$endif}
         movl    $0xffffffff,%ecx
         movl    $0xffffffff,%ecx
         xorl    %eax,%eax
         xorl    %eax,%eax
+	test    %edi,%edi
+	jz      .LStrLenDone
         cld
         cld
         repne
         repne
         scasb
         scasb
         movl    $0xfffffffe,%eax
         movl    $0xfffffffe,%eax
         subl    %ecx,%eax
         subl    %ecx,%eax
         movl    saveedi,%edi
         movl    saveedi,%edi
+.LStrLenDone:
 end;
 end;
 {$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 {$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 
 

+ 4 - 1
rtl/inc/cgeneric.inc

@@ -112,7 +112,10 @@ function libc_pchar_length(p:pchar):size_t; cdecl; external 'c' name 'strlen';
 
 
 function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
 function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
 begin
 begin
-  fpc_pchar_length:=libc_pchar_length(p);
+  if assigned(p) then
+    fpc_pchar_length:=libc_pchar_length(p)
+  else
+    fpc_pchar_length:=0;
 end;
 end;
 
 
 {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

+ 3 - 1
rtl/inc/generic.inc

@@ -1187,7 +1187,9 @@ function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; co
 var i : longint;
 var i : longint;
 begin
 begin
   i:=0;
   i:=0;
-  while p[i]<>#0 do inc(i);
+  if assigned(p) then
+    while p[i]<>#0 do
+      inc(i);
   exit(i);
   exit(i);
 end;
 end;
 
 

+ 12 - 0
tests/test/units/system/tpchlen.pp

@@ -0,0 +1,12 @@
+procedure test(p: pchar; len: longint);
+begin
+  if (length(p)<>len) then
+    halt(1);
+end;
+
+begin
+  test(nil,0);
+  test(#0,0);
+  test('a',1);
+  test('hello',5);
+end.