paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 00:30:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added support for reading set properties

Browse Source
This commit is contained in:
sg 2003-06-25 08:56:26 +00:00
parent aebf2e96af
commit c16cbd8677
1 changed files with 49 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
fcl/net/mkxmlrpc.pp
View File

@ -207,7 +207,7 @@ procedure WriteClassServerSource(ServerClass: TPasClassType;
type type
TConversionInfo = record TConversionInfo = record
ConverterName: String; ConverterName, TypecastFunction: String;
ArgIsParent: Boolean; ArgIsParent: Boolean;
end; end;
@ -270,13 +270,32 @@ type
(s = 'EXTENDED') then (s = 'EXTENDED') then
Result.ConverterName := 'AWriter.CreateDoubleValue'; Result.ConverterName := 'AWriter.CreateDoubleValue';
end else if Element.ClassType = TPasClassType then end else if Element.ClassType = TPasClassType then
Result.ConverterName := MakeStructConverter(TPasClassType(Element), Referrer).Name; Result.ConverterName := MakeStructConverter(TPasClassType(Element), Referrer).Name
else if Element.ClassType = TPasEnumType then
begin
Result.ConverterName := 'AWriter.CreateIntValue';
Result.TypecastFunction := 'Ord';
end;
if Length(Result.ConverterName) = 0 then if Length(Result.ConverterName) = 0 then
raise Exception.Create('Result type not supported: ' + Element.ClassName + raise Exception.Create('Result type not supported: ' + Element.ClassName +
' ' + Element.Name); ' ' + Element.Name);
end; end;
function MakeAccessor(ConversionInfo: TConversionInfo;
const DataSource, ArrayIndex: String): String;
begin
Result := ConversionInfo.ConverterName + '(';
if ConversionInfo.TypecastFunction <> '' then
Result := Result + ConversionInfo.TypecastFunction + '(';
Result := Result + DataSource;
if ConversionInfo.TypecastFunction <> '' then
Result := Result + ')';
if ArrayIndex <> '' then
Result := Result + '[' + ArrayIndex + ']';
Result := Result + ')';
end;
function GetParseValueFnName(PasType: TPasType): String; function GetParseValueFnName(PasType: TPasType): String;
var var
s: String; s: String;
@ -370,12 +389,12 @@ type
if LocalMember.ClassType = TPasProperty then if LocalMember.ClassType = TPasProperty then
begin begin
ConversionInfo := GetConversionInfo(LocalMember, Result); ConversionInfo := GetConversionInfo(LocalMember, Result);
s := 'AWriter.AddStructMember(Result, ''' + LocalMember.Name + ''', ' +
ConversionInfo.ConverterName;
if ConversionInfo.ArgIsParent then if ConversionInfo.ArgIsParent then
s := s + '(Inst))' s := 'Inst'
else else
s := s + '(Inst.' + LocalMember.Name + '))'; s := 'Inst.' + LocalMember.Name;
s := 'AWriter.AddStructMember(Result, ''' + LocalMember.Name + ''', ' +
MakeAccessor(ConversionInfo, s, '') + ')';
Commands.Commands.Add(s); Commands.Commands.Add(s);
end; end;
end; end;
@ -420,11 +439,12 @@ type
'0', MethodPrefix + ArraySizeProp.Name + ' - 1'); '0', MethodPrefix + ArraySizeProp.Name + ' - 1');
ForLoop.Body := TPasImplCommand.Create('', ForLoop); ForLoop.Body := TPasImplCommand.Create('', ForLoop);
ConversionInfo := GetConversionInfo(Member.VarType, Result); ConversionInfo := GetConversionInfo(Member.VarType, Result);
s := 'AWriter.AddArrayElement(Result, ' + ConversionInfo.ConverterName;
if ConversionInfo.ArgIsParent then if ConversionInfo.ArgIsParent then
s := s + '(Inst))' s := 'Inst'
else else
s := s + '(Inst.' + Member.Name + '[i]))'; s := 'Inst.' + Member.Name + '[i]';
s := 'AWriter.AddArrayElement(Result, ' +
MakeAccessor(ConversionInfo, s, '') + ')';
TPasImplCommand(ForLoop.Body).Command := s; TPasImplCommand(ForLoop.Body).Command := s;
end; end;
@ -493,6 +513,7 @@ var
var var
Commands: TPasImplCommands; Commands: TPasImplCommands;
s: String;
begin begin
CreateBranch(Member.Name); CreateBranch(Member.Name);
Commands := TPasImplCommands.Create('', IfElse); Commands := TPasImplCommands.Create('', IfElse);
@ -508,10 +529,11 @@ var
end else end else
begin begin
// function // function
s := MethodPrefix + Member.Name +
MakeProcArgs(TPasProcedure(Member).ProcType.Args);
Commands.Commands.Add('AWriter.WriteResponse(' + Commands.Commands.Add('AWriter.WriteResponse(' +
GetConversionInfo(TPasFunctionType(TPasFunction(Member).ProcType). MakeAccessor(GetConversionInfo(TPasFunctionType(TPasFunction(Member).
ResultEl.ResultType, ProcImpl).ConverterName + '(' + MethodPrefix + ProcType).ResultEl.ResultType, ProcImpl), s, '') + ')');
Member.Name + MakeProcArgs(TPasProcedure(Member).ProcType.Args) + '))');
end; end;
end; end;
@ -554,8 +576,8 @@ var
LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse); LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse);
TPasImplCommand(LocalIfElse.IfBranch).Command := TPasImplCommand(LocalIfElse.IfBranch).Command :=
'AWriter.WriteResponse(' + 'AWriter.WriteResponse(' +
GetConversionInfo(Member, ProcImpl).ConverterName + '(' + MakeAccessor(GetConversionInfo(Member, ProcImpl),
Copy(MethodPrefix, 1, Length(MethodPrefix) - 1) + '))'; Copy(MethodPrefix, 1, Length(MethodPrefix) - 1), '') + ')';
LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse); LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse);
TPasImplCommand(LocalIfElse.ElseBranch).Command := TPasImplCommand(LocalIfElse.ElseBranch).Command :=
@ -569,8 +591,8 @@ var
LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse); LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse);
TPasImplCommand(LocalIfElse.IfBranch).Command := TPasImplCommand(LocalIfElse.IfBranch).Command :=
'AWriter.WriteResponse(' + 'AWriter.WriteResponse(' +
GetConversionInfo(Member, ProcImpl).ConverterName + '(' + MakeAccessor(GetConversionInfo(Member, ProcImpl),
MethodPrefix + Member.Name + '))'; MethodPrefix + Member.Name, '') + ')';
LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse); LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse);
TPasImplCommand(LocalIfElse.ElseBranch).Command := s + ', ' + s2 + ')'; TPasImplCommand(LocalIfElse.ElseBranch).Command := s + ', ' + s2 + ')';
end else end else
@ -586,21 +608,21 @@ var
LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse); LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse);
TPasImplCommand(LocalIfElse.IfBranch).Command := TPasImplCommand(LocalIfElse.IfBranch).Command :=
'AWriter.WriteResponse(' + 'AWriter.WriteResponse(' +
GetConversionInfo(Member, ProcImpl).ConverterName + '(' + MakeAccessor(GetConversionInfo(Member, ProcImpl),
Copy(MethodPrefix, 1, Length(MethodPrefix) - 1) + '))'; Copy(MethodPrefix, 1, Length(MethodPrefix) - 1), '') + ')';
LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse); LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse);
TPasImplCommand(LocalIfElse.ElseBranch).Command := TPasImplCommand(LocalIfElse.ElseBranch).Command :=
'AWriter.WriteResponse(' + 'AWriter.WriteResponse(' +
GetConversionInfo(Member.VarType, ProcImpl).ConverterName + '(' + MakeAccessor(GetConversionInfo(Member.VarType, ProcImpl),
MethodPrefix + Member.Name + '[AParser.GetNext' + MethodPrefix + Member.Name, 'AParser.GetNext' +
GetParseValueFnName(TPasArgument(Member.Args[0]).ArgType) + ']))'; GetParseValueFnName(TPasArgument(Member.Args[0]).ArgType)) + ')';
end else end else
begin begin
IfElse.IfBranch := TPasImplCommand.Create('', IfElse); IfElse.IfBranch := TPasImplCommand.Create('', IfElse);
TPasImplCommand(IfElse.IfBranch).Command := 'AWriter.WriteResponse(' + TPasImplCommand(IfElse.IfBranch).Command := 'AWriter.WriteResponse(' +
GetConversionInfo(Member.VarType, ProcImpl).ConverterName + '(' + MakeAccessor(GetConversionInfo(Member.VarType, ProcImpl),
MethodPrefix + Member.Name + '))'; MethodPrefix + Member.Name, '') + ')';
end; end;
end; end;
@ -834,7 +856,10 @@ end.
{ {
$Log$ $Log$
Revision 1.2 2003-06-12 19:00:53 michael Revision 1.3 2003-06-25 08:56:26 sg
* Added support for reading set properties
Revision 1.2 2003/06/12 19:00:53 michael
* Supports usage of declarations from other units (as long as mkxmlrpc * Supports usage of declarations from other units (as long as mkxmlrpc
parsed these units due to a --input=unitname command) parsed these units due to a --input=unitname command)