瀏覽代碼

Merged revisions 7124-7125 via svnmerge from
svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r7124 | florian | 2007-04-17 21:47:00 +0200 (Tue, 17 Apr 2007) | 2 lines

* made second parameter of inverserect const, resolves #8705

........
r7125 | florian | 2007-04-17 22:34:58 +0200 (Tue, 17 Apr 2007) | 2 lines

* handle rtti for sets with a size of 1 and 2 properly, resolves #8660

........

git-svn-id: branches/fixes_2_2@7193 -

joost 18 年之前
父節點
當前提交
24809d4eae
共有 7 個文件被更改,包括 48 次插入5 次删除
  1. 1 0
      .gitattributes
  2. 8 1
      compiler/ncgrtti.pas
  3. 1 1
      compiler/symdef.pas
  4. 2 1
      rtl/objpas/typinfo.pp
  5. 1 1
      rtl/win/wininc/func.inc
  6. 1 1
      rtl/wince/wininc/coredll.inc
  7. 34 0
      tests/webtbs/tw8660.pp

+ 1 - 0
.gitattributes

@@ -8056,6 +8056,7 @@ tests/webtbs/tw8434.pp svneol=native#text/plain
 tests/webtbs/tw8462.pp svneol=native#text/plain
 tests/webtbs/tw8462.pp svneol=native#text/plain
 tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/tw8573.pp svneol=native#text/plain
 tests/webtbs/tw8573.pp svneol=native#text/plain
+tests/webtbs/tw8660.pp svneol=native#text/plain
 tests/webtbs/tw8664.pp svneol=native#text/plain
 tests/webtbs/tw8664.pp svneol=native#text/plain
 tests/webtbs/tw8757.pp svneol=native#text/plain
 tests/webtbs/tw8757.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain

+ 8 - 1
compiler/ncgrtti.pas

@@ -513,7 +513,14 @@ implementation
 {$ifdef cpurequiresproperalignment}
 {$ifdef cpurequiresproperalignment}
            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
 {$endif cpurequiresproperalignment}
 {$endif cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
+           case def.size of
+             1:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
+             2:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord));
+             4:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
+           end;
 {$ifdef cpurequiresproperalignment}
 {$ifdef cpurequiresproperalignment}
            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
 {$endif cpurequiresproperalignment}
 {$endif cpurequiresproperalignment}

+ 1 - 1
compiler/symdef.pas

@@ -2095,7 +2095,7 @@ implementation
 
 
     function tsetdef.is_publishable : boolean;
     function tsetdef.is_publishable : boolean;
       begin
       begin
-         is_publishable:=(settype=smallset);
+         is_publishable:=savesize in [1,2,4];
       end;
       end;
 
 
 
 

+ 2 - 1
rtl/objpas/typinfo.pp

@@ -84,7 +84,7 @@ unit typinfo;
          case TTypeKind of
          case TTypeKind of
             tkUnKnown,tkLString,tkWString,tkAString,tkVariant:
             tkUnKnown,tkLString,tkWString,tkAString,tkVariant:
               ();
               ();
-            tkInteger,tkChar,tkEnumeration,tkWChar:
+            tkInteger,tkChar,tkEnumeration,tkWChar,tkSet:
               (OrdType : TOrdType;
               (OrdType : TOrdType;
                case TTypeKind of
                case TTypeKind of
                   tkInteger,tkChar,tkEnumeration,tkBool,tkWChar : (
                   tkInteger,tkChar,tkEnumeration,tkBool,tkWChar : (
@@ -754,6 +754,7 @@ begin
       DataSize:=1;
       DataSize:=1;
     tkWChar:
     tkWChar:
       DataSize:=2;
       DataSize:=2;
+    tkSet,
     tkEnumeration,
     tkEnumeration,
     tkInteger:
     tkInteger:
       begin
       begin

+ 1 - 1
rtl/win/wininc/func.inc

@@ -597,7 +597,7 @@ function SetSysColors(cElements:longint; var lpaElements:wINT; var lpaRgbValues:
 function DrawFocusRect(hDC:HDC; var lprc:RECT):WINBOOL; external 'user32' name 'DrawFocusRect';
 function DrawFocusRect(hDC:HDC; var lprc:RECT):WINBOOL; external 'user32' name 'DrawFocusRect';
 function FillRect(hDC:HDC; const lprc:RECT; hbr:HBRUSH):longint; external 'user32' name 'FillRect';
 function FillRect(hDC:HDC; const lprc:RECT; hbr:HBRUSH):longint; external 'user32' name 'FillRect';
 function FrameRect(hDC:HDC; var lprc:RECT; hbr:HBRUSH):longint; external 'user32' name 'FrameRect';
 function FrameRect(hDC:HDC; var lprc:RECT; hbr:HBRUSH):longint; external 'user32' name 'FrameRect';
-function InvertRect(hDC:HDC; var lprc:RECT):WINBOOL; external 'user32' name 'InvertRect';
+function InvertRect(hDC:HDC; const lprc:RECT):WINBOOL; external 'user32' name 'InvertRect';
 function SetRect(lprc:LPRECT; xLeft:longint; yTop:longint; xRight:longint; yBottom:longint):WINBOOL; external 'user32' name 'SetRect';
 function SetRect(lprc:LPRECT; xLeft:longint; yTop:longint; xRight:longint; yBottom:longint):WINBOOL; external 'user32' name 'SetRect';
 function SetRectEmpty(lprc:LPRECT):WINBOOL; external 'user32' name 'SetRectEmpty';
 function SetRectEmpty(lprc:LPRECT):WINBOOL; external 'user32' name 'SetRectEmpty';
 function CopyRect(lprcDst:LPRECT; var lprcSrc:RECT):WINBOOL; external 'user32' name 'CopyRect';
 function CopyRect(lprcDst:LPRECT; var lprcSrc:RECT):WINBOOL; external 'user32' name 'CopyRect';

+ 1 - 1
rtl/wince/wininc/coredll.inc

@@ -2761,7 +2761,7 @@ function IntersectRect(lprcDst:LPRECT; var lprcSrc1:RECT; var lprcSrc2:RECT):WIN
 function InvalidateRect(hWnd:HWND; var lpRect:RECT; bErase:WINBOOL):WINBOOL; external KernelDLL name 'InvalidateRect';
 function InvalidateRect(hWnd:HWND; var lpRect:RECT; bErase:WINBOOL):WINBOOL; external KernelDLL name 'InvalidateRect';
 function InvalidateRect(hWnd:HWND;lpRect:LPRECT; bErase:WINBOOL):WINBOOL; external KernelDLL name 'InvalidateRect';
 function InvalidateRect(hWnd:HWND;lpRect:LPRECT; bErase:WINBOOL):WINBOOL; external KernelDLL name 'InvalidateRect';
 function InvalidateRgn(hWnd:HWND; hRgn:HRGN; bErase:WINBOOL):WINBOOL; external KernelDLL name 'InvalidateRgn';
 function InvalidateRgn(hWnd:HWND; hRgn:HRGN; bErase:WINBOOL):WINBOOL; external KernelDLL name 'InvalidateRgn';
-function InvertRect(hDC:HDC; var lprc:RECT):WINBOOL; external KernelDLL name 'InvertRect';
+function InvertRect(hDC:HDC; const lprc:RECT):WINBOOL; external KernelDLL name 'InvertRect';
 function IsBadReadPtr(lp:LPVOID; ucb:UINT):WINBOOL; external Kerneldll name 'IsBadReadPtr';
 function IsBadReadPtr(lp:LPVOID; ucb:UINT):WINBOOL; external Kerneldll name 'IsBadReadPtr';
 function IsBadWritePtr(lp:LPVOID; ucb:UINT):WINBOOL; external Kerneldll name 'IsBadWritePtr';
 function IsBadWritePtr(lp:LPVOID; ucb:UINT):WINBOOL; external Kerneldll name 'IsBadWritePtr';
 function IsBadCodePtr(lpfn:FARPROC):WINBOOL; external Kerneldll name 'IsBadCodePtr';
 function IsBadCodePtr(lpfn:FARPROC):WINBOOL; external Kerneldll name 'IsBadCodePtr';

+ 34 - 0
tests/webtbs/tw8660.pp

@@ -0,0 +1,34 @@
+program TestGetSetProp;
+{$APPTYPE CONSOLE}{$PACKSET 1}
+
+uses TypInfo;
+
+{$M+}
+type
+  TEnum = (ckNormal, ckBusiness, ckVip, ckCorporate);
+  TSet = set of TEnum;
+  TClient = class
+  private
+    _Num: byte; // Works if Integer
+    _St: TSet;
+  published
+    property Num: byte read _Num write _Num; // Works if Integer
+    property St: TSet read _St write _St;
+  end;
+
+var
+  C : TClient;
+  V : TSet;
+begin
+  C := TClient.Create;
+  C.Num := 2;
+  C.St := [ckVip, ckNormal]; // the numeric representation is 5
+  V := C.St;
+  writeln(sizeof(V), ' ', byte(V)); // It's OK
+  writeln(sizeof(C.St), ' ', byte(C.St)); // It's OK
+  if GetOrdProp(C, 'St')<>5 then
+    halt(1);
+  if GetSetProp(C, 'St')<>'ckNormal,ckVip' then
+    halt(1);
+  writeln('ok');
+end.