2
0
Эх сурвалжийг харах

* don't crash when looking for a local/parasym while current_procinfo is
nil, such as while parsing a property definition (mantis #14849)

git-svn-id: trunk@13958 -

Jonas Maebe 15 жил өмнө
parent
commit
dd937bd32d

+ 1 - 0
.gitattributes

@@ -8734,6 +8734,7 @@ tests/webtbf/tw1467.pp svneol=native#text/plain
 tests/webtbf/tw14713.pp svneol=native#text/plain
 tests/webtbf/tw14713.pp svneol=native#text/plain
 tests/webtbf/tw14713a.pp svneol=native#text/plain
 tests/webtbf/tw14713a.pp svneol=native#text/plain
 tests/webtbf/tw1483.pp svneol=native#text/plain
 tests/webtbf/tw1483.pp svneol=native#text/plain
+tests/webtbf/tw14849.pp svneol=native#text/plain
 tests/webtbf/tw1599.pp svneol=native#text/plain
 tests/webtbf/tw1599.pp svneol=native#text/plain
 tests/webtbf/tw1599b.pp svneol=native#text/plain
 tests/webtbf/tw1599b.pp svneol=native#text/plain
 tests/webtbf/tw1633.pp svneol=native#text/plain
 tests/webtbf/tw1633.pp svneol=native#text/plain

+ 4 - 0
compiler/nutils.pas

@@ -344,6 +344,10 @@ implementation
       var
       var
         pd : tprocdef;
         pd : tprocdef;
       begin
       begin
+        result:=nil;
+        { is not assigned while parsing a property }
+        if not assigned(current_procinfo) then
+          exit;
         { we can't use searchsym here, because the
         { we can't use searchsym here, because the
           symtablestack is not fully setup when pass1
           symtablestack is not fully setup when pass1
           is run for nested procedures }
           is run for nested procedures }

+ 48 - 0
tests/webtbf/tw14849.pp

@@ -0,0 +1,48 @@
+{ %norun }
+{ %fail }
+
+unit tw14849;
+
+{$mode objfpc}
+
+interface
+uses
+  Classes, SysUtils; 
+
+type
+  TMarkerState=(leftActive,rightActive);
+
+  TWorldPoint=record
+    fX,fY:double;
+  end;
+
+  TCoolClass = class(TComponent)
+  private
+    fMarkerPos:array[TMarkerState] of TWorldPoint;
+    { private declarations }
+
+  public
+    function LeftMarker :integer;
+		function RightMarker:integer;
+    { public declarations }
+    { error: using function to index property }
+    property xLPM:double read fMarkerPos[leftMarker].fX write fMarkerPos[leftmarker].fX;
+  end; 
+
+implementation
+
+function TCoolClass.LeftMarker :integer;
+begin
+  Result:=0;
+end;
+
+function TCoolClass.RightMarker:integer;
+begin
+  Result:=1;
+end;
+
+
+ 
+
+end.
+