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

First implementation of the "WSDL to Pascal" fonctionality support in ws_helper.

Browse Source 
ws_helper now has the following parameters :
  ws_helper [-u] [-p] [-b] [-i] [-oPATH] inputFilename
    -u  Generate the pascal translation of the WSDL input file
    -p  Generate service proxy
    -b  Generate service binder
    -i  Generate service minimal implementation
    -o  PATH  Relative output directory
    -a  PATH  Absolute output directory

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@135 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2007-03-23 23:22:35 +00:00
parent 2bb98d8d9a
commit 0071bd8371
49 changed files with 10767 additions and 1133 deletions
Download Patch File Download Diff File Expand all files Collapse all files

258
wst/trunk/base_binary_formatter.pas
View File

@ -22,6 +22,7 @@ uses
const
sROOT = 'ROOT';
sSCOPE_INNER_NAME = 'INNER_VAL';
{$IFDEF wst_binary_header}
sHEADER = 'HEADER';
{$ENDIF}
@ -86,6 +87,7 @@ type
Head : PObjectBufferItem;
Last : PObjectBufferItem;
Attributes : PObjectBuffer;
InnerData : PDataBuffer;
End;
PDataBufferList = ^TDataBufferList;
@ -111,6 +113,8 @@ type
Const AName : String;
const ADataType : TDataType
):PDataBuffer;virtual;abstract;
function CreateInnerBuffer(const ADataType : TDataType):PDataBuffer;virtual;abstract;
function GetInnerBuffer():PDataBuffer;virtual;abstract;
procedure NilCurrentScope();virtual;abstract;
function IsCurrentScopeNil():Boolean;virtual;abstract;
property ScopeObject : PDataBuffer Read FScopeObject;
@ -129,6 +133,8 @@ type
Const AName : String;
const ADataType : TDataType
):PDataBuffer;override;
function CreateInnerBuffer(const ADataType : TDataType):PDataBuffer;override;
function GetInnerBuffer():PDataBuffer;override;
procedure NilCurrentScope();override;
function IsCurrentScopeNil():Boolean;override;
End;
@ -147,6 +153,8 @@ type
Const AName : String;
const ADataType : TDataType
):PDataBuffer;override;
function CreateInnerBuffer(const ADataType : TDataType):PDataBuffer;override;
function GetInnerBuffer():PDataBuffer;
procedure NilCurrentScope();override;
function IsCurrentScopeNil():Boolean;override;
End;
@ -162,6 +170,7 @@ type
FHeaderEnterCount : Integer;
{$ENDIF}
private
function GetCurrentScope: String;
function GetCurrentScopeObject():PDataBuffer;
procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle);
function GetSerializationStyle():TSerializationStyle;
@ -250,7 +259,6 @@ type
constructor Create();override;
destructor Destroy();override;
function GetCurrentScope():string;
procedure Clear();
procedure BeginObject(
@ -284,11 +292,19 @@ type
Const ATypeInfo : PTypeInfo;
Const AData
);
procedure PutScopeInnerValue(
const ATypeInfo : PTypeInfo;
const AData
);
procedure Get(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData
);
procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo;
var AData
);
procedure SaveToStream(AStream : TStream);
procedure LoadFromStream(AStream : TStream);
@ -517,16 +533,22 @@ Begin
dtEnum : ADest.WriteEnum(ARoot^.EnumData);
dtObject :
Begin
i := ARoot^.ObjectData^.Count;
ADest.WriteInt32S(i);
ADest.WriteBool(ARoot^.ObjectData^.NilObject) ;
if not ARoot^.ObjectData^.NilObject then begin
i := ARoot^.ObjectData^.Count;
ADest.WriteInt32S(i);
If ( i > 0 ) Then Begin
p := ARoot^.ObjectData^.Head;
For i := 1 To i Do Begin
SaveObjectToStream(p^.Data,ADest);
p := p^.Next;
If ( i > 0 ) Then Begin
p := ARoot^.ObjectData^.Head;
For i := 1 To i Do Begin
SaveObjectToStream(p^.Data,ADest);
p := p^.Next;
End;
End;
End;
ADest.WriteBool(Assigned(ARoot^.ObjectData^.InnerData));
if Assigned(ARoot^.ObjectData^.InnerData) then
SaveObjectToStream(ARoot^.ObjectData^.InnerData,ADest);
end;
End;
dtArray :
Begin
@ -574,11 +596,16 @@ Begin
dtEnum : Result^.EnumData := AStoreRdr.ReadEnum();
dtObject :
Begin
i := AStoreRdr.ReadInt32S();
For i := 1 To i Do Begin
AddObj(Result,LoadObjectFromStream(AStoreRdr));
End;
End;
Result^.ObjectData^.NilObject := AStoreRdr.ReadBool();
if not Result^.ObjectData^.NilObject then begin
i := AStoreRdr.ReadInt32S();
For i := 1 To i Do Begin
AddObj(Result,LoadObjectFromStream(AStoreRdr));
End;
if AStoreRdr.ReadBool() then
Result^.ObjectData^.InnerData := LoadObjectFromStream(AStoreRdr);
end;
end;
dtArray :
Begin
i := AStoreRdr.ReadInt32S();
@ -606,6 +633,10 @@ begin
q^.Data := Nil;
Freemem(q);
end;
if Assigned(ABuffer^.InnerData) then begin
ClearObj(ABuffer^.InnerData);
ABuffer^.InnerData := nil;
end;
//ABuffer^.Head := nil;
//ABuffer^.Last := nil;
Freemem(ABuffer);
@ -698,6 +729,17 @@ begin
Result := CreateObjBuffer(ADataType,AName,ScopeObject);
end;
function TObjectStackItem.CreateInnerBuffer(const ADataType: TDataType): PDataBuffer;
begin
Result := CreateObjBuffer(ADataType,sSCOPE_INNER_NAME,nil);
ScopeObject^.ObjectData^.InnerData := Result;
end;
function TObjectStackItem.GetInnerBuffer(): PDataBuffer;
begin
Result := ScopeObject^.ObjectData^.InnerData;
end;
procedure TObjectStackItem.NilCurrentScope();
begin
Assert(ScopeObject^.ObjectData^.Count = 0);
@ -706,7 +748,7 @@ end;
function TObjectStackItem.IsCurrentScopeNil(): Boolean;
begin
Result:= ScopeObject^.ObjectData^.NilObject;
Result := ScopeObject^.ObjectData^.NilObject;
end;
//----------------------------------------------------------------
@ -1040,7 +1082,6 @@ end;
procedure TBaseBinaryFormatter.Put(const AName: String; const ATypeInfo: PTypeInfo;const AData);
Var
intData : Integer;
int64Data : Int64;
strData : string;
objData : TObject;
@ -1100,6 +1141,129 @@ begin
End;
end;
procedure TBaseBinaryFormatter.PutScopeInnerValue(
const ATypeInfo : PTypeInfo;
const AData
);
var
int64SData : Int64;
int64UData : QWord;
strData : string;
boolData : Boolean;
enumData : TEnumData;
floatDt : TFloat_Extended_10;
begin
CheckScope();
case ATypeInfo^.Kind of
tkLString, tkAString :
begin
strData := string(AData);
StackTop().CreateInnerBuffer(dtString)^.StrData^.Data := strData;
end;
tkInt64 :
begin
int64SData := Int64(AData);
StackTop().CreateInnerBuffer(dtInt64S)^.Int64S := int64SData;
end;
tkQWord :
begin
int64UData := QWord(AData);
StackTop().CreateInnerBuffer(dtInt64U)^.Int64U := int64UData;
end;
tkClass :
begin
raise EBinaryFormatterException.Create('Inner Scope value must be a "simple type" value.');
end;
tkBool :
begin
boolData := Boolean(AData);
StackTop().CreateInnerBuffer(dtBool)^.BoolData := boolData;
end;
tkInteger :
begin
enumData := 0;
case GetTypeData(ATypeInfo)^.OrdType of
otSByte :
begin
enumData := ShortInt(AData);
StackTop().CreateInnerBuffer(dtInt8S)^.Int8S := enumData;
end;
otUByte :
begin
enumData := Byte(AData);
StackTop().CreateInnerBuffer(dtInt8U)^.Int8U := enumData;
end;
otSWord :
begin
enumData := SmallInt(AData);
StackTop().CreateInnerBuffer(dtInt16S)^.Int16S := enumData;
end;
otUWord :
begin
enumData := Word(AData);
StackTop().CreateInnerBuffer(dtInt16U)^.Int16U := enumData;
end;
otSLong :
begin
enumData := LongInt(AData);
StackTop().CreateInnerBuffer(dtInt32S)^.Int32S := enumData;
end;
otULong :
begin
enumData := LongWord(AData);
StackTop().CreateInnerBuffer(dtInt32U)^.Int32U := enumData;
end;
end;
end;
tkEnumeration :
begin
enumData := 0;
case GetTypeData(ATypeInfo)^.OrdType of
otSByte : enumData := ShortInt(AData);
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong : enumData := LongInt(AData);
otULong : enumData := LongWord(AData);
end;
StackTop().CreateInnerBuffer(dtEnum)^.EnumData := enumData;
end;
tkFloat :
begin
floatDt := 0;
case GetTypeData(ATypeInfo)^.FloatType of
ftSingle :
begin
floatDt := Single(AData);
StackTop().CreateInnerBuffer(dtSingle)^.SingleData := floatDt;
end;
ftDouble :
begin
floatDt := Double(AData);
StackTop().CreateInnerBuffer(dtDouble)^.DoubleData := floatDt;
end;
ftExtended :
begin
floatDt := Extended(AData);
StackTop().CreateInnerBuffer(dtExtended)^.ExtendedData := floatDt;
end;
ftCurr :
begin
floatDt := Currency(AData);
StackTop().CreateInnerBuffer(dtExtended)^.ExtendedData := floatDt;
end;
ftComp :
begin
floatDt := Comp(AData);
StackTop().CreateInnerBuffer(dtCurrency)^.CurrencyData := floatDt;
end;
else
StackTop().CreateInnerBuffer(dtExtended)^.ExtendedData := floatDt;
end;
end;
end;
end;
procedure TBaseBinaryFormatter.Get(
const ATypeInfo: PTypeInfo;
var AName: String;
@ -1169,6 +1333,58 @@ begin
End;
end;
procedure TBaseBinaryFormatter.GetScopeInnerValue(
const ATypeInfo : PTypeInfo;
var AData
);
Var
dataBuffer : PDataBuffer;
begin
CheckScope();
dataBuffer := StackTop().GetInnerBuffer();
Case ATypeInfo^.Kind Of
tkInt64 : Int64(AData) := dataBuffer^.Int64S;
tkQWord : QWord(AData) := dataBuffer^.Int64U;
tkLString,
tkAString : string(AData) := dataBuffer^.StrData^.Data;
tkClass : raise EBinaryFormatterException.Create('Inner Scope value must be a "simple type" value.');
tkBool : Boolean(AData) := dataBuffer^.BoolData;
tkInteger :
begin
case GetTypeData(ATypeInfo)^.OrdType Of
otSByte : ShortInt(AData) := dataBuffer^.Int8S;
otUByte : Byte(AData) := dataBuffer^.Int8U;
otSWord : SmallInt(AData) := dataBuffer^.Int16S;
otUWord : Word(AData) := dataBuffer^.Int16U;
otSLong : LongInt(AData) := dataBuffer^.Int32S;
otULong : LongWord(AData) := dataBuffer^.Int32U;
end;
end;
tkEnumeration :
begin
case GetTypeData(ATypeInfo)^.OrdType Of
otSByte : ShortInt(AData) := dataBuffer^.EnumData;
otUByte : Byte(AData) := dataBuffer^.EnumData;
otSWord : SmallInt(AData) := dataBuffer^.EnumData;
otUWord : Word(AData) := dataBuffer^.EnumData;
otSLong : LongInt(AData) := dataBuffer^.EnumData;
otULong : LongWord(AData) := dataBuffer^.EnumData;
end;
end;
tkFloat :
begin
case GetTypeData(ATypeInfo)^.FloatType of
ftSingle : Single(AData) := dataBuffer^.SingleData;
ftDouble : Double(AData) := dataBuffer^.DoubleData;
ftExtended : Extended(AData) := dataBuffer^.ExtendedData;
ftCurr : Currency(AData) := dataBuffer^.CurrencyData;
else
Comp(AData) := dataBuffer^.ExtendedData;
end;
end;
end;
end;
procedure TBaseBinaryFormatter.SaveToStream(AStream: TStream);
Var
locStore : IDataStore;
@ -1261,6 +1477,16 @@ begin
Inc(FIndex);
end;
function TArrayStackItem.CreateInnerBuffer(const ADataType: TDataType): PDataBuffer;
begin
raise EBinaryFormatterException.Create('Array do not support "inner value" feature.');
end;
function TArrayStackItem.GetInnerBuffer(): PDataBuffer;
begin
raise EBinaryFormatterException.Create('Array do not support "inner value" feature.');
end;
procedure TArrayStackItem.NilCurrentScope();
begin
end;

1327
wst/trunk/base_service_intf.pas
View File

File diff suppressed because it is too large Load Diff

280
wst/trunk/base_soap_formatter.pas
View File

@ -26,8 +26,8 @@ Const
sXML_NS = 'xmlns';
sXSI_NS = 'http://www.w3.org/1999/XMLSchema-instance';
sXSI_TYPE = 'xsi:type';
sXSI_NIL = 'xsi:nil';
sTYPE = 'type';
sNIL = 'nil';
sSOAP_ENC = 'http://schemas.xmlsoap.org/soap/encoding/';
sSOAP_ENC_ABR = 'SOAP-ENC';
@ -198,6 +198,10 @@ Type
):boolean;
function FindAttributeByValueInScope(Const AAttValue : String):String;
function FindAttributeByNameInScope(Const AAttName : String):String;
function GetNameSpaceShortName(
const ANameSpace : string;
const ACreateIfNotFound : Boolean
):shortstring;
protected
function GetCurrentScope():String;
function GetCurrentScopeObject():TDOMElement;
@ -254,11 +258,19 @@ Type
Const ATypeInfo : PTypeInfo;
Const AData
);
procedure PutScopeInnerValue(
const ATypeInfo : PTypeInfo;
const AData
);
procedure Get(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData
);
procedure GetScopeInnerValue(
const ATypeInfo : PTypeInfo;
var AData
);
procedure SaveToStream(AStream : TStream);
procedure LoadFromStream(AStream : TStream);
@ -529,6 +541,22 @@ begin
Result := '';
end;
function TSOAPBaseFormatter.GetNameSpaceShortName(
const ANameSpace : string;
const ACreateIfNotFound : Boolean
): shortstring;
begin
Result := FindAttributeByValueInScope(ANameSpace);
if IsStrEmpty(Result) then begin
if ACreateIfNotFound then begin
Result := 'ns' + IntToStr(NextNameSpaceCounter());
AddScopeAttribute('xmlns:'+Result, ANameSpace);
end;
end else begin
Result := Copy(Result,Length('xmlns:')+1,MaxInt);
end;
end;
procedure TSOAPBaseFormatter.CheckScope();
begin
If Not HasScope() Then
@ -570,26 +598,29 @@ begin
Result := FDoc.CreateElement(strNodeName);
Result.AppendChild(FDoc.CreateTextNode(AData));
GetCurrentScopeObject().AppendChild(Result);
If ( EncodingStyle = Encoded ) Then Begin
regItem := GetTypeRegistry().ItemByTypeInfo[ATypeInfo];
strName := regItem.DeclaredName;
namespaceLongName := regItem.NameSpace;
If Not IsStrEmpty(namespaceLongName) Then Begin
namespaceShortName := FindAttributeByValueInScope(namespaceLongName);
If IsStrEmpty(namespaceShortName) Then Begin
namespaceShortName := Format('ns%d',[NextNameSpaceCounter()]);
AddScopeAttribute(sXML_NS + ':'+namespaceShortName,namespaceLongName);
End Else Begin
namespaceShortName := ExtractNameSpaceShortName(namespaceShortName);//Copy(namespaceShortName,AnsiPos(':',namespaceShortName) + 1,MaxInt);
End;
strName := Format('%s:%s',[namespaceShortName,strName])
End;
namespaceShortName := GetNameSpaceShortName(sXSI_NS,True);
if not IsStrEmpty(namespaceShortName) then
namespaceShortName := namespaceShortName + ':';
(Result As TDOMElement).SetAttribute(namespaceShortName + sTYPE,strName);
End;
end else begin
Result := GetCurrentScopeObject();
(Result as TDOMElement).SetAttribute(strNodeName,AData);
end;
If ( EncodingStyle = Encoded ) Then Begin
regItem := GetTypeRegistry().ItemByTypeInfo[ATypeInfo];
strName := regItem.DeclaredName;
namespaceLongName := regItem.NameSpace;
If Not IsStrEmpty(namespaceLongName) Then Begin
namespaceShortName := FindAttributeByValueInScope(namespaceLongName);
If IsStrEmpty(namespaceShortName) Then Begin
namespaceShortName := Format('ns%d',[NextNameSpaceCounter()]);
AddScopeAttribute(sXML_NS + ':'+namespaceShortName,namespaceLongName);
End Else Begin
namespaceShortName := ExtractNameSpaceShortName(namespaceShortName);//Copy(namespaceShortName,AnsiPos(':',namespaceShortName) + 1,MaxInt);
End;
strName := Format('%s:%s',[namespaceShortName,strName])
End;
(Result As TDOMElement).SetAttribute(sXSI_TYPE,strName);
End;
end;
function TSOAPBaseFormatter.PutEnum(
@ -598,7 +629,11 @@ function TSOAPBaseFormatter.PutEnum(
const AData: TEnumIntType
): TDOMNode;
begin
Result := InternalPutData(AName,ATypeInfo,GetEnumName(ATypeInfo,AData));
Result := InternalPutData(
AName,
ATypeInfo,
GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,AData))
);
end;
function TSOAPBaseFormatter.PutBool(
@ -688,7 +723,7 @@ begin
else
Result := locElt.NodeValue;
end else begin
Error('Param not found : "%s"',[AName]);
Error('Param or Attribute not found : "%s"',[AName]);
end;
//WriteLn(StringOfChar(' ',FStack.Count), AName,' = ',Result);
end;
@ -824,7 +859,7 @@ procedure TSOAPBaseFormatter.BeginObject(
);
Var
typData : TTypeRegistryItem;
nmspc,nmspcSH : string;
nmspc,nmspcSH, xsiNmspcSH : string;
mustAddAtt : Boolean;
strNodeName : string;
begin
@ -858,8 +893,12 @@ begin
BeginScope(strNodeName,'');
If mustAddAtt Then
AddScopeAttribute('xmlns:'+nmspcSH, nmspc);
if ( EncodingStyle = Encoded ) then
AddScopeAttribute(sXSI_TYPE,Format('%s:%s',[nmspcSH,typData.DeclaredName]));
if ( EncodingStyle = Encoded ) then begin
xsiNmspcSH := GetNameSpaceShortName(sXSI_NS,True);
if not IsStrEmpty(xsiNmspcSH) then
xsiNmspcSH := xsiNmspcSH + ':';
AddScopeAttribute(xsiNmspcSH + sTYPE,Format('%s:%s',[nmspcSH,typData.DeclaredName]));
end;
StackTop().SetNameSpace(nmspc);
end;
@ -916,27 +955,39 @@ begin
end;
procedure TSOAPBaseFormatter.NilCurrentScope();
var
nmspcSH : shortstring;
begin
CheckScope();
GetCurrentScopeObject().SetAttribute(sXSI_NIL,'true');
nmspcSH := FindAttributeByValueInScope(sXSI_NS);
if IsStrEmpty(nmspcSH) then begin
nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter());
AddScopeAttribute('xmlns:'+nmspcSH, sXSI_NS);
end else begin
nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt);
end;
GetCurrentScopeObject().SetAttribute(nmspcSH + ':' + sNIL,'true');
end;
function TSOAPBaseFormatter.IsCurrentScopeNil(): Boolean;
Var
s,nsShortName,nilName : string;
s,nsShortName,nilName : shortstring;
begin
CheckScope();
nsShortName := FindAttributeByValueInScope(sXSI_NS);
Result := False;
if not IsStrEmpty(nsShortName) then begin
if IsStrEmpty(nsShortName) then begin
nilName := 'nil';
end else begin
nsShortName := Copy(nsShortName,1 + Pos(':',nsShortName),MaxInt);
if not IsStrEmpty(nsShortName) Then
nsShortName := nsShortName + ':';
nilName := nsShortName + 'nil';
s := Trim(GetCurrentScopeObject().GetAttribute(nilName));
if ( Length(s) > 0 ) and ( AnsiSameText(s,'true') or AnsiSameText(s,'"true"') ) then
Result := True;
end
end;
s := Trim(GetCurrentScopeObject().GetAttribute(nilName));
if ( Length(s) > 0 ) and ( AnsiSameText(s,'true') or AnsiSameText(s,'"true"') ) then begin
Result := True;
end;
end;
procedure TSOAPBaseFormatter.BeginScope(
@ -1182,6 +1233,113 @@ begin
End;
end;
procedure TSOAPBaseFormatter.PutScopeInnerValue(
const ATypeInfo : PTypeInfo;
const AData
);
Var
int64SData : Int64;
int64UData : QWord;
strData : string;
objData : TObject;
boolData : Boolean;
enumData : TEnumIntType;
floatDt : Extended;
dataBuffer : string;
frmt : string;
prcsn,i : Integer;
begin
CheckScope();
Case ATypeInfo^.Kind Of
tkInt64 :
begin
int64SData := Int64(AData);
dataBuffer := IntToStr(int64SData);
end;
tkQWord :
begin
int64UData := QWord(AData);
dataBuffer := IntToStr(int64UData);
end;
tkLString, tkAString :
begin
strData := string(AData);
dataBuffer := strData;
end;
tkClass :
begin
raise ESOAPException.Create('Inner Scope value must be a "simple type" value.');
end;
tkBool :
begin
boolData := Boolean(AData);
dataBuffer := BoolToStr(boolData);
end;
tkInteger :
begin
case GetTypeData(ATypeInfo)^.OrdType of
otSByte : enumData := ShortInt(AData);
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
end;
dataBuffer := IntToStr(enumData);
end;
tkEnumeration :
begin
enumData := 0;
case GetTypeData(ATypeInfo)^.OrdType of
otSByte : enumData := ShortInt(AData);
otUByte : enumData := Byte(AData);
otSWord : enumData := SmallInt(AData);
otUWord : enumData := Word(AData);
otSLong,
otULong : enumData := LongInt(AData);
end;
dataBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetExternalPropertyName(GetEnumName(ATypeInfo,enumData))
end;
tkFloat :
begin
floatDt := 0;
case GetTypeData(ATypeInfo)^.FloatType of
ftSingle :
begin
floatDt := Single(AData);
prcsn := 7;
end;
ftDouble :
begin
floatDt := Double(AData);
prcsn := 15;
end;
ftExtended :
begin
floatDt := Extended(AData);
prcsn := 15;
end;
ftCurr :
begin
floatDt := Currency(AData);
prcsn := 7;
end;
ftComp :
begin
floatDt := Comp(AData);
prcsn := 7;
end;
end;
frmt := '#.' + StringOfChar('#',prcsn) + 'E-0';
dataBuffer := FormatFloat(frmt,floatDt);
i := Pos(',',dataBuffer);
if ( i > 0 ) then
dataBuffer[i] := '.';
end;
end;
StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer));
end;
procedure TSOAPBaseFormatter.Get(
const ATypeInfo : PTypeInfo;
var AName : String;
@ -1251,6 +1409,68 @@ begin
End;
end;
procedure TSOAPBaseFormatter.GetScopeInnerValue(
const ATypeInfo : PTypeInfo;
var AData
);
Var
enumData : TEnumIntType;
floatDt : Extended;
dataBuffer : string;
nd : TDOMNode;
begin
CheckScope();
nd := StackTop().ScopeObject;
if nd.HasChildNodes() then
dataBuffer := nd.FirstChild.NodeValue
else
dataBuffer := StackTop().ScopeObject.NodeValue;
Case ATypeInfo^.Kind Of
tkInt64 : Int64(AData) := StrToInt64Def(Trim(dataBuffer),0);
tkQWord : QWord(AData) := StrToInt64Def(Trim(dataBuffer),0);
tkLString,
tkAString : string(AData) := dataBuffer;
tkClass :
begin
raise ESOAPException.Create('Inner Scope value must be a "simple type" value.');
end;
tkBool :
begin
dataBuffer := LowerCase(Trim(dataBuffer));
if IsStrEmpty(dataBuffer) then
Boolean(AData) := False
else
Boolean(AData) := StrToBool(dataBuffer);
end;
tkInteger, tkEnumeration :
begin
if ( ATypeInfo^.Kind = tkInteger ) then
enumData := StrToIntDef(Trim(dataBuffer),0)
else
enumData := GetEnumValue(ATypeInfo,GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(dataBuffer));
case GetTypeData(ATypeInfo)^.OrdType of
otSByte : ShortInt(AData) := enumData;
otUByte : Byte(AData) := enumData;
otSWord : SmallInt(AData) := enumData;
otUWord : Word(AData) := enumData;
otSLong,
otULong : LongInt(AData) := enumData;
end;
end;
tkFloat :
begin
floatDt := StrToFloatDef(Trim(dataBuffer),0);
case GetTypeData(ATypeInfo)^.FloatType of
ftSingle : Single(AData) := floatDt;
ftDouble : Double(AData) := floatDt;
ftExtended : Extended(AData) := floatDt;
ftCurr : Currency(AData) := floatDt;
ftComp : Comp(AData) := floatDt;
end;
end;
end;
end;
procedure TSOAPBaseFormatter.SaveToStream(AStream: TStream);
begin
WriteXMLFile(FDoc,AStream);

BIN
wst/trunk/doc/WebServiceToolKit.odt
View File

Binary file not shown.

6
wst/trunk/metadata_wsdl.pas
View File

@ -670,7 +670,11 @@ begin
c := GetEnumNameCount(typItm.DataType);
for i := 0 to pred(c) do begin
s := Format('%s:%s',[sXSD,sENUMERATION]);
CreateElement(s,restrictNode,AWsdlDocument).SetAttribute(sVALUE,GetEnumName(typItm.DataType,i));
//CreateElement(s,restrictNode,AWsdlDocument).SetAttribute(sVALUE,GetEnumName(typItm.DataType,i));
CreateElement(s,restrictNode,AWsdlDocument).SetAttribute(
sVALUE,
typItm.GetExternalPropertyName(GetEnumName(typItm.DataType,i))
);
end;
end;
end;

109
wst/trunk/tests/calculator/gui_client/test_calc.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="1"/>
<ActiveEditorIndexAtStart Value="3"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -26,14 +26,14 @@
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="40">
<Units Count="41">
<Unit0>
<Filename Value="test_calc.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_calc"/>
<CursorPos X="66" Y="10"/>
<TopLine Value="1"/>
<UsageCount Value="80"/>
<UsageCount Value="82"/>
</Unit0>
<Unit1>
<Filename Value="main_unit.pas"/>
@ -41,10 +41,10 @@
<IsPartOfProject Value="True"/>
<ResourceFilename Value="main_unit.lrs"/>
<UnitName Value="main_unit"/>
<CursorPos X="28" Y="9"/>
<TopLine Value="1"/>
<CursorPos X="40" Y="42"/>
<TopLine Value="25"/>
<EditorIndex Value="0"/>
<UsageCount Value="80"/>
<UsageCount Value="82"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
@ -53,16 +53,16 @@
<UnitName Value="calculator"/>
<CursorPos X="30" Y="16"/>
<TopLine Value="8"/>
<UsageCount Value="80"/>
<UsageCount Value="82"/>
</Unit2>
<Unit3>
<Filename Value="calculator_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calculator_proxy"/>
<CursorPos X="20" Y="39"/>
<TopLine Value="37"/>
<EditorIndex Value="1"/>
<UsageCount Value="80"/>
<TopLine Value="25"/>
<EditorIndex Value="4"/>
<UsageCount Value="82"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -158,9 +158,11 @@
<Unit17>
<Filename Value="..\..\..\soap_formatter.pas"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="42" Y="171"/>
<TopLine Value="157"/>
<UsageCount Value="32"/>
<CursorPos X="24" Y="125"/>
<TopLine Value="172"/>
<EditorIndex Value="1"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
<Filename Value="..\..\..\service_intf.pas"/>
@ -179,9 +181,11 @@
<Unit20>
<Filename Value="..\..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="454"/>
<UsageCount Value="31"/>
<CursorPos X="3" Y="466"/>
<TopLine Value="458"/>
<EditorIndex Value="2"/>
<UsageCount Value="32"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="..\..\..\base_service_intf.pas"/>
@ -311,20 +315,81 @@
<TopLine Value="115"/>
<UsageCount Value="10"/>
</Unit39>
<Unit40>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="32" Y="210"/>
<TopLine Value="356"/>
<EditorIndex Value="3"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit40>
</Units>
<JumpHistory Count="3" HistoryIndex="2">
<JumpHistory Count="16" HistoryIndex="15">
<Position1>
<Filename Value="main_unit.pas"/>
<Caret Line="9" Column="28" TopLine="1"/>
<Caret Line="42" Column="40" TopLine="25"/>
</Position1>
<Position2>
<Filename Value="calculator_proxy.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="..\..\..\soap_formatter.pas"/>
<Caret Line="20" Column="33" TopLine="4"/>
</Position2>
<Position3>
<Filename Value="calculator_proxy.pas"/>
<Caret Line="39" Column="20" TopLine="37"/>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="63" Column="20" TopLine="49"/>
</Position4>
<Position5>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="78" Column="5" TopLine="64"/>
</Position5>
<Position6>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="84" Column="51" TopLine="70"/>
</Position6>
<Position7>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="88" Column="98" TopLine="74"/>
</Position7>
<Position8>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="106" Column="44" TopLine="92"/>
</Position8>
<Position9>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="112" Column="28" TopLine="98"/>
</Position9>
<Position10>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="117" Column="9" TopLine="103"/>
</Position10>
<Position11>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="179" Column="28" TopLine="151"/>
</Position11>
<Position12>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="193" Column="9" TopLine="177"/>
</Position12>
<Position13>
<Filename Value="..\..\..\soap_formatter.pas"/>
<Caret Line="21" Column="53" TopLine="4"/>
</Position13>
<Position14>
<Filename Value="..\..\..\soap_formatter.pas"/>
<Caret Line="125" Column="24" TopLine="115"/>
</Position14>
<Position15>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="1266" Column="20" TopLine="1264"/>
</Position15>
<Position16>
<Filename Value="..\..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<Caret Line="975" Column="24" TopLine="962"/>
</Position16>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>

15
wst/trunk/tests/ebay/test_ebay.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
<ActiveEditorIndexAtStart Value="2"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -37,7 +37,7 @@
<IsPartOfProject Value="True"/>
<UnitName Value="ebay"/>
<CursorPos X="10" Y="525"/>
<TopLine Value="519"/>
<TopLine Value="5"/>
<EditorIndex Value="2"/>
<UsageCount Value="45"/>
<Loaded Value="True"/>
@ -200,16 +200,7 @@
<UsageCount Value="10"/>
</Unit22>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="test_ebay.lpr"/>
<Caret Line="55" Column="65" TopLine="46"/>
</Position1>
<Position2>
<Filename Value="test_ebay.lpr"/>
<Caret Line="24" Column="29" TopLine="19"/>
</Position2>
</JumpHistory>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>

255
wst/trunk/tests/ebay/test_ebay_gui.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="2"/>
<ActiveEditorIndexAtStart Value="4"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -26,14 +26,14 @@
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="23">
<Units Count="30">
<Unit0>
<Filename Value="test_ebay_gui.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_ebay_gui"/>
<CursorPos X="1" Y="17"/>
<TopLine Value="1"/>
<UsageCount Value="63"/>
<UsageCount Value="101"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
@ -41,20 +41,20 @@
<IsPartOfProject Value="True"/>
<ResourceFilename Value="umain.lrs"/>
<UnitName Value="umain"/>
<CursorPos X="39" Y="144"/>
<TopLine Value="137"/>
<EditorIndex Value="1"/>
<UsageCount Value="63"/>
<CursorPos X="44" Y="9"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="101"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\synapse_http_protocol.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="synapse_http_protocol"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="153"/>
<EditorIndex Value="0"/>
<UsageCount Value="63"/>
<CursorPos X="42" Y="22"/>
<TopLine Value="8"/>
<EditorIndex Value="1"/>
<UsageCount Value="101"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
@ -63,7 +63,7 @@
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="30"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -71,63 +71,63 @@
<UnitName Value="service_intf"/>
<CursorPos X="23" Y="333"/>
<TopLine Value="320"/>
<UsageCount Value="31"/>
<UsageCount Value="27"/>
</Unit4>
<Unit5>
<Filename Value="..\..\soap_formatter.pas"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="60" Y="159"/>
<TopLine Value="149"/>
<UsageCount Value="24"/>
<UsageCount Value="20"/>
</Unit5>
<Unit6>
<Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/>
<CursorPos X="3" Y="119"/>
<TopLine Value="109"/>
<UsageCount Value="17"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="13"/>
</Unit6>
<Unit7>
<Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="33" Y="86"/>
<TopLine Value="76"/>
<UsageCount Value="26"/>
<CursorPos X="28" Y="377"/>
<TopLine Value="371"/>
<EditorIndex Value="2"/>
<UsageCount Value="43"/>
<Bookmarks Count="2">
<Item0 X="14" Y="670" ID="1"/>
<Item1 X="1" Y="437" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="D:\lazarusClean\others_package\synapse\httpsend.pas"/>
<UnitName Value="httpsend"/>
<CursorPos X="40" Y="123"/>
<TopLine Value="122"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit8>
<Unit9>
<Filename Value="ebay.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ebay"/>
<CursorPos X="42" Y="535"/>
<TopLine Value="534"/>
<EditorIndex Value="3"/>
<UsageCount Value="47"/>
<Loaded Value="True"/>
<TopLine Value="139"/>
<UsageCount Value="85"/>
</Unit9>
<Unit10>
<Filename Value="..\..\metadata_service.pas"/>
<UnitName Value="metadata_service"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="43"/>
<UsageCount Value="8"/>
<UsageCount Value="4"/>
</Unit10>
<Unit11>
<Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="46" Y="84"/>
<TopLine Value="84"/>
<UsageCount Value="17"/>
<UsageCount Value="13"/>
<Bookmarks Count="1">
<Item0 X="1" Y="91" ID="3"/>
</Bookmarks>
@ -136,83 +136,252 @@
<Filename Value="ebay_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ebay_proxy"/>
<CursorPos X="26" Y="96"/>
<TopLine Value="70"/>
<EditorIndex Value="2"/>
<UsageCount Value="47"/>
<CursorPos X="19" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="85"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\heaph.inc"/>
<CursorPos X="10" Y="94"/>
<TopLine Value="82"/>
<UsageCount Value="8"/>
<UsageCount Value="4"/>
</Unit13>
<Unit14>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\heap.inc"/>
<CursorPos X="3" Y="342"/>
<TopLine Value="346"/>
<UsageCount Value="8"/>
<UsageCount Value="4"/>
</Unit14>
<Unit15>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="94"/>
<UsageCount Value="9"/>
<UsageCount Value="5"/>
</Unit15>
<Unit16>
<Filename Value="ebay.lrs"/>
<CursorPos X="20" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
<UsageCount Value="5"/>
</Unit16>
<Unit17>
<Filename Value="D:\lazarusClean\lcl\lresources.pp"/>
<UnitName Value="LResources"/>
<CursorPos X="3" Y="930"/>
<TopLine Value="907"/>
<UsageCount Value="9"/>
<UsageCount Value="5"/>
</Unit17>
<Unit18>
<Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpash.inc"/>
<CursorPos X="20" Y="169"/>
<TopLine Value="157"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit18>
<Unit19>
<Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpas.inc"/>
<CursorPos X="28" Y="446"/>
<TopLine Value="428"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit19>
<Unit20>
<Filename Value="D:\Lazarus\fpcsrc\fcl\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="23" Y="520"/>
<TopLine Value="517"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit20>
<Unit21>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="15" Y="204"/>
<TopLine Value="192"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit21>
<Unit22>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\lists.inc"/>
<CursorPos X="3" Y="417"/>
<TopLine Value="412"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit22>
<Unit23>
<Filename Value="..\..\wsdl_to_pascal\tmp_intf.pas"/>
<UnitName Value="tmp_intf"/>
<CursorPos X="34" Y="10344"/>
<TopLine Value="10333"/>
<UsageCount Value="20"/>
</Unit23>
<Unit24>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="14" Y="222"/>
<TopLine Value="210"/>
<UsageCount Value="7"/>
</Unit24>
<Unit25>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\win32\classes.pp"/>
<UnitName Value="Classes"/>
<CursorPos X="12" Y="32"/>
<TopLine Value="15"/>
<UsageCount Value="7"/>
</Unit25>
<Unit26>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="15" Y="1153"/>
<TopLine Value="1136"/>
<UsageCount Value="7"/>
</Unit26>
<Unit27>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\parser.inc"/>
<CursorPos X="34" Y="59"/>
<TopLine Value="51"/>
<UsageCount Value="7"/>
</Unit27>
<Unit28>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
<CursorPos X="8" Y="116"/>
<TopLine Value="102"/>
<UsageCount Value="8"/>
</Unit28>
<Unit29>
<Filename Value="..\..\binary_streamer.pas"/>
<UnitName Value="binary_streamer"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="55"/>
<EditorIndex Value="5"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit29>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1617" Column="1" TopLine="1595"/>
</Position1>
<Position2>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1056" Column="41" TopLine="1042"/>
</Position3>
<Position4>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1609" Column="64" TopLine="1595"/>
</Position4>
<Position5>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3060" Column="42" TopLine="3036"/>
</Position5>
<Position6>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position6>
<Position7>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1626" Column="48" TopLine="1605"/>
</Position7>
<Position8>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3068" Column="41" TopLine="3046"/>
</Position8>
<Position9>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position9>
<Position10>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1646" Column="1" TopLine="1629"/>
</Position10>
<Position11>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position11>
<Position12>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1629" Column="57" TopLine="1615"/>
</Position12>
<Position13>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="300" Column="1" TopLine="285"/>
</Position13>
<Position14>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1605" Column="1" TopLine="1602"/>
</Position14>
<Position15>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3012" Column="42" TopLine="2998"/>
</Position15>
<Position16>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1166" Column="41" TopLine="1152"/>
</Position16>
<Position17>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1237" Column="38" TopLine="1237"/>
</Position17>
<Position18>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1166" Column="71" TopLine="1166"/>
</Position18>
<Position19>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1237" Column="113" TopLine="1237"/>
</Position19>
<Position20>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1241" Column="12" TopLine="1227"/>
</Position20>
<Position21>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1165" Column="80" TopLine="1147"/>
</Position21>
<Position22>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1161" Column="74" TopLine="1151"/>
</Position22>
<Position23>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1165" Column="14" TopLine="1147"/>
</Position23>
<Position24>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1225" Column="34" TopLine="1211"/>
</Position24>
<Position25>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1148" Column="59" TopLine="1125"/>
</Position25>
<Position26>
<Filename Value="..\..\binary_streamer.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position26>
<Position27>
<Filename Value="umain.pas"/>
<Caret Line="43" Column="9" TopLine="29"/>
</Position27>
<Position28>
<Filename Value="..\..\synapse_http_protocol.pas"/>
<Caret Line="1" Column="1" TopLine="139"/>
</Position28>
<Position29>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1285" Column="27" TopLine="1294"/>
</Position29>
<Position30>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3663" Column="24" TopLine="3652"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="D:\lazarus\others_package\synapse\;..\..\"/>
<OtherUnitFiles Value="C:\lazarusClean\others_package\synapse\;C:\Programmes\lazarus\wst\wsdl_to_pascal\;..\..\"/>
<UnitOutputDirectory Value="obj"/>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
</SearchPaths>

18
wst/trunk/tests/ebay/umain.lfm
View File

@ -15,36 +15,36 @@ object Form1: TForm1
TabOrder = 0
object Label1: TLabel
Left = 16
Height = 14
Height = 18
Top = 53
Width = 77
Width = 98
Caption = 'eBayAuthToken'
Color = clNone
ParentColor = False
end
object Label2: TLabel
Left = 16
Height = 14
Height = 18
Top = 79
Width = 30
Width = 37
Caption = 'AppId'
Color = clNone
ParentColor = False
end
object Label3: TLabel
Left = 16
Height = 14
Height = 18
Top = 111
Width = 30
Width = 38
Caption = 'DevId'
Color = clNone
ParentColor = False
end
object Label4: TLabel
Left = 16
Height = 14
Height = 18
Top = 144
Width = 45
Width = 56
Caption = 'AuthCert'
Color = clNone
ParentColor = False
@ -115,7 +115,7 @@ object Form1: TForm1
Top = 184
Width = 400
Align = alClient
DefaultItemHeight = 15
DefaultItemHeight = 19
TabOrder = 1
end
end

18
wst/trunk/tests/ebay/umain.lrs
View File

@ -1,15 +1,17 @@
{ Ceci est un fichier ressource g�n�r� automatiquement par Lazarus }
LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'-'#1#6'Height'#3#132#1#3'Top'#3#159#0#5'W'
+'idth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3#131#1
+#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#8'OnCreate'#7#10'FormC'
+'reate'#0#6'TPanel'#6'Panel1'#6'Height'#3#184#0#5'Width'#3#144#1#5'Align'#7#5
+'alTop'#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3
+'Top'#2'5'#5'Width'#2'M'#7'Caption'#6#13'eBayAuthToken'#5'Color'#7#6'clNone'
+#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#16#6'Height'#2#14#3'Top'
+#2'O'#5'Width'#2#30#7'Caption'#6#5'AppId'#5'Color'#7#6'clNone'#11'ParentColo'
+'r'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#16#6'Height'#2#14#3'Top'#2'o'#5'Widt'
+'h'#2#30#7'Caption'#6#5'DevId'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6
+'TLabel'#6'Label4'#4'Left'#2#16#6'Height'#2#14#3'Top'#3#144#0#5'Width'#2'-'#7
+'alTop'#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#18#3
+'Top'#2'5'#5'Width'#2'b'#7'Caption'#6#13'eBayAuthToken'#5'Color'#7#6'clNone'
+#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#16#6'Height'#2#18#3'Top'
+#2'O'#5'Width'#2'%'#7'Caption'#6#5'AppId'#5'Color'#7#6'clNone'#11'ParentColo'
+'r'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#16#6'Height'#2#18#3'Top'#2'o'#5'Widt'
+'h'#2'&'#7'Caption'#6#5'DevId'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6
+'TLabel'#6'Label4'#4'Left'#2#16#6'Height'#2#18#3'Top'#3#144#0#5'Width'#2'8'#7
+'Caption'#6#8'AuthCert'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TBevel'
+#6'Bevel1'#4'Left'#2#10#6'Height'#3#170#0#3'Top'#2#4#5'Width'#3'|'#1#7'Ancho'
+'rs'#11#5'akTop'#6'akLeft'#7'akRight'#0#0#0#7'TButton'#7'Button1'#4'Left'#3
@ -27,5 +29,5 @@ LazarusResources.Add('TForm1','FORMDATA',[
+'eft'#2'`'#6'Height'#2#23#3'Top'#3#136#0#5'Width'#3' '#1#7'Anchors'#11#5'akT'
+'op'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#5#0#0#0#9'TTreeView'#6'trvOut'#6'H'
+'eight'#3#204#0#3'Top'#3#184#0#5'Width'#3#144#1#5'Align'#7#8'alClient'#17'De'
+'faultItemHeight'#2#15#8'TabOrder'#2#1#0#0#0
+'faultItemHeight'#2#19#8'TabOrder'#2#1#0#0#0
]);

5
wst/trunk/tests/ebay/umain.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons, StdCtrls, ComCtrls;
Buttons, StdCtrls, ComCtrls, eBaySvc_intf;
type
@ -40,7 +40,8 @@ var
implementation
uses TypInfo, StrUtils,
httpsend, ssl_openssl,
httpsend,
ssl_openssl,
service_intf, soap_formatter, base_service_intf, base_soap_formatter,
ebay, ebay_proxy,
synapse_http_protocol;

147
wst/trunk/tests/files/CALCULATOR.wsdl Normal file
View File

@ -0,0 +1,147 @@
<?xml version="1.0"?>
<definitions name="calculator" targetNamespace="urn:CALCULATOR" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="urn:CALCULATOR" xmlns="http://schemas.xmlsoap.org/wsdl/">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:CALCULATOR">
<xsd:simpleType name="TCalc_Op">
<xsd:restriction base="xsd:string">
<xsd:enumeration value="coAdd"/>
<xsd:enumeration value="coSub"/>
<xsd:enumeration value="coMul"/>
<xsd:enumeration value="coDiv"/>
</xsd:restriction>
</xsd:simpleType>
<xsd:element name="TBinaryArgsResult">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="Arg_A" type="xsd:int" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Arg_B" type="xsd:int" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Arg_R" type="xsd:int" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Arg_OP" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Arg_OpEnum" type="tns:TCalc_Op" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Comment" type="xsd:string" minOccurs="0" maxOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TBinaryArgsResultArray">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="tns:TBinaryArgsResult" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="CalcHeader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="Login" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Password" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="WantedPrecision" type="xsd:int" minOccurs="1" maxOccurs="1"/>
</xsd:sequence>
<xsd:attribute name="mustUnderstand" type="xsd:int" attribute="optional"/>
</xsd:complexType>
</xsd:element>
<xsd:element name="CalcResultHeader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="Login" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Password" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="WantedPrecision" type="xsd:int" minOccurs="1" maxOccurs="1"/>
<xsd:element name="TimeStamp" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="SessionID" type="xsd:string" minOccurs="1" maxOccurs="1"/>
</xsd:sequence>
<xsd:attribute name="mustUnderstand" type="xsd:int" attribute="optional"/>
</xsd:complexType>
</xsd:element>
</xsd:schema>
</types>
<message name="AddInt">
<part name="A" type="xsd:int"/>
<part name="B" type="xsd:int"/>
</message>
<message name="AddIntResponse">
<part name="result" type="tns:TBinaryArgsResult"/>
</message>
<message name="DivInt">
<part name="A" type="xsd:int"/>
<part name="B" type="xsd:int"/>
</message>
<message name="DivIntResponse">
<part name="result" type="xsd:int"/>
</message>
<message name="DoAllOperations">
<part name="A" type="xsd:int"/>
<part name="B" type="xsd:int"/>
</message>
<message name="DoAllOperationsResponse">
<part name="result" type="tns:TBinaryArgsResultArray"/>
</message>
<message name="DoOperation">
<part name="A" type="xsd:int"/>
<part name="B" type="xsd:int"/>
<part name="AOperation" type="tns:TCalc_Op"/>
</message>
<message name="DoOperationResponse">
<part name="result" type="tns:TBinaryArgsResult"/>
</message>
<portType name="ICalculator">
<operation name="AddInt">
<input message="tns:AddInt"/>
<output message="tns:AddIntResponse"/>
</operation>
<operation name="DivInt">
<input message="tns:DivInt"/>
<output message="tns:DivIntResponse"/>
</operation>
<operation name="DoAllOperations">
<input message="tns:DoAllOperations"/>
<output message="tns:DoAllOperationsResponse"/>
</operation>
<operation name="DoOperation">
<input message="tns:DoOperation"/>
<output message="tns:DoOperationResponse"/>
</operation>
</portType>
<binding name="ICalculatorBinding" type="tns:ICalculator">
<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="urn:CALCULATOR/ICalculatorAddInt"/>
<operation name="AddInt">
<input>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
<soap:operation soapAction="urn:CALCULATOR/ICalculatorDivInt"/>
<operation name="DivInt">
<input>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
<soap:operation soapAction="urn:CALCULATOR/ICalculatorDoAllOperations"/>
<operation name="DoAllOperations">
<input>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
<soap:operation soapAction="urn:CALCULATOR/ICalculatorDoOperation"/>
<operation name="DoOperation">
<input>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded" namespace="urn:CALCULATOR" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
</binding>
<service name="ICalculator">
<port name="ICalculatorPort" binding="tns:ICalculatorBinding">
<soap:address location="http://127.0.0.1:8000/services/ICalculator"/>
</port>
</service>
</definitions>

214
wst/trunk/tests/files/metadata_service.wsdl Normal file
View File

@ -0,0 +1,214 @@
<?xml version="1.0"?>
<definitions name="metadata_service" targetNamespace="urn:wst_base" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="urn:wst_base" xmlns="http://schemas.xmlsoap.org/wsdl/">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst_base">
<xsd:simpleType name="TOperationParamFlag">
<xsd:restriction base="xsd:string">
<xsd:enumeration value="opfNone"/>
<xsd:enumeration value="opfIn"/>
<xsd:enumeration value="opfVar"/>
<xsd:enumeration value="opfOut"/>
</xsd:restriction>
</xsd:simpleType>
<xsd:element name="TWSTMtdOperationParam">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="Name" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="TypeName" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Modifier" type="tns:TOperationParamFlag" minOccurs="1" maxOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TWSTMtdOperationParamArray">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="tns:TWSTMtdOperationParam" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TWSTMtdServiceOperation">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="Name" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Params" type="tns:TWSTMtdOperationParamArray" minOccurs="1" maxOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TWSTMtdServiceOperationArray">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="tns:TWSTMtdServiceOperation" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TWSTMtdService">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="Name" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Operations" type="tns:TWSTMtdServiceOperationArray" minOccurs="1" maxOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TWSTMtdServiceArray">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="tns:TWSTMtdService" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TWSTMtdRepository">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="Name" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="NameSpace" type="xsd:string" minOccurs="1" maxOccurs="1"/>
<xsd:element name="Services" type="tns:TWSTMtdServiceArray" minOccurs="1" maxOccurs="1"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfStringRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:string" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfBooleanRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:boolean" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt8URemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:unsignedByte" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt8SRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:byte" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt16URemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:unsignedShort" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt16SRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:short" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt32URemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:unsignedInt" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt32SRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:int" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt64URemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:int" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfInt64SRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:long" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfFloatSingleRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:float" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfFloatDoubleRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:double" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfFloatExtendedRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:double" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
<xsd:element name="TArrayOfFloatCurrencyRemotable">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="item" type="xsd:float" minOccurs="0" maxOccurs="unbounded"/>
</xsd:sequence>
</xsd:complexType>
</xsd:element>
</xsd:schema>
</types>
<message name="GetRepositoryList"/>
<message name="GetRepositoryListResponse">
<part name="result" type="tns:TArrayOfStringRemotable"/>
</message>
<message name="GetRepositoryInfo">
<part name="AName" type="xsd:string"/>
</message>
<message name="GetRepositoryInfoResponse">
<part name="result" type="tns:TWSTMtdRepository"/>
</message>
<portType name="IWSTMetadataService">
<operation name="GetRepositoryList">
<input message="tns:GetRepositoryList"/>
<output message="tns:GetRepositoryListResponse"/>
</operation>
<operation name="GetRepositoryInfo">
<input message="tns:GetRepositoryInfo"/>
<output message="tns:GetRepositoryInfoResponse"/>
</operation>
</portType>
<binding name="IWSTMetadataServiceBinding" type="tns:IWSTMetadataService">
<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
<soap:operation soapAction="urn:wst_base/IWSTMetadataServiceGetRepositoryList"/>
<operation name="GetRepositoryList">
<input>
<soap:body use="encoded" namespace="urn:wst_base" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded" namespace="urn:wst_base" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
<soap:operation soapAction="urn:wst_base/IWSTMetadataServiceGetRepositoryInfo"/>
<operation name="GetRepositoryInfo">
<input>
<soap:body use="encoded" namespace="urn:wst_base" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</input>
<output>
<soap:body use="encoded" namespace="urn:wst_base" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
</output>
</operation>
</binding>
<service name="IWSTMetadataService">
<port name="IWSTMetadataServicePort" binding="tns:IWSTMetadataServiceBinding">
<soap:address location="http://127.0.0.1:8000/services/IWSTMetadataService"/>
</port>
</service>
</definitions>

2
wst/trunk/tests/google_api/test_google_api.pas
View File

@ -16,7 +16,7 @@ Const
sADDRESS = 'http:Address=http://api.google.com/search/beta2'+
';ProxyServer=10.0.0.5;ProxyPort=8080';
sTARGET = 'urn:GoogleSearch';
sKEY = '0w9pU3tQFHJyjRUP/bKgv2qwCoXf5pop';
sKEY = '<your key here>';
sSERVICE_PROTOCOL = 'SOAP';
Var
tmpObj : IGoogleSearch;

2
wst/trunk/tests/http_server/app_object.pas
View File

@ -293,8 +293,8 @@ initialization
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
RegisterCalculatorImplementationFactory();
Server_service_RegisterCalculatorService();
RegisterCalculatorImplementationFactory();
Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory();

29
wst/trunk/tests/http_server/wst_http_server.lpi
View File

@ -12,7 +12,6 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="5"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -37,20 +36,16 @@
<IsPartOfProject Value="True"/>
<UnitName Value="wst_http_server"/>
<CursorPos X="30" Y="29"/>
<TopLine Value="12"/>
<EditorIndex Value="4"/>
<TopLine Value="13"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="app_object.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="app_object"/>
<CursorPos X="1" Y="258"/>
<TopLine Value="237"/>
<EditorIndex Value="5"/>
<CursorPos X="46" Y="296"/>
<TopLine Value="63"/>
<UsageCount Value="202"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\fpc\Core\IdSocketHandle.pas"/>
@ -158,13 +153,11 @@
<UnitName Value="server_service_intf"/>
<CursorPos X="56" Y="332"/>
<TopLine Value="319"/>
<EditorIndex Value="1"/>
<UsageCount Value="200"/>
<Bookmarks Count="2">
<Item0 X="28" Y="60" ID="0"/>
<Item1 X="21" Y="169" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit17>
<Unit18>
<Filename Value="..\..\base_service_intf.pas"/>
@ -172,12 +165,10 @@
<UnitName Value="base_service_intf"/>
<CursorPos X="75" Y="817"/>
<TopLine Value="811"/>
<EditorIndex Value="2"/>
<UsageCount Value="201"/>
<Bookmarks Count="1">
<Item0 X="52" Y="707" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit18>
<Unit19>
<Filename Value="..\..\server_service_imputils.pas"/>
@ -244,12 +235,10 @@
<UnitName Value="metadata_wsdl"/>
<CursorPos X="39" Y="549"/>
<TopLine Value="537"/>
<EditorIndex Value="7"/>
<UsageCount Value="201"/>
<Bookmarks Count="1">
<Item0 X="23" Y="440" ID="3"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit27>
<Unit28>
<Filename Value="..\..\metadata_repository.pas"/>
@ -285,9 +274,7 @@
<UnitName Value="base_soap_formatter"/>
<CursorPos X="1" Y="249"/>
<TopLine Value="235"/>
<EditorIndex Value="0"/>
<UsageCount Value="59"/>
<Loaded Value="True"/>
</Unit32>
<Unit33>
<Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpash.inc"/>
@ -478,17 +465,15 @@
<IsPartOfProject Value="True"/>
<UnitName Value="calculator_imp"/>
<CursorPos X="65" Y="3"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<TopLine Value="129"/>
<UsageCount Value="123"/>
<Loaded Value="True"/>
</Unit61>
<Unit62>
<Filename Value="..\calculator\srv\calculator_binder.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="calculator_binder"/>
<CursorPos X="69" Y="51"/>
<TopLine Value="39"/>
<CursorPos X="13" Y="31"/>
<TopLine Value="17"/>
<UsageCount Value="123"/>
</Unit62>
<Unit63>
@ -543,9 +528,7 @@
<UnitName Value="logger_extension"/>
<CursorPos X="32" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit70>
<Unit71>
<Filename Value="..\..\soap_formatter.pas"/>

20
wst/trunk/tests/metadata_browser/metadata_browser.lpi
View File

@ -7,7 +7,6 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -21,13 +20,10 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="indylaz"/>
</Item2>
</RequiredPackages>
<Units Count="27">
<Unit0>
@ -36,7 +32,7 @@
<UnitName Value="metadata_browser"/>
<CursorPos X="25" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="74"/>
<UsageCount Value="75"/>
</Unit0>
<Unit1>
<Filename Value="umain.pas"/>
@ -44,11 +40,9 @@
<IsPartOfProject Value="True"/>
<ResourceFilename Value="umain.lrs"/>
<UnitName Value="umain"/>
<CursorPos X="59" Y="99"/>
<TopLine Value="79"/>
<EditorIndex Value="0"/>
<UsageCount Value="74"/>
<Loaded Value="True"/>
<CursorPos X="32" Y="97"/>
<TopLine Value="82"/>
<UsageCount Value="75"/>
</Unit1>
<Unit2>
<Filename Value="..\..\metadata_service_proxy.pas"/>
@ -56,7 +50,7 @@
<UnitName Value="metadata_service_proxy"/>
<CursorPos X="1" Y="43"/>
<TopLine Value="29"/>
<UsageCount Value="74"/>
<UsageCount Value="75"/>
</Unit2>
<Unit3>
<Filename Value="..\..\base_service_intf.pas"/>
@ -113,7 +107,7 @@
<UnitName Value="metadata_service"/>
<CursorPos X="35" Y="106"/>
<TopLine Value="99"/>
<UsageCount Value="69"/>
<UsageCount Value="70"/>
</Unit10>
<Unit11>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\objpash.inc"/>

2
wst/trunk/tests/metadata_browser/metadata_browser.lpr
View File

@ -8,7 +8,7 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ add your units here }, umain, metadata_service_proxy, indylaz,
{ add your units here }, umain, metadata_service_proxy,
metadata_service;
begin

14
wst/trunk/tests/metadata_browser/umain.lfm
View File

@ -7,14 +7,10 @@ object fMain: TfMain
VertScrollBar.Page = 310
ActiveControl = edtAddress
Caption = 'WST Metadata Browser'
ClientHeight = 311
ClientWidth = 574
object pnlHead: TPanel
Height = 82
Width = 574
Align = alTop
ClientHeight = 82
ClientWidth = 574
TabOrder = 0
object Label1: TLabel
Left = 14
@ -89,21 +85,19 @@ object fMain: TfMain
Align = alClient
BevelInner = bvRaised
BevelOuter = bvLowered
ClientHeight = 229
ClientWidth = 574
TabOrder = 1
object Label2: TLabel
Left = 14
Height = 14
Height = 18
Top = 14
Width = 53
Width = 67
Caption = 'Repository'
Color = clNone
ParentColor = False
end
object edtRepositoryList: TComboBox
Left = 112
Height = 21
Height = 24
Top = 7
Width = 344
Anchors = [akTop, akLeft, akRight]
@ -145,10 +139,12 @@ object fMain: TfMain
top = 464
object actGetRepositoryList: TAction
Caption = 'Get Rep. List'
DisableIfNoHandler = True
OnExecute = actGetRepositoryListExecute
end
object actGetRepository: TAction
Caption = 'Get Repository'
DisableIfNoHandler = True
OnExecute = actGetRepositoryExecute
OnUpdate = actGetRepositoryUpdate
end

91
wst/trunk/tests/metadata_browser/umain.lrs
View File

@ -3,50 +3,49 @@
LazarusResources.Add('TfMain','FORMDATA',[
'TPF0'#6'TfMain'#5'fMain'#4'Left'#3#175#0#6'Height'#3'7'#1#3'Top'#3#233#0#5'W'
+'idth'#3'>'#2#18'HorzScrollBar.Page'#3'='#2#18'VertScrollBar.Page'#3'6'#1#13
+'ActiveControl'#7#10'edtAddress'#7'Caption'#6#20'WST Metadata Browser'#12'Cl'
+'ientHeight'#3'7'#1#11'ClientWidth'#3'>'#2#0#6'TPanel'#7'pnlHead'#6'Height'#2
+'R'#5'Width'#3'>'#2#5'Align'#7#5'alTop'#12'ClientHeight'#2'R'#11'ClientWidth'
+#3'>'#2#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#14#6'Height'#2#18#3
+'Top'#2#12#5'Width'#2#26#7'Caption'#6#3'URL'#5'Color'#7#6'clNone'#11'ParentC'
+'olor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#11#6'Height'#2#18#3'Top'#2'.'#5'W'
+'idth'#2'-'#7'Caption'#6#6'Format'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0
+#5'TEdit'#10'edtAddress'#4'Left'#2'X'#6'Height'#2#23#3'Top'#2#12#5'Width'#3
+#224#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#12'Font.CharSet'#7#12'A'
+'NSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#243#9'Font.Name'
+#6#5'Arial'#10'Font.Pitch'#7#10'fpVariable'#8'TabOrder'#2#0#4'Text'#6'6http:'
+'//127.0.0.1:8000/wst/services/IWSTMetadataService'#0#0#7'TButton'#13'btnGet'
+'RepList'#4'Left'#3#221#1#6'Height'#2#25#3'Top'#2'('#5'Width'#2'['#6'Action'
+#7#20'actGetRepositoryList'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpa'
+'cing.InnerBorder'#2#4#8'TabOrder'#2#2#0#0#11'TRadioGroup'#9'edtFormat'#4'Le'
+'ft'#2'X'#6'Height'#2'%'#3'Top'#2'#'#5'Width'#3#24#1#8'AutoFill'#9#7'Caption'
+#6#9' &Format '#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBotto'
+'mSpacing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResi'
+'ze'#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'Child'
+'Sizing.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'
+#7#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBot'
+'tom'#27'ChildSizing.ControlsPerLine'#2#2#7'Columns'#2#2#9'ItemIndex'#2#0#13
+'Items.Strings'#1#6#5'&SOAP'#6#7'&binary'#0#8'TabOrder'#2#1#0#0#0#6'TPanel'#9
+'pnlClient'#6'Height'#3#229#0#3'Top'#2'R'#5'Width'#3'>'#2#5'Align'#7#8'alCli'
+'ent'#10'BevelInner'#7#8'bvRaised'#10'BevelOuter'#7#9'bvLowered'#12'ClientHe'
+'ight'#3#229#0#11'ClientWidth'#3'>'#2#8'TabOrder'#2#1#0#6'TLabel'#6'Label2'#4
+'Left'#2#14#6'Height'#2#14#3'Top'#2#14#5'Width'#2'5'#7'Caption'#6#10'Reposit'
+'ory'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#9'TComboBox'#17'edtReposito'
+'ryList'#4'Left'#2'p'#6'Height'#2#21#3'Top'#2#7#5'Width'#3'X'#1#7'Anchors'#11
+#5'akTop'#6'akLeft'#7'akRight'#0#16'AutoCompleteText'#11#22'cbactEndOfLineCo'
+'mplete'#20'cbactSearchAscending'#0#9'MaxLength'#2#0#8'TabOrder'#2#0#4'Text'
+#6#17'edtRepositoryList'#0#0#9'TTreeView'#11'tvwMetadata'#4'Left'#2#11#6'Hei'
+'ght'#3#176#0#3'Top'#2'&'#5'Width'#3'+'#2#7'Anchors'#11#5'akTop'#6'akLeft'#7
+'akRight'#8'akBottom'#0#17'DefaultItemHeight'#2#18#12'Font.CharSet'#7#12'ANS'
+'I_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#243#9'Font.Name'#6
+#11'Courier New'#10'Font.Pitch'#7#7'fpFixed'#8'ReadOnly'#9#8'TabOrder'#2#1#7
+'Options'#11#17'tvoAutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCollapsedN'
+'odes'#11'tvoReadOnly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#17
+'tvoShowSeparators'#11'tvoToolTips'#0#13'TreeLineColor'#7#6'clNavy'#0#0#7'TB'
+'utton'#7'Button1'#4'Left'#3#221#1#6'Height'#2#25#3'Top'#2#6#5'Width'#2'['#6
+'Action'#7#16'actGetRepository'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'Borde'
+'rSpacing.InnerBorder'#2#4#8'TabOrder'#2#2#0#0#0#11'TActionList'#2'AL'#4'lef'
+'t'#2'H'#3'top'#3#208#1#0#7'TAction'#20'actGetRepositoryList'#7'Caption'#6#13
+'Get Rep. List'#9'OnExecute'#7#27'actGetRepositoryListExecute'#0#0#7'TAction'
+#16'actGetRepository'#7'Caption'#6#14'Get Repository'#9'OnExecute'#7#23'actG'
+'etRepositoryExecute'#8'OnUpdate'#7#22'actGetRepositoryUpdate'#0#0#0#0
+'ActiveControl'#7#10'edtAddress'#7'Caption'#6#20'WST Metadata Browser'#0#6'T'
+'Panel'#7'pnlHead'#6'Height'#2'R'#5'Width'#3'>'#2#5'Align'#7#5'alTop'#8'TabO'
+'rder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#14#6'Height'#2#18#3'Top'#2#12#5'W'
+'idth'#2#26#7'Caption'#6#3'URL'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6
+'TLabel'#6'Label3'#4'Left'#2#11#6'Height'#2#18#3'Top'#2'.'#5'Width'#2'-'#7'C'
+'aption'#6#6'Format'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#5'TEdit'#10
+'edtAddress'#4'Left'#2'X'#6'Height'#2#23#3'Top'#2#12#5'Width'#3#224#1#7'Anch'
+'ors'#11#5'akTop'#6'akLeft'#7'akRight'#0#12'Font.CharSet'#7#12'ANSI_CHARSET'
+#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#243#9'Font.Name'#6#5'Arial'#10
+'Font.Pitch'#7#10'fpVariable'#8'TabOrder'#2#0#4'Text'#6'6http://127.0.0.1:80'
+'00/wst/services/IWSTMetadataService'#0#0#7'TButton'#13'btnGetRepList'#4'Lef'
+'t'#3#221#1#6'Height'#2#25#3'Top'#2'('#5'Width'#2'['#6'Action'#7#20'actGetRe'
+'positoryList'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBor'
+'der'#2#4#8'TabOrder'#2#2#0#0#11'TRadioGroup'#9'edtFormat'#4'Left'#2'X'#6'He'
+'ight'#2'%'#3'Top'#2'#'#5'Width'#3#24#1#8'AutoFill'#9#7'Caption'#6#9' &Forma'
+'t '#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'#2
+#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'Child'
+'Sizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.Shrin'
+'kHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsSc'
+'aleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'Ch'
+'ildSizing.ControlsPerLine'#2#2#7'Columns'#2#2#9'ItemIndex'#2#0#13'Items.Str'
+'ings'#1#6#5'&SOAP'#6#7'&binary'#0#8'TabOrder'#2#1#0#0#0#6'TPanel'#9'pnlClie'
+'nt'#6'Height'#3#229#0#3'Top'#2'R'#5'Width'#3'>'#2#5'Align'#7#8'alClient'#10
+'BevelInner'#7#8'bvRaised'#10'BevelOuter'#7#9'bvLowered'#8'TabOrder'#2#1#0#6
+'TLabel'#6'Label2'#4'Left'#2#14#6'Height'#2#18#3'Top'#2#14#5'Width'#2'C'#7'C'
+'aption'#6#10'Repository'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#9'TComb'
+'oBox'#17'edtRepositoryList'#4'Left'#2'p'#6'Height'#2#24#3'Top'#2#7#5'Width'
+#3'X'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#16'AutoCompleteText'#11
+#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLength'#2#0#8'Ta'
+'bOrder'#2#0#4'Text'#6#17'edtRepositoryList'#0#0#9'TTreeView'#11'tvwMetadata'
+#4'Left'#2#11#6'Height'#3#176#0#3'Top'#2'&'#5'Width'#3'+'#2#7'Anchors'#11#5
+'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#17'DefaultItemHeight'#2#18#12'Fon'
+'t.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2
+#243#9'Font.Name'#6#11'Courier New'#10'Font.Pitch'#7#7'fpFixed'#8'ReadOnly'#9
+#8'TabOrder'#2#1#7'Options'#11#17'tvoAutoItemHeight'#16'tvoHideSelection'#21
+'tvoKeepCollapsedNodes'#11'tvoReadOnly'#14'tvoShowButtons'#12'tvoShowLines'
+#11'tvoShowRoot'#17'tvoShowSeparators'#11'tvoToolTips'#0#13'TreeLineColor'#7
+#6'clNavy'#0#0#7'TButton'#7'Button1'#4'Left'#3#221#1#6'Height'#2#25#3'Top'#2
+#6#5'Width'#2'['#6'Action'#7#16'actGetRepository'#7'Anchors'#11#5'akTop'#7'a'
+'kRight'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#2#0#0#0#11'TActio'
+'nList'#2'AL'#4'left'#2'H'#3'top'#3#208#1#0#7'TAction'#20'actGetRepositoryLi'
+'st'#7'Caption'#6#13'Get Rep. List'#18'DisableIfNoHandler'#9#9'OnExecute'#7
+#27'actGetRepositoryListExecute'#0#0#7'TAction'#16'actGetRepository'#7'Capti'
+'on'#6#14'Get Repository'#18'DisableIfNoHandler'#9#9'OnExecute'#7#23'actGetR'
+'epositoryExecute'#8'OnUpdate'#7#22'actGetRepositoryUpdate'#0#0#0#0
]);

5
wst/trunk/tests/metadata_browser/umain.pas
View File

@ -44,7 +44,7 @@ implementation
uses base_service_intf, service_intf,
soap_formatter, binary_formatter,
synapse_http_protocol, //indy_http_protocol, ics_http_protocol,
//ics_tcp_protocol,
ics_tcp_protocol,
library_protocol,
metadata_service_proxy;
@ -94,7 +94,7 @@ begin
Result := TWSTMetadataService_Proxy.Create(
'WSTMetadataService',
s,
Format('http:Address=%s',[edtAddress.Text])
edtAddress.Text//Format('http:Address=%s',[edtAddress.Text])
) as IWSTMetadataService;
//lib:FileName=C:\Programmes\lazarus\wst\tests\library\obj\lib_server.dll;target=IWSTMetadataService
//'http:Address=http://127.0.0.1:8000/services/IWSTMetadataService'
@ -163,6 +163,7 @@ initialization
RegisterStdTypes();
SYNAPSE_RegisterHTTP_Transport();
LIB_Register_Transport();
ICS_RegisterTCP_Transport();
//ICS_RegisterHTTP_Transport();
//INDY_RegisterHTTP_Transport();
end.

119
wst/trunk/tests/tcp_server/tcp_gui_server.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="1"/>
<ActiveEditorIndexAtStart Value="3"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -26,15 +26,15 @@
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="38">
<Units Count="41">
<Unit0>
<Filename Value="tcp_gui_server.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="tcp_gui_server"/>
<CursorPos X="25" Y="3"/>
<CursorPos X="1" Y="16"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="127"/>
<EditorIndex Value="9"/>
<UsageCount Value="131"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@ -43,20 +43,20 @@
<IsPartOfProject Value="True"/>
<ResourceFilename Value="umain.lrs"/>
<UnitName Value="umain"/>
<CursorPos X="41" Y="88"/>
<TopLine Value="1"/>
<CursorPos X="51" Y="90"/>
<TopLine Value="73"/>
<EditorIndex Value="0"/>
<UsageCount Value="127"/>
<UsageCount Value="131"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="server_unit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_unit"/>
<CursorPos X="3" Y="9"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="127"/>
<CursorPos X="48" Y="14"/>
<TopLine Value="243"/>
<EditorIndex Value="5"/>
<UsageCount Value="131"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
@ -235,16 +235,18 @@
<UnitName Value="server_service_intf"/>
<CursorPos X="1" Y="202"/>
<TopLine Value="195"/>
<EditorIndex Value="2"/>
<UsageCount Value="44"/>
<EditorIndex Value="6"/>
<UsageCount Value="46"/>
<Loaded Value="True"/>
</Unit28>
<Unit29>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="22"/>
<TopLine Value="17"/>
<UsageCount Value="38"/>
<CursorPos X="46" Y="224"/>
<TopLine Value="235"/>
<EditorIndex Value="4"/>
<UsageCount Value="40"/>
<Loaded Value="True"/>
</Unit29>
<Unit30>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
@ -293,8 +295,8 @@
<UnitName Value="calculator"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="20"/>
<EditorIndex Value="7"/>
<UsageCount Value="24"/>
<Loaded Value="True"/>
</Unit35>
<Unit36>
@ -303,8 +305,8 @@
<UnitName Value="calculator_imp"/>
<CursorPos X="48" Y="117"/>
<TopLine Value="110"/>
<EditorIndex Value="4"/>
<UsageCount Value="20"/>
<EditorIndex Value="8"/>
<UsageCount Value="24"/>
<Loaded Value="True"/>
</Unit36>
<Unit37>
@ -313,18 +315,81 @@
<UnitName Value="calculator_binder"/>
<CursorPos X="80" Y="174"/>
<TopLine Value="170"/>
<UsageCount Value="20"/>
<UsageCount Value="24"/>
</Unit37>
<Unit38>
<Filename Value="..\..\metadata_service.pas"/>
<UnitName Value="metadata_service"/>
<CursorPos X="36" Y="89"/>
<TopLine Value="114"/>
<EditorIndex Value="3"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit38>
<Unit39>
<Filename Value="..\..\metadata_service_imp.pas"/>
<UnitName Value="metadata_service_imp"/>
<CursorPos X="62" Y="17"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit39>
<Unit40>
<Filename Value="..\..\metadata_service_binder.pas"/>
<UnitName Value="metadata_service_binder"/>
<CursorPos X="61" Y="29"/>
<TopLine Value="19"/>
<EditorIndex Value="1"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit40>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<JumpHistory Count="11" HistoryIndex="10">
<Position1>
<Filename Value="server_unit.pas"/>
<Caret Line="189" Column="25" TopLine="174"/>
<Filename Value="umain.pas"/>
<Caret Line="42" Column="60" TopLine="37"/>
</Position1>
<Position2>
<Filename Value="server_unit.pas"/>
<Caret Line="9" Column="3" TopLine="1"/>
<Filename Value="tcp_gui_server.lpr"/>
<Caret Line="3" Column="25" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="..\..\metadata_service.pas"/>
<Caret Line="252" Column="23" TopLine="227"/>
</Position3>
<Position4>
<Filename Value="..\..\metadata_service.pas"/>
<Caret Line="159" Column="23" TopLine="134"/>
</Position4>
<Position5>
<Filename Value="..\..\metadata_service.pas"/>
<Caret Line="252" Column="23" TopLine="227"/>
</Position5>
<Position6>
<Filename Value="umain.pas"/>
<Caret Line="43" Column="38" TopLine="43"/>
</Position6>
<Position7>
<Filename Value="tcp_gui_server.lpr"/>
<Caret Line="16" Column="1" TopLine="1"/>
</Position7>
<Position8>
<Filename Value="..\..\metadata_service_imp.pas"/>
<Caret Line="17" Column="62" TopLine="1"/>
</Position8>
<Position9>
<Filename Value="umain.pas"/>
<Caret Line="43" Column="53" TopLine="24"/>
</Position9>
<Position10>
<Filename Value="umain.pas"/>
<Caret Line="31" Column="15" TopLine="24"/>
</Position10>
<Position11>
<Filename Value="..\..\metadata_service.pas"/>
<Caret Line="89" Column="36" TopLine="80"/>
</Position11>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>

12
wst/trunk/tests/tcp_server/umain.lfm
View File

@ -7,15 +7,12 @@ object fMain: TfMain
VertScrollBar.Page = 299
ActiveControl = Button1
Caption = 'Simple TCP App Server'
ClientHeight = 300
ClientWidth = 400
OnCreate = FormCreate
PixelsPerInch = 96
object Label1: TLabel
Left = 16
Height = 14
Height = 18
Top = 72
Width = 18
Width = 24
Caption = 'Log'
Color = clNone
ParentColor = False
@ -26,7 +23,6 @@ object fMain: TfMain
Top = 8
Width = 104
Action = actStart
BorderSpacing.InnerBorder = 2
TabOrder = 0
end
object mmoLog: TMemo
@ -45,7 +41,6 @@ object fMain: TfMain
Top = 40
Width = 104
Action = actStop
BorderSpacing.InnerBorder = 2
TabOrder = 2
end
object edtPort: TEdit
@ -61,16 +56,19 @@ object fMain: TfMain
top = 32
object actStart: TAction
Caption = 'Start( Port=)'
DisableIfNoHandler = True
OnExecute = actStartExecute
OnUpdate = actStartUpdate
end
object actStop: TAction
Caption = 'Stop'
DisableIfNoHandler = True
OnExecute = actStopExecute
OnUpdate = actStopUpdate
end
object actClearLog: TAction
Caption = 'Clear Log'
DisableIfNoHandler = True
OnExecute = actClearLogExecute
end
end

35
wst/trunk/tests/tcp_server/umain.lrs
View File

@ -3,22 +3,21 @@
LazarusResources.Add('TfMain','FORMDATA',[
'TPF0'#6'TfMain'#5'fMain'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#180#0#5'Wi'
+'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#13
+'ActiveControl'#7#7'Button1'#7'Caption'#6#21'Simple TCP App Server'#12'Clien'
+'tHeight'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#13'Pix'
+'elsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3'Top'#2
+'H'#5'Width'#2#18#7'Caption'#6#3'Log'#5'Color'#7#6'clNone'#11'ParentColor'#8
+#0#0#7'TButton'#7'Button1'#4'Left'#2#16#6'Height'#2#25#3'Top'#2#8#5'Width'#2
+'h'#6'Action'#7#8'actStart'#25'BorderSpacing.InnerBorder'#2#2#8'TabOrder'#2#0
+#0#0#5'TMemo'#6'mmoLog'#4'Left'#2#8#6'Height'#3#192#0#3'Top'#2'`'#5'Width'#3
+#128#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#8'ReadOnly'
+#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#1#0#0#7'TButton'#7'Button2'
+#4'Left'#2#16#6'Height'#2#25#3'Top'#2'('#5'Width'#2'h'#6'Action'#7#7'actStop'
+#25'BorderSpacing.InnerBorder'#2#2#8'TabOrder'#2#2#0#0#5'TEdit'#7'edtPort'#4
+'Left'#3#128#0#6'Height'#2#23#3'Top'#2#10#5'Width'#2'P'#8'TabOrder'#2#3#4'Te'
+'xt'#6#4'1234'#0#0#11'TActionList'#2'AL'#4'left'#3#152#0#3'top'#2' '#0#7'TAc'
+'tion'#8'actStart'#7'Caption'#6#13'Start( Port=)'#9'OnExecute'#7#15'actStart'
+'Execute'#8'OnUpdate'#7#14'actStartUpdate'#0#0#7'TAction'#7'actStop'#7'Capti'
+'on'#6#4'Stop'#9'OnExecute'#7#14'actStopExecute'#8'OnUpdate'#7#13'actStopUpd'
+'ate'#0#0#7'TAction'#11'actClearLog'#7'Caption'#6#9'Clear Log'#9'OnExecute'#7
+#18'actClearLogExecute'#0#0#0#0
+'ActiveControl'#7#7'Button1'#7'Caption'#6#21'Simple TCP App Server'#8'OnCrea'
+'te'#7#10'FormCreate'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#18#3'To'
+'p'#2'H'#5'Width'#2#24#7'Caption'#6#3'Log'#5'Color'#7#6'clNone'#11'ParentCol'
+'or'#8#0#0#7'TButton'#7'Button1'#4'Left'#2#16#6'Height'#2#25#3'Top'#2#8#5'Wi'
+'dth'#2'h'#6'Action'#7#8'actStart'#8'TabOrder'#2#0#0#0#5'TMemo'#6'mmoLog'#4
+'Left'#2#8#6'Height'#3#192#0#3'Top'#2'`'#5'Width'#3#128#1#7'Anchors'#11#5'ak'
+'Top'#6'akLeft'#7'akRight'#8'akBottom'#0#8'ReadOnly'#9#10'ScrollBars'#7#10's'
+'sAutoBoth'#8'TabOrder'#2#1#0#0#7'TButton'#7'Button2'#4'Left'#2#16#6'Height'
+#2#25#3'Top'#2'('#5'Width'#2'h'#6'Action'#7#7'actStop'#8'TabOrder'#2#2#0#0#5
+'TEdit'#7'edtPort'#4'Left'#3#128#0#6'Height'#2#23#3'Top'#2#10#5'Width'#2'P'#8
+'TabOrder'#2#3#4'Text'#6#4'1234'#0#0#11'TActionList'#2'AL'#4'left'#3#152#0#3
+'top'#2' '#0#7'TAction'#8'actStart'#7'Caption'#6#13'Start( Port=)'#18'Disabl'
+'eIfNoHandler'#9#9'OnExecute'#7#15'actStartExecute'#8'OnUpdate'#7#14'actStar'
+'tUpdate'#0#0#7'TAction'#7'actStop'#7'Caption'#6#4'Stop'#18'DisableIfNoHandl'
+'er'#9#9'OnExecute'#7#14'actStopExecute'#8'OnUpdate'#7#13'actStopUpdate'#0#0
+#7'TAction'#11'actClearLog'#7'Caption'#6#9'Clear Log'#18'DisableIfNoHandler'
+#9#9'OnExecute'#7#18'actClearLogExecute'#0#0#0#0
]);

7
wst/trunk/tests/tcp_server/umain.pas
View File

@ -39,7 +39,8 @@ var
implementation
uses server_unit,
server_service_soap, server_binary_formatter,
calculator, calculator_imp, calculator_binder;
calculator, calculator_imp, calculator_binder,
metadata_service, metadata_service_imp, metadata_service_binder;
Var
scktServer : TTcpSrvApp;
@ -84,6 +85,9 @@ begin
RegisterCalculatorImplementationFactory();
Server_service_RegisterSoapFormat();
Server_service_RegisterBinaryFormat();
RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterWSTMetadataServiceService
end;
procedure TfMain.LogMessage(const AMsg: string);
@ -95,4 +99,3 @@ initialization
{$I umain.lrs}
end.

109
wst/trunk/tests/test_suite/test_parserdef.pas Normal file
View File

@ -0,0 +1,109 @@
unit test_parserdef;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, parserdefs, fpcunit, testregistry;
type
{ TTest_TClassTypeDefinition }
TTest_TClassTypeDefinition = class(TTestCase)
published
procedure IsDescendantOf();
procedure SetParent();
end;
implementation
{ TTest_TClassTypeDefinition }
procedure TTest_TClassTypeDefinition.IsDescendantOf();
var
a, b , c, d : TClassTypeDefinition;
begin
a := nil;
b := nil;
c := nil;
d := nil;
try
a := TClassTypeDefinition.Create('a');
b := TClassTypeDefinition.Create('b');
b.SetParent(a);
c := TClassTypeDefinition.Create('c');
c.SetParent(b);
d := TClassTypeDefinition.Create('d');
AssertTrue('b IsDescendantOf a',b.IsDescendantOf(a));
AssertTrue('c IsDescendantOf b',c.IsDescendantOf(b));
AssertTrue('c IsDescendantOf a',c.IsDescendantOf(a));
AssertFalse('b IsDescendantOf c',b.IsDescendantOf(c));
AssertFalse('a IsDescendantOf b',a.IsDescendantOf(b));
AssertFalse('a IsDescendantOf c',a.IsDescendantOf(c));
AssertFalse('d IsDescendantOf a',d.IsDescendantOf(a));
finally
FreeAndNil(d);
FreeAndNil(c);
FreeAndNil(b);
FreeAndNil(a);
end;
end;
procedure TTest_TClassTypeDefinition.SetParent();
var
a, b , c, d : TClassTypeDefinition;
excp : Boolean;
begin
a := nil;
b := nil;
c := nil;
d := nil;
try
a := TClassTypeDefinition.Create('a');
b := TClassTypeDefinition.Create('b');
b.SetParent(a);
c := TClassTypeDefinition.Create('c');
c.SetParent(b);
d := TClassTypeDefinition.Create('d');
excp := False;;
try
c.SetParent(c);
except
excp := True;
end;
if not excp then begin
Fail('c.SetParent(c);');
end;
AssertSame('a.Parent = nil',nil,a.Parent);
AssertSame('b.Parent = a',a,b.Parent);
AssertSame('c.Parent = b',b,c.Parent);
AssertSame('d.Parent = nil',nil,d.Parent);
finally
FreeAndNil(d);
FreeAndNil(c);
FreeAndNil(b);
FreeAndNil(a);
end;
end;
initialization
RegisterTest(TTest_TClassTypeDefinition);
end.

1432
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

File diff suppressed because it is too large Load Diff

539
wst/trunk/tests/test_suite/wst_test_suite.lpi
View File

@ -7,7 +7,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="9"/>
<ActiveEditorIndexAtStart Value="1"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -18,7 +18,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-a"/>
<CommandLineParams Value="-a >res.xml"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
@ -27,23 +27,23 @@
<PackageName Value="FPCUnitTestRunner"/>
</Item1>
</RequiredPackages>
<Units Count="47">
<Units Count="40">
<Unit0>
<Filename Value="wst_test_suite.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wst_test_suite"/>
<CursorPos X="69" Y="11"/>
<TopLine Value="9"/>
<UsageCount Value="149"/>
<CursorPos X="33" Y="11"/>
<TopLine Value="1"/>
<UsageCount Value="200"/>
</Unit0>
<Unit1>
<Filename Value="testformatter_unit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testformatter_unit"/>
<CursorPos X="27" Y="905"/>
<TopLine Value="886"/>
<EditorIndex Value="9"/>
<UsageCount Value="149"/>
<CursorPos X="42" Y="2999"/>
<TopLine Value="2972"/>
<EditorIndex Value="4"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
@ -52,49 +52,50 @@
<UnitName Value="server_service_soap"/>
<CursorPos X="20" Y="205"/>
<TopLine Value="162"/>
<EditorIndex Value="2"/>
<UsageCount Value="149"/>
<Loaded Value="True"/>
<UsageCount Value="200"/>
</Unit2>
<Unit3>
<Filename Value="..\..\soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="8" Y="97"/>
<TopLine Value="86"/>
<EditorIndex Value="1"/>
<UsageCount Value="149"/>
<Loaded Value="True"/>
<CursorPos X="10" Y="118"/>
<TopLine Value="89"/>
<UsageCount Value="200"/>
</Unit3>
<Unit4>
<Filename Value="..\..\base_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_binary_formatter"/>
<CursorPos X="39" Y="180"/>
<TopLine Value="171"/>
<EditorIndex Value="6"/>
<UsageCount Value="149"/>
<Loaded Value="True"/>
<CursorPos X="48" Y="502"/>
<TopLine Value="497"/>
<UsageCount Value="200"/>
<Bookmarks Count="1">
<Item0 X="45" Y="1161" ID="0"/>
</Bookmarks>
</Unit4>
<Unit5>
<Filename Value="..\..\base_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="3" Y="106"/>
<TopLine Value="121"/>
<CursorPos X="21" Y="263"/>
<TopLine Value="250"/>
<EditorIndex Value="0"/>
<UsageCount Value="149"/>
<UsageCount Value="200"/>
<Bookmarks Count="1">
<Item0 X="5" Y="1159" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\..\base_soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="1" Y="1082"/>
<TopLine Value="1061"/>
<EditorIndex Value="7"/>
<UsageCount Value="149"/>
<Loaded Value="True"/>
<CursorPos X="34" Y="900"/>
<TopLine Value="872"/>
<UsageCount Value="200"/>
<Bookmarks Count="1">
<Item0 X="22" Y="1236" ID="1"/>
</Bookmarks>
</Unit6>
<Unit7>
<Filename Value="..\..\binary_formatter.pas"/>
@ -102,17 +103,15 @@
<UnitName Value="binary_formatter"/>
<CursorPos X="15" Y="44"/>
<TopLine Value="33"/>
<EditorIndex Value="4"/>
<UsageCount Value="149"/>
<Loaded Value="True"/>
<UsageCount Value="200"/>
</Unit7>
<Unit8>
<Filename Value="..\..\binary_streamer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_streamer"/>
<CursorPos X="32" Y="38"/>
<TopLine Value="22"/>
<UsageCount Value="149"/>
<CursorPos X="18" Y="40"/>
<TopLine Value="40"/>
<UsageCount Value="200"/>
</Unit8>
<Unit9>
<Filename Value="..\..\server_binary_formatter.pas"/>
@ -120,281 +119,351 @@
<UnitName Value="server_binary_formatter"/>
<CursorPos X="5" Y="136"/>
<TopLine Value="92"/>
<UsageCount Value="149"/>
<UsageCount Value="200"/>
</Unit9>
<Unit10>
<Filename Value="D:\lazarusClean\fpcsrc\fcl\fpcunit\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="39" Y="66"/>
<TopLine Value="66"/>
<UsageCount Value="6"/>
</Unit10>
<Unit11>
<Filename Value="D:\lazarusClean\fpcsrc\fcl\fpcunit\testregistry.pp"/>
<UnitName Value="testregistry"/>
<CursorPos X="11" Y="29"/>
<TopLine Value="35"/>
<UsageCount Value="9"/>
</Unit11>
<Unit12>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="11" Y="216"/>
<TopLine Value="230"/>
<UsageCount Value="3"/>
</Unit12>
<Unit13>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="10" Y="137"/>
<TopLine Value="127"/>
<UsageCount Value="1"/>
</Unit13>
<Unit14>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
<CursorPos X="23" Y="1007"/>
<TopLine Value="1005"/>
<UsageCount Value="1"/>
</Unit14>
<Unit15>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\systemh.inc"/>
<CursorPos X="65" Y="452"/>
<TopLine Value="441"/>
<UsageCount Value="6"/>
</Unit15>
<Unit16>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\system.pp"/>
<UnitName Value="System"/>
<CursorPos X="20" Y="1012"/>
<TopLine Value="1011"/>
<UsageCount Value="6"/>
</Unit16>
<Unit17>
<Filename Value="D:\lazarusClean\fpcsrc\fcl\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="3" Y="625"/>
<TopLine Value="623"/>
<UsageCount Value="1"/>
</Unit17>
<Unit18>
</Unit10>
<Unit11>
<Filename Value="..\..\metadata_repository.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="3" Y="79"/>
<TopLine Value="70"/>
<UsageCount Value="124"/>
</Unit18>
<Unit19>
<UsageCount Value="200"/>
</Unit11>
<Unit12>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="15" Y="579"/>
<TopLine Value="565"/>
<UsageCount Value="5"/>
</Unit19>
<Unit20>
<UsageCount Value="7"/>
</Unit12>
<Unit13>
<Filename Value="testmetadata_unit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testmetadata_unit"/>
<CursorPos X="83" Y="119"/>
<TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="117"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<TopLine Value="46"/>
<UsageCount Value="199"/>
</Unit13>
<Unit14>
<Filename Value="..\..\ws_helper\metadata_generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_generator"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="31"/>
<UsageCount Value="117"/>
</Unit21>
<Unit22>
<UsageCount Value="199"/>
</Unit14>
<Unit15>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parserdefs"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="117"/>
</Unit22>
<Unit23>
<Filename Value="D:\Lazarus\fpcsrc\fcl\fpcunit\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="21" Y="81"/>
<TopLine Value="71"/>
<UsageCount Value="2"/>
</Unit23>
<Unit24>
<Filename Value="D:\Lazarus\fpcsrc\fcl\fpcunit\testregistry.pp"/>
<UnitName Value="testregistry"/>
<CursorPos X="11" Y="29"/>
<TopLine Value="1"/>
<UsageCount Value="3"/>
</Unit24>
<Unit25>
<Filename Value="D:\Lazarus\fpcsrc\rtl\inc\heaph.inc"/>
<CursorPos X="10" Y="87"/>
<TopLine Value="61"/>
<UsageCount Value="2"/>
</Unit25>
<Unit26>
<Filename Value="D:\Lazarus\fpcsrc\rtl\inc\heap.inc"/>
<CursorPos X="3" Y="235"/>
<TopLine Value="223"/>
<UsageCount Value="2"/>
</Unit26>
<Unit27>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="3" Y="1248"/>
<TopLine Value="1238"/>
<UsageCount Value="2"/>
</Unit27>
<Unit28>
<EditorIndex Value="2"/>
<UsageCount Value="199"/>
<Bookmarks Count="2">
<Item0 X="45" Y="1146" ID="0"/>
<Item1 X="18" Y="1133" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="..\..\metadata_wsdl.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_wsdl"/>
<CursorPos X="38" Y="148"/>
<TopLine Value="142"/>
<UsageCount Value="109"/>
</Unit28>
<Unit29>
<CursorPos X="25" Y="759"/>
<TopLine Value="751"/>
<EditorIndex Value="1"/>
<UsageCount Value="191"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
<Filename Value="D:\Lazarus\fpcsrc\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="15" Y="429"/>
<TopLine Value="413"/>
<UsageCount Value="4"/>
</Unit29>
<Unit30>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\classes.pp"/>
<UnitName Value="Classes"/>
<CursorPos X="14" Y="32"/>
<TopLine Value="13"/>
<UsageCount Value="6"/>
</Unit30>
<Unit31>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="14" Y="149"/>
<TopLine Value="138"/>
<UsageCount Value="6"/>
</Unit31>
<Unit32>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\lists.inc"/>
<CursorPos X="3" Y="29"/>
<TopLine Value="27"/>
<UsageCount Value="6"/>
</Unit32>
<Unit33>
</Unit17>
<Unit18>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="13" Y="235"/>
<TopLine Value="215"/>
<UsageCount Value="8"/>
</Unit33>
<Unit34>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutils.inc"/>
<CursorPos X="9" Y="110"/>
<TopLine Value="106"/>
<UsageCount Value="7"/>
</Unit34>
<Unit35>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\heaptrc.pp"/>
<UnitName Value="heaptrc"/>
<CursorPos X="40" Y="1168"/>
<TopLine Value="1190"/>
<UsageCount Value="7"/>
</Unit35>
<Unit36>
<UsageCount Value="0"/>
</Unit18>
<Unit19>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="3" Y="187"/>
<TopLine Value="175"/>
<UsageCount Value="9"/>
</Unit36>
<Unit37>
<UsageCount Value="1"/>
</Unit19>
<Unit20>
<Filename Value="..\..\server_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_intf"/>
<CursorPos X="35" Y="379"/>
<TopLine Value="376"/>
<EditorIndex Value="3"/>
<UsageCount Value="43"/>
<Loaded Value="True"/>
</Unit37>
<Unit38>
<TopLine Value="397"/>
<UsageCount Value="125"/>
</Unit20>
<Unit21>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="23"/>
<EditorIndex Value="5"/>
<UsageCount Value="19"/>
<Loaded Value="True"/>
</Unit38>
<Unit39>
<UsageCount Value="11"/>
</Unit21>
<Unit22>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="3" Y="316"/>
<TopLine Value="304"/>
<UsageCount Value="8"/>
</Unit39>
<Unit40>
<UsageCount Value="0"/>
</Unit22>
<Unit23>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\lists.inc"/>
<CursorPos X="3" Y="407"/>
<TopLine Value="404"/>
<UsageCount Value="8"/>
</Unit40>
<Unit41>
<UsageCount Value="0"/>
</Unit23>
<Unit24>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="3" Y="474"/>
<TopLine Value="471"/>
<UsageCount Value="8"/>
</Unit41>
<Unit42>
<UsageCount Value="0"/>
</Unit24>
<Unit25>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
<CursorPos X="27" Y="121"/>
<TopLine Value="104"/>
<UsageCount Value="8"/>
</Unit42>
<Unit43>
<UsageCount Value="0"/>
</Unit25>
<Unit26>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpas.inc"/>
<CursorPos X="9" Y="166"/>
<TopLine Value="142"/>
<UsageCount Value="8"/>
</Unit43>
<Unit44>
<UsageCount Value="0"/>
</Unit26>
<Unit27>
<Filename Value="D:\Lazarus\components\fpcunit\guitestrunner.pas"/>
<ComponentName Value="GUITestRunner"/>
<HasResources Value="True"/>
<UnitName Value="GuiTestRunner"/>
<CursorPos X="34" Y="32"/>
<TopLine Value="25"/>
<UsageCount Value="8"/>
</Unit44>
<Unit45>
<UsageCount Value="0"/>
</Unit27>
<Unit28>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="26" Y="231"/>
<TopLine Value="193"/>
<UsageCount Value="9"/>
</Unit45>
<Unit46>
<UsageCount Value="1"/>
</Unit28>
<Unit29>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="21" Y="94"/>
<TopLine Value="80"/>
<UsageCount Value="10"/>
</Unit46>
<TopLine Value="83"/>
<UsageCount Value="8"/>
</Unit29>
<Unit30>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\DUnitCompatibleInterface.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="4"/>
<UsageCount Value="2"/>
</Unit30>
<Unit31>
<Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/>
<CursorPos X="15" Y="36"/>
<TopLine Value="22"/>
<UsageCount Value="2"/>
</Unit31>
<Unit32>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="3" Y="1412"/>
<TopLine Value="1407"/>
<UsageCount Value="6"/>
</Unit32>
<Unit33>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="33" Y="192"/>
<TopLine Value="186"/>
<UsageCount Value="5"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\xmlread.pp"/>
<UnitName Value="XMLRead"/>
<CursorPos X="43" Y="13"/>
<TopLine Value="1"/>
<UsageCount Value="6"/>
</Unit34>
<Unit35>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\datih.inc"/>
<CursorPos X="10" Y="109"/>
<TopLine Value="107"/>
<UsageCount Value="7"/>
</Unit35>
<Unit36>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\dati.inc"/>
<CursorPos X="46" Y="130"/>
<TopLine Value="122"/>
<UsageCount Value="7"/>
</Unit36>
<Unit37>
<Filename Value="test_parserdef.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_parserdef"/>
<CursorPos X="93" Y="76"/>
<TopLine Value="11"/>
<EditorIndex Value="3"/>
<UsageCount Value="45"/>
<Loaded Value="True"/>
</Unit37>
<Unit38>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\testutils.pp"/>
<UnitName Value="testutils"/>
<CursorPos X="34" Y="25"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
</Unit38>
<Unit39>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\testregistry.pp"/>
<UnitName Value="testregistry"/>
<CursorPos X="18" Y="17"/>
<TopLine Value="16"/>
<UsageCount Value="7"/>
</Unit39>
</Units>
<JumpHistory Count="3" HistoryIndex="2">
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="875" Column="3" TopLine="866"/>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="1128" Column="39" TopLine="1122"/>
</Position1>
<Position2>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="2126" Column="1" TopLine="143"/>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="956" Column="19" TopLine="935"/>
</Position2>
<Position3>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="877" Column="26" TopLine="863"/>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="977" Column="50" TopLine="956"/>
</Position3>
<Position4>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="978" Column="33" TopLine="957"/>
</Position4>
<Position5>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="1118" Column="28" TopLine="1112"/>
</Position5>
<Position6>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position6>
<Position7>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="956" Column="48" TopLine="935"/>
</Position7>
<Position8>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="977" Column="28" TopLine="956"/>
</Position8>
<Position9>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="1142" Column="1" TopLine="1129"/>
</Position9>
<Position10>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position10>
<Position11>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="986" Column="21" TopLine="951"/>
</Position11>
<Position12>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="963" Column="27" TopLine="941"/>
</Position12>
<Position13>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="974" Column="1" TopLine="957"/>
</Position13>
<Position14>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="976" Column="17" TopLine="962"/>
</Position14>
<Position15>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="978" Column="50" TopLine="964"/>
</Position15>
<Position16>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="980" Column="33" TopLine="965"/>
</Position16>
<Position17>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="1050" Column="19" TopLine="1039"/>
</Position17>
<Position18>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="214" Column="45" TopLine="210"/>
</Position18>
<Position19>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="2881" Column="31" TopLine="2866"/>
</Position19>
<Position20>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="213" Column="35" TopLine="200"/>
</Position20>
<Position21>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1139" Column="42" TopLine="1126"/>
</Position21>
<Position22>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="467" Column="3" TopLine="465"/>
</Position22>
<Position23>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3667" Column="88" TopLine="3647"/>
</Position23>
<Position24>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position24>
<Position25>
<Filename Value="..\..\ws_helper\parserdefs.pas"/>
<Caret Line="1132" Column="44" TopLine="1113"/>
</Position25>
<Position26>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1167" Column="124" TopLine="1145"/>
</Position26>
<Position27>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3927" Column="13" TopLine="3912"/>
</Position27>
<Position28>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position28>
<Position29>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="416" Column="3" TopLine="414"/>
</Position29>
<Position30>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="2965" Column="35" TopLine="2960"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
@ -423,7 +492,7 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="19">
<BreakPoints Count="14">
<Item1>
<Source Value="..\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
<Line Value="15"/>
@ -477,29 +546,9 @@
<Line Value="568"/>
</Item13>
<Item14>
<Source Value="testformatter_unit.pas"/>
<Line Value="366"/>
</Item14>
<Item15>
<Source Value="testformatter_unit.pas"/>
<Line Value="337"/>
</Item15>
<Item16>
<Source Value="testformatter_unit.pas"/>
<Line Value="194"/>
</Item16>
<Item17>
<Source Value="testformatter_unit.pas"/>
<Line Value="349"/>
</Item17>
<Item18>
<Source Value="testformatter_unit.pas"/>
<Line Value="363"/>
</Item18>
<Item19>
<Source Value="testformatter_unit.pas"/>
<Line Value="909"/>
</Item19>
</Item14>
</BreakPoints>
<Watches Count="2">
<Item1>

3
wst/trunk/tests/test_suite/wst_test_suite.lpr
View File

@ -8,7 +8,8 @@ uses
server_service_soap, soap_formatter, base_binary_formatter,
base_service_intf, base_soap_formatter, binary_formatter, binary_streamer,
server_binary_formatter, metadata_repository,
metadata_generator, parserdefs, server_service_intf, metadata_wsdl;
metadata_generator, parserdefs, server_service_intf, metadata_wsdl,
test_parserdef;
Const
ShortOpts = 'alh';

17
wst/trunk/ws_helper/command_line_parser.pas
View File

@ -28,7 +28,10 @@ uses
Type
TComandLineOption = ( cloProxy, cloImp, cloBinder, cloOutPutDir );
TComandLineOption = (
cloInterface, cloProxy, cloImp, cloBinder,
cloOutPutDirRelative, cloOutPutDirAbsolute
);
TComandLineOptions = set of TComandLineOption;
function ParseCmdLineOptions(out AAppOptions : TComandLineOptions):Integer;
@ -53,15 +56,21 @@ begin
AAppOptions := [];
c := #0;
Repeat
c := GetOpt('pibo:');
c := GetOpt('upibo:a:');
case c of
'u' : Include(AAppOptions,cloInterface);
'p' : Include(AAppOptions,cloProxy);
'i' : Include(AAppOptions,cloImp);
'b' : Include(AAppOptions,cloBinder);
'o' :
Begin
Include(AAppOptions,cloOutPutDir);
OptionsArgsMAP[cloOutPutDir] := OptArg;
Include(AAppOptions,cloOutPutDirRelative);
OptionsArgsMAP[cloOutPutDirRelative] := OptArg;
End;
'a' :
Begin
Include(AAppOptions,cloOutPutDirAbsolute);
OptionsArgsMAP[cloOutPutDirAbsolute] := OptArg;
End;
end;
Until ( c = EndOfOptions );

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

@ -139,9 +139,39 @@ type
procedure Execute();override;
End;
{ TInftGenerator }
TInftGenerator = class(TBaseGenerator)
private
FDecStream : ISourceStream;
FImpStream : ISourceStream;
FImpTempStream : ISourceStream;
private
function GenerateIntfName(AIntf : TInterfaceDefinition):string;
procedure GenerateUnitHeader();
procedure GenerateUnitImplementationHeader();
procedure GenerateUnitImplementationFooter();
procedure GenerateIntf(AIntf : TInterfaceDefinition);
procedure GenerateTypeAlias(ASymbol : TTypeAliasDefinition);
procedure GenerateClass(ASymbol : TClassTypeDefinition);
procedure GenerateEnum(ASymbol : TEnumTypeDefinition);
procedure GenerateArray(ASymbol : TArrayDefinition);
function GetDestUnitName():string;
public
constructor Create(
ASymTable : TSymbolTable;
ASrcMngr : ISourceManager
);
procedure Execute();override;
end;
implementation
uses parserutils;
uses parserutils, Contnrs;
Const sPROXY_BASE_CLASS = 'TBaseProxy';
sBINDER_BASE_CLASS = 'TBaseServiceBinder';
@ -149,6 +179,7 @@ Const sPROXY_BASE_CLASS = 'TBaseProxy';
sSERIALIZER_CLASS = 'IFormatterClient';
RETURN_PARAM_NAME = 'return';
RETURN_VAL_NAME = 'returnVal';
sNAME_SPACE = 'sNAME_SPACE';
sPRM_NAME = 'strPrmName';
sLOC_SERIALIZER = 'locSerializer';
@ -377,7 +408,7 @@ Var
Indent();WriteLn('%s := GetSerializer();',[sLOC_SERIALIZER]);
Indent();WriteLn('Try');IncIndent();
Indent();WriteLn('%s.BeginCall(''%s'', GetTarget(),(Self as ICallContext));',[sLOC_SERIALIZER,AMthd.Name]);
Indent();WriteLn('%s.BeginCall(''%s'', GetTarget(),(Self as ICallContext));',[sLOC_SERIALIZER,AMthd.ExternalName]);
IncIndent();
prmCnt := AMthd.ParameterCount;
If ( AMthd.MethodType = mtFunction ) Then
@ -385,7 +416,7 @@ Var
For k := 0 To Pred(prmCnt) Do Begin
prm := AMthd.Parameter[k];
If ( prm.Modifier <> pmOut ) Then Begin
Indent();WriteLn('%s.Put(''%s'', TypeInfo(%s), %s);',[sLOC_SERIALIZER,prm.Name,prm.DataType.Name,prm.Name]);
Indent();WriteLn('%s.Put(%s, TypeInfo(%s), %s);',[sLOC_SERIALIZER,QuotedStr(prm.ExternalName),prm.DataType.Name,prm.Name]);
End;
End;
DecIndent();
@ -402,8 +433,10 @@ Var
prm := AMthd.Parameter[k];
//Indent();WriteLn('%s := TypeInfo(%s);',[sRES_TYPE_INFO,prm.DataType.Name]);
if prm.DataType.NeedFinalization() then begin
if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin
Indent();WriteLn('Pointer(Result) := Nil;');
if prm.DataType.InheritsFrom(TClassTypeDefinition) or
prm.DataType.InheritsFrom(TArrayDefinition)
then begin
Indent();WriteLn('TObject(Result) := Nil;');
end else begin
Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]);
IncIndent();
@ -411,20 +444,24 @@ Var
DecIndent();
end;
end;
Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(RETURN_PARAM_NAME)]);
Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.DataType.Name,sPRM_NAME,prm.Name]);
Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(prm.ExternalName)]);//Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(RETURN_PARAM_NAME)]);
Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.DataType.Name,sPRM_NAME,'Result']);
End;
//--------------------------------
for k := 0 to Pred(prmCnt) do begin
prm := AMthd.Parameter[k];
if ( prm.Modifier = pmOut ) then begin
if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin
Indent();WriteLn('Pointer(%s) := Nil;',[prm.Name]);
end else begin
Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]);
IncIndent();
Indent();WriteLn('Pointer(%s) := Nil;',[prm.Name]);
DecIndent();
if prm.DataType.NeedFinalization() then begin
if prm.DataType.InheritsFrom(TClassTypeDefinition) or
prm.DataType.InheritsFrom(TArrayDefinition)
then begin
Indent();WriteLn('TObject(%s) := Nil;',[prm.Name]);
end else begin
Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]);
IncIndent();
Indent();WriteLn('Pointer(%s) := Nil;',[prm.Name]);
DecIndent();
end;
end;
end;
end;
@ -433,7 +470,7 @@ Var
For k := 0 To Pred(prmCnt) Do Begin
prm := AMthd.Parameter[k];
If ( prm.Modifier In [pmVar, pmOut] ) Then Begin
Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(prm.Name)]);
Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(prm.ExternalName)]);
Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.DataType.Name,sPRM_NAME,prm.Name]);
End;
End;
@ -766,7 +803,7 @@ Var
NewLine();
For k := 0 To Pred(prmCnt) Do Begin
prm := AMthd.Parameter[k];
Write('%s := %s;',[sPRM_NAME,QuotedStr(prm.Name)]);
Write('%s := %s;',[sPRM_NAME,QuotedStr(prm.ExternalName)]);
WriteLn('AFormatter.Get(TypeInfo(%s),%s,%s);',[prm.DataType.Name,sPRM_NAME,prm.Name]);
If prm.DataType.NeedFinalization() Then Begin
if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin
@ -824,20 +861,20 @@ Var
WriteLn('AFormatter.Clear();');
WriteLn('AFormatter.BeginCallResponse(procName,trgName);');
//BeginAutoIndent();
IncIndent();
If ( AMthd.MethodType = mtFunction ) Then
WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(RETURN_PARAM_NAME),AMthd.Parameter[prmCnt].DataType.Name,RETURN_VAL_NAME]);
if ( AMthd.MethodType = mtFunction ) then begin
//WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(RETURN_PARAM_NAME),AMthd.Parameter[prmCnt].DataType.Name,RETURN_VAL_NAME]);
WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(prm.ExternalName),AMthd.Parameter[prmCnt].DataType.Name,RETURN_VAL_NAME]);
end;
For k := 0 To Pred(prmCnt) Do Begin
prm := AMthd.Parameter[k];
If ( prm.Modifier In [pmOut,pmVar] ) Then
WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(prm.Name),prm.DataType.Name,prm.Name]);
WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(prm.ExternalName),prm.DataType.Name,prm.Name]);
End;
DecIndent();
WriteLn('AFormatter.EndCallResponse();');
NewLine();
WriteLn('callCtx := Nil;');
//EndAutoIndent();
DecIndent();EndAutoIndent();
WriteLn('End;');
@ -1206,4 +1243,637 @@ begin
FImpStream := Nil;
end;
{ TInftGenerator }
function TInftGenerator.GenerateIntfName(AIntf: TInterfaceDefinition): string;
begin
Result := ExtractserviceName(AIntf);
end;
procedure TInftGenerator.GenerateUnitHeader();
begin
SetCurrentStream(FDecStream);
WriteLn('{');
WriteLn('This unit has been produced by ws_helper.');
WriteLn(' Input unit name : "%s".',[SymbolTable.Name]);
WriteLn(' This unit name : "%s".',[GetDestUnitName()]);
WriteLn(' Date : "%s".',[DateTimeToStr(Now())]);
WriteLn('}');
WriteLn('unit %s;',[GetDestUnitName()]);
WriteLn('{$mode objfpc}{$H+}');
WriteLn('interface');
WriteLn('');
WriteLn('uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;');
WriteLn('');
WriteLn('const');
IncIndent();
Indent();WriteLn('sNAME_SPACE = %s;',[QuotedStr(FSymbolTable.ExternalName)]);
DecIndent();
WriteLn('');
WriteLn('type');
WriteLn('');
end;
procedure TInftGenerator.GenerateUnitImplementationHeader();
begin
SetCurrentStream(FImpStream);
WriteLn('');
WriteLn('Implementation');
FImpTempStream.WriteLn('initialization');
end;
procedure TInftGenerator.GenerateUnitImplementationFooter();
begin
SetCurrentStream(FImpStream);
NewLine();
NewLine();
FImpTempStream.NewLine();
FImpTempStream.WriteLn('End.');
end;
procedure TInftGenerator.GenerateIntf(AIntf: TInterfaceDefinition);
procedure WriteDec();
begin
Indent();
WriteLn('%s = interface',[GenerateIntfName(AIntf)]);
end;
procedure WriteMethod(AMthd : TMethodDefinition);
Var
prmCnt,k : Integer;
prm : TParameterDefinition;
Begin
Indent();
prmCnt := AMthd.ParameterCount;
If ( AMthd.MethodType = mtProcedure ) Then
Write('procedure ')
Else Begin
Write('function ');
Dec(prmCnt);
End;
Write('%s(',[AMthd.Name]);
If ( prmCnt > 0 ) Then Begin
IncIndent();
For k := 0 To Pred(prmCnt) Do Begin
prm := AMthd.Parameter[k];
If (k > 0 ) Then
Write('; ');
NewLine();
Indent();
Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]);
End;
DecIndent();
NewLine();
Indent();
End;
Write(')');
If ( AMthd.MethodType = mtFunction ) Then Begin
Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]);
End;
WriteLn(';');
End;
procedure WriteMethods();
Var
k : Integer;
begin
If ( AIntf.MethodCount = 0 ) Then
Exit;
IncIndent();
For k := 0 To Pred(AIntf.MethodCount) Do
WriteMethod(AIntf.Method[k]);
DecIndent();
end;
begin
SetCurrentStream(FDecStream);
NewLine();
IncIndent();
WriteDec();
WriteMethods();
Indent(); WriteLn('end;');
DecIndent();
end;
procedure TInftGenerator.GenerateTypeAlias(ASymbol: TTypeAliasDefinition);
begin
try
SetCurrentStream(FDecStream);
NewLine();
IncIndent();
Indent();
WriteLn('%s = type %s;',[ASymbol.Name,ASymbol.BaseType.Name]);
DecIndent();
except
on e : Exception do
System.WriteLn('TInftGenerator.GenerateTypeAlias()=', ASymbol.Name, ' ;; ', e.Message);
end;
end;
procedure TInftGenerator.GenerateClass(ASymbol: TClassTypeDefinition);
var
locClassPropNbr, locStoredPropsNbr : Integer;
loc_BaseComplexSimpleContentRemotable : TClassTypeDefinition;
procedure Prepare();
var
k : Integer;
p : TPropertyDefinition;
begin
locClassPropNbr := 0;
locStoredPropsNbr := 0;
for k := 0 to Pred(ASymbol.PropertyCount) do begin
p := ASymbol.Properties[k];
if ( p.StorageOption = soOptional ) then
Inc(locStoredPropsNbr);
if p.DataType.InheritsFrom(TClassTypeDefinition) then
Inc(locClassPropNbr);
end;
end;
procedure WriteDec();
var
s : string;
begin
if Assigned(ASymbol.Parent) then begin
{if ASymbol.Parent.InheritsFrom(TNativeSimpleTypeDefinition) and
Assigned(TNativeSimpleTypeDefinition(ASymbol.Parent).BoxedType)
then begin
s := Format('%s',[TNativeSimpleTypeDefinition(ASymbol.Parent).BoxedType.Name]);
end else begin
s := Format('%s',[ASymbol.Parent.Name]);
end;}
s := Format('%s',[ASymbol.Parent.Name]);
end else begin
s := 'XX';//'TBaseComplexRemotable';
end;
Indent();
WriteLn('%s = class(%s)',[ASymbol.Name,s]);
end;
procedure WritePropertyField(AProp : TPropertyDefinition);
begin
Indent();
WriteLn('F%s : %s;',[AProp.Name,AProp.DataType.Name]);
End;
procedure WriteProperty(AProp : TPropertyDefinition);
var
propName, locStore : string;
begin
propName := AProp.Name;
case AProp.StorageOption of
soAlways : locStore := '';
soNever : locStore := ' stored False';
soOptional : locStore := Format(' stored Has%s',[AProp.Name]);
end;
Indent();
WriteLn('property %s : %s read F%s write F%s%s;',[propName,AProp.DataType.Name,propName,propName,locStore]);
if not AnsiSameText(AProp.Name,AProp.ExternalName) then begin
FImpTempStream.Indent();
FImpTempStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(AProp.Name),QuotedStr(AProp.ExternalName)]);
end;
if AProp.IsAttribute and ( not ASymbol.IsDescendantOf(loc_BaseComplexSimpleContentRemotable) ) then begin
FImpTempStream.Indent();
FImpTempStream.WriteLn('%s.RegisterAttributeProperty(%s);',[ASymbol.Name,QuotedStr(AProp.Name)]);
end;
end;
procedure WriteProperties();
Var
k : Integer;
p : TPropertyDefinition;
begin
If ( ASymbol.PropertyCount > 0 ) Then begin
Indent();
WriteLn('private');
IncIndent();
for k := 0 to Pred(ASymbol.PropertyCount) do begin
p := ASymbol.Properties[k];
WritePropertyField(p);
end;
DecIndent();
//
if ( locStoredPropsNbr > 0 ) then begin
Indent();
WriteLn('private');
IncIndent();
for k := 0 to Pred(ASymbol.PropertyCount) do begin
p := ASymbol.Properties[k];
if ( p.StorageOption = soOptional ) then begin
Indent();
WriteLn('function Has%s() : Boolean;',[p.Name]);
end;
end;
DecIndent();
end;
//
if ( locClassPropNbr > 0 ) then begin
Indent();
WriteLn('public');
IncIndent();
Indent();
WriteLn('destructor Destroy();override;');
DecIndent();
end;
//
Indent();
WriteLn('published');
IncIndent();
For k := 0 To Pred(ASymbol.PropertyCount) Do
WriteProperty(ASymbol.Properties[k]);
DecIndent();
end;
end;
procedure WriteImp();
var
k : Integer;
p : TPropertyDefinition;
begin
if ( locClassPropNbr > 0 ) or ( locStoredPropsNbr > 0 ) then begin
NewLine();
WriteLn('{ %s }',[ASymbol.Name]);
if ( locClassPropNbr > 0 ) then begin
NewLine();
WriteLn('destructor %s.Destroy();',[ASymbol.Name]);
WriteLn('begin');
IncIndent();
for k := 0 to Pred(ASymbol.PropertyCount) do begin
p := ASymbol.Properties[k];
if p.DataType.InheritsFrom(TClassTypeDefinition) then begin
Indent();
WriteLn('if Assigned(F%s) then',[p.Name]);
IncIndent();
Indent();
WriteLn('FreeAndNil(F%s);',[p.Name]) ;
DecIndent();
end;
end;
Indent();
WriteLn('inherited Destroy();');
DecIndent();
WriteLn('end;');
end;
if ( locStoredPropsNbr > 0 ) then begin
for k := 0 to Pred(ASymbol.PropertyCount) do begin
p := ASymbol.Properties[k];
if ( p.StorageOption = soOptional ) then begin
NewLine();
WriteLn('function %s.Has%s() : Boolean;',[ASymbol.Name,p.Name]);
WriteLn('begin');
IncIndent();
Indent();
WriteLn('Result := True;');
DecIndent();
WriteLn('end;');
end;
end;
end;
end;
end;
begin
Prepare();
try
loc_BaseComplexSimpleContentRemotable := FSymbolTable.ByName('TBaseComplexSimpleContentRemotable') as TClassTypeDefinition;
SetCurrentStream(FDecStream);
NewLine();
IncIndent();
WriteDec();
WriteProperties();
Indent(); WriteLn('end;');
DecIndent();
FImpTempStream.Indent();
FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]);
SetCurrentStream(FImpStream);
WriteImp();
except
on e : Exception do
System.WriteLn('TInftGenerator.GenerateClass()=', ASymbol.Name, ' ;; ', e.Message);
end;
end;
procedure TInftGenerator.GenerateEnum(ASymbol: TEnumTypeDefinition);
var
itm : TEnumItemDefinition;
i : Integer;
begin
try
SetCurrentStream(FDecStream);
NewLine();
IncIndent();
Indent();WriteLn('%s = ( ',[ASymbol.Name]);
FImpTempStream.Indent();
FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]);
IncIndent();
for i := 0 to Pred(ASymbol.ItemCount) do begin
itm := ASymbol.Item[i];
Indent();
if ( i > 0 ) then
WriteLn(',%s',[itm.Name])
else
WriteLn('%s',[itm.Name]);
if not AnsiSameText(itm.Name,itm.ExternalName) then begin
FImpTempStream.Indent();
FImpTempStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(itm.Name),QuotedStr(itm.ExternalName)]);
end;
end;
DecIndent();
Indent(); WriteLn(');');
DecIndent();
except
on e : Exception do
System.WriteLn('TInftGenerator.GenerateClass()=', ASymbol.Name, ' ;; ', e.Message);
end;
end;
procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition);
procedure WriteObjectArray();
begin
SetCurrentStream(FDecStream);
NewLine();
IncIndent();
BeginAutoIndent();
try
WriteLn('%s = class(TBaseObjectArrayRemotable)',[ASymbol.Name]);
WriteLn('private');
Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ItemType.Name]);
WriteLn('public');
Indent();WriteLn('class function GetItemClass():TBaseRemotableClass;override;');
Indent();WriteLn('property Item[AIndex:Integer] : %s Read GetItem;Default;',[ASymbol.ItemType.Name]);
WriteLn('end;');
finally
EndAutoIndent();
DecIndent();
end;
SetCurrentStream(FImpStream);
NewLine();
WriteLn('{ %s }',[ASymbol.Name]);
NewLine();
WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ItemType.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('Result := Inherited GetItem(AIndex) As %s;',[ASymbol.ItemType.Name]);
DecIndent();
WriteLn('end;');
NewLine();
WriteLn('class function %s.GetItemClass(): TBaseRemotableClass;',[ASymbol.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('Result:= %s;',[ASymbol.ItemType.Name]);
DecIndent();
WriteLn('end;');
end;
procedure WriteSimpleTypeArray();
begin
SetCurrentStream(FDecStream);
NewLine();
IncIndent();
BeginAutoIndent();
try
WriteLn('%s = class(TBaseSimpleTypeArrayRemotable)',[ASymbol.Name]);
WriteLn('private');
Indent();WriteLn('FData : array of %s;',[ASymbol.ItemType.Name]);
WriteLn('private');
Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ItemType.Name]);
Indent();WriteLn('procedure SetItem(AIndex: Integer; const AValue: %s);',[ASymbol.ItemType.Name]);
WriteLn('protected');
Indent();WriteLn('function GetLength():Integer;override;');
Indent();WriteLn('procedure SaveItem(AStore : IFormatterBase;const AName : String;const AIndex : Integer);override;');
Indent();WriteLn('procedure LoadItem(AStore : IFormatterBase;const AIndex : Integer);override;');
WriteLn('public');
Indent();WriteLn('class function GetItemTypeInfo():PTypeInfo;override;');
Indent();WriteLn('procedure SetLength(const ANewSize : Integer);override;');
Indent();WriteLn('property Item[AIndex:Integer] : %s read GetItem write SetItem; default;',[ASymbol.ItemType.Name]);
WriteLn('end;');
finally
EndAutoIndent();
DecIndent();
end;
SetCurrentStream(FImpStream);
NewLine();
WriteLn('{ %s }',[ASymbol.Name]);
NewLine();
WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ItemType.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('CheckIndex(AIndex);');
Indent();WriteLn('Result := FData[AIndex];');
DecIndent();
WriteLn('end;');
NewLine();
WriteLn('procedure %s.SetItem(AIndex: Integer;const AValue: %S);',[ASymbol.Name,ASymbol.ItemType.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('CheckIndex(AIndex);');
Indent();WriteLn('FData[AIndex] := AValue;');
DecIndent();
WriteLn('end;');
NewLine();
WriteLn('function %s.GetLength(): Integer;',[ASymbol.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('Result := System.Length(FData);');
DecIndent();
WriteLn('end;');
NewLine();
WriteLn('procedure %s.SaveItem(AStore: IFormatterBase;const AName: String; const AIndex: Integer);',[ASymbol.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('AStore.Put(%s,TypeInfo(%s),FData[AIndex]);',[QuotedStr(ASymbol.ItemName),ASymbol.ItemType.Name]);
DecIndent();
WriteLn('end;');
NewLine();
IncIndent();
WriteLn('procedure %s.LoadItem(AStore: IFormatterBase;const AIndex: Integer);',[ASymbol.Name]);
WriteLn('var');
Indent();WriteLn('sName : string;');
WriteLn('begin');
Indent();WriteLn('sName := %s;',[QuotedStr(ASymbol.ItemName)]);
Indent();WriteLn('AStore.Get(TypeInfo(%s),sName,FData[AIndex]);',[ASymbol.ItemType.Name]);
DecIndent();
WriteLn('end;');
NewLine();
WriteLn('class function %s.GetItemTypeInfo(): PTypeInfo;',[ASymbol.Name]);
WriteLn('begin');
IncIndent();
Indent();WriteLn('Result := TypeInfo(%s);',[ASymbol.ItemType.Name]);
DecIndent();
WriteLn('end;');
NewLine();
IncIndent();
WriteLn('procedure %s.SetLength(const ANewSize: Integer);',[ASymbol.Name]);
WriteLn('var');
Indent();WriteLn('i : Integer;');
WriteLn('begin');
Indent();WriteLn('if ( ANewSize < 0 ) then');
Indent();Indent();WriteLn('i := 0');
Indent();WriteLn('else');
Indent();Indent();WriteLn('i := ANewSize;');
Indent();WriteLn('System.SetLength(FData,i);');
DecIndent();
WriteLn('end;');
end;
var
classItemArray : Boolean;
begin
classItemArray := ( ASymbol.ItemType is TClassTypeDefinition ) or
( ASymbol.ItemType is TArrayDefinition ) ;
if classItemArray then begin
WriteObjectArray();
end else begin
WriteSimpleTypeArray();
end;
FImpTempStream.Indent();
FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]);
end;
function TInftGenerator.GetDestUnitName(): string;
begin
Result := Format('%s_intf',[SymbolTable.Name]);
end;
constructor TInftGenerator.Create(
ASymTable : TSymbolTable;
ASrcMngr : ISourceManager
);
begin
inherited Create(ASymTable,ASrcMngr);
FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec');
FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp');
FImpTempStream := SrcMngr.CreateItem(GetDestUnitName() + '.tmp_imp');
FImpTempStream.IncIndent();
end;
procedure TInftGenerator.Execute();
var
i,c, j, k : Integer;
clssTyp : TClassTypeDefinition;
gnrClssLst : TObjectList;
objLst : TObjectList;
begin
objLst := nil;
gnrClssLst := TObjectList.Create(False);
try
GenerateUnitHeader();
GenerateUnitImplementationHeader();
c := Pred(SymbolTable.Count);
SetCurrentStream(FDecStream);
IncIndent();
for i := 0 to c do begin
if SymbolTable.Item[i] is TForwardTypeDefinition then begin
WriteLn('// %s = unable to resolve this symbol.',[SymbolTable.Item[i].Name]);
end;
end;
DecIndent();
IncIndent();
for i := 0 to c do begin
if ( SymbolTable.Item[i] is TClassTypeDefinition ) or
( SymbolTable.Item[i] is TArrayDefinition )
then begin
Indent();
WriteLn('%s = class;',[SymbolTable.Item[i].Name]);
end;
end;
DecIndent();
for i := 0 to c do begin
if SymbolTable.Item[i] is TEnumTypeDefinition then begin
GenerateEnum(SymbolTable.Item[i] as TEnumTypeDefinition);
end;
end;
for i := 0 to c do begin
if SymbolTable.Item[i] is TTypeAliasDefinition then begin
GenerateTypeAlias(SymbolTable.Item[i] as TTypeAliasDefinition);
end;
end;
objLst := TObjectList.Create();
objLst.OwnsObjects := False;
for i := 0 to c do begin
if SymbolTable.Item[i].InheritsFrom(TClassTypeDefinition) then begin
clssTyp := SymbolTable.Item[i] as TClassTypeDefinition;
if ( gnrClssLst.IndexOf(clssTyp) = -1 ) then begin
while ( objLst.Count > 0 ) do begin
objLst.Clear();
end;
while Assigned(clssTyp) do begin
objLst.Add(clssTyp);
if Assigned(clssTyp.Parent) and clssTyp.Parent.InheritsFrom(TClassTypeDefinition) then begin
clssTyp := clssTyp.Parent as TClassTypeDefinition;
end else begin
clssTyp := nil;
end;
end;
k := Pred(objLst.Count);
for j := 0 to k do begin
clssTyp := objLst[k-j] as TClassTypeDefinition;
if ( gnrClssLst.IndexOf(clssTyp) = -1 ) then begin
if ( FSymbolTable.IndexOf(clssTyp) <> -1 ) then begin
GenerateClass(clssTyp);
gnrClssLst.Add(clssTyp);
end;
end;
end;
end;
end;
end;
for i := 0 to c do begin
if SymbolTable.Item[i] is TArrayDefinition then begin
GenerateArray(SymbolTable.Item[i] as TArrayDefinition);
end;
end;
for i := 0 to c do begin
if SymbolTable.Item[i] is TInterfaceDefinition then begin
GenerateIntf(SymbolTable.Item[i] as TInterfaceDefinition);
end;
end;
GenerateUnitImplementationFooter();
FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream,FImpTempStream]);
FDecStream := nil;
FImpStream := nil;
FImpTempStream := nil;
finally
FreeAndNil(objLst);
FreeAndNil(gnrClssLst);
end;
end;
end.

859
wst/trunk/ws_helper/parserdefs.pas
View File

File diff suppressed because it is too large Load Diff

1
wst/trunk/ws_helper/test_CALCULATOR.bat Normal file
View File

@ -0,0 +1 @@
C:\Programmes\lazarus\wst\ws_helper\ws_helper -u -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\wst\tests\files\CALCULATOR.wsdl" >test_res_CALCULATOR.txt

1
wst/trunk/ws_helper/test_ebay.bat Normal file
View File

@ -0,0 +1 @@
C:\Programmes\lazarus\wst\ws_helper\ws_helper -u -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\utils\eBayLast\eBayWSDL.WSDL" >test_res_eBayWSDL.txt

1
wst/trunk/ws_helper/test_googleSearch.bat Normal file
View File

@ -0,0 +1 @@
C:\Programmes\lazarus\wst\ws_helper\ws_helper -u -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\utils\googleapi\GoogleSearch.wsdl" >test_res_GoogleSearch.txt

1
wst/trunk/ws_helper/test_metadata.bat Normal file
View File

@ -0,0 +1 @@
C:\Programmes\lazarus\wst\ws_helper\ws_helper -u -i -p -b -a"C:\Programmes\lazarus\wst\tests\files" "C:\Programmes\lazarus\wst\tests\files\metadata_service.wsdl" >test_res_metadata_service.txt

365
wst/trunk/ws_helper/ws_helper.lpi
View File

@ -12,6 +12,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=""/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<PublishOptions>
<Version Value="2"/>
@ -23,7 +24,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-b -i -o..\server E:\Inoussa\Sources\lazarus\projet_ki2\src\shared\gestion_intf.pas"/>
<CommandLineParams Value="-u -i -p -b -a&quot;C:\Programmes\lazarus\wst\tests\files&quot; &quot;C:\Programmes\lazarus\utils\googleapi\GoogleSearch.wsdl&quot;"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
@ -32,57 +33,67 @@
<PackageName Value="FCL"/>
</Item1>
</RequiredPackages>
<Units Count="35">
<Units Count="48">
<Unit0>
<Filename Value="ws_helper.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ws_helper"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<CursorPos X="26" Y="29"/>
<TopLine Value="15"/>
<EditorIndex Value="1"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="ws_parser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ws_parser"/>
<CursorPos X="21" Y="192"/>
<TopLine Value="234"/>
<CursorPos X="53" Y="420"/>
<TopLine Value="400"/>
<EditorIndex Value="7"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="generator"/>
<CursorPos X="39" Y="16"/>
<TopLine Value="148"/>
<CursorPos X="112" Y="448"/>
<TopLine Value="417"/>
<EditorIndex Value="0"/>
<UsageCount Value="200"/>
<Bookmarks Count="3">
<Item0 X="43" Y="692" ID="0"/>
<Item1 X="69" Y="829" ID="1"/>
<Item2 X="17" Y="194" ID="2"/>
<Item0 X="43" Y="723" ID="0"/>
<Item1 X="69" Y="860" ID="1"/>
<Item2 X="17" Y="219" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="parserdefs.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parserdefs"/>
<CursorPos X="14" Y="119"/>
<TopLine Value="29"/>
<CursorPos X="3" Y="41"/>
<TopLine Value="30"/>
<EditorIndex Value="5"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="parserutils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parserutils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="23"/>
<CursorPos X="1" Y="39"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="ws_helper.lpi"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="2"/>
<UsageCount Value="8"/>
<SyntaxHighlighter Value="None"/>
</Unit5>
<Unit6>
@ -90,84 +101,84 @@
<UnitName Value="Classes"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="2"/>
<UsageCount Value="8"/>
</Unit6>
<Unit7>
<Filename Value="usr\share\fpcsrc\rtl\objpas\strutils.pp"/>
<UnitName Value="strutils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="2"/>
<UsageCount Value="8"/>
</Unit7>
<Unit8>
<Filename Value="usr\share\fpcsrc\rtl\unix\sysutils.pp"/>
<UnitName Value="sysutils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="2"/>
<UsageCount Value="8"/>
</Unit8>
<Unit9>
<Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\lazarus\IdDsnCoreResourceStrings.pas"/>
<UnitName Value="IdDsnCoreResourceStrings"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="3"/>
<UsageCount Value="9"/>
</Unit9>
<Unit10>
<Filename Value="D:\Lazarus\others_package\indy\indy-10.2.0.1\lazarus\IdDsnPropEdBinding.pas"/>
<UnitName Value="IdDsnPropEdBinding"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="3"/>
<UsageCount Value="9"/>
</Unit10>
<Unit11>
<Filename Value="D:\Lazarus\ide\lazarus.pp"/>
<UnitName Value="Lazarus"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="3"/>
<UsageCount Value="9"/>
</Unit11>
<Unit12>
<Filename Value="source_utils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="source_utils"/>
<CursorPos X="1" Y="231"/>
<TopLine Value="220"/>
<UsageCount Value="179"/>
<CursorPos X="3" Y="34"/>
<TopLine Value="45"/>
<UsageCount Value="201"/>
</Unit12>
<Unit13>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<UnitName Value="getopts"/>
<CursorPos X="16" Y="45"/>
<TopLine Value="33"/>
<UsageCount Value="8"/>
<UsageCount Value="4"/>
</Unit13>
<Unit14>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\strutils.pp"/>
<UnitName Value="strutils"/>
<CursorPos X="23" Y="246"/>
<TopLine Value="246"/>
<UsageCount Value="7"/>
<UsageCount Value="3"/>
</Unit14>
<Unit15>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="10" Y="74"/>
<TopLine Value="70"/>
<UsageCount Value="7"/>
<UsageCount Value="3"/>
</Unit15>
<Unit16>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\sysutils\sysstr.inc"/>
<CursorPos X="3" Y="185"/>
<TopLine Value="180"/>
<UsageCount Value="7"/>
<UsageCount Value="3"/>
</Unit16>
<Unit17>
<Filename Value="command_line_parser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="command_line_parser"/>
<CursorPos X="1" Y="53"/>
<TopLine Value="42"/>
<UsageCount Value="159"/>
<CursorPos X="34" Y="69"/>
<TopLine Value="19"/>
<UsageCount Value="200"/>
</Unit17>
<Unit18>
<Filename Value="metadata_generator.pas"/>
@ -175,7 +186,7 @@
<UnitName Value="metadata_generator"/>
<CursorPos X="1" Y="19"/>
<TopLine Value="1"/>
<UsageCount Value="110"/>
<UsageCount Value="170"/>
</Unit18>
<Unit19>
<Filename Value="..\binary_streamer.pas"/>
@ -183,70 +194,70 @@
<UnitName Value="binary_streamer"/>
<CursorPos X="6" Y="13"/>
<TopLine Value="1"/>
<UsageCount Value="110"/>
<UsageCount Value="170"/>
</Unit19>
<Unit20>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\sysutils\finah.inc"/>
<CursorPos X="11" Y="27"/>
<TopLine Value="1"/>
<UsageCount Value="6"/>
<UsageCount Value="2"/>
</Unit20>
<Unit21>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\sysutils\fina.inc"/>
<CursorPos X="3" Y="26"/>
<TopLine Value="23"/>
<UsageCount Value="6"/>
<UsageCount Value="2"/>
</Unit21>
<Unit22>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="17" Y="662"/>
<TopLine Value="652"/>
<UsageCount Value="3"/>
<UsageCount Value="9"/>
</Unit22>
<Unit23>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\sysutils\filutilh.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="54"/>
<UsageCount Value="6"/>
<UsageCount Value="2"/>
</Unit23>
<Unit24>
<Filename Value="D:\Lazarus\lcl\lresources.pp"/>
<UnitName Value="LResources"/>
<CursorPos X="15" Y="590"/>
<TopLine Value="586"/>
<UsageCount Value="9"/>
<UsageCount Value="5"/>
</Unit24>
<Unit25>
<Filename Value="D:\Lazarus\fpcsrc\rtl\win\sysutils.pp"/>
<UnitName Value="sysutils"/>
<CursorPos X="12" Y="33"/>
<TopLine Value="11"/>
<UsageCount Value="6"/>
<UsageCount Value="2"/>
</Unit25>
<Unit26>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="11" Y="221"/>
<TopLine Value="194"/>
<UsageCount Value="6"/>
<UsageCount Value="2"/>
</Unit26>
<Unit27>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\win32\classes.pp"/>
<UnitName Value="Classes"/>
<CursorPos X="1" Y="47"/>
<TopLine Value="25"/>
<UsageCount Value="6"/>
<UsageCount Value="2"/>
</Unit27>
<Unit28>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="30" Y="1183"/>
<TopLine Value="1171"/>
<UsageCount Value="8"/>
<UsageCount Value="4"/>
</Unit28>
<Unit29>
<Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\parser.inc"/>
<CursorPos X="3" Y="303"/>
<TopLine Value="299"/>
<UsageCount Value="8"/>
<UsageCount Value="4"/>
</Unit29>
<Unit30>
<Filename Value="wst_resources_utils.pas"/>
@ -254,36 +265,240 @@
<UnitName Value="wst_resources_utils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="25"/>
<UsageCount Value="85"/>
</Unit30>
<Unit31>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\win32\classes.pp"/>
<UnitName Value="Classes"/>
<CursorPos X="8" Y="27"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<CursorPos X="1" Y="47"/>
<TopLine Value="20"/>
<UsageCount Value="9"/>
</Unit31>
<Unit32>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\win32\sysutils.pp"/>
<UnitName Value="sysutils"/>
<CursorPos X="15" Y="33"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit32>
<Unit33>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="15" Y="19"/>
<TopLine Value="7"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit33>
<Unit34>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\osutilsh.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<UsageCount Value="6"/>
</Unit34>
<Unit35>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\finah.inc"/>
<CursorPos X="10" Y="30"/>
<TopLine Value="16"/>
<UsageCount Value="6"/>
</Unit35>
<Unit36>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\fina.inc"/>
<CursorPos X="15" Y="102"/>
<TopLine Value="78"/>
<UsageCount Value="6"/>
</Unit36>
<Unit37>
<Filename Value="..\wsdl_to_pascal\wsdl2pas_imp.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wsdl2pas_imp"/>
<CursorPos X="29" Y="1641"/>
<TopLine Value="1633"/>
<UsageCount Value="77"/>
</Unit37>
<Unit38>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\fexpand.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="124"/>
<UsageCount Value="6"/>
</Unit38>
<Unit39>
<Filename Value="..\wst_rtti_filter\rtti_filters.pas"/>
<UnitName Value="rtti_filters"/>
<CursorPos X="1" Y="571"/>
<TopLine Value="557"/>
<UsageCount Value="11"/>
</Unit39>
<Unit40>
<Filename Value="..\wst_rtti_filter\dom_cursors.pas"/>
<UnitName Value="dom_cursors"/>
<CursorPos X="1" Y="194"/>
<TopLine Value="180"/>
<EditorIndex Value="4"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit40>
<Unit41>
<Filename Value="..\wst_rtti_filter\cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="1" Y="113"/>
<TopLine Value="99"/>
<EditorIndex Value="3"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit41>
<Unit42>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="41" Y="69"/>
<TopLine Value="67"/>
<UsageCount Value="7"/>
</Unit42>
<Unit43>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="14" Y="292"/>
<TopLine Value="271"/>
<UsageCount Value="10"/>
</Unit43>
<Unit44>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
<CursorPos X="26" Y="139"/>
<TopLine Value="125"/>
<UsageCount Value="9"/>
</Unit44>
<Unit45>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\objpas.inc"/>
<CursorPos X="11" Y="360"/>
<TopLine Value="354"/>
<UsageCount Value="9"/>
</Unit45>
<Unit46>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="14" Y="219"/>
<TopLine Value="183"/>
<UsageCount Value="10"/>
</Unit46>
<Unit47>
<Filename Value="wsdl2pas_imp.pas"/>
<UnitName Value="wsdl2pas_imp"/>
<CursorPos X="43" Y="883"/>
<TopLine Value="862"/>
<EditorIndex Value="2"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit47>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
<JumpHistory Count="28" HistoryIndex="27">
<Position1>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="802" Column="48" TopLine="780"/>
</Position1>
<Position2>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="1321" Column="37" TopLine="1300"/>
</Position3>
<Position4>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="1460" Column="57" TopLine="1438"/>
</Position4>
<Position5>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="849" Column="32" TopLine="861"/>
</Position5>
<Position6>
<Filename Value="wsdl2pas_imp.pas"/>
<Caret Line="802" Column="112" TopLine="788"/>
</Position6>
<Position7>
<Filename Value="generator.pas"/>
<Caret Line="458" Column="20" TopLine="420"/>
</Position7>
<Position8>
<Filename Value="generator.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position8>
<Position9>
<Filename Value="generator.pas"/>
<Caret Line="193" Column="9" TopLine="172"/>
</Position9>
<Position10>
<Filename Value="generator.pas"/>
<Caret Line="194" Column="39" TopLine="173"/>
</Position10>
<Position11>
<Filename Value="generator.pas"/>
<Caret Line="274" Column="9" TopLine="253"/>
</Position11>
<Position12>
<Filename Value="generator.pas"/>
<Caret Line="439" Column="47" TopLine="418"/>
</Position12>
<Position13>
<Filename Value="generator.pas"/>
<Caret Line="443" Column="49" TopLine="422"/>
</Position13>
<Position14>
<Filename Value="generator.pas"/>
<Caret Line="497" Column="34" TopLine="476"/>
</Position14>
<Position15>
<Filename Value="generator.pas"/>
<Caret Line="541" Column="9" TopLine="520"/>
</Position15>
<Position16>
<Filename Value="generator.pas"/>
<Caret Line="546" Column="9" TopLine="525"/>
</Position16>
<Position17>
<Filename Value="generator.pas"/>
<Caret Line="586" Column="9" TopLine="565"/>
</Position17>
<Position18>
<Filename Value="generator.pas"/>
<Caret Line="587" Column="19" TopLine="566"/>
</Position18>
<Position19>
<Filename Value="generator.pas"/>
<Caret Line="588" Column="18" TopLine="567"/>
</Position19>
<Position20>
<Filename Value="generator.pas"/>
<Caret Line="604" Column="9" TopLine="583"/>
</Position20>
<Position21>
<Filename Value="generator.pas"/>
<Caret Line="605" Column="47" TopLine="584"/>
</Position21>
<Position22>
<Filename Value="generator.pas"/>
<Caret Line="927" Column="26" TopLine="906"/>
</Position22>
<Position23>
<Filename Value="generator.pas"/>
<Caret Line="966" Column="9" TopLine="945"/>
</Position23>
<Position24>
<Filename Value="generator.pas"/>
<Caret Line="1001" Column="9" TopLine="980"/>
</Position24>
<Position25>
<Filename Value="generator.pas"/>
<Caret Line="1002" Column="44" TopLine="981"/>
</Position25>
<Position26>
<Filename Value="generator.pas"/>
<Caret Line="1215" Column="9" TopLine="1194"/>
</Position26>
<Position27>
<Filename Value="generator.pas"/>
<Caret Line="1250" Column="9" TopLine="1229"/>
</Position27>
<Position28>
<Filename Value="generator.pas"/>
<Caret Line="1535" Column="30" TopLine="1514"/>
</Position28>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
@ -292,7 +507,7 @@
<Filename Value="ws_helper.exe"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="..\"/>
<OtherUnitFiles Value="..\;C:\Programmes\lazarus\wst\wst_rtti_filter\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>
@ -306,6 +521,14 @@
<OptimizationLevel Value="2"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-Xi
"/>
@ -313,40 +536,32 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="8">
<BreakPoints Count="4">
<Item1>
<Source Value="generator.pas"/>
<Line Value="225"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item4>
<Item5>
<Source Value="ws_helper.pas"/>
<Line Value="85"/>
</Item5>
<Item6>
<Source Value="ws_helper.pas"/>
<Line Value="93"/>
</Item6>
<Item7>
<Source Value="ws_helper.pas"/>
<Line Value="95"/>
</Item7>
<Item8>
<Source Value="generator.pas"/>
<Line Value="870"/>
</Item8>
</Item4>
</BreakPoints>
<Watches Count="2">
<Item1>
<Expression Value="locStrFilter"/>
</Item1>
<Item2>
<Expression Value="i"/>
</Item2>
</Watches>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>

191
wst/trunk/ws_helper/ws_helper.pas
View File

@ -25,24 +25,32 @@ program ws_helper;
uses
Classes, SysUtils, wst_resources_utils,
parserdefs, ws_parser, generator, parserutils, source_utils,
command_line_parser, metadata_generator, binary_streamer;
command_line_parser, metadata_generator, binary_streamer,
DOM, xmlread, wsdl2pas_imp;
resourcestring
sUSAGE = 'ws_helper [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE +
sUSAGE = 'ws_helper [-u] [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE +
' -u Generate the pascal translation of the WSDL input file ' + sNEW_LINE +
' -p Generate service proxy' + sNEW_LINE +
' -b Generate service binder' + sNEW_LINE +
' -i Generate service minimal implementation' + sNEW_LINE +
' -o PATH Output directory' + sNEW_LINE;
' -o PATH Relative output directory' + sNEW_LINE +
' -a PATH Absolute output directory' + sNEW_LINE;
sCOPYRIGHT = 'ws_helper, Web Service Toolkit 0.3 Copyright (c) 2006 by Inoussa OUEDRAOGO';
const
sWST_META = 'wst_meta';
type
TSourceFileType = ( sftPascal, sftWSDL );
Var
inFileName,outPath,errStr : string;
srcMngr : ISourceManager;
AppOptions : TComandLineOptions;
NextParam : Integer;
sourceType : TSourceFileType;
symtable : TSymbolTable;
function ProcessCmdLine():boolean;
begin
@ -50,22 +58,83 @@ Var
If ( NextParam <= Paramcount ) Then
inFileName := ParamStr(NextParam);
Result := FileExists(ExpandFileName(inFileName));
if AnsiSameText(ExtractFileExt(inFileName),'.PAS') or
AnsiSameText(ExtractFileExt(inFileName),'.PP')
then begin
sourceType := sftPascal;
end else if AnsiSameText(ExtractFileExt(inFileName),'.WSDL') then begin
sourceType := sftWSDL;
end;
If Result Then Begin
If ( AppOptions = [] ) Then
Include(AppOptions,cloProxy);
End Else
errStr := Format('File not Found : "%s"',[inFileName]);
outPath := ExtractFilePath(inFileName);
If ( cloOutPutDir in AppOptions ) Then Begin
outPath := outPath + Trim(GetOptionArg(cloOutPutDir));
outPath := IncludeTrailingPathDelimiter(outPath);
End;
if ( cloOutPutDirAbsolute in AppOptions ) then begin
outPath := Trim(GetOptionArg(cloOutPutDirAbsolute));
end else begin
outPath := ExtractFilePath(inFileName);
if ( cloOutPutDirRelative in AppOptions ) then begin
outPath := outPath + Trim(GetOptionArg(cloOutPutDirRelative));
end;
end;
outPath := IncludeTrailingPathDelimiter(outPath);
end;
function GenerateSymbolTable() : Boolean ;
procedure ParsePascalFile();
var
s : TFileStream;
p : TPascalParser;
begin
s := nil;
p := nil;
try
s := TFileStream.Create(inFileName,fmOpenRead);
p := TPascalParser.Create(s,symtable);
if not p.Parse() then
p.Error('"%s" at line %d',[p.ErrorMessage,p.SourceLine]);
finally
FreeAndNil(p);
FreeAndNil(s);
end;
end;
procedure ParseWsdlFile();
var
locDoc : TXMLDocument;
prsr : TWsdlParser;
begin
prsr := nil;
ReadXMLFile(locDoc,inFileName);
try
prsr := TWsdlParser.Create(locDoc,symtable);
prsr.Parse();
finally
FreeAndNil(prsr);
FreeAndNil(locDoc);
end;
end;
begin
try
WriteLn('Parsing the file : ', inFileName);
case sourceType of
sftPascal : ParsePascalFile();
sftWSDL : ParseWsdlFile();
end;
Result := True;
except
on e : Exception do begin
Result := False;
errStr := e.Message;
end;
end;
end;
function ProcessFile():Boolean;
Var
p : TPascalParser;
s : TFileStream;
mtdaFS: TMemoryStream;
g : TBaseGenerator;
mg : TMetadataGenerator;
@ -76,86 +145,98 @@ Var
mtdaFS := nil;
mg := nil;
g := Nil;
s := Nil;
p := Nil;
Try
Try
s := TFileStream.Create(inFileName,fmOpenRead);
p := TPascalParser.Create(s);
If Not p.Parse() Then
p.Error(p.ErrorMessage);
try
try
if ( cloInterface in AppOptions ) then begin
WriteLn('Interface file generation...');
g := TInftGenerator.Create(symtable,srcMngr);
g.Execute();
FreeAndNil(g);
end;
If ( cloProxy in AppOptions ) Then Begin
g := TProxyGenerator.Create(p.SymbolTable,srcMngr);
WriteLn('Proxy file generation...');
g := TProxyGenerator.Create(symtable,srcMngr);
g.Execute();
FreeAndNil(g);
End;
If ( cloBinder in AppOptions ) Then Begin
g := TBinderGenerator.Create(p.SymbolTable,srcMngr);
WriteLn('Binder file generation...');
g := TBinderGenerator.Create(symtable,srcMngr);
g.Execute();
FreeAndNil(g);
End;
If ( cloImp in AppOptions ) Then Begin
g := TImplementationGenerator.Create(p.SymbolTable,srcMngr);
WriteLn('Implementation file generation...');
g := TImplementationGenerator.Create(symtable,srcMngr);
g.Execute();
FreeAndNil(g);
End;
if ( [cloBinder,cloProxy]*AppOptions <> [] ) then begin
WriteLn('Metadata file generation...');
mtdaFS := TMemoryStream.Create();
mg := TMetadataGenerator.Create(p.SymbolTable,CreateBinaryWriter(mtdaFS));
mg := TMetadataGenerator.Create(symtable,CreateBinaryWriter(mtdaFS));
mg.Execute();
mtdaFS.SaveToFile(ChangeFileExt(inFileName,'.' + sWST_META));
rsrcStrm := TMemoryStream.Create();
mtdaFS.Position := 0;
//BinaryToLazarusResourceCode(mtdaFS,rsrcStrm,UpperCase(p.SymbolTable.Name),sWST_META);
BinToWstRessource(UpperCase(p.SymbolTable.Name),mtdaFS,rsrcStrm);
BinToWstRessource(UpperCase(symtable.Name),mtdaFS,rsrcStrm);
rsrcStrm.SaveToFile(outPath + ChangeFileExt(ExtractFileName(inFileName),'.' + sWST_EXTENSION));
end;
Result := True;
Except
On E : Exception Do Begin
except
on E : Exception do begin
Result := False;
errStr := Format('"%s" at line %d',[E.Message,p.SourceLine]) ;
End;
End;
Finally
errStr := E.Message;
end;
end;
finally
rsrcStrm.Free();
mg.Free();;
mtdaFS.Free();;
g.Free();
p.Free();
s.Free();
End;
end;
end;
begin
Try
Writeln(sCOPYRIGHT);
If ( ParamCount = 0 ) Then Begin
WriteLn(sUSAGE);
Exit;
End;
symtable := nil;
try
try
Writeln(sCOPYRIGHT);
If ( ParamCount = 0 ) Then Begin
WriteLn(sUSAGE);
Exit;
End;
if not ProcessCmdLine() then begin
WriteLn(errStr);
Exit;
end;
symtable := TSymbolTable.Create(ChangeFileExt(ExtractFileName(inFileName),''));
srcMngr := CreateSourceManager();
srcMngr := CreateSourceManager();
If Not ProcessCmdLine() Then Begin
WriteLn(errStr);
Exit;
End;
if not GenerateSymbolTable() then begin
WriteLn(errStr);
Exit;
end;
If Not ProcessFile() Then Begin
WriteLn(errStr);
Exit;
End;
If Not ProcessFile() Then Begin
WriteLn(errStr);
Exit;
End;
srcMngr.SaveToFile(outPath);
WriteLn(Format('File "%s" parsed succesfully.',[inFileName]));
except
on e:exception Do
Writeln('Exception : ' + e.Message)
srcMngr.SaveToFile(outPath);
WriteLn(Format('File "%s" parsed succesfully.',[inFileName]));
except
on e:exception Do
Writeln('Exception : ' + e.Message)
end;
finally
FreeAndNil(symtable);
end;
end.

10
wst/trunk/ws_helper/ws_parser.pas
View File

@ -60,7 +60,7 @@ Type
procedure ParseEnumType(Const AName : String);
procedure ParseClassType(Const AName : String);
public
constructor Create(AStream : TStream);
constructor Create(AStream : TStream; ASymbolTable : TSymbolTable);
destructor Destroy();override;
procedure Error(Const AMsg : String);overload;
procedure Error(Const AMsg : String; Const AArgs : Array of const);overload;
@ -417,7 +417,7 @@ begin
tmpStr := Tokenizer.TokenString;
If ( FSymbolTable.IndexOf(tmpStr) > -1 ) Then
Error('Duplicated symbol : "%s"',[tmpStr]);
sblItem := TEnumItemDefinition.Create(tmpStr,tmpInt);
sblItem := TEnumItemDefinition.Create(tmpStr,sbl,tmpInt);
FSymbolTable.Add(sblItem);
sbl.AddItem(sblItem);
NextToken();
@ -451,19 +451,19 @@ begin
NextToken();
end;
constructor TPascalParser.Create(AStream : TStream);
constructor TPascalParser.Create(AStream : TStream; ASymbolTable : TSymbolTable);
begin
Assert(Assigned(AStream));
Assert(Assigned(ASymbolTable));
FStream := AStream;
FTokenizer := TParser.Create(FStream);
FSymbolTable := TSymbolTable.Create('tmp_name');
FSymbolTable := ASymbolTable;
FCurrentSymbol := Nil;
end;
destructor TPascalParser.Destroy();
begin
FTokenizer.Free();
FreeAndNil(FSymbolTable);
inherited Destroy();
end;

1924
wst/trunk/ws_helper/wsdl2pas_imp.pas Normal file
View File

File diff suppressed because it is too large Load Diff

153
wst/trunk/wst_rtti_filter/cursor_intf.pas Normal file
View File

@ -0,0 +1,153 @@
unit cursor_intf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
ECursorException = class(Exception)
end;
ICursor = interface
['{2B7756B1-E239-4B6F-A7A3-4B57B98FAD4F}']
procedure Reset();
function MoveNext() : Boolean;
function Clone():ICursor;
end;
IObjectFilter = interface
['{3DFB1A26-ED2D-428A-9F62-2091A076D97B}']
function Evaluate(const AObject : TObject) : Boolean;
end;
IObjectCursor = interface(ICursor)
['{13E9C22D-0508-4D7A-A969-96E2291B4FE8}']
function GetCurrent() : TObject;
end;
IFilterableObjectCursor = interface(IObjectCursor)
['{F11B588A-E8CF-45D3-98D2-B49755FFC22D}']
function GetFilter() : IObjectFilter;
function SetFilter(const AFilter : IObjectFilter) : IObjectFilter;
end;
function CreateCursorOn(
AInputCursor : IObjectCursor;
AFilter : IObjectFilter
) : IFilterableObjectCursor ;
(*
['{4E3C49EE-5EA6-47CD-8862-3AA4F96BD86E}']
['{65D250B6-90AC-40DC-A6EE-4750188D1D94}']
['{8B4AE228-C231-45E5-B8A4-2864481B9263}']
['{658709D2-2D25-44DB-83CF-DC430D55A21F}']
['{B2CFB744-43CF-4787-8256-A0F34E26A729}']
['{D3A4A37A-B63A-42AD-8E44-4AD4C28E3C34}']
['{DB7A8303-0621-41A0-A948-A7BD71CA99F8}']
['{3BB114EB-73CF-4555-ABC7-ABA4A643DBDA}']
['{C64B6235-54BE-4DA9-A5E8-D67B579FA14F}']
*)
implementation
type
{ TSimpleObjectFilterableCursor }
TSimpleObjectFilterableCursor = class(
TInterfacedObject,
ICursor,IObjectCursor,IFilterableObjectCursor
)
private
FBaseCursor : IObjectCursor;
FFilter : IObjectFilter;
protected
procedure Reset();
function MoveNext() : Boolean;
function Clone():ICursor;
function GetCurrent() : TObject;
function GetFilter() : IObjectFilter;
function SetFilter(const AFilter : IObjectFilter) : IObjectFilter;
public
constructor Create(
AInputCursor : IObjectCursor;
AFilter : IObjectFilter
);
end;
function CreateCursorOn(
AInputCursor : IObjectCursor;
AFilter : IObjectFilter
) : IFilterableObjectCursor ;
begin
Result := TSimpleObjectFilterableCursor.Create(AInputCursor,AFilter);
end;
{ TSimpleObjectFilterableCursor }
procedure TSimpleObjectFilterableCursor.Reset();
begin
FBaseCursor.Reset();
end;
function TSimpleObjectFilterableCursor.MoveNext(): Boolean;
begin
if ( FFilter = nil ) then begin
Result := FBaseCursor.MoveNext();
end else begin
while FBaseCursor.MoveNext() do begin
if FFilter.Evaluate(FBaseCursor.GetCurrent()) then begin
Result := True;
exit;
end;
end;
Result := False;
end;
end;
function TSimpleObjectFilterableCursor.Clone(): ICursor;
var
baseClone : ICursor;
begin
Result := nil;
baseClone := FBaseCursor.Clone();
if ( baseClone <> nil ) then
Result := TSimpleObjectFilterableCursor.Create(baseClone as IObjectCursor,FFilter);
end;
function TSimpleObjectFilterableCursor.GetCurrent(): TObject;
begin
Result := FBaseCursor.GetCurrent();
end;
function TSimpleObjectFilterableCursor.GetFilter(): IObjectFilter;
begin
Result := FFilter;
end;
function TSimpleObjectFilterableCursor.SetFilter(const AFilter: IObjectFilter): IObjectFilter;
begin
FFilter := AFilter;
Result := FFilter;
end;
constructor TSimpleObjectFilterableCursor.Create(
AInputCursor : IObjectCursor;
AFilter : IObjectFilter
);
begin
Assert(Assigned(AInputCursor));
inherited Create();
FBaseCursor := AInputCursor;
FFilter := AFilter;
end;
end.

257
wst/trunk/wst_rtti_filter/dom_cursors.pas Normal file
View File

@ -0,0 +1,257 @@
unit dom_cursors;
{$mode objfpc}{$H+}
//{$define FPC_211}
interface
uses
Classes, SysUtils,
cursor_intf, DOM;
type
TFreeAction = ( faNone, faFreeOnDestroy );
{ TDOMNodeListCursor }
TDOMNodeListCursor = class(TInterfacedObject,ICursor,IObjectCursor)
private
FList : TDOMNodeList;
FCurrent : TDOMNode;
FFreeListOnDestroy : TFreeAction;
FHasItem : Boolean;
protected
procedure Reset();
function MoveNext() : Boolean;
function Clone():ICursor;
function GetCurrent() : TObject;virtual;
public
constructor Create(
ADataList : TDOMNodeList;
const AFreeListOnDestroy : TFreeAction
);
destructor Destroy();override;
end;
{ TDOMNamedNodeMapCursor }
TDOMNamedNodeMapCursor = class(TInterfacedObject,ICursor,IObjectCursor)
private
FList : TDOMNamedNodeMap;
FCurrent : Integer;
FFreeListOnDestroy : TFreeAction;
protected
procedure Reset();
function MoveNext() : Boolean;
function Clone():ICursor;
function GetCurrent() : TObject;
public
constructor Create(
ADataList : TDOMNamedNodeMap;
const AFreeListOnDestroy : TFreeAction
);
destructor Destroy();override;
end;
{ TDOMNodeRttiExposer }
TDOMNodeRttiExposer = class(TPersistent)
private
FInnerObject: TDOMNode;
function GetNodeName: DOMString;
function GetNodeValue: DOMString;
procedure SetInnerObject(const AValue: TDOMNode);
public
constructor Create(AInnerObject : TDOMNode);
property InnerObject : TDOMNode read FInnerObject write SetInnerObject;
published
property NodeName: DOMString read GetNodeName;
property NodeValue: DOMString read GetNodeValue;
end;
{ TDOMNodeRttiExposerCursor }
TDOMNodeRttiExposerCursor = class(TInterfacedObject,ICursor,IObjectCursor)
private
FCurrentExposer : TDOMNodeRttiExposer;
FBaseCursor : IObjectCursor;
protected
procedure Reset();
function MoveNext() : Boolean;
function Clone():ICursor;
function GetCurrent() : TObject;virtual;
public
constructor Create(ADataList : IObjectCursor);
destructor Destroy();override;
end;
implementation
{ TDOMNodeListCursor }
procedure TDOMNodeListCursor.Reset();
begin
FCurrent := nil;
end;
function TDOMNodeListCursor.MoveNext(): Boolean;
begin
if ( FCurrent = nil ) then begin
if FHasItem then
FCurrent := FList.Item[0];
end else begin
FCurrent := FCurrent.NextSibling;
end;
Result := ( FCurrent <> nil ) ;
end;
function TDOMNodeListCursor.Clone(): ICursor;
begin
Result := TDOMNodeListCursor.Create(FList,faNone);
end;
function TDOMNodeListCursor.GetCurrent(): TObject;
begin
Result := FCurrent;
end;
constructor TDOMNodeListCursor.Create(
ADataList : TDOMNodeList;
const AFreeListOnDestroy : TFreeAction
);
begin
Assert(Assigned(ADataList));
FFreeListOnDestroy := AFreeListOnDestroy;
FList := ADataList;
FHasItem := ( FList.Count > 0 );
Reset();
end;
destructor TDOMNodeListCursor.Destroy();
begin
FCurrent := nil;
if ( FFreeListOnDestroy = faFreeOnDestroy ) then
FreeAndNil(FList)
else
FList := nil;
inherited Destroy();
end;
{ TDOMNodeRttiExposer }
function TDOMNodeRttiExposer.GetNodeName: DOMString;
begin
Result := InnerObject.NodeName;
end;
function TDOMNodeRttiExposer.GetNodeValue: DOMString;
begin
Result := InnerObject.NodeValue;
end;
procedure TDOMNodeRttiExposer.SetInnerObject(const AValue: TDOMNode);
begin
if ( FInnerObject = AValue ) then
exit;
FInnerObject := AValue;
end;
constructor TDOMNodeRttiExposer.Create(AInnerObject: TDOMNode);
begin
Inherited Create();
SetInnerObject(AInnerObject);
end;
{ TDOMNodeRttiExposerCursor }
procedure TDOMNodeRttiExposerCursor.Reset();
begin
FBaseCursor.Reset();
end;
function TDOMNodeRttiExposerCursor.MoveNext(): Boolean;
begin
Result := FBaseCursor.MoveNext();
end;
function TDOMNodeRttiExposerCursor.Clone(): ICursor;
var
baseClone : ICursor;
begin
Result := nil;
baseClone := FBaseCursor.Clone();
if ( baseClone <> nil ) then
Result := TDOMNodeRttiExposerCursor.Create(baseClone as IObjectCursor) ;
end;
function TDOMNodeRttiExposerCursor.GetCurrent(): TObject;
begin
FCurrentExposer.InnerObject := FBaseCursor.GetCurrent() as TDOMNode;
if ( FCurrentExposer.InnerObject = nil ) then
Result := nil
else
Result := FCurrentExposer;
end;
constructor TDOMNodeRttiExposerCursor.Create(ADataList : IObjectCursor);
begin
Assert(Assigned(ADataList));
inherited Create();
FBaseCursor := ADataList;
FCurrentExposer := TDOMNodeRttiExposer.Create(nil);
end;
destructor TDOMNodeRttiExposerCursor.Destroy();
begin
FreeAndNil(FCurrentExposer);;
inherited Destroy();
end;
{ TDOMNamedNodeMapCursor }
procedure TDOMNamedNodeMapCursor.Reset();
begin
FCurrent := -1;
end;
function TDOMNamedNodeMapCursor.MoveNext(): Boolean;
begin
Inc(FCurrent);
Result := ( FCurrent < FList.{$IFNDEF FPC_211}Count{$ELSE}Length{$ENDIF} );
end;
function TDOMNamedNodeMapCursor.Clone(): ICursor;
begin
Result := TDOMNamedNodeMapCursor.Create(FList,faNone);
end;
function TDOMNamedNodeMapCursor.GetCurrent(): TObject;
begin
if ( FCurrent > -1 ) and ( FCurrent < FList.{$IFNDEF FPC_211}Count{$ELSE}Length{$ENDIF} ) then
Result := FList.Item[FCurrent]
else
Result := nil;
end;
constructor TDOMNamedNodeMapCursor.Create(
ADataList : TDOMNamedNodeMap;
const AFreeListOnDestroy : TFreeAction
);
begin
Assert(Assigned(ADataList));
FFreeListOnDestroy := AFreeListOnDestroy;
FList := ADataList;
Reset();
end;
destructor TDOMNamedNodeMapCursor.Destroy();
begin
if ( FFreeListOnDestroy = faFreeOnDestroy ) then
FreeAndNil(FList)
else
FList := nil;
inherited Destroy();
end;
end.

655
wst/trunk/wst_rtti_filter/rtti_filters.pas Normal file
View File

@ -0,0 +1,655 @@
unit rtti_filters;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Contnrs, TypInfo,
cursor_intf;
type
ERttiFilterException = class(Exception)
end;
TFilterConnector = ( fcNone, fcAnd, fcOr );
TNumericFilterOperator = ( nfoEqual, nfoGreater, nfoLesser, nfoNotEqual );
TStringFilterOperator = ( sfoEqualCaseSensitive, sfoEqualCaseInsensitive, sfoNotEqual );
TRttiFilterCreatorTarget = TPersistent;
TRttiFilterCreatorTargetClass = class of TRttiFilterCreatorTarget;
TRttiExpNodeItem = class;
TRttiExpNode = class;
TClearAction = ( clrNone, clrFreeObjects );
{ TRttiFilterCreator }
TRttiFilterCreator = class
private
FRoot : TRttiExpNode;
FCurrent : TRttiExpNode;
FTargetClass: TRttiFilterCreatorTargetClass;
FCurrentStack : TObjectStack;
private
procedure AddNode(
const ANode : TRttiExpNodeItem;
const AConnector : TFilterConnector
);
procedure PushCurrent(ACurrent : TRttiExpNode);
function PopCurrent() : TRttiExpNode;
public
constructor Create(const ATargetClass : TRttiFilterCreatorTargetClass);
destructor Destroy();override;
procedure Clear(const AFreeObjects : TClearAction);
function AddCondition(
const APropertyName : string;
const AOperator : TNumericFilterOperator;
const AValue : Integer;
const AConnector : TFilterConnector
) : TRttiFilterCreator;overload;
function AddCondition(
const APropertyName : string;
const AOperator : TStringFilterOperator;
const AValue : AnsiString;
const AConnector : TFilterConnector
) : TRttiFilterCreator;overload;
function AddCondition(
const APropertyName : string;
const AOperator : TStringFilterOperator;
const AValue : WideString;
const AConnector : TFilterConnector
) : TRttiFilterCreator;overload;
function BeginGroup(const AConnector : TFilterConnector):TRttiFilterCreator;
function EndGroup():TRttiFilterCreator;
property TargetClass : TRttiFilterCreatorTargetClass read FTargetClass;
property Root : TRttiExpNode read FRoot;
end;
TRttiExpNodeItem = class
public
function Evaluate(AInstance : TRttiFilterCreatorTarget):Boolean;virtual;abstract;
end;
{ TRttiObjectFilter }
TRttiObjectFilter = class(TInterfacedObject,IObjectFilter)
private
FFilterRoot : TRttiExpNodeItem;
FOnDestroyFilterAction : TClearAction;
protected
function Evaluate(const AObject : TObject) : Boolean;
public
constructor Create(
AFilterRoot : TRttiExpNodeItem;
const AOnDestroyFilterAction : TClearAction
);
destructor Destroy();override;
end;
{ TRttiExpNode }
TRttiExpNode = class(TRttiExpNodeItem)
private
FConnector: TFilterConnector;
FLeft: TRttiExpNodeItem;
FRight: TRttiExpNodeItem;
private
procedure SetConnector(const AValue: TFilterConnector);
procedure SetLeft(const AValue: TRttiExpNodeItem);
procedure SetRight(const AValue: TRttiExpNodeItem);
public
destructor Destroy();override;
function Evaluate(AInstance : TRttiFilterCreatorTarget):Boolean;override;
property Connector : TFilterConnector read FConnector write SetConnector;
property Left : TRttiExpNodeItem read FLeft write SetLeft;
property Right : TRttiExpNodeItem read FRight write SetRight;
end;
{ TRttiExpConcreteNodeItem }
TRttiExpConcreteNodeItem = class(TRttiExpNodeItem)
private
FPropInfo: PPropInfo;
public
constructor Create(const APropInfo : PPropInfo);
property PropInfo : PPropInfo read FPropInfo;
end;
{ TRttiExpNumericNodeItem }
TRttiExpNumericNodeItem = class(TRttiExpConcreteNodeItem)
private
FOperation: TNumericFilterOperator;
public
constructor Create(
const APropInfo : PPropInfo;
const AOperation : TNumericFilterOperator
);
property Operation : TNumericFilterOperator read FOperation;
end;
{ TRttiExpIntegerNodeItem }
TRttiExpIntegerNodeItem = class(TRttiExpNumericNodeItem)
private
FComparedValue: Integer;
public
constructor Create(
const APropInfo : PPropInfo;
const AOperation : TNumericFilterOperator;
const AComparedValue : Integer
);
function Evaluate(AInstance : TRttiFilterCreatorTarget):Boolean;override;
property ComparedValue : Integer read FComparedValue;
end;
{ TRttiExpStringNodeItem }
TRttiExpStringNodeItem = class(TRttiExpConcreteNodeItem)
private
FOperation: TStringFilterOperator;
public
constructor Create(
const APropInfo : PPropInfo;
const AOperation : TStringFilterOperator
);
property Operation : TStringFilterOperator read FOperation;
end;
{ TRttiExpAnsiStringNodeItem }
TRttiExpAnsiStringNodeItem = class(TRttiExpStringNodeItem)
private
FComparedValue: AnsiString;
public
constructor Create(
const APropInfo : PPropInfo;
const AOperation : TStringFilterOperator;
const AComparedValue : AnsiString
);
function Evaluate(AInstance : TRttiFilterCreatorTarget):Boolean;override;
property ComparedValue : AnsiString read FComparedValue;
end;
{ TRttiExpWideStringNodeItem }
TRttiExpWideStringNodeItem = class(TRttiExpStringNodeItem)
private
FComparedValue: WideString;
public
constructor Create(
const APropInfo : PPropInfo;
const AOperation : TStringFilterOperator;
const AComparedValue : WideString
);
function Evaluate(AInstance : TRttiFilterCreatorTarget):Boolean;override;
property ComparedValue : WideString read FComparedValue;
end;
procedure ParseFilter(const AFilterText: string; AFltrCrtr : TRttiFilterCreator);overload;
function ParseFilter(
const AFilterText : string;
ATargetClass : TRttiFilterCreatorTargetClass
) : IObjectFilter;overload;
implementation
function ParseFilter(
const AFilterText : string;
ATargetClass : TRttiFilterCreatorTargetClass
) : IObjectFilter;
var
fltr : TRttiFilterCreator;
begin
Result := nil;
fltr := TRttiFilterCreator.Create(ATargetClass);
try
try
ParseFilter(AFilterText,fltr);
Result := TRttiObjectFilter.Create(fltr.Root,clrFreeObjects);
fltr.Clear(clrNone);
except
fltr.Clear(clrFreeObjects);
end;
finally
FreeAndNil(fltr);
end;
end;
procedure ParseFilter(const AFilterText: string; AFltrCrtr : TRttiFilterCreator);
const
tkn_LeftParenthesis = '('; tkn_RigthParenthesis = ')';
tkn_Equal = '='; tkn_NotEqual = '<>';
tkn_Sup = '>'; tkn_Inf = '<';
tkn_And = 'and'; tkn_Or = 'or';
var
strm : TStringStream;
prsr : TParser;
procedure MoveNext();
begin
prsr.NextToken();
if ( prsr.Token = toEOF ) then
raise ERttiFilterException.Create('Unexpected end of filter.');
end;
var
propName : string;
propInfo : PPropInfo;
lastCntr : TFilterConnector;
procedure Handle_String();
var
s : string;
ws : WideString;
fltrOp : TStringFilterOperator;
begin
MoveNext();
s := prsr.TokenString();
if ( s = tkn_Equal ) then
fltrOp := sfoEqualCaseInsensitive
else if ( s = tkn_NotEqual ) then
fltrOp := sfoNotEqual
else
raise ERttiFilterException.CreateFmt('Unexpected symbol : "%s".',[s]);
MoveNext();
prsr.CheckToken(toString);
if ( propInfo^.PropType^.Kind = tkWString ) then begin
ws := prsr.TokenString();
AFltrCrtr.AddCondition(propName,fltrOp,ws,lastCntr);
end else begin
s := prsr.TokenString();
AFltrCrtr.AddCondition(propName,fltrOp,s,lastCntr);
end;
end;
procedure Handle_Integer();
var
s : string;
fltrOp : TNumericFilterOperator;
begin
MoveNext();
s := prsr.TokenString();
if ( s = tkn_Equal ) then
fltrOp := nfoEqual
else if ( s = tkn_NotEqual ) then
fltrOp := nfoNotEqual
else if ( s = tkn_Inf ) then
fltrOp := nfoLesser
else if ( s = tkn_Sup ) then
fltrOp := nfoGreater
else
raise ERttiFilterException.CreateFmt('Unexpected symbol : "%s".',[s]);
MoveNext();
prsr.CheckToken(toInteger);
AFltrCrtr.AddCondition(propName,fltrOp,prsr.TokenInt(),lastCntr);
end;
var
s : string;
begin
lastCntr := fcAnd;
AFltrCrtr.Clear(clrFreeObjects);
strm := TStringStream.Create(Trim(AFilterText));
try
prsr := TParser.Create(strm);
while ( prsr.Token <> toEOF ) do begin
s := prsr.TokenString();
if SameText(s,tkn_LeftParenthesis) then
AFltrCrtr.BeginGroup(lastCntr)
else if SameText(s,tkn_RigthParenthesis) then
AFltrCrtr.EndGroup()
else if SameText(s,tkn_And) then
lastCntr := fcAnd
else if SameText(s,tkn_Or) then
lastCntr := fcOr
else begin
prsr.CheckToken(toSymbol);
propName := prsr.TokenString();
propInfo := GetPropInfo(AFltrCrtr.TargetClass,propName);
if ( propInfo = nil ) then
raise ERttiFilterException.CreateFmt('Invalid property : "%s"',[propName]);
if ( propInfo^.PropType^.Kind in [tkSString,tkLString,tkAString,tkWString] ) then
Handle_String()
else if ( propInfo^.PropType^.Kind in [tkInteger,tkInt64,tkQWord] ) then
Handle_Integer()
else
raise ERttiFilterException.CreateFmt('Type not handled : "%s"',[GetEnumName(TypeInfo(TTypeKind),Ord(propInfo^.PropType^.Kind))]);
end;
prsr.NextToken();
end;
finally
FreeAndNil(strm);
end;
end;
procedure ClearObject(ARoot : TRttiExpNodeItem);
begin
if Assigned(ARoot) then begin
if ARoot.InheritsFrom(TRttiExpNode) then begin
with TRttiExpNode(ARoot) do begin
ClearObject(Right);
Right := nil;
ClearObject(Left);
Left := nil;
end;
end;
ARoot.Free();
end;
end;
{ TRttiExpNode }
procedure TRttiExpNode.SetRight(const AValue: TRttiExpNodeItem);
begin
if ( Connector = fcNone ) and ( AValue <> nil ) then
raise ERttiFilterException.Create('"Connector" must be set before "Right".');
//FreeAndNil(FRight);
FRight := AValue;
end;
procedure TRttiExpNode.SetConnector(const AValue: TFilterConnector);
begin
if ( AValue = fcNone ) and ( FRight <> nil ) then
raise ERttiFilterException.Create('"Right" must be set to "nil" before "Connector" can be set to "none".');
FConnector := AValue;
end;
procedure TRttiExpNode.SetLeft(const AValue: TRttiExpNodeItem);
begin
if ( FRight <> nil ) and ( AValue = nil ) then
raise ERttiFilterException.Create('"Right" must be set to "nil" before "Left" can be set to "none".');
//FreeAndNil(FLeft);
FLeft := AValue;
end;
destructor TRttiExpNode.Destroy();
begin
FreeAndNil(FLeft);
FreeAndNil(FRight);
inherited Destroy();
end;
function TRttiExpNode.Evaluate(AInstance: TRttiFilterCreatorTarget): Boolean;
begin
if Assigned(Left) then begin
Result := Left.Evaluate(AInstance);
if not Assigned(Right) then
Exit;
if Result and ( Connector = fcOr ) then
Exit;
if ( not Result ) and ( Connector = fcAnd ) then
Exit;
Result := Right.Evaluate(AInstance);
end else begin
Result := False;
end;
end;
{ TRttiExpConcreteNodeItem }
constructor TRttiExpConcreteNodeItem.Create(const APropInfo : PPropInfo);
begin
Assert(Assigned(APropInfo));
FPropInfo := APropInfo;
end;
{ TRttiExpIntegerNodeItem }
constructor TRttiExpIntegerNodeItem.Create(
const APropInfo : PPropInfo;
const AOperation : TNumericFilterOperator;
const AComparedValue : Integer
);
begin
Assert(Assigned(APropInfo));
if not ( APropInfo^.PropType^.Kind in [tkInteger,tkInt64,tkQWord] ) then
raise ERttiFilterException.CreateFmt('Invalid property data type. "%s" excpeted.',['Integer']);
inherited Create(APropInfo,AOperation);
FComparedValue := AComparedValue;
end;
function TRttiExpIntegerNodeItem.Evaluate(AInstance: TRttiFilterCreatorTarget): Boolean;
begin
case Operation of
nfoEqual : Result := ( GetOrdProp(AInstance,PropInfo) = ComparedValue );
nfoGreater : Result := ( GetOrdProp(AInstance,PropInfo) > ComparedValue );
nfoLesser : Result := ( GetOrdProp(AInstance,PropInfo) < ComparedValue );
nfoNotEqual : Result := ( GetOrdProp(AInstance,PropInfo) <> ComparedValue );
end;
end;
{ TRttiFilterCreator }
procedure TRttiFilterCreator.AddNode(
const ANode : TRttiExpNodeItem;
const AConnector : TFilterConnector
);
var
tmpNode : TRttiExpNode;
begin
Assert(Assigned(ANode));
if not Assigned(FRoot) then begin
FRoot := TRttiExpNode.Create();
FCurrent := FRoot;
end;
if not Assigned(FCurrent.Left) then begin
FCurrent.Left := ANode;
FCurrent.Connector := AConnector;
Exit;
end;
if ( AConnector <= fcNone ) then
raise ERttiFilterException.Create('Invalid connector value.');
if not Assigned(FCurrent.Right) then begin
FCurrent.Right := ANode;
FCurrent.Connector := AConnector;
Exit;
end;
tmpNode := TRttiExpNode.Create();
tmpNode.Left := FCurrent.Right;
FCurrent.Right := tmpNode;
FCurrent := tmpNode;
FCurrent.Connector := AConnector;
FCurrent.Right := ANode;
end;
procedure TRttiFilterCreator.PushCurrent(ACurrent: TRttiExpNode);
begin
FCurrentStack.Push(FCurrent);
FCurrent := ACurrent;
end;
function TRttiFilterCreator.PopCurrent(): TRttiExpNode;
begin
if not FCurrentStack.AtLeast(1) then
raise ERttiFilterException.Create('"BeginGroup" must be called before "EndGroup".');
Result := FCurrentStack.Pop() as TRttiExpNode;
FCurrent := Result;
end;
constructor TRttiFilterCreator.Create(const ATargetClass: TRttiFilterCreatorTargetClass);
begin
Assert(Assigned(ATargetClass));
FTargetClass := ATargetClass;
FCurrentStack := TObjectStack.Create();
end;
destructor TRttiFilterCreator.Destroy();
begin
FreeAndNil(FCurrentStack);
inherited Destroy();
end;
procedure TRttiFilterCreator.Clear(const AFreeObjects: TClearAction);
var
i : Integer;
begin
if ( AFreeObjects = clrFreeObjects ) then
ClearObject(FRoot);
for i := 0 to Pred(FCurrentStack.Count) do
FCurrentStack.Pop();
FRoot := nil;
end;
function TRttiFilterCreator.AddCondition(
const APropertyName : string;
const AOperator : TNumericFilterOperator;
const AValue : Integer;
const AConnector : TFilterConnector
) : TRttiFilterCreator;
begin
AddNode(
TRttiExpIntegerNodeItem.Create(GetPropInfo(TargetClass,APropertyName),AOperator,AValue),
AConnector
);
Result := Self;
end;
function TRttiFilterCreator.AddCondition(
const APropertyName : string;
const AOperator : TStringFilterOperator;
const AValue : AnsiString;
const AConnector : TFilterConnector
): TRttiFilterCreator;
begin
AddNode(
TRttiExpAnsiStringNodeItem.Create(GetPropInfo(TargetClass,APropertyName),AOperator,AValue),
AConnector
);
Result := Self;
end;
function TRttiFilterCreator.AddCondition(
const APropertyName : string;
const AOperator : TStringFilterOperator;
const AValue : WideString;
const AConnector : TFilterConnector
): TRttiFilterCreator;
begin
AddNode(
TRttiExpWideStringNodeItem.Create(GetPropInfo(TargetClass,APropertyName),AOperator,AValue),
AConnector
);
Result := Self;
end;
function TRttiFilterCreator.BeginGroup(const AConnector: TFilterConnector):TRttiFilterCreator;
var
gn : TRttiExpNode;
begin
if not Assigned(FCurrent) then
AddNode(TRttiExpNode.Create(),fcNone);
gn := TRttiExpNode.Create();
AddNode(gn,AConnector);
PushCurrent(gn);
Result := Self;
end;
function TRttiFilterCreator.EndGroup(): TRttiFilterCreator;
begin
PopCurrent();
Result := Self;
end;
{ TRttiObjectFilter }
function TRttiObjectFilter.Evaluate(const AObject: TObject): Boolean;
begin
Result := FFilterRoot.Evaluate(TRttiFilterCreatorTarget(AObject));
end;
constructor TRttiObjectFilter.Create(
AFilterRoot : TRttiExpNodeItem;
const AOnDestroyFilterAction : TClearAction
);
begin
Assert(Assigned(AFilterRoot));
FFilterRoot := AFilterRoot;
FOnDestroyFilterAction := AOnDestroyFilterAction;
end;
destructor TRttiObjectFilter.Destroy();
begin
if ( FOnDestroyFilterAction = clrFreeObjects ) then
ClearObject(FFilterRoot);
inherited Destroy();
end;
{ TRttiExpNumericNodeItem }
constructor TRttiExpNumericNodeItem.Create(
const APropInfo: PPropInfo;
const AOperation: TNumericFilterOperator
);
begin
Assert(Assigned(APropInfo));
inherited Create(APropInfo);
FOperation := AOperation;
end;
{ TRttiExpStringNodeItem }
constructor TRttiExpStringNodeItem.Create(
const APropInfo: PPropInfo;
const AOperation: TStringFilterOperator
);
begin
Assert(Assigned(APropInfo));
inherited Create(APropInfo);
FOperation := AOperation;
end;
{ TRttiExpAnsiStringNodeItem }
constructor TRttiExpAnsiStringNodeItem.Create(
const APropInfo: PPropInfo;
const AOperation: TStringFilterOperator;
const AComparedValue: AnsiString
);
begin
Assert(Assigned(APropInfo));
if not ( APropInfo^.PropType^.Kind in [tkSString,tkLString,tkAString] ) then
raise ERttiFilterException.CreateFmt('Invalid property data type. "%s" excpeted.',['AnsiString']);
inherited Create(APropInfo,AOperation);
FComparedValue := AComparedValue;
end;
function TRttiExpAnsiStringNodeItem.Evaluate(AInstance: TRttiFilterCreatorTarget): Boolean;
begin
case Operation of
sfoEqualCaseSensitive : Result := ( GetStrProp(AInstance,PropInfo) = ComparedValue );
sfoEqualCaseInsensitive : Result := AnsiSameText(GetStrProp(AInstance,PropInfo),ComparedValue);
sfoNotEqual : Result := ( GetStrProp(AInstance,PropInfo) <> ComparedValue);
end;
end;
{ TRttiExpWideStringNodeItem }
constructor TRttiExpWideStringNodeItem.Create(
const APropInfo: PPropInfo;
const AOperation: TStringFilterOperator;
const AComparedValue: WideString
);
begin
Assert(Assigned(APropInfo));
if not ( APropInfo^.PropType^.Kind in [tkWString] ) then
raise ERttiFilterException.CreateFmt('Invalid property data type. "%s" excpeted.',['WideString']);
inherited Create(APropInfo,AOperation);
FComparedValue := AComparedValue;
end;
function TRttiExpWideStringNodeItem.Evaluate(AInstance: TRttiFilterCreatorTarget): Boolean;
begin
case Operation of
sfoEqualCaseSensitive : Result := ( GetStrProp(AInstance,PropInfo) = ComparedValue );
sfoEqualCaseInsensitive : Result := WideSameText(GetStrProp(AInstance,PropInfo),ComparedValue);
sfoNotEqual : Result := ( GetStrProp(AInstance,PropInfo) <> ComparedValue );
end;
end;
end.

266
wst/trunk/wst_rtti_filter/rtti_filters_tests.lpi Normal file
View File

@ -0,0 +1,266 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-a"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="FCL"/>
</Item1>
</RequiredPackages>
<Units Count="22">
<Unit0>
<Filename Value="rtti_filters_tests.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rtti_filters_tests"/>
<CursorPos X="9" Y="15"/>
<TopLine Value="49"/>
<UsageCount Value="67"/>
</Unit0>
<Unit1>
<Filename Value="tests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="tests"/>
<CursorPos X="41" Y="861"/>
<TopLine Value="873"/>
<EditorIndex Value="0"/>
<UsageCount Value="67"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="rtti_filters.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rtti_filters"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="67"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="cursor_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="31" Y="19"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="67"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="67" Y="40"/>
<TopLine Value="27"/>
<UsageCount Value="9"/>
</Unit4>
<Unit5>
<Filename Value="D:\Lazarus\fpcsrc\rtl\inc\objpash.inc"/>
<CursorPos X="23" Y="138"/>
<TopLine Value="128"/>
<UsageCount Value="6"/>
</Unit5>
<Unit6>
<Filename Value="D:\Lazarus\fpcsrc\fcl\fpcunit\DUnitCompatibleInterface.inc"/>
<CursorPos X="13" Y="134"/>
<TopLine Value="119"/>
<UsageCount Value="8"/>
</Unit6>
<Unit7>
<Filename Value="D:\Lazarus\fpcsrc\fcl\fpcunit\testregistry.pp"/>
<UnitName Value="testregistry"/>
<CursorPos X="11" Y="29"/>
<TopLine Value="19"/>
<UsageCount Value="5"/>
</Unit7>
<Unit8>
<Filename Value="D:\Lazarus\fpcsrc\fcl\fpcunit\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="3" Y="542"/>
<TopLine Value="540"/>
<UsageCount Value="8"/>
</Unit8>
<Unit9>
<Filename Value="D:\Lazarus\fpcsrc\fcl\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="26" Y="72"/>
<TopLine Value="66"/>
<UsageCount Value="8"/>
</Unit9>
<Unit10>
<Filename Value="std_cursors.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="std_cursors"/>
<CursorPos X="54" Y="68"/>
<TopLine Value="50"/>
<EditorIndex Value="3"/>
<UsageCount Value="48"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="3" Y="186"/>
<TopLine Value="204"/>
<UsageCount Value="8"/>
</Unit11>
<Unit12>
<Filename Value="D:\Lazarus\fpcsrc\rtl\objpas\classes\lists.inc"/>
<CursorPos X="3" Y="355"/>
<TopLine Value="353"/>
<UsageCount Value="8"/>
</Unit12>
<Unit13>
<Filename Value="test_std_cursors.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_std_cursors"/>
<CursorPos X="48" Y="202"/>
<TopLine Value="190"/>
<EditorIndex Value="5"/>
<UsageCount Value="48"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="26" Y="68"/>
<TopLine Value="54"/>
<UsageCount Value="15"/>
</Unit14>
<Unit15>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="10" Y="80"/>
<TopLine Value="67"/>
<UsageCount Value="8"/>
</Unit15>
<Unit16>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysstr.inc"/>
<CursorPos X="53" Y="453"/>
<TopLine Value="451"/>
<UsageCount Value="8"/>
</Unit16>
<Unit17>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\wstringh.inc"/>
<CursorPos X="5" Y="67"/>
<TopLine Value="53"/>
<UsageCount Value="8"/>
</Unit17>
<Unit18>
<Filename Value="dom_cursors.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="dom_cursors"/>
<CursorPos X="46" Y="168"/>
<TopLine Value="120"/>
<EditorIndex Value="4"/>
<UsageCount Value="39"/>
<Loaded Value="True"/>
</Unit18>
<Unit19>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="15" Y="426"/>
<TopLine Value="412"/>
<UsageCount Value="13"/>
</Unit19>
<Unit20>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="14" Y="1168"/>
<TopLine Value="1154"/>
<UsageCount Value="13"/>
</Unit20>
<Unit21>
<Filename Value="..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\parser.inc"/>
<CursorPos X="3" Y="303"/>
<TopLine Value="297"/>
<UsageCount Value="13"/>
</Unit21>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="rtti_filters_tests.exe"/>
</Target>
<SearchPaths>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CustomOptions Value="-Xi
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="9">
<Item1>
<Source Value="..\v0.3\tests\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
<Line Value="15"/>
</Item1>
<Item2>
<Source Value="..\v0.3\tests\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
<Line Value="16"/>
</Item2>
<Item3>
<Source Value="..\v0.3\tests\google_api\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
<Line Value="18"/>
</Item3>
<Item4>
<Source Value="..\v0.3\tests\google_api\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
<Line Value="63"/>
</Item4>
<Item5>
<Source Value="..\v0.3\tests\google_api\home\inoussa\Projets\Laz\v0.2\indy_http_protocol.pas"/>
<Line Value="69"/>
</Item5>
<Item6>
<Source Value="..\v0.3\tests\google_api\home\inoussa\Projets\Laz\v0.2\service_intf.pas"/>
<Line Value="567"/>
</Item6>
<Item7>
<Source Value="..\v0.3\tests\google_api\home\inoussa\Projets\Laz\v0.2\imp_utils.pas"/>
<Line Value="83"/>
</Item7>
<Item8>
<Source Value="tests.pas"/>
<Line Value="830"/>
</Item8>
<Item9>
<Source Value="tests.pas"/>
<Line Value="919"/>
</Item9>
</BreakPoints>
<Watches Count="1">
<Item1>
<Expression Value="ASource.Memory^"/>
</Item1>
</Watches>
</Debugging>
</CONFIG>

159
wst/trunk/wst_rtti_filter/rtti_filters_tests.lpr Normal file
View File

@ -0,0 +1,159 @@
program rtti_filters_tests;
{$mode objfpc}{$H+}
//{$DEFINE VER2_0}
uses
custapp, Classes, SysUtils, fpcunit, testreport, testregistry, tests,
cursor_intf, rtti_filters, std_cursors, test_std_cursors, dom_cursors;
const
ShortOpts = 'alh';
Longopts: array[1..5] of string = ('all', 'list', 'format:', 'suite:', 'help');
Version = 'Version 0.1';
type
TFormat = (fPlain, fLatex, fXML);
TTestRunner = class(TCustomApplication)
private
protected
procedure DoRun; override;
procedure doTestRun(aTest: TTest); virtual;
public
end;
var
FormatParam: TFormat;
procedure TTestRunner.doTestRun(aTest: TTest);
var
testResult: TTestResult;
procedure doXMLTestRun(aText: TTest);
var
XMLResultsWriter: TXMLResultsWriter;
begin
try
XMLResultsWriter := TXMLResultsWriter.Create;
testResult.AddListener(XMLResultsWriter);
XMLResultsWriter.WriteHeader;
aTest.Run(testResult);
XMLResultsWriter.WriteResult(testResult);
finally
XMLResultsWriter.Free;
testResult.Free;
end;
end;
{$IFNDEF VER2_0}
procedure doPlainTestRun(aText: TTest);
var
PlainResultsWriter: TPlainResultsWriter;
begin
try
PlainResultsWriter := TPlainResultsWriter.Create;
testResult.AddListener(PlainResultsWriter);
PlainResultsWriter.WriteHeader;
aTest.Run(testResult);
PlainResultsWriter.WriteResult(testResult);
finally
PlainResultsWriter.Free;
testResult.Free;
end;
end;
{$ENDIF}
begin
testResult := TTestResult.Create;
case FormatParam of
fLatex: doXMLTestRun(aTest); //no latex implemented yet
{$IFNDEF VER2_0}
fPlain: doPlainTestRun(aTest);
{$ENDIF}
else
doXMLTestRun(aTest);
end;
end;
procedure TTestRunner.DoRun;
var
I: integer;
S: string;
begin
S := CheckOptions(ShortOpts, LongOpts);
if (S <> '') then
Writeln(S);
if HasOption('h', 'help') or (ParamCount = 0) then
begin
writeln(Title);
writeln(Version);
writeln;
writeln('Usage: ');
writeln(' --format=latex output as latex source (only list implemented)');
{$IFNDEF VER2_0}
writeln(' --format=plain output as plain ASCII source');
{$ENDIF}
writeln(' --format=xml output as XML source (default)');
writeln;
writeln(' -l or --list show a list of registered tests');
writeln(' -a or --all run all tests');
writeln(' --suite=MyTestSuiteName run single test suite class');
writeln;
writeln('The results can be redirected to an xml file,');
writeln('for example: ./testrunner --all > results.xml');
end;
//get the format parameter
FormatParam := fXML;
if HasOption('format') then
begin
if GetOptionValue('format') = 'latex' then
FormatParam := fLatex;
{$IFNDEF VER2_0}
if GetOptionValue('format') = 'plain' then
FormatParam := fPlain;
{$ENDIF}
end;
//get a list of all registed tests
if HasOption('l', 'list') then
case FormatParam of
fLatex: Write(GetSuiteAsLatex(GetTestRegistry));
{$IFNDEF VER2_0}
fPlain: Write(GetSuiteAsPlain(GetTestRegistry));
{$ENDIF}
else
Write(GetSuiteAsXML(GetTestRegistry));
end;
//run the tests
if HasOption('a', 'all') then
doTestRun(GetTestRegistry)
else
if HasOption('suite') then
begin
S := '';
S := GetOptionValue('suite');
if S = '' then
for I := 0 to GetTestRegistry.Tests.Count - 1 do
writeln(GetTestRegistry[i].TestName)
else
for I := 0 to GetTestRegistry.Tests.Count - 1 do
if GetTestRegistry[i].TestName = S then
doTestRun(GetTestRegistry[i]);
end;
Terminate;
end;
var
App: TTestRunner;
begin
App := TTestRunner.Create(nil);
App.Initialize;
App.Title := 'FPCUnit Console Test Case runner.';
App.Run;
App.Free;
end.

11
wst/trunk/wst_rtti_filter/rtti_filters_tests.pas Normal file
View File

@ -0,0 +1,11 @@
program rtti_filters_tests;
{$mode objfpc}{$H+}
uses
Classes, SysUtils,
cursor_intf, rtti_filters;
begin
end.

112
wst/trunk/wst_rtti_filter/std_cursors.pas Normal file
View File

@ -0,0 +1,112 @@
unit std_cursors;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Contnrs,
cursor_intf;
type
{ TObjectListCursor }
TObjectListCursor = class(TInterfacedObject,ICursor,IObjectCursor)
private
FList : TObjectList;
FCurrentIndex : Integer;
protected
procedure Reset();
function MoveNext() : Boolean;virtual;
function Clone():ICursor;
function GetCurrent() : TObject;
public
constructor Create(ADataList : TObjectList);
end;
{ TObjectListFilterableCursor }
TObjectListFilterableCursor = class(TObjectListCursor,IFilterableObjectCursor)
private
FFilter : IObjectFilter;
protected
function MoveNext() : Boolean;override;
function GetFilter() : IObjectFilter;
function SetFilter(const AFilter : IObjectFilter) : IObjectFilter;
public
destructor Destroy();override;
end;
implementation
{ TObjectListCursor }
procedure TObjectListCursor.Reset();
begin
FCurrentIndex := -1;
end;
function TObjectListCursor.MoveNext(): Boolean;
begin
Inc(FCurrentIndex);
Result := ( FCurrentIndex < FList.Count );
end;
function TObjectListCursor.Clone(): ICursor;
begin
Result := TObjectListCursor.Create(FList);
end;
function TObjectListCursor.GetCurrent(): TObject;
begin
if ( FCurrentIndex < 0 ) or ( FCurrentIndex >= FList.Count ) then
raise ECursorException.Create('Invalid cursor state.');
Result := FList[FCurrentIndex];
end;
constructor TObjectListCursor.Create(ADataList: TObjectList);
begin
Assert(Assigned(ADataList));
FList := ADataList;
Reset();
end;
{ TObjectListFilterableCursor }
function TObjectListFilterableCursor.MoveNext(): Boolean;
begin
if ( FFilter = nil ) then begin
Result := inherited MoveNext();
end else begin
while ( inherited MoveNext() ) do begin
if FFilter.Evaluate(GetCurrent()) then begin
Result := True;
Exit;
end;
end;
Result := False;
end;
end;
function TObjectListFilterableCursor.GetFilter(): IObjectFilter;
begin
Result := FFilter;
end;
function TObjectListFilterableCursor.SetFilter(
const AFilter: IObjectFilter
): IObjectFilter;
begin
FFilter := AFilter;
Result := FFilter;
end;
destructor TObjectListFilterableCursor.Destroy();
begin
FFilter := nil;
inherited Destroy();
end;
end.

232
wst/trunk/wst_rtti_filter/test_std_cursors.pas Normal file
View File

@ -0,0 +1,232 @@
unit test_std_cursors;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Contnrs,
fpcunit, testutils, testregistry,
cursor_intf, std_cursors, rtti_filters;
type
{ TClass_A }
TClass_A = class(TPersistent)
private
FIntProp: Integer;
public
constructor Create(AIntProp : Integer);
published
property IntProp : Integer read FIntProp;
end;
{ TClass_B }
TClass_B = class(TClass_A)
private
FIntProp_A: Integer;
FIntProp_B: Integer;
public
constructor Create(AIntProp,AIntProp_A,AIntProp_B : Integer);
published
property IntProp_A : Integer read FIntProp_A;
property IntProp_B : Integer read FIntProp_B;
end;
{ TObjectListCursor_Test }
TObjectListCursor_Test = class(TTestCase)
published
procedure All();
end;
{ TObjectListFilterableCursor_Test }
TObjectListFilterableCursor_Test = class(TTestCase)
published
procedure All();
end;
implementation
{ TClass_A }
constructor TClass_A.Create(AIntProp: Integer);
begin
FIntProp := AIntProp;
end;
{ TObjectListCursor_Test }
procedure TObjectListCursor_Test.All();
const O_COUNT = 100;
var
x : IObjectCursor;
ls : TObjectList;
c, i : Integer;
begin
ls := TObjectList.Create(True);
try
x := TObjectListCursor.Create(ls);
x.Reset();
CheckEquals(False,x.MoveNext());
x.Reset();
CheckEquals(False,x.MoveNext());
CheckEquals(False,x.MoveNext());
try
x.GetCurrent();
Check(False);
except
on e : ECursorException do begin
// GOOD
end;
end;
ls.Add(TClass_A.Create(0));
x.Reset();
CheckEquals(True,x.MoveNext());
CheckSame(ls[0],x.GetCurrent());
CheckEquals(False,x.MoveNext());
try
x.GetCurrent();
Check(False);
except
on e : ECursorException do begin
// GOOD
end;
end;
x.Reset();
CheckEquals(True,x.MoveNext());
CheckSame(ls[0],x.GetCurrent());
CheckEquals(False,x.MoveNext());
ls.Clear();
for i := 0 to Pred(O_COUNT) do
ls.Add(TClass_A.Create(i));
x.Reset();
for i := 0 to Pred(O_COUNT) do begin
CheckEquals(True,x.MoveNext());
CheckSame(ls[i],x.GetCurrent());
end;
CheckEquals(False,x.MoveNext());
x.Reset();
for i := 0 to Pred(O_COUNT) do begin
CheckEquals(True,x.MoveNext());
CheckSame(ls[i],x.GetCurrent());
end;
finally
ls.Free();
end;
end;
{ TClass_B }
constructor TClass_B.Create(AIntProp, AIntProp_A, AIntProp_B: Integer);
begin
inherited Create(AIntProp);
FIntProp_A := AIntProp_A;
FIntProp_B := AIntProp_B;
end;
{ TObjectListFilterableCursor_Test }
procedure TObjectListFilterableCursor_Test.All();
const O_COUNT = 100;
var
x : IFilterableObjectCursor;
ls : TObjectList;
c, i : Integer;
f : IObjectFilter;
fcr : TRttiFilterCreator;
begin
fcr := nil;
ls := TObjectList.Create(True);
try
x := TObjectListFilterableCursor.Create(ls);
CheckNull(x.GetFilter());
x.Reset();
CheckEquals(False,x.MoveNext());
x.Reset();
CheckEquals(False,x.MoveNext());
CheckEquals(False,x.MoveNext());
try
x.GetCurrent();
Check(False);
except
on e : ECursorException do begin
// GOOD
end;
end;
ls.Add(TClass_A.Create(0));
x.Reset();
CheckEquals(True,x.MoveNext());
CheckSame(ls[0],x.GetCurrent());
CheckEquals(False,x.MoveNext());
try
x.GetCurrent();
Check(False);
except
on e : ECursorException do begin
// GOOD
end;
end;
x.Reset();
CheckEquals(True,x.MoveNext());
CheckSame(ls[0],x.GetCurrent());
CheckEquals(False,x.MoveNext());
ls.Clear();
for i := 0 to Pred(O_COUNT) do
ls.Add(TClass_A.Create(i));
x.Reset();
for i := 0 to Pred(O_COUNT) do begin
CheckEquals(True,x.MoveNext());
CheckSame(ls[i],x.GetCurrent());
end;
CheckEquals(False,x.MoveNext());
x.Reset();
for i := 0 to Pred(O_COUNT) do begin
CheckEquals(True,x.MoveNext());
CheckSame(ls[i],x.GetCurrent());
end;
ls.Clear();
for i := 0 to Pred(O_COUNT) do
ls.Add(TClass_B.Create(i,( i mod 10 ), ( i mod ( ( i + 1 ) * 2 ) ) ));
fcr := TRttiFilterCreator.Create(TClass_B);
fcr.AddCondition('IntProp',nfoEqual,-1,fcOr);//
f := TRttiObjectFilter.Create(fcr.Root,clrFreeObjects) as IObjectFilter;
x.SetFilter(f);
Check(x.GetFilter()=f);
x.SetFilter(nil);
CheckNull(x.GetFilter());
x.SetFilter(f);
Check(x.GetFilter()=f);
x.Reset();
CheckEquals(False,x.MoveNext());
fcr.AddCondition('IntProp',nfoGreater,-1,fcOr);
x.Reset();
CheckEquals(True,x.MoveNext());
x.Reset();
for i := 0 to Pred(O_COUNT) do begin
CheckEquals(True,x.MoveNext());
CheckSame(ls[i],x.GetCurrent());
end;
finally
ls.Free();
fcr.Free();
end;
end;
Initialization
RegisterTests([TObjectListCursor_Test,TObjectListFilterableCursor_Test]);
end.

900
wst/trunk/wst_rtti_filter/tests.pas Normal file
View File

@ -0,0 +1,900 @@
unit tests;
{$mode objfpc}{$H+}
//{$DEFINE DBG_DISPLAY}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, TypInfo,
rtti_filters;
type
{ TClass_A }
TClass_A = class(TPersistent)
private
FIntProp: Integer;
FStrProp: string;
FWideStrProp: widestring;
published
property IntProp : Integer read FIntProp write FIntProp;
property StrProp : string read FStrProp write FStrProp;
property WideStrProp : widestring read FWideStrProp write FWideStrProp;
end;
TClass_AClass = class of TClass_A;
{ TRttiExpIntegerNodeItem_Test }
TRttiExpIntegerNodeItem_Test = class(TTestCase)
published
procedure Create_Test();
procedure Evaluate_Equal();
procedure Evaluate_Lesser();
procedure Evaluate_Greater();
end;
{ TRttiExpAnsiStringNodeItem_Test }
TRttiExpAnsiStringNodeItem_Test = class(TTestCase)
published
procedure Create_Test();
procedure Evaluate_EqualCaseSensitive();
procedure Evaluate_EqualCaseInsensitive();
end;
{ TRttiExpwWideStringNodeItem_Test }
TRttiExpwWideStringNodeItem_Test = class(TTestCase)
published
procedure Create_Test();
procedure Evaluate_EqualCaseSensitive();
procedure Evaluate_EqualCaseInsensitive();
end;
{ TRttiExpNode_Test }
TRttiExpNode_Test = class(TTestCase)
published
procedure Left_True();
procedure LeftTrue_Or_RightFalse();
procedure LeftTrue_Or_RightTrue();
procedure LeftTrue_And_RightFalse();
procedure LeftTrue_And_RightTrue();
procedure Left_False();
procedure LeftFalse_Or_RightFalse();
procedure LeftFalse_Or_RightTrue();
procedure LeftFalse_And_RightFalse();
end;
{ TRttiFilterCreator_Test }
TRttiFilterCreator_Test = class(TTestCase)
published
procedure Creation();
procedure AddContion();
procedure BeginEnd_Group();
end;
{ TRttiParser_Test }
TRttiParser_Test = class(TTestCase)
published
procedure SimpleOperators();
procedure BeginEnd_Group();
end;
implementation
procedure TRttiExpIntegerNodeItem_Test.Create_Test();
var
x : TRttiExpIntegerNodeItem;
begin
x := nil;
try
try
x := TRttiExpIntegerNodeItem.Create(GetPropInfo(TClass_A,'StrProp'),nfoEqual,10);
Check(False);
except
on e : EAssertionFailedError do
raise;
on e : ERttiFilterException do begin
// nothing!
end;
end;
finally
x.Free();
end;
end;
procedure TRttiExpIntegerNodeItem_Test.Evaluate_Equal();
const VAL_1 : Integer = 1210;
var
x : TRttiExpIntegerNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoEqual,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = False ,'False');
t.IntProp := VAL_1;
Check( x.Evaluate(t) = True, 'True' );
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpIntegerNodeItem_Test.Evaluate_Lesser();
const VAL_1 : Integer = 1210;
var
x : TRttiExpIntegerNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = True ,'True');
t.IntProp := VAL_1 + 1;
Check( x.Evaluate(t) = False, 'False' );
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpIntegerNodeItem_Test.Evaluate_Greater();
const VAL_1 : Integer = 1210;
var
x : TRttiExpIntegerNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoGreater,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = False, 'False' );
t.IntProp := VAL_1 + 1;
Check( x.Evaluate(t) = True ,'True');
finally
x.Free();
t.Free();
end;
end;
{ TRttiExpNode_Test }
procedure TRttiExpNode_Test.Left_True();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoEqual,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = False, 'False' );
t.IntProp := VAL_1;
Check( x.Evaluate(t) = True ,'True');
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.LeftTrue_Or_RightFalse();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,VAL_1);
x.Connector := fcOr;
x.Right := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoGreater,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = True ,'True');
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.LeftTrue_Or_RightTrue();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,VAL_1);
x.Connector := fcOr;
x.Right := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = True ,'True');
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.LeftTrue_And_RightFalse();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,VAL_1);
x.Connector := fcAnd;
x.Right := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoGreater,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = False ,'False');
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.LeftTrue_And_RightTrue();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,VAL_1);
x.Connector := fcAnd;
x.Right := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = True ,'True');
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.Left_False();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoGreater,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = False, 'False' );
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.LeftFalse_Or_RightFalse();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoEqual,VAL_1);
x.Connector := fcOr;
x.Right := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoGreater,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = False ,'False');
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.LeftFalse_Or_RightTrue();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoEqual,VAL_1);
x.Connector := fcOr;
x.Right := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoEqual,0);
t.IntProp := 0;
Check( x.Evaluate(t) = True ,'True');
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpNode_Test.LeftFalse_And_RightFalse();
const VAL_1 : Integer = 1210;
var
x : TRttiExpNode;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpNode.Create();
CheckNull(x.Left);
CheckNull(x.Right);
Check(x.Connector = fcNone);
x.Left := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesser,-VAL_1);
x.Connector := fcAnd;
x.Right := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoGreater,VAL_1);
t.IntProp := 0;
Check( x.Evaluate(t) = False ,'False');
finally
x.Free();
t.Free();
end;
end;
{ TRttiFilterCreator_Test }
procedure TRttiFilterCreator_Test.Creation();
var
x : TRttiFilterCreator;
begin
x := TRttiFilterCreator.Create(TClass_A);
try
CheckNull(x.Root,'Root <> nil');
Check(( x.TargetClass = TClass_A ), 'TargetClass');
finally
x.Free();
end;
end;
procedure Display(const AMsg : string);
begin
{$IFDEF DBG_DISPLAY}
Write(AMsg);
{$ENDIF}
end;
type TPrintProc = procedure(const AMsg : string);
procedure PrintTree(
ATree : TRttiExpNodeItem;
APrintProc : TPrintProc;
const AIndent : Integer
);
begin
if Assigned(ATree) then begin
if ATree.InheritsFrom(TRttiExpNode) then begin
APrintProc(StringOfChar('-',AIndent));
APrintProc(GetEnumName(TypeInfo(TFilterConnector),Ord(TRttiExpNode(ATree).Connector)) + #10#13);
PrintTree(TRttiExpNode(ATree).Left,APrintProc,AIndent+2);
PrintTree(TRttiExpNode(ATree).Right,APrintProc,AIndent+2);
end else if ATree.InheritsFrom(TRttiExpConcreteNodeItem) then begin
APrintProc(StringOfChar('-',AIndent));
if ATree.InheritsFrom(TRttiExpNumericNodeItem) then begin
APrintProc(TRttiExpConcreteNodeItem(ATree).PropInfo^.Name + ' ' + GetEnumName(TypeInfo(TNumericFilterOperator),Ord(TRttiExpNumericNodeItem(ATree).Operation)) );
end else if ATree.InheritsFrom(TRttiExpStringNodeItem) then begin
APrintProc(TRttiExpConcreteNodeItem(ATree).PropInfo^.Name + ' ' + GetEnumName(TypeInfo(TStringFilterOperator),Ord(TRttiExpStringNodeItem(ATree).Operation)) )
end;
if ATree.InheritsFrom(TRttiExpIntegerNodeItem) then
APrintProc(' ' + IntToStr(TRttiExpIntegerNodeItem(ATree).ComparedValue))
else if ATree.InheritsFrom(TRttiExpAnsiStringNodeItem) then
APrintProc(' ' + QuotedStr(TRttiExpAnsiStringNodeItem(ATree).ComparedValue));
APrintProc(#10#13);
end;
end;
end;
procedure CompareTree(ATreeA,ATreeB : TRttiExpNodeItem);
begin
if ( ( ATreeA = nil ) and ( ATreeB <> nil ) ) or
( ( ATreeB = nil ) and ( ATreeA <> nil ) )
then begin
raise Exception.Create('not equal');
end;
if ( ATreeA <> nil ) then begin
if ATreeA.ClassType <> ATreeB.ClassType then
raise Exception.Create('Class not equal');
if ATreeA.InheritsFrom(TRttiExpNode) then begin
if TRttiExpNode(ATreeA).Connector <>
TRttiExpNode(ATreeB).Connector
then
raise Exception.Create('TRttiExpNode not equal');
CompareTree(TRttiExpNode(ATreeA).Left,TRttiExpNode(ATreeB).Left);
CompareTree(TRttiExpNode(ATreeA).Right,TRttiExpNode(ATreeB).Right);
end else if ATreeA.InheritsFrom(TRttiExpConcreteNodeItem) then begin
if ATreeA.InheritsFrom(TRttiExpIntegerNodeItem) then begin
if TRttiExpIntegerNodeItem(ATreeA).Operation <>
TRttiExpIntegerNodeItem(ATreeB).Operation
then
raise Exception.Create('Operation not equal');
if TRttiExpIntegerNodeItem(ATreeA).ComparedValue <>
TRttiExpIntegerNodeItem(ATreeB).ComparedValue
then
raise Exception.Create('Value not equal');
end else if ATreeA.InheritsFrom(TRttiExpStringNodeItem) then begin
if TRttiExpStringNodeItem(ATreeA).Operation <>
TRttiExpStringNodeItem(ATreeB).Operation
then
raise Exception.Create('Operation not equal');
if ATreeA.InheritsFrom(TRttiExpAnsiStringNodeItem) then begin
if TRttiExpAnsiStringNodeItem(ATreeA).ComparedValue <>
TRttiExpAnsiStringNodeItem(ATreeB).ComparedValue
then
raise Exception.Create('Value not equal');
end else if ATreeA.InheritsFrom(TRttiExpWideStringNodeItem) then begin
if TRttiExpWideStringNodeItem(ATreeA).ComparedValue <>
TRttiExpWideStringNodeItem(ATreeB).ComparedValue
then
raise Exception.Create('Value not equal');
end
end;
end;
end;
end;
procedure TRttiFilterCreator_Test.AddContion();
const VAL_1 : Integer = 1210; VAL_2 : Integer = 1076; VAL_3 : Integer = 176;
VAL_4 : Integer = -176;
var
x : TRttiFilterCreator;
xin : TRttiExpIntegerNodeItem;
xn : TRttiExpNode;
begin
x := TRttiFilterCreator.Create(TClass_A);
try
x.AddCondition('IntProp',nfoGreater,VAL_1,fcOr);
CheckNotNull(x.Root,'Root');
CheckNotNull(x.Root.Left,'Root.Left');
CheckIs(x.Root.Left,TRttiExpIntegerNodeItem,'Root.Left');
xin := x.Root.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_1,xin.ComparedValue);
Check( ( xin.Operation = nfoGreater ), 'Operation');
CheckNull(x.Root.Right,'Root.Right');
Check( ( x.Root.Connector = fcOr ), 'Root.Connector');
x.AddCondition('IntProp',nfoLesser,VAL_2,fcAnd);
CheckNotNull(x.Root.Left,'Root.Left');
CheckIs(x.Root.Left,TRttiExpIntegerNodeItem,'Root.Left');
xin := x.Root.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_1,xin.ComparedValue);
Check( ( xin.Operation = nfoGreater ), 'Operation');
CheckNotNull(x.Root.Right,'Root.Right');
Check( ( x.Root.Connector = fcAnd ), 'Root.Connector');
CheckIs(x.Root.Right,TRttiExpIntegerNodeItem,'Root.Right');
xin := x.Root.Right as TRttiExpIntegerNodeItem;
CheckEquals(VAL_2,xin.ComparedValue);
Check( ( xin.Operation = nfoLesser ), 'Operation');
x.AddCondition('IntProp',nfoEqual,VAL_3,fcOr);
CheckNotNull(x.Root.Left,'Root.Left');
CheckIs(x.Root.Left,TRttiExpIntegerNodeItem,'Root.Left');
xin := x.Root.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_1,xin.ComparedValue);
Check( ( xin.Operation = nfoGreater ), 'Operation');
CheckNotNull(x.Root.Right,'Root.Right');
Check( ( x.Root.Connector = fcAnd ), 'Root.Connector');
CheckIs(x.Root.Right,TRttiExpNode,'Root.Right');
xn := x.Root.Right as TRttiExpNode;
CheckNotNull(xn.Left,'Root.Right.Left');
CheckIs(xn.Left,TRttiExpIntegerNodeItem);
xin := xn.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_2,xin.ComparedValue);
Check( ( xin.Operation = nfoLesser ), 'Operation');
CheckIs(xn.Right,TRttiExpIntegerNodeItem,'xn.Right');
xin := xn.Right as TRttiExpIntegerNodeItem;
CheckEquals(VAL_3,xin.ComparedValue);
Check( ( xin.Operation = nfoEqual ), 'Operation');
x.AddCondition('IntProp',nfoEqual,VAL_4,fcAnd);
PrintTree(x.Root,@Display,2);
finally
x.Free();
end;
end;
procedure TRttiFilterCreator_Test.BeginEnd_Group();
const VAL_1 : Integer = 1210; VAL_2 : Integer = 1076; VAL_3 : Integer = 176;
VAL_4 : Integer = -176;
var
x : TRttiFilterCreator;
xin : TRttiExpIntegerNodeItem;
xn : TRttiExpNode;
begin
x := TRttiFilterCreator.Create(TClass_A);
try
x.AddCondition('IntProp',nfoGreater,VAL_1,fcOr);
CheckNotNull(x.Root,'Root');
CheckNotNull(x.Root.Left,'Root.Left');
CheckIs(x.Root.Left,TRttiExpIntegerNodeItem,'Root.Left');
xin := x.Root.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_1,xin.ComparedValue);
Check( ( xin.Operation = nfoGreater ), 'Operation');
CheckNull(x.Root.Right,'Root.Right');
Check( ( x.Root.Connector = fcOr ), 'Root.Connector');
x.BeginGroup(fcOr);
CheckNotNull(x.Root.Left,'Root.Left');
CheckIs(x.Root.Left,TRttiExpIntegerNodeItem,'Root.Left');
xin := x.Root.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_1,xin.ComparedValue);
Check( ( xin.Operation = nfoGreater ), 'Operation');
CheckNotNull(x.Root.Right,'Root.Right');
Check( ( x.Root.Connector = fcOr ), 'Root.Connector');
CheckIs(x.Root.Right,TRttiExpNode,'Root.Right');
xn := x.Root.Right as TRttiExpNode;
CheckNull(xn.Left);
CheckNull(xn.Right);
x.AddCondition('IntProp',nfoLesser,VAL_2,fcAnd);
CheckNotNull(x.Root.Left,'Root.Left');
CheckIs(x.Root.Left,TRttiExpIntegerNodeItem,'Root.Left');
xin := x.Root.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_1,xin.ComparedValue);
Check( ( xin.Operation = nfoGreater ), 'Operation');
CheckNotNull(x.Root.Right,'Root.Right');
Check( ( x.Root.Connector = fcOr ), 'Root.Connector');
CheckIs(x.Root.Right,TRttiExpNode,'Root.Right');
xn := x.Root.Right as TRttiExpNode;
CheckNotNull(xn.Left,'xn.Left');
CheckNull(xn.Right,'xn.Right');
Check( ( xn.Connector = fcAnd ), 'xn.Connector');
CheckIs(xn.Left,TRttiExpIntegerNodeItem,'xn.Left');
xin := xn.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_2,xin.ComparedValue);
Check( ( xin.Operation = nfoLesser ), 'Operation');
x.AddCondition('IntProp',nfoEqual,VAL_3,fcAnd);
CheckNotNull(x.Root.Left,'Root.Left');
CheckIs(x.Root.Left,TRttiExpIntegerNodeItem,'Root.Left');
xin := x.Root.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_1,xin.ComparedValue);
Check( ( xin.Operation = nfoGreater ), 'Operation');
CheckNotNull(x.Root.Right,'Root.Right');
Check( ( x.Root.Connector = fcOr ), 'Root.Connector');
CheckIs(x.Root.Right,TRttiExpNode,'Root.Right');
xn := x.Root.Right as TRttiExpNode;
CheckNotNull(xn.Left,'xn.Left');
CheckNotNull(xn.Right,'xn.Right');
Check( ( xn.Connector = fcAnd ), 'xn.Connector');
CheckIs(xn.Left,TRttiExpIntegerNodeItem,'xn.Left');
xin := xn.Left as TRttiExpIntegerNodeItem;
CheckEquals(VAL_2,xin.ComparedValue);
Check( ( xin.Operation = nfoLesser ), 'Operation');
CheckIs(xn.Right,TRttiExpIntegerNodeItem,'xn.Right');
xin := xn.Right as TRttiExpIntegerNodeItem;
CheckEquals(VAL_3,xin.ComparedValue);
Check( ( xin.Operation = nfoEqual ), 'Operation');
x.EndGroup();
x.AddCondition('IntProp',nfoEqual,VAL_4,fcOr);
PrintTree(x.Root,@Display,2);
Display(#10#13);
Display(#10#13);
x.Clear(clrFreeObjects);
x.BeginGroup(fcAnd);
x.AddCondition('IntProp',nfoLesser,VAL_1,fcAnd);
x.BeginGroup(fcOr);
x.AddCondition('IntProp',nfoEqual,VAL_2,fcAnd);
x.AddCondition('IntProp',nfoEqual,VAL_3,fcAnd);
x.EndGroup();
x.AddCondition('IntProp',nfoEqual,VAL_2,fcOr);
x.EndGroup();
x.AddCondition('IntProp',nfoGreater,VAL_4,fcAnd);
PrintTree(x.Root,@Display,2);
finally
x.Free();
end;
end;
{ TRttiExpAnsiStringNodeItem_Test }
procedure TRttiExpAnsiStringNodeItem_Test.Create_Test();
var
x : TRttiExpAnsiStringNodeItem;
begin
x := nil;
try
try
x := TRttiExpAnsiStringNodeItem.Create(GetPropInfo(TClass_A,'IntProp'),sfoEqualCaseInsensitive,'Azerty');
Check(False);
except
on e : EAssertionFailedError do
raise;
on e : ERttiFilterException do begin
// nothing!
end;
end;
finally
x.Free();
end;
end;
procedure TRttiExpAnsiStringNodeItem_Test.Evaluate_EqualCaseSensitive();
const VAL_1 = 'AzertY';
var
x : TRttiExpAnsiStringNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpAnsiStringNodeItem.Create(GetPropInfo(t,'StrProp'),sfoEqualCaseSensitive,VAL_1);
t.StrProp := 'aaadddd';
Check( x.Evaluate(t) = False ,'False');
t.StrProp := UpperCase(VAL_1);
Check( x.Evaluate(t) = False ,'False');
t.StrProp := LowerCase(VAL_1);
Check( x.Evaluate(t) = False ,'False');
t.StrProp := VAL_1;
Check( x.Evaluate(t) = True, 'True' );
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpAnsiStringNodeItem_Test.Evaluate_EqualCaseInsensitive();
const VAL_1 = 'AzertY';
var
x : TRttiExpAnsiStringNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpAnsiStringNodeItem.Create(GetPropInfo(t,'StrProp'),sfoEqualCaseInsensitive,VAL_1);
t.StrProp := 'aaadddd';
Check( x.Evaluate(t) = False ,'False');
t.StrProp := UpperCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
t.StrProp := LowerCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
t.StrProp := VAL_1;
Check( x.Evaluate(t) = True, 'True' );
finally
x.Free();
t.Free();
end;
end;
{ TRttiExpwWideStringNodeItem_Test }
procedure TRttiExpwWideStringNodeItem_Test.Create_Test();
var
x : TRttiExpWideStringNodeItem;
begin
x := nil;
try
try
x := TRttiExpWideStringNodeItem.Create(GetPropInfo(TClass_A,'IntProp'),sfoEqualCaseInsensitive,'Azerty');
Check(False);
except
on e : EAssertionFailedError do
raise;
on e : ERttiFilterException do begin
// nothing!
end;
end;
finally
x.Free();
end;
end;
procedure TRttiExpwWideStringNodeItem_Test.Evaluate_EqualCaseSensitive();
const VAL_1 = 'AzertY';
var
x : TRttiExpWideStringNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpWideStringNodeItem.Create(GetPropInfo(t,'WideStrProp'),sfoEqualCaseSensitive,VAL_1);
t.WideStrProp := 'aaadddd';
Check( x.Evaluate(t) = False ,'False');
t.WideStrProp := UpperCase(VAL_1);
Check( x.Evaluate(t) = False ,'False');
t.WideStrProp := LowerCase(VAL_1);
Check( x.Evaluate(t) = False ,'False');
t.WideStrProp := VAL_1;
Check( x.Evaluate(t) = True, 'True' );
finally
x.Free();
t.Free();
end;
end;
procedure TRttiExpwWideStringNodeItem_Test.Evaluate_EqualCaseInsensitive();
const VAL_1 = 'AzertY';
var
x : TRttiExpWideStringNodeItem;
t : TClass_A;
begin
x := nil;
t := TClass_A.Create();
try
x := TRttiExpWideStringNodeItem.Create(GetPropInfo(t,'WideStrProp'),sfoEqualCaseInsensitive,VAL_1);
t.WideStrProp := 'aaadddd';
Check( x.Evaluate(t) = False ,'False');
t.WideStrProp := UpperCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
t.WideStrProp := LowerCase(VAL_1);
Check( x.Evaluate(t) = True ,'True');
t.WideStrProp := VAL_1;
Check( x.Evaluate(t) = True, 'True' );
finally
x.Free();
t.Free();
end;
end;
{ TRttiParser_Test }
procedure TRttiParser_Test.SimpleOperators();
const VAL_1 = 'inoussa';
var
x : TRttiFilterCreator;
sN : TRttiExpAnsiStringNodeItem;
begin
x := TRttiFilterCreator.Create(TClass_A);
try
ParseFilter(Format('StrProp = %s',[QuotedStr(VAL_1)]),x);
CheckNotNull(x.Root,'Root <> nil');
CheckIs(x.Root.Left,TRttiExpAnsiStringNodeItem);
sN := x.Root.Left as TRttiExpAnsiStringNodeItem;
CheckEquals('StrProp',sN.PropInfo^.Name);
CheckEquals(VAL_1,sN.ComparedValue);
finally
x.Free();
end;
end;
procedure TRttiParser_Test.BeginEnd_Group();
const VAL_1 : Integer = 1210; VAL_2 : Integer = 1076; VAL_3 : Integer = 176;
VAL_4 : Integer = -176;
VAL_S = 'inoussa';
var
x, y : TRttiFilterCreator;
xin : TRttiExpIntegerNodeItem;
xn : TRttiExpNode;
sfltr : string;
begin
y := nil;
x := TRttiFilterCreator.Create(TClass_A);
try
sfltr := Format('IntProp > %d or ( IntProp < %d and StrProp = %s ) or IntProp = %d',[VAL_1,VAL_2,QuotedStr(VAL_S),VAL_4]);
ParseFilter(sfltr,x);
PrintTree(x.Root,@Display,2);
y := TRttiFilterCreator.Create(TClass_A);
y.AddCondition('IntProp',nfoGreater,VAL_1,fcOr);
y.BeginGroup(fcOr);
y.AddCondition('IntProp',nfoLesser,VAL_2,fcAnd);
y.AddCondition('StrProp',sfoEqualCaseInsensitive,VAL_S,fcAnd);
y.EndGroup();
y.AddCondition('IntProp',nfoEqual,VAL_4,fcOr);
CompareTree(x.Root,y.Root);
finally
x.Free();
end;
end;
Initialization
RegisterTests(
[ TRttiExpIntegerNodeItem_Test,
TRttiExpAnsiStringNodeItem_Test,
TRttiExpwWideStringNodeItem_Test,
TRttiExpNode_Test,TRttiFilterCreator_Test,
TRttiParser_Test
]
);
end.