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

+ proper init rtti for proc. vars

git-svn-id: trunk@1479 -
florian 20 жил өмнө
parent
commit
7be36096f0

+ 1 - 0
.gitattributes

@@ -6309,6 +6309,7 @@ tests/webtbs/tw4223.pp svneol=native#text/plain
 tests/webtbs/tw4233.pp svneol=native#text/plain
 tests/webtbs/tw4234.pp svneol=native#text/plain
 tests/webtbs/tw4234a.pp svneol=native#text/plain
+tests/webtbs/tw4239.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

+ 1 - 0
compiler/symconst.pas

@@ -65,6 +65,7 @@ const
   tkA16string = 23;
   tkA64string = 24;
 {$endif}
+  tkprocvar  = 25;
 
   otSByte    = 0;
   otUByte    = 1;

+ 5 - 0
compiler/symdef.pas

@@ -4120,6 +4120,11 @@ implementation
 
              { write name of result type }
              tstoreddef(rettype.def).write_rtti_name;
+          end
+        else
+          begin
+            asmlist[al_rtti].concat(Tai_const.Create_8bit(tkprocvar));
+            write_rtti_name;
           end;
       end;
 

+ 21 - 0
tests/webtbs/tw4239.pp

@@ -0,0 +1,21 @@
+{ Source provided for Free Pascal Bug Report 4239 }
+{ Submitted by "Lars" on  2005-07-30 }
+{ e-mail: [email protected] }
+program Project1;
+
+{$mode objfpc}{$H+}
+
+var
+  MyProc: array of procedure(s:string);
+
+procedure testing(s:string);
+begin
+  writeln(s);
+end;
+
+begin
+  setlength(myproc,1);
+  MyProc[0]:=@testing;
+  MyProc[0]('Test me');
+  readln; //watch for error on close
+end.