Просмотр исходного кода

* dyn. arrays are always passed by value, fixes 4240

git-svn-id: trunk@800 -
florian 20 лет назад
Родитель
Сommit
9be5247db5
5 измененных файлов с 90 добавлено и 5 удалено
  1. 1 0
      .gitattributes
  2. 4 2
      compiler/i386/cpupara.pas
  3. 6 2
      compiler/sparc/cpupara.pas
  4. 2 1
      compiler/x86_64/cpupara.pas
  5. 77 0
      tests/webtbs/tw4240.pp

+ 1 - 0
.gitattributes

@@ -6155,6 +6155,7 @@ tests/webtbs/tw4199.pp svneol=native#text/plain
 tests/webtbs/tw4202.pp svneol=native#text/plain
 tests/webtbs/tw4215.pp svneol=native#text/plain
 tests/webtbs/tw4233.pp svneol=native#text/plain
+tests/webtbs/tw4240.pp svneol=native#text/plain
 tests/webtbs/tw4247.pp svneol=native#text/plain
 tests/webtbs/tw4253.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain

+ 4 - 2
compiler/i386/cpupara.pas

@@ -163,9 +163,11 @@ unit cpupara;
                  (tarraydef(def).highrange>=tarraydef(def).lowrange) then
                 result:=false
               else
-              { array of const values are pushed on the stack }
+              { array of const values are pushed on the stack as
+                well as dyn. arrays }
                 if (calloption in [pocall_cdecl,pocall_cppdecl]) then
-                  result:=not is_array_of_const(def)
+                  result:=not(is_array_of_const(def) or
+                    is_dynamic_array(def))
               else
                 begin
                   result:=(

+ 6 - 2
compiler/sparc/cpupara.pas

@@ -117,11 +117,15 @@ implementation
             exit;
           end;
         case def.deftype of
+          arraydef:
+            result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
+                             is_open_array(def) or
+                             is_array_of_const(def) or
+                             is_array_constructor(def);
           recorddef,
-          arraydef,
           variantdef,
           formaldef :
-            push_addr_param:=true;
+            result:=true;
           objectdef :
             result:=is_object(def);
           stringdef :

+ 2 - 1
compiler/x86_64/cpupara.pas

@@ -187,7 +187,8 @@ unit cpupara;
                           { cdecl array of const need to be ignored and therefor be puhsed
                             as value parameter with length 0 }
                           (calloption in [pocall_cdecl,pocall_cppdecl]) and
-                          is_array_of_const(def)
+                          (is_array_of_const(def) or
+                           is_dynamic_array(def))
                          );
             end;
           objectdef :

+ 77 - 0
tests/webtbs/tw4240.pp

@@ -0,0 +1,77 @@
+{ %cpu=i386 }
+{ Source provided for Free Pascal Bug Report 4240 }
+{ Submitted by "Den Jean" on  2005-07-30 }
+{ e-mail: [email protected] }
+program TestPointArray;
+{$H+}
+{$asmmode intel}
+{$mode delphi}
+
+uses
+  Classes, SysUtils, Types;
+
+type
+  PPointArray = ^TPointArray;
+  TPointArray = array of TPoint;
+
+var
+  Points     : TPointArray;
+  p          : PPointArray;
+  i          : integer;
+
+
+function GetPointsLength1 (PA: pointer): Integer; cdecl;
+begin
+  asm
+    mov EAX,[EBP+$08]
+    mov i,eax
+  end;
+writeln('Within GetPointsLength using Pointer argument:');
+
+writeln(Format('--- Address on Stack:$%p',[Pointer(i)]));
+if i <> integer (p)
+then writeln ('  * Wrong Address passed on stack');
+
+writeln(Format('--- Address using Parameter:$%p',[PA]));
+if integer(PA) <> integer (p)
+then writeln ('  * Parameter addresss different from given variable');
+
+Result:=Length(TPointArray(PA));
+writeln('--- Array Length:',Result);
+end;
+
+{$IFDEF FPC}
+{$asmmode intel}
+{$ENDIF}
+
+function GetPointsLength2 (const PA: TPointArray): Integer; cdecl;
+begin
+  asm
+    mov EAX,[EBP+$08]
+    mov i,eax
+  end;
+writeln('Within GetPointsLength using const TPointArray argument:');
+
+writeln(Format('--- Address on Stack:$%p',[Pointer(i)]));
+if i <> integer (p)
+then writeln ('  * Wrong Address passed on stack');
+
+writeln(Format('--- Address using Parameter:$%p',[pointer(PA)]));
+if integer(PA) <> integer (p)
+then writeln ('  * Parameter addresss different from given variable');
+
+Result:=Length(PA);
+writeln('--- Array Length:',Result);
+end;
+
+
+begin
+SetLength (Points, 3);
+Points [0] := Point (1,2);
+Points [1] := Point (3,4);
+Points [2] := Point (5,6);
+p:=@Points[0];
+writeln(Format('Address of TPointArray:$%p',[p]));
+getPointsLength1(Points);
+getPointsLength2(Points);
+end.