浏览代码

* don't prefer int const to pointer

git-svn-id: trunk@700 -
peter 20 年之前
父节点
当前提交
a24dc41f36
共有 3 个文件被更改,包括 35 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/defcmp.pas
  3. 33 0
      tests/webtbs/tw4201.pp

+ 1 - 0
.gitattributes

@@ -6147,6 +6147,7 @@ tests/webtbs/tw4162.pp svneol=native#text/plain
 tests/webtbs/tw4173.pp svneol=native#text/plain
 tests/webtbs/tw4188.pp svneol=native#text/plain
 tests/webtbs/tw4199.pp svneol=native#text/plain
+tests/webtbs/tw4201.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 1 - 1
compiler/defcmp.pas

@@ -773,7 +773,7 @@ implementation
                          if (m_delphi in aktmodeswitches) and is_integer(def_from) then
                           begin
                             doconv:=tc_cord_2_pointer;
-                            eq:=te_convert_l1;
+                            eq:=te_convert_l2;
                           end;
                       end;
                      { delphi compatible, allow explicit typecasts from

+ 33 - 0
tests/webtbs/tw4201.pp

@@ -0,0 +1,33 @@
+type
+  XTask   = type Pointer;
+  XInt4   = Integer;
+  XID     = type Longword;
+  XUniStr = type Pointer;
+  XResult = type Integer;
+
+function XLogS(const Task: XTask; const Severity: XInt4; const Msg: XID; const Args:
+array of const): XResult; overload;
+begin
+  Result := 0;
+end;
+
+function XLogS(const Task: XTask; const Severity: XInt4; const Text: XUniStr):
+XResult; overload;
+begin
+  Result := 0;
+end;
+
+function XLogS(const Task: XTask; const Severity: XInt4; const FormatStr: XUniStr;
+const Args: array of const): XResult; overload;
+begin
+  Result := 0;
+end;
+
+const
+  XSeverityDebug = 12;
+  msg_sys_object_create = 1;
+var
+  FTask: XTask;
+begin
+  XLogS(FTask, XSeverityDebug, msg_sys_object_create, [1]);
+end.