pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Fix "record" marshalling, Better Proxy/Binder generated code

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3861 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2015-01-03 13:33:43 +00:00
parent 9f1a41a166
commit a9a772e219
4 changed files with 31 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
wst/trunk/record_rtti.pas
View File

@ -139,7 +139,7 @@ end;
procedure FreeRawTypeInfo(ARawTypeInfo : PTypeInfo); procedure FreeRawTypeInfo(ARawTypeInfo : PTypeInfo);
var var
i : PtrInt; i : Cardinal;
delphiFT : PFieldTable; delphiFT : PFieldTable;
tmp : PByte; tmp : PByte;
fieldInfo : PFieldInfo; fieldInfo : PFieldInfo;
@ -170,7 +170,7 @@ var
begin begin
tmp := PByte(ARawTypeInfo); tmp := PByte(ARawTypeInfo);
Inc(tmp); Inc(tmp);
Inc(tmp,1 + Byte(ARawTypeInfo.Name[0])); Inc(tmp,1 + Byte(ARawTypeInfo^.Name[0]));
delphiFT := PFieldTable(tmp); delphiFT := PFieldTable(tmp);
count := delphiFT^.Count; count := delphiFT^.Count;
{calc buffer size} {calc buffer size}
@ -181,7 +181,7 @@ begin
( count * SizeOf(TRecordFieldInfo) ); // Fields: array [0..0] of TRecordFieldInfo; ( count * SizeOf(TRecordFieldInfo) ); // Fields: array [0..0] of TRecordFieldInfo;
GetMem(resBuffer,bufferSize); GetMem(resBuffer,bufferSize);
FillChar(Pointer(resBuffer)^,bufferSize,#0); FillChar(Pointer(resBuffer)^,bufferSize,#0);
resBuffer^.Name := PTypeInfo(ARawTypeInfo).Name; resBuffer^.Name := PTypeInfo(ARawTypeInfo)^.Name;
resBuffer^.RecordSize := delphiFT^.Size; resBuffer^.RecordSize := delphiFT^.Size;
resBuffer^.FieldCount := count; resBuffer^.FieldCount := count;
{ Process elements } { Process elements }
@ -196,7 +196,7 @@ begin
end; end;
{$ENDIF WST_RECORD_RTTI} {$ENDIF WST_RECORD_RTTI}
{$IFDEF FPC} {$IFDEF FPC_XXXXXX}
function aligntoptr(p : pointer) : pointer;inline; function aligntoptr(p : pointer) : pointer;inline;
begin begin
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
@ -288,7 +288,7 @@ constructor TRecordRttiDataObject.Create(
); );
var var
locData : PRecordTypeData; locData : PRecordTypeData;
i : PtrUInt; i : Integer;
ls, s : string; ls, s : string;
begin begin
locData := AData; locData := AData;
@ -318,7 +318,7 @@ end;
function TRecordRttiDataObject.FindField(const AFieldName : shortstring) : PRecordFieldInfo; function TRecordRttiDataObject.FindField(const AFieldName : shortstring) : PRecordFieldInfo;
var var
i : PtrInt; i : Integer;
locData : PRecordTypeData; locData : PRecordTypeData;
locField : shortstring; locField : shortstring;
begin begin

89
wst/trunk/ws_helper/generator.pas
View File

@ -722,22 +722,23 @@ Var
elt := prm.ArgType; elt := prm.ArgType;
if elt.InheritsFrom(TPasUnresolvedTypeRef) then if elt.InheritsFrom(TPasUnresolvedTypeRef) then
elt := SymbolTable.FindElement(SymbolTable.GetExternalName(elt)); elt := SymbolTable.FindElement(SymbolTable.GetExternalName(elt));
if elt.InheritsFrom(TPasUnresolvedTypeRef) then begin
Indent(); WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) then begin',[elt.Name]);
IncIndent();
Indent(); WriteLn('%s := TObject(%s.%s);',[sTEMP_OBJ,sINPUT_PARAM,prm.Name]);
Indent(); WriteLn('%s.Free();',[sTEMP_OBJ]);
Indent(); WriteLn('TObject(%s.%s) := nil;',[sINPUT_PARAM,prm.Name]);
DecIndent();
Indent(); WriteLn('end;');
end else begin
if SymbolTable.IsOfType(TPasType(elt),TPasClassType) or if SymbolTable.IsOfType(TPasType(elt),TPasClassType) or
SymbolTable.IsOfType(TPasType(elt),TPasArrayType) SymbolTable.IsOfType(TPasType(elt),TPasArrayType)
then begin then begin
Indent(); WriteLn('%s := %s.%s;',[sTEMP_OBJ,sINPUT_PARAM,prm.Name]); Indent(); WriteLn('%s := %s.%s;',[sTEMP_OBJ,sINPUT_PARAM,prm.Name]);
Indent(); WriteLn('%s.%s := nil;',[sINPUT_PARAM,prm.Name]); Indent(); WriteLn('%s.%s := nil;',[sINPUT_PARAM,prm.Name]);
Indent(); WriteLn('%s.Free();',[sTEMP_OBJ]); Indent(); WriteLn('%s.Free();',[sTEMP_OBJ]);
end; end else if SymbolTable.IsOfType(TPasType(elt),TPasUnresolvedTypeRef) then begin
WriteLn('{$IF SizeOf(%s) = SizeOf(Pointer)}',[elt.Name]);
Indent(); WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) then begin',[elt.Name]);
IncIndent();
Indent(); WriteLn('%s := TObject(%s.%s);',[sTEMP_OBJ,sINPUT_PARAM,prm.Name]);
Indent(); WriteLn('%s.Free();',[sTEMP_OBJ]);
Indent(); WriteLn('TObject(%s.%s) := nil;',[sINPUT_PARAM,prm.Name]);
DecIndent();
WriteLn('{$IFEND}');
Indent(); WriteLn('end;');
end; end;
Indent(); WriteLn('%s.%s := %s;',[sINPUT_PARAM,prm.Name,prm.Name]); Indent(); WriteLn('%s.%s := %s;',[sINPUT_PARAM,prm.Name,prm.Name]);
end; end;
@ -941,12 +942,7 @@ Var
if SymbolTable.IsOfType(resPrm.ResultType,TPasClassType) or if SymbolTable.IsOfType(resPrm.ResultType,TPasClassType) or
SymbolTable.IsOfType(resPrm.ResultType,TPasArrayType) SymbolTable.IsOfType(resPrm.ResultType,TPasArrayType)
then begin then begin
Indent();WriteLn('TObject(Result) := Nil;'); Indent();WriteLn('Result := Nil;');
end else begin
Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[resPrm.ResultType.Name]);
IncIndent();
Indent();WriteLn('Pointer(Result) := Nil;');
DecIndent();
end; end;
end; end;
Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(FSymbolTable.GetExternalName(resPrm))]); Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(FSymbolTable.GetExternalName(resPrm))]);
@ -960,12 +956,7 @@ Var
if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or
SymbolTable.IsOfType(prm.ArgType,TPasArrayType) SymbolTable.IsOfType(prm.ArgType,TPasArrayType)
then begin then begin
Indent();WriteLn('TObject(%s) := Nil;',[prm.Name]); Indent();WriteLn('%s := Nil;',[prm.Name]);
end else begin
Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.ArgType.Name]);
IncIndent();
Indent();WriteLn('Pointer(%s) := Nil;',[prm.Name]);
DecIndent();
end; end;
end; end;
end; end;
@ -1365,40 +1356,14 @@ Var
WriteLn('callCtx := AContext;'); WriteLn('callCtx := AContext;');
if AMthd.InheritsFrom(TPasFunction) then begin if AMthd.InheritsFrom(TPasFunction) then begin
resElt := TPasFunctionType(AMthd.ProcType).ResultEl; resElt := TPasFunctionType(AMthd.ProcType).ResultEl;
if SymbolTable.IsInitNeed(resElt.ResultType) then begin if SymbolTable.IsInitNeed(resElt.ResultType) then
WriteLn('Fillchar(%s,SizeOf(%s),#0);',[RETURN_VAL_NAME,resElt.ResultType.Name]); WriteLn('%s := nil;',[RETURN_VAL_NAME]);
{if ( SymbolTable.IsOfType(resElt.ResultType,TPasClassType) and
( TPasClassType(GetUltimeType(resElt.ResultType)).ObjKind = okClass )
) or
SymbolTable.IsOfType(resElt.ResultType,TPasArrayType)
then begin
WriteLn('TObject(%s) := nil;',[RETURN_VAL_NAME]);
end else if SymbolTable.IsOfType(resElt.ResultType,TPasRecordType) then begin
WriteLn('Fillchar(%s,SizeOf(%s),#0);',[RETURN_VAL_NAME,resElt.ResultType.Name]);
end else begin
WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) then',[resElt.ResultType.Name]);
IncIndent();
WriteLn('Pointer(%s) := nil;',[RETURN_VAL_NAME]);
DecIndent();
end;}
end;
end; end;
for k := 0 to Pred(prmCnt) do begin for k := 0 to Pred(prmCnt) do begin
prm := TPasArgument(prms[k]); prm := TPasArgument(prms[k]);
if SymbolTable.IsInitNeed(prm.ArgType) then begin if SymbolTable.IsInitNeed(prm.ArgType) then
WriteLn('Fillchar(%s,SizeOf(%s),#0);',[prm.Name,prm.ArgType.Name]); WriteLn('%s := nil;',[RETURN_VAL_NAME]);
{if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or
SymbolTable.IsOfType(prm.ArgType,TPasArrayType)
then begin
WriteLn('TObject(%s) := nil;',[prm.Name]);
end else begin
WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkObject,tkInterface] ) then',[prm.ArgType.Name]);
IncIndent();
WriteLn('Pointer(%s) := nil;',[prm.Name]);
DecIndent();
end;}
end;
end; end;
NewLine(); NewLine();
@ -1408,14 +1373,9 @@ Var
WriteLn('AFormatter.Get(TypeInfo(%s),%s,%s);',[prm.ArgType.Name,sPRM_NAME,prm.Name]); WriteLn('AFormatter.Get(TypeInfo(%s),%s,%s);',[prm.ArgType.Name,sPRM_NAME,prm.Name]);
if SymbolTable.IsInitNeed(prm.ArgType) then begin if SymbolTable.IsInitNeed(prm.ArgType) then begin
if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or SymbolTable.IsOfType(prm.ArgType,TPasArrayType) then begin if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or SymbolTable.IsOfType(prm.ArgType,TPasArrayType) then begin
WriteLn('if Assigned(Pointer(%s)) then',[prm.Name]); WriteLn('if (%s <> nil) then',[prm.Name]);
IncIndent(); IncIndent();
WriteLn('callCtx.AddObjectToFree(TObject(%s));',[prm.Name]); WriteLn('callCtx.AddObjectToFree(%s);',[prm.Name]);
DecIndent();
end else begin
WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) and Assigned(Pointer(%s)) then',[prm.ArgType.Name,prm.Name]);
IncIndent();
WriteLn('callCtx.AddObjectToFree(TObject(%s));',[prm.Name]);
DecIndent(); DecIndent();
end; end;
end; end;
@ -1449,12 +1409,9 @@ Var
if AMthd.InheritsFrom(TPasFunction) then begin if AMthd.InheritsFrom(TPasFunction) then begin
if SymbolTable.IsInitNeed(resElt.ResultType) then begin if SymbolTable.IsInitNeed(resElt.ResultType) then begin
if SymbolTable.IsOfType(resElt.ResultType,TPasClassType) or SymbolTable.IsOfType(resElt.ResultType,TPasArrayType) then WriteLn('if (%s <> nil) then',[RETURN_VAL_NAME]);
WriteLn('if Assigned(TObject(%s)) then',[RETURN_VAL_NAME])
else
WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) and Assigned(Pointer(%s)) then',[resElt.ResultType.Name,RETURN_VAL_NAME]);
IncIndent(); IncIndent();
WriteLn('callCtx.AddObjectToFree(TObject(%s));',[RETURN_VAL_NAME]); WriteLn('callCtx.AddObjectToFree(%s);',[RETURN_VAL_NAME]);
DecIndent(); DecIndent();
end; end;
end; end;
@ -2203,9 +2160,7 @@ begin
WriteLn('{$IFDEF FPC}'); WriteLn('{$IFDEF FPC}');
WriteLn(' {$mode objfpc} {$H+}'); WriteLn(' {$mode objfpc} {$H+}');
WriteLn('{$ENDIF}'); WriteLn('{$ENDIF}');
WriteLn('{$IFNDEF FPC}'); WriteLn('{$DEFINE WST_RECORD_RTTI}');
WriteLn(' {$DEFINE WST_RECORD_RTTI}');
WriteLn('{$ENDIF}');
WriteLn('interface'); WriteLn('interface');
WriteLn(''); WriteLn('');
s := GenerateExtraUses(); s := GenerateExtraUses();

4
wst/trunk/ws_helper/pascal_parser_intf.pas
View File

@ -1005,9 +1005,7 @@ end;
function TwstPasTreeContainer.IsInitNeed(AType : TPasType) : Boolean; function TwstPasTreeContainer.IsInitNeed(AType : TPasType) : Boolean;
begin begin
Result := IsOfType(AType,TPasClassType) or Result := IsOfType(AType,TPasClassType) or
IsOfType(AType,TPasPointerType) or IsOfType(AType,TPasArrayType);
IsOfType(AType,TPasArrayType) or
IsOfType(AType,TPasRecordType);
end; end;
procedure TwstPasTreeContainer.SetCurrentModule(AModule: TPasModule); procedure TwstPasTreeContainer.SetCurrentModule(AModule: TPasModule);

1
wst/trunk/wst_global.inc
View File

@ -16,6 +16,7 @@
{$DEFINE HAS_BUILT_IN_64UINT} {$DEFINE HAS_BUILT_IN_64UINT}
{$DEFINE HAS_TKBOOL} {$DEFINE HAS_TKBOOL}
{$UNDEF WST_INTF_DOM} {$UNDEF WST_INTF_DOM}
{$DEFINE WST_RECORD_RTTI}
//{$DEFINE USE_INLINE} //{$DEFINE USE_INLINE}
{$IF Defined(FPC_VERSION) and {$IF Defined(FPC_VERSION) and
( (FPC_VERSION > 2) or ( (FPC_VERSION > 2) or