Browse Source

* fixed setstrprop() for shortstring properties (based on hint by Zawullon,
mantis #14040)

git-svn-id: trunk@13323 -

Jonas Maebe 16 years ago
parent
commit
77feb9d45c
3 changed files with 38 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 1 1
      rtl/objpas/typinfo.pp
  3. 36 0
      tests/webtbs/tw14040.pp

+ 1 - 0
.gitattributes

@@ -9172,6 +9172,7 @@ tests/webtbs/tw1401.pp svneol=native#text/plain
 tests/webtbs/tw14019.pp svneol=native#text/plain
 tests/webtbs/tw14020.pp svneol=native#text/plain
 tests/webtbs/tw14020a.pp svneol=native#text/plain
+tests/webtbs/tw14040.pp svneol=native#text/plain
 tests/webtbs/tw1407.pp svneol=native#text/plain
 tests/webtbs/tw1408.pp svneol=native#text/plain
 tests/webtbs/tw1409.pp svneol=native#text/plain

+ 1 - 1
rtl/objpas/typinfo.pp

@@ -1312,7 +1312,7 @@ begin
           ptstatic,
           ptvirtual :
             begin
-              if (PropInfo^.PropProcs and 3)=ptStatic then
+              if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
                 AMethod.Code:=PropInfo^.SetProc
               else
                 AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;

+ 36 - 0
tests/webtbs/tw14040.pp

@@ -0,0 +1,36 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+uses
+  classes, typinfo;
+
+type
+  tstrtype = shortstring;
+  TSomeType = class (TPersistent)
+  private
+    FName: tstrtype;
+    procedure SetName(const AValue: tstrtype);
+  published
+    property Name: tstrtype read FName write SetName;
+  end;
+
+
+procedure tsometype.setname(const avalue: tstrtype);
+begin
+  fname:=avalue;
+end;
+
+var
+  c: tsometype;
+begin
+  c:=tsometype.create;
+  SetStrProp(c,'Name','This is a test of the emergency broadcast system');
+  if (c.name<>'This is a test of the emergency broadcast system') then
+    begin
+      writeln('"',c.name,'"');
+      halt(1);
+    end;
+  if getstrprop(c,'Name')<>'This is a test of the emergency broadcast system' then
+    halt(2);
+end.