Merged revisions 8770,8789-8790,8792-8793,8808,8810-8815 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r8770 | jonas | 2007-10-12 13:54:37 +0200 (Fri, 12 Oct 2007) | 4 lines

  * disallow using inline nodes with a non-void resultdef as statements
    (e.g. length, lo/hi, ord, etc). Not the same as mantis #9918, but
    somewhat related

........
r8789 | jonas | 2007-10-14 11:44:18 +0200 (Sun, 14 Oct 2007) | 2 lines

  - removed COMPPROCINLINEFIXED define and ifdefs (fixed in 2.2.0)

........
r8790 | jonas | 2007-10-14 12:55:40 +0200 (Sun, 14 Oct 2007) | 2 lines

  * procedure version of fpc_copy to avoid errors with {$x-} (mantis #9918)

........
r8792 | jonas | 2007-10-14 14:19:52 +0200 (Sun, 14 Oct 2007) | 2 lines

  * fixed in case the fpc binary is not in the PATH

........
r8793 | jonas | 2007-10-14 14:26:16 +0200 (Sun, 14 Oct 2007) | 2 lines

  * quoted a bunch of variables

........
r8808 | jonas | 2007-10-14 22:22:23 +0200 (Sun, 14 Oct 2007) | 5 lines

  * in case of "movzbl %dl,%edx" etc, %edx depends on its previous value.
    regloadedwithnewvalue() gave the wrong answer for this in case
    candependonprevvalue was false (caused a wrong optimization in the
    space() function of the rtl)

........
r8810 | jonas | 2007-10-15 12:54:29 +0200 (Mon, 15 Oct 2007) | 2 lines

  * fixed properties

........
r8811 | jonas | 2007-10-15 12:54:49 +0200 (Mon, 15 Oct 2007) | 3 lines

  * fixed comparedword
  * fixed properties

........
r8812 | jonas | 2007-10-15 12:55:28 +0200 (Mon, 15 Oct 2007) | 2 lines

  + comparebyte/word/dword test based on tmove

........
r8813 | jonas | 2007-10-15 13:22:03 +0200 (Mon, 15 Oct 2007) | 2 lines

  * fixed comparedword (same as for ppc32)

........
r8814 | jonas | 2007-10-15 15:29:27 +0200 (Mon, 15 Oct 2007) | 3 lines

  + basic test for indexbyte/word/dword (no tests yet for special
    cases like negative or overflowing counts)

........
r8815 | jonas | 2007-10-15 15:44:57 +0200 (Mon, 15 Oct 2007) | 2 lines

  * fixed comparedword in case len=0

........

git-svn-id: branches/fixes_2_2@8822 -

.gitattributes

@@ -5287,11 +5287,11 @@ rtl/palmos/syspalm.pp svneol=native#text/plain
 rtl/palmos/system.pp svneol=native#text/plain
 rtl/palmos/systraps.pp svneol=native#text/plain
 rtl/powerpc/int64p.inc svneol=native#text/plain
-rtl/powerpc/makefile.cpu -text
+rtl/powerpc/makefile.cpu svneol=native#text/plain
 rtl/powerpc/math.inc svneol=native#text/plain
 rtl/powerpc/mathu.inc svneol=native#text/plain
 rtl/powerpc/mathuh.inc svneol=native#text/plain
-rtl/powerpc/powerpc.inc -text
+rtl/powerpc/powerpc.inc svneol=native#text/plain
 rtl/powerpc/set.inc svneol=native#text/plain
 rtl/powerpc/setjump.inc svneol=native#text/plain
 rtl/powerpc/setjumph.inc svneol=native#text/plain
@@ -6832,6 +6832,7 @@ tests/test/opt/treg2.pp svneol=native#text/plain
 tests/test/opt/treg3.pp svneol=native#text/plain
 tests/test/opt/treg4.pp svneol=native#text/plain
 tests/test/opt/tretopt.pp svneol=native#text/plain
+tests/test/opt/tspace.pp svneol=native#text/plain
 tests/test/t4cc1.pp svneol=native#text/plain
 tests/test/t4cc2.pp svneol=native#text/plain
 tests/test/tabstrcl.pp svneol=native#text/plain
@@ -6864,6 +6865,7 @@ tests/test/tclass6.pp svneol=native#text/plain
 tests/test/tclass7.pp svneol=native#text/plain
 tests/test/tclass8.pp svneol=native#text/plain
 tests/test/tclrprop.pp svneol=native#text/plain
+tests/test/tcmp.pp svneol=native#text/plain
 tests/test/tendian1.pp svneol=native#text/plain
 tests/test/tenum1.pp svneol=native#text/plain
 tests/test/tenum2.pp svneol=native#text/plain
@@ -6922,6 +6924,7 @@ tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/thintdir.pp svneol=native#text/plain
 tests/test/timplprog.pp svneol=native#text/plain
+tests/test/tindex.pp svneol=native#text/plain
 tests/test/tinivar.pp svneol=native#text/plain
 tests/test/tinlin64.pp svneol=native#text/plain
 tests/test/tinline1.pp svneol=native#text/plain
@@ -7449,6 +7452,10 @@ tests/webtbf/tw9499.pp svneol=native#text/plain
 tests/webtbf/tw9499a.pp svneol=native#text/plain
 tests/webtbf/tw9579a.pp svneol=native#text/plain
 tests/webtbf/tw9579b.pp svneol=native#text/plain
+tests/webtbf/tw9918a.pp svneol=native#text/plain
+tests/webtbf/tw9918b.pp svneol=native#text/plain
+tests/webtbf/tw9918c.pp svneol=native#text/plain
+tests/webtbf/tw9918d.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
 tests/webtbf/uw0840b.pp svneol=native#text/plain
@@ -8414,6 +8421,7 @@ tests/webtbs/tw9667.pp svneol=native#text/plain
 tests/webtbs/tw9695.pp svneol=native#text/plain
 tests/webtbs/tw9704.pp svneol=native#text/plain
 tests/webtbs/tw9897.pp svneol=native#text/plain
+tests/webtbs/tw9918.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

compiler/i386/daopt386.pas

@@ -1124,10 +1124,13 @@ begin
      (p.oper[1]^.typ = top_reg) and
      (getsupreg(p.oper[1]^.reg) = supreg) and
      (canDependOnPrevValue or
-      (p.oper[0]^.typ <> top_ref) or
-      not regInRef(supreg,p.oper[0]^.ref^)) or
-     ((p.opcode = A_POP) and
-      (getsupreg(p.oper[0]^.reg) = supreg)));
+      (p.oper[0]^.typ = top_const) or
+      ((p.oper[0]^.typ = top_reg) and
+       (getsupreg(p.oper[0]^.reg) <> supreg)) or
+      ((p.oper[0]^.typ = top_ref) and
+       not regInRef(supreg,p.oper[0]^.ref^)))) or
+    ((p.opcode = A_POP) and
+     (getsupreg(p.oper[0]^.reg) = supreg));
 end;
 
 procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai);

compiler/nld.pas

@@ -618,7 +618,7 @@ implementation
                ccallparanode.create(ctypeconvnode.create_internal(
                  caddrnode.create_internal(right),voidpointertype),
                nil)));
-           result:=ccallnode.createintern('fpc_copy',hp);
+           result:=ccallnode.createintern('fpc_copy_proc',hp);
            left:=nil;
            right:=nil;
            exit;

compiler/options.pas

@@ -2111,7 +2111,6 @@ begin
   { "main" symbol is generated in the main program, and left out of the system unit }
   def_system_macro('FPC_DARWIN_PASCALMAIN');
   def_system_macro('FPC_DARWIN_JMP_MAIN');
-  def_system_macro('COMPPROCINLINEFIXED');
   def_system_macro('PARAOUTFILE');
   def_system_macro('RESSTRSECTIONS');
   def_system_macro('FPC_HASFIXED64BITVARIANT');

compiler/pstatmnt.pas

@@ -1074,7 +1074,9 @@ implementation
              { with a separate statement for each read/write operation (JM)    }
              { the same is true for val() if the third parameter is not 32 bit }
              if not(p.nodetype in [nothingn,calln,ifn,assignn,breakn,inlinen,
-                                   continuen,labeln,blockn,exitn]) then
+                                   continuen,labeln,blockn,exitn]) or
+                ((p.nodetype=inlinen) and
+                 not is_void(p.resultdef)) then
                Message(parser_e_illegal_expression);
 
              { Specify that we don't use the value returned by the call.

compiler/utils/samplecfg

@@ -11,7 +11,7 @@ GCCSPEC=`(gcc -v $@ 2>&1)| head -n 1| awk '{ print $4 } '`
 if [ -z "$GCCSPEC" ] ; then
   GCCSPEC=`gcc -print-libgcc-file-name $@ 2>/dev/null`
 fi
-GCCDIR=`dirname $GCCSPEC`
+GCCDIR=`dirname "$GCCSPEC"`
 }
 
 
@@ -22,7 +22,7 @@ if [ -z "$GCCSPEC" ] ; then
   GCCSPEC=`gcc -print-libgcc-file-name -arch $1`
 fi
 
-GCCDIR=`dirname $GCCSPEC`
+GCCDIR=`dirname "$GCCSPEC"`
 
 if [ -z "$GCCDIR" ] ; then
   return
@@ -62,24 +62,25 @@ if [ $# = 0 ]; then
   echo 'confdir = Path to /etc'
   exit 1
 fi
-if [ $2 ]; then
-  sysdir=$2
-  [ -d $sysdir ] || mkdir $sysdir
+if [ "$2" ]; then
+  sysdir="$2"
+  [ -d "$sysdir" ] || mkdir "$sysdir"
 else
   sysdir=/etc
 fi
+FPCBIN=`dirname "$1"`/../../bin/fpc
 
 # Detect if we have write permission in root.
-if [ -w $sysdir ] ; then
+if [ -w "$sysdir" ] ; then
   echo Write permission in $sysdir.
-  thefile=$sysdir/fpc.cfg
+  thefile="$sysdir"/fpc.cfg
 else
   echo No write premission in $sysdir.
-  thefile=$HOME/.fpc.cfg
+  thefile"=$HOME"/.fpc.cfg
 fi
 #
 if [ -f $thefile ] ; then
-  mv $thefile $thefile.orig  >/dev/null 2>&1
+  mv "$thefile" "$thefile.orig"  >/dev/null 2>&1
   if [ $? = 0 ]; then
     echo Saved old config to $thefile.orig
   else
@@ -106,16 +107,16 @@ case $HOSTOS in
      ;;
  darwin)
    setgccdirarch ppc
-   GCCDIR2=$GCCDIR
+   GCCDIR2="$GCCDIR"
    setgccdirarch ppc64
-   GCCDIR3=$GCCDIR
+   GCCDIR3="$GCCDIR"
    setgccdirarch i386
-   GCCDIR4=$GCCDIR
+   GCCDIR4="$GCCDIR"
    setgccdirarch x86_64
      ;;
  *)
-   if [ -d $GCCDIR ]; then	
-      echo Found libgcc.a in $GCCDIR
+   if [ -d "$GCCDIR" ]; then	
+      echo Found libgcc.a in "$GCCDIR"
     GCCDIR=-Fl$GCCDIR
    fi
     ;;
@@ -125,7 +126,7 @@ esac
 CPUCROSSIFDEF1="#DEFINE NEEDCROSSBINUTILS"
 CPUCROSSIFDEF2=""
 
-case `fpc -PP` in
+case `"$FPCBIN" -PP` in
   i?86|x86_64|amd64)
     # Cross-binutils are not needed to compile for i386 on an x86_64 system
     CPUCROSSIFDEF1="

rtl/i386/i386.inc

@@ -500,9 +500,9 @@ asm
         movl    %edx,%esi
         movl    %ecx,%eax
 {$else}
-        movl    len,%eax
         movl    buf2,%esi       { Load params}
         movl    buf1,%edi
+        movl    len,%eax
 {$endif}
         testl   %eax,%eax       {We address -1(%esi), so we have to deal with len=0}
         je      .LCmpbyteExit
@@ -558,9 +558,9 @@ asm
         movl    %edx,%esi
         movl    %ecx,%eax
 {$else}
-        movl    len,%eax
         movl    buf2,%esi       { Load params}
         movl    buf1,%edi
+        movl    len,%eax
 {$endif}
         testl   %eax,%eax       {We address -2(%esi), so we have to deal with len=0}
         je      .LCmpwordExit
@@ -623,13 +623,16 @@ asm
 {$ifdef REGCALL}
         movl    %eax,%edi
         movl    %edx,%esi
+        movl    %ecx,%eax
 {$else}
-        movl    len,%ecx
         movl    buf2,%esi       { Load params}
         movl    buf1,%edi
+        movl    len,%eax
+        movl    %eax,%ecx
 {$endif}
-        testl   %ecx,%ecx
+        testl   %eax,%eax
         je      .LCmpDwordExit
+        movl    %eax,%ecx
         xorl    %eax,%eax
         rep                     { Compare entire DWords}
         cmpsl

rtl/inc/compproc.inc

@@ -404,6 +404,7 @@ Procedure fpc_Addref (Data,TypeInfo : Pointer); compilerproc;
 Procedure fpc_DecRef (Data,TypeInfo : Pointer);  compilerproc;
 procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); compilerproc;
 Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt; compilerproc;
+Procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer); compilerproc; inline;
 {$endif FPC_HAS_FEATURE_RTTI}
 
 

rtl/inc/rtti.inc

@@ -326,6 +326,15 @@ begin
 end;
 
 
+{ For internal use by the compiler, because otherwise $x- can cause trouble. }
+{ Generally disabling extended syntax checking for all compilerprocs may     }
+{ have unintended side-effects                                               }
+procedure fpc_Copy_proc (Src, Dest, TypeInfo : Pointer);compilerproc; inline;
+begin
+  fpc_copy_internal(src,dest,typeinfo);
+end;
+
+
 procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];  compilerproc;
   var
      i : longint;

rtl/inc/systemh.inc

@@ -28,9 +28,7 @@
 
 { Using inlining for small system functions/wrappers }
 {$inline on}
-{$ifdef COMPPROCINLINEFIXED}
 {$define SYSTEMINLINE}
-{$endif COMPPROCINLINEFIXED}
 
 { don't use FPU registervariables on the i386 }
 {$ifdef CPUI386}

rtl/powerpc/powerpc.inc

@@ -768,10 +768,19 @@ asm
         lwzu    r9,4(r11)
         lwzu    r10,4(r4)
         { calculate difference }
-        sub.    r3,r9,r10
+        sub.    r0,r9,r10
         { if chars not equal or at the end, we're ready }
         bdnzt   cr0*4+eq, .LCompDWordLoop
 .LCompDWordDone:
+        cmplw cr1,r9,r10
+        beq .Ldone
+        { since these were two dwords, we have to perform an additional }
+        { unsigned comparison and set the result accordingly            }
+        bgt cr1,.Lpos
+        li r3,-2
+.Lpos:
+        addi r3,r3,1
+.Ldone:
 end;
 {$endif FPC_SYSTEM_HAS_COMPAREDWORD}
 
@@ -1248,9 +1257,9 @@ begin
      lfd f1,8(r1)
      mtfsf 7,f1
   end;
-  { powerpc might use softfloat code }
-  softfloat_exception_flags:=0;
-  softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
+  { powerpc might use softfloat code }
+  softfloat_exception_flags:=0;
+  softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
 end;
 {$ENDIF}
 

rtl/powerpc64/powerpc64.inc

@@ -282,6 +282,15 @@ asm
   { if chars not equal or at the end, we're ready }
   bdnzt   cr0*4+eq, .LCompDWordLoop
 .LCompDWordDone:
+  cmpld   cr1,r9,r10
+  beq     .Ldone
+  { since these were two dwords, we have to perform an additional }
+  { unsigned comparison and set the result accordingly            }
+  bgt       cr1,.Lpos
+  li r3,-2
+.Lpos:
+  addi r3,r3,1
+.Ldone:
 end;
 {$endif FPC_SYSTEM_HAS_COMPAREDWORD}
 

tests/test/opt/tspace.pp

@@ -0,0 +1,20 @@
+{ %opt=-O2 }
+
+function space (b : byte): shortstring;
+begin
+  space[0] := chr(b);
+  FillChar (Space[1],b,' ');
+end;
+
+var
+  s: string;
+  i: longint;
+begin
+  fillchar(s,sizeof(s),255);
+  s:=space(255);
+  if length(s)<>255 then
+    halt(1);
+  for i:=1 to 255 do
+    if s[i]<>' ' then
+      halt(2);
+end.

tests/test/tcmp.pp

@@ -0,0 +1,86 @@
+const
+  err: boolean = false;
+
+var
+  a, b: array[0..512] of byte;
+
+procedure test_compare;
+type
+  pdword = ^cardinal;
+var
+  i, j, k: longint;
+  l: longint;
+begin
+  for i := 0 to 512 do
+    a[i] := byte(i);
+  for i := 0 to 256 do
+    for j := 0 to 31 do
+      for k := 0 to 31 do
+        begin
+          fillchar(b,sizeof(b),0);
+          move(a[j],b[k+4],i);
+          if comparebyte(a[j],b[k+4],i)<>0 then
+            begin
+              writeln('cmpbyte error 1 for (',i,',',j,',',k,')');
+              halt(1);
+            end;
+          if comparebyte(a[j],b[k+4],i+1)<0 then
+            begin
+              writeln(a[j+i],' ',b[k+4+i]);
+              writeln('cmpbyte error 2 for (',i,',',j,',',k,')');
+              halt(2);
+            end;
+
+          if (i and 1 = 0) then
+            begin
+              if compareword(a[j],b[k+4],i shr 1)<>0 then
+                begin
+                  writeln('cmpword error 3 for (',i,',',j,',',k,')');
+                  halt(3);
+                end;
+              if compareword(a[j],b[k+4],i shr 1 + 1)<0 then
+                begin
+                  writeln('cmpword error 4 for (',i,',',j,',',k,')');
+                  halt(4);
+                end;
+            end
+          else
+            if compareword(a[j],b[k+4],(i+1) shr 1)<0 then
+              begin
+                writeln('cmpword error 5 for (',i,',',j,',',k,')');
+                halt(5);
+              end;
+
+          if (i and 3 = 0) then
+            begin
+              if comparedword(a[j],b[k+4],i shr 2)<>0 then
+                begin
+                  writeln('cmpdword error 6 for (',i,',',j,',',k,')');
+                  halt(6);
+                end;
+              if comparedword(a[j],b[k+4],i shr 2 + 1)<=0 then
+                begin
+                  writeln(comparedword(a[j],b[k+4],i shr 2+1));
+                  writeln(pdword(@a[j])^,' ',pdword(@b[k+4])^);
+                  writeln(pdword(@a[j+i])^,' ',pdword(@b[k+4+i])^);
+                  writeln(pdword(@a[j+i+4])^,' ',pdword(@b[k+4+i+4])^);
+                  writeln('cmpdword error 7 for (',i,',',j,',',k,')');
+                  halt(7);
+                end;
+            end
+          else
+            if comparedword(a[j],b[k+4],(i+3) shr 2)<0 then
+              begin
+                writeln(comparedword(a[j],b[k+4],(i+3) shr 2));
+                writeln(pdword(@a[j])^,' ',pdword(@b[k+4])^);
+                writeln(pdword(@a[j+(i+3) shr 2-1])^,' ',pdword(@b[k+4+(i+3) shr 2-1])^);
+                writeln('cmpdword error 8 for (',i,',',j,',',k,')');
+                halt(8);
+              end;
+        end;
+end;
+
+
+begin
+  test_compare;
+end.

tests/test/tindex.pp

@@ -0,0 +1,188 @@
+const
+  err: boolean = false;
+
+var
+  a, b: array[0..515] of byte;
+  bw: array[0..258] of word absolute b;
+  bd: array[0..129] of dword absolute b;
+
+procedure test_index;
+type
+  pword = ^word;
+  pdword = ^cardinal;
+var
+  i, j, k: longint;
+  index: longint;
+  l: dword;
+begin
+  for i := 0 to 512 do
+    a[i] := byte(i);
+  for i := 0 to 256 do
+    for j := 0 to 31 do
+      for k := 0 to 31 do
+        begin
+          fillchar(b,sizeof(b),0);
+          move(a[j],b[k+4],i);
+          { for i = 256, every element appears in the array }
+          if (byte(i)>0) then
+            index:=i-1
+          else
+            index:=0;
+          if indexbyte(b[k+4],index,a[j+i])<>-1 then
+            begin
+              writeln(indexbyte(b[k+4],index,a[j+1]),' <> -1');
+              writeln('indexbyte error 1 for (',i,',',j,',',k,')');
+              halt(1);
+            end;
+          if b[k+4]=0 then
+            index:=0
+          else if (b[k+4]+i>=256) then
+            index:=256-b[k+4]
+          else
+            index:=i;
+          if indexbyte(b[k+4],i+1,0)<>index then
+            begin
+              writeln(indexbyte(b[k+4],i+1,0),' <> ',index);
+              writeln('indexbyte error 2 for (',i,',',j,',',k,')');
+              halt(2);
+            end;
+
+          if indexbyte(b[k+4],i,b[k+4+i-1])<>i-1 then
+            begin
+              writeln('indexbyte error 3 for (',i,',',j,',',k,')');
+              halt(3);
+            end;
+          if (i<1) then
+            index:=-1
+          else
+            index:=i shr 1;
+          if indexbyte(b[k+4],i,b[k+4+i shr 1])<>index then
+            begin
+              writeln(indexbyte(b[k+4],i,b[k+4+i shr 1]),' <> ',index);
+              writeln('indexbyte error 4 for (',i,',',j,',',k,')');
+              halt(4);
+            end;
+          if (i=0) then
+            index:=-1
+          else
+            index:=0;
+          if indexbyte(b[k+4],i,b[k+4])<>index then
+            begin
+              writeln('indexbyte error 5 for (',i,',',j,',',k,')');
+              halt(3);
+            end;
+
+
+          if indexword(b[k+4],i shr 1,0)<>-1 then
+            begin
+              writeln('indexword error 6 for (',i,',',j,',',k,')');
+              halt(6);
+            end;
+
+          if (unaligned(pword(@b[k+4])^)=0) then
+            index:=0
+          else if (i=0) then
+            index:=-1
+          else if (b[k+4+i-1] = 0) and
+                  odd(i) then
+            index:=((i+1) shr 1)-1
+          else
+            index:=((i+1) shr 1);
+          if indexword(b[k+4],(i+1) shr 1 + 1,0)<>index then
+            begin
+              writeln(indexword(b[k+4],(i+1) shr 1 + 1,0),' <> ',index);
+              writeln('indexword error 7 for (',i,',',j,',',k,')');
+              halt(7);
+            end;
+
+          if (i=0) then
+            index:=0
+          else
+            index:=i shr 1;
+          l:=unaligned(pword(@(b[k+4+(i and not 1)]))^);
+          if indexword(b[k+4],i shr 1+1,l)<>index then
+            begin
+              writeln(indexword(b[k+4],((i and not 1)+1) shr 1+1,l),' <> ',index);
+              writeln('indexword error 8 for (',i,',',j,',',k,')');
+              halt(8);
+            end;
+
+           l:=unaligned(pword(@(b[k+4+((i shr 2) and not 1)-2]))^);
+           if (i>=8) then
+             index:=((i shr 2) and not 1) shr 1 - 1
+           else
+             index:=-1;
+           if indexword(b[k+4],i shr 1,l)<>index then
+             begin
+               writeln(indexword(b[k+4],i shr 1,l),' <> ',index);
+               writeln('indexword error 9 for (',i,',',j,',',k,')');
+               halt(9);
+             end;
+           l:=unaligned(pword(@(b[k+4]))^);
+           if (i<2) then
+             index:=-1
+           else
+             index:=0;
+           if indexword(b[k+4],i shr 1,l)<>index then
+             begin
+               writeln('indexword error 10 for (',i,',',j,',',k,')');
+               halt(10);
+             end;
+
+
+           if (unaligned(pdword(@b[k+4])^)=0) then
+             index:=0
+           else if (i=0) then
+             index:=-1
+           else if (b[k+4+i-1] = 0) and
+                   ((i mod 4) = 1) then
+             index:=((i+3) shr 2)-1
+           else
+             index:=((i+3) shr 2);
+           if indexdword(b[k+4],(i+3) shr 2 + 1,0)<>index then
+             begin
+               writeln(indexdword(b[k+4],(i+3) shr 2 + 1,0),' <> ',index);
+               writeln('indexdword error 11 for (',i,',',j,',',k,')');
+               halt(11);
+             end;
+
+           if (i=0) then
+             index:=0
+           else
+             index:=i shr 2;
+           l:=unaligned(pdword(@(b[k+4+(i and not 3)]))^);
+           if indexdword(b[k+4],i shr 2+1,l)<>index then
+             begin
+               writeln('indexdword error 12 for (',i,',',j,',',k,')');
+               halt(12);
+             end;
+
+           l:=unaligned(pdword(@(b[k+4+((i shr 3) and not 3)-4]))^);
+           if (i>=32) then
+             index:=((i shr 3) and not 3) shr 2 - 1
+           else
+             index:=-1;
+           if indexdword(b[k+4],i shr 2,l)<>index then
+             begin
+               writeln(indexdword(b[k+4],i shr 2,l),' <> ',index);
+               writeln('indexword error 13 for (',i,',',j,',',k,')');
+               halt(13);
+             end;
+          l:=unaligned(pword(@(b[k+4]))^);
+          if (i<4) then
+            index:=-1
+          else
+            index:=0;
+          if indexword(b[k+4],i shr 2,l)<>index then
+            begin
+              writeln('indexdword error 14 for (',i,',',j,',',k,')');
+              halt(14);
+            end;
+
+        end;
+end;
+
+
+begin
+  test_index;
+end.

tests/webtbf/tw9918a.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+{$x-}
+
+var
+  a: array of byte;
+begin
+  length(a);
+end.

tests/webtbf/tw9918b.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+{$x+}
+
+var
+  s: shortstring;
+begin
+  length(s);
+end.

tests/webtbf/tw9918c.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+{$x+}
+
+var
+  l: longint;
+begin
+  lo(l);
+end.

tests/webtbf/tw9918d.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+{$x+}
+
+var
+  d: double;
+begin
+  trunc(d);
+end.

tests/webtbs/tw9918.pp

@@ -0,0 +1,12 @@
+{ %norun }
+{$x-}
+
+
+PROCEDURE Test;
+TYPE T = ARRAY OF Char;
+VAR V : T;
+BEGIN V := V;
+END;
+
+begin
+end.