Forráskód Böngészése

* write class string message table correctly, resolves #14145

git-svn-id: trunk@13440 -
florian 16 éve
szülő
commit
b4914d063a
3 módosított fájl, 44 hozzáadás és 1 törlés
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/nobj.pas
  3. 42 0
      tests/webtbs/tw14145.pp

+ 1 - 0
.gitattributes

@@ -9212,6 +9212,7 @@ tests/webtbs/tw1412.pp svneol=native#text/plain
 tests/webtbs/tw14134.pp svneol=native#text/plain
 tests/webtbs/tw1414.pp svneol=native#text/plain
 tests/webtbs/tw14143.pp svneol=native#text/plain
+tests/webtbs/tw14145.pp svneol=native#text/plain
 tests/webtbs/tw14149.pp svneol=native#text/plain
 tests/webtbs/tw14155.pp svneol=native#text/plain
 tests/webtbs/tw1416.pp svneol=native#text/plain

+ 1 - 1
compiler/nobj.pas

@@ -726,7 +726,7 @@ implementation
          len:=length(p^.data.messageinf.str^);
          current_asmdata.asmlists[al_globals].concat(tai_const.create_8bit(len));
          getmem(ca,len+1);
-         move(p^.data.messageinf.str[1],ca^,len);
+         move(p^.data.messageinf.str^[1],ca^,len);
          ca[len]:=#0;
          current_asmdata.asmlists[al_globals].concat(Tai_string.Create_pchar(ca,len));
          if assigned(p^.r) then

+ 42 - 0
tests/webtbs/tw14145.pp

@@ -0,0 +1,42 @@
+{$mode objfpc}
+program testm;
+
+uses
+  Strings;
+
+Type
+  TMyObject = Class(TObject)
+  public
+    Procedure MyMessage(Var Msg); message 'somestring';
+  end;
+
+  TMyMessage = packed record
+    MsgStr : ShortString;
+    Data : Pointer;
+  end;
+
+Var
+  MyExitCode : Longint;
+
+Procedure TMyObject.MyMessage(Var Msg);
+
+begin
+  Writeln('Got Message');
+  MyExitCode:=0;
+end;
+
+var
+  msg : TMyMessage;
+  M : TMyObject;
+  s : shortstring;
+begin
+  MyExitCode:=1;
+  M:=TMyObject.Create;
+  try
+    msg.MsgStr:='somestring';
+    M.DispatchStr(Msg);
+  finally
+    M.Free;
+  end;
+  halt(MyExitCode);
+end.