Browse Source

Merged revision(s) 45974 from trunk:
* fix for Mantis #37355: the method name and the named parameters need to be separated by a single #0
+ added test
........

git-svn-id: branches/fixes_3_2@46278 -

svenbarth 5 years ago
parent
commit
1e64c9947e
3 changed files with 38 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 3 1
      compiler/ncal.pas
  3. 34 0
      tests/webtbs/tw37355.pp

+ 1 - 0
.gitattributes

@@ -17644,6 +17644,7 @@ tests/webtbs/tw3721.pp svneol=native#text/plain
 tests/webtbs/tw37228.pp svneol=native#text/plain
 tests/webtbs/tw37322.pp svneol=native#text/pascal
 tests/webtbs/tw37323.pp svneol=native#text/pascal
+tests/webtbs/tw37355.pp svneol=native#text/pascal
 tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw3751.pp svneol=native#text/plain
 tests/webtbs/tw3758.pp svneol=native#text/plain

+ 3 - 1
compiler/ncal.pas

@@ -573,7 +573,9 @@ implementation
 
         if variantdispatch then
           begin
-            tcb.emit_pchar_const(pchar(methodname),length(methodname),true);
+            { length-1, because the following names variable *always* starts
+              with #0 which will be the terminator for methodname }
+            tcb.emit_pchar_const(pchar(methodname),length(methodname)-1,true);
             { length-1 because we added a null terminator to the string itself
               already }
             tcb.emit_pchar_const(pchar(names),length(names)-1,true);

+ 34 - 0
tests/webtbs/tw37355.pp

@@ -0,0 +1,34 @@
+{ %TARGET=win32,win64,wince }
+program tw37355;
+{$MODE OBJFPC}
+{$macro on}
+uses SysUtils, ComObj;
+var w:variant; err:string;
+begin
+  writeln('FPC ver.: '+ IntToStr(FPC_FULLVERSION));
+  write('Press Enter to start IE...');
+  //readln;
+  err := 'no error';
+  try
+  w := CreateOleObject('InternetExplorer.Application');
+  w.Visible := true;
+  try
+  w.Navigate(url:='https://bugs.freepascal.org/view.php?id=37355');
+  except
+    on E:Exception do begin
+      err := 'ERROR: ' + e.Message;
+      halt(1);
+    end;
+  end;
+  w.Quit;
+  w := UnAssigned;
+  except
+    on E:Exception do begin
+      err := 'ERROR: ' + e.Message;
+      halt(2);
+    end;
+  end;
+  writeln(err);
+  write('Press Enter to exit...');
+  //readln;
+end.