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

(XSD's) ElementFormDefault and AttributeFormDefault, group and attributeGroup, parsing and runtime handling.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4209 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2015-07-15 16:02:12 +00:00
parent e0b25c8f51
commit 20a4f70c7f
51 changed files with 3122 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files

166
wst/trunk/base_service_intf.pas
View File

@ -288,11 +288,14 @@ type
const ATypeInfo : PTypeInfo
);virtual;abstract;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;virtual;
function wstHasValue() : Boolean;virtual;
End;
TAbstractSimpleRemotableClass = class of TAbstractSimpleRemotable;
TAbstractSimpleRemotable = class(TBaseRemotable)
end;
{ TAbstractSimpleRemotable }
TAbstractSimpleRemotable = class(TBaseRemotable) end;
{ TStringBufferRemotable }
@ -315,6 +318,7 @@ type
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
function wstHasValue() : Boolean;override;
property Data : string read FData write FData;
end;
@ -345,6 +349,7 @@ type
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
function wstHasValue() : Boolean;override;
procedure LoadFromStream(AStream : TStream);
procedure LoadFromFile(const AFileName : string);
procedure SaveToStream(AStream : TStream);
@ -403,6 +408,7 @@ type
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
function wstHasValue() : Boolean;override;
property AsDate : TDateTime index 0 read GetDate write SetDate;
property AsUTCDate : TDateTime index 1 read GetDate write SetDate;
@ -463,6 +469,7 @@ type
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
function wstHasValue() : Boolean;override;
procedure Clear();
class function Parse(const ABuffer : string) : TDurationRec;
@ -509,6 +516,7 @@ type
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
function wstHasValue() : Boolean;override;
procedure Clear();
class function Parse(const ABuffer : string) : TTimeRec;
@ -620,6 +628,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Byte read FValue write FValue;
end;
@ -632,6 +641,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : ShortInt read FValue write FValue;
end;
@ -644,9 +654,12 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : SmallInt read FValue write FValue;
end;
{ TComplexInt16UContentRemotable }
TComplexInt16UContentRemotable = class(TBaseComplexSimpleContentRemotable)
private
FValue: Word;
@ -654,6 +667,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Word read FValue write FValue;
end;
@ -666,6 +680,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : LongInt read FValue write FValue;
end;
@ -678,6 +693,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : LongWord read FValue write FValue;
end;
@ -690,6 +706,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Int64 read FValue write FValue;
end;
@ -702,6 +719,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : QWord read FValue write FValue;
end;
@ -714,6 +732,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Extended read FValue write FValue;
end;
@ -726,6 +745,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Double read FValue write FValue;
end;
@ -738,6 +758,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Single read FValue write FValue;
end;
@ -750,6 +771,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Currency read FValue write FValue;
end;
@ -782,6 +804,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : string read FValue write FValue;
end;
@ -794,6 +817,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : Widestring read FValue write FValue;
end;
@ -807,6 +831,7 @@ type
class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override;
class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override;
public
function wstHasValue() : Boolean;override;
property Value : UnicodeString read FValue write FValue;
end;
{$ENDIF WST_UNICODESTRING}
@ -825,6 +850,7 @@ type
public
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
function wstHasValue() : Boolean;override;
procedure LoadFromStream(AStream : TStream);
procedure LoadFromFile(const AFileName : string);
procedure LoadFromBuffer(const ABuffer; const ABufferLen : Integer);
@ -1556,7 +1582,11 @@ type
property TimeOut : PtrUInt read FTimeOut write FTimeOut;
end;
TTypeRegistryItemOption = ( trioNonVisibleToMetadataService, trioNonQualifiedName );
TTypeRegistryItemOption = (
trioNonVisibleToMetadataService,
trioUnqualifiedElement, trioQualifiedElement,
trioUnqualifiedAttribute, trioQualifiedAttribute
);
TTypeRegistryItemOptions = set of TTypeRegistryItemOption;
TTypeRegistry = class;
TTypeRegistryItem = class;
@ -1639,6 +1669,7 @@ type
const APropName : string;
const AOptions : TTypeRegistryItemOptions
); virtual;
procedure AddOptions(const AOptions : TTypeRegistryItemOptions);
procedure RegisterObject(const APropName : string; const AObject : TObject);
function GetObject(const APropName : string) : TObject;
@ -2006,7 +2037,6 @@ begin
Result := pstOptional;
end;
end;
{$ELSE}
function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType;
{var
@ -2062,6 +2092,11 @@ begin
Result := ( Self = ACompareTo );
end;
function TBaseRemotable.wstHasValue() : Boolean;
begin
Result := True;
end;
{ TBaseComplexRemotable }
Type
@ -3176,12 +3211,8 @@ begin
Result := TPropertyItem(FProperties[i]);
end;
constructor TTypeRegistryItem.Create(
AOwner : TTypeRegistry;
ANameSpace : String;
ADataType : PTypeInfo;
Const ADeclaredName : String
);
constructor TTypeRegistryItem.Create(AOwner: TTypeRegistry; ANameSpace: string;
ADataType: PTypeInfo; const ADeclaredName: string);
begin
FOwner := AOwner;
FNameSpace := ANameSpace;
@ -3318,6 +3349,13 @@ begin
po.FOptions := AOptions;
end;
procedure TTypeRegistryItem.AddOptions(
const AOptions: TTypeRegistryItemOptions
);
begin
FOptions := FOptions + AOptions;
end;
{ TTypeRegistry }
function TTypeRegistry.GetItemClassFor(const ATypeInfo : PTypeInfo) : TTypeRegistryItemClass;
@ -5663,6 +5701,11 @@ begin
(AObject as TComplexInt32SContentRemotable).Value := i;
end;
function TComplexInt32SContentRemotable.wstHasValue: Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexInt32UContentRemotable }
class procedure TComplexInt32UContentRemotable.SaveValue(
@ -5685,6 +5728,11 @@ begin
(AObject as TComplexInt32UContentRemotable).Value := i;
end;
function TComplexInt32UContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexInt16SContentRemotable }
class procedure TComplexInt16SContentRemotable.SaveValue(
@ -5707,6 +5755,11 @@ begin
(AObject as TComplexInt16SContentRemotable).Value := i;
end;
function TComplexInt16SContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexInt16UContentRemotable }
class procedure TComplexInt16UContentRemotable.SaveValue(
@ -5729,6 +5782,11 @@ begin
(AObject as TComplexInt16UContentRemotable).Value := i;
end;
function TComplexInt16UContentRemotable.wstHasValue: Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexFloatExtendedContentRemotable }
class procedure TComplexFloatExtendedContentRemotable.SaveValue(
@ -5751,6 +5809,11 @@ begin
(AObject as TComplexFloatExtendedContentRemotable).Value := i;
end;
function TComplexFloatExtendedContentRemotable.wstHasValue: Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexFloatDoubleContentRemotable }
class procedure TComplexFloatDoubleContentRemotable.SaveValue(
@ -5773,6 +5836,11 @@ begin
(AObject as TComplexFloatDoubleContentRemotable).Value := i;
end;
function TComplexFloatDoubleContentRemotable.wstHasValue: Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexStringContentRemotable }
class procedure TComplexStringContentRemotable.SaveValue(
@ -5795,6 +5863,11 @@ begin
(AObject as TComplexStringContentRemotable).Value := i;
end;
function TComplexStringContentRemotable.wstHasValue: Boolean;
begin
Result := (FValue <> '');
end;
{ TComplexWideStringContentRemotable }
class procedure TComplexWideStringContentRemotable.SaveValue(
@ -5817,6 +5890,11 @@ begin
(AObject as TComplexWideStringContentRemotable).Value := i;
end;
function TComplexWideStringContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> '');
end;
{$IFDEF WST_UNICODESTRING}
{ TComplexUnicodeStringContentRemotable }
@ -5839,6 +5917,11 @@ begin
AStore.GetScopeInnerValue(TypeInfo(UnicodeString),i);
(AObject as TComplexUnicodeStringContentRemotable).Value := i;
end;
function TComplexUnicodeStringContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> '');
end;
{$ENDIF WST_UNICODESTRING}
{ TDateRemotable }
@ -5947,6 +6030,11 @@ begin
);
end;
function TBaseDateRemotable.wstHasValue() : Boolean;
begin
Result := (FDate.Date <> 0);
end;
function TBaseDateRemotable.GetDate(const AIndex : Integer) : TDateTime;
begin
Result := FDate.Date;
@ -6039,6 +6127,11 @@ begin
(AObject as TComplexInt8SContentRemotable).Value := i;
end;
function TComplexInt8SContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexInt8UContentRemotable }
class procedure TComplexInt8UContentRemotable.SaveValue(
@ -6061,6 +6154,11 @@ begin
(AObject as TComplexInt8UContentRemotable).Value := i;
end;
function TComplexInt8UContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexFloatSingleContentRemotable }
class procedure TComplexFloatSingleContentRemotable.SaveValue(
@ -6083,6 +6181,11 @@ begin
(AObject as TComplexFloatSingleContentRemotable).Value := i;
end;
function TComplexFloatSingleContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexCurrencyContentRemotable }
class procedure TComplexCurrencyContentRemotable.SaveValue(
@ -6105,6 +6208,11 @@ begin
(AObject as TComplexCurrencyContentRemotable).Value := i;
end;
function TComplexCurrencyContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexInt64SContentRemotable }
class procedure TComplexInt64SContentRemotable.SaveValue(
@ -6127,6 +6235,11 @@ begin
(AObject as TComplexInt64SContentRemotable).Value := i;
end;
function TComplexInt64SContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexInt64UContentRemotable }
class procedure TComplexInt64UContentRemotable.SaveValue(
@ -6149,6 +6262,11 @@ begin
(AObject as TComplexInt64UContentRemotable).Value := i;
end;
function TComplexInt64UContentRemotable.wstHasValue() : Boolean;
begin
Result := (FValue <> 0);
end;
{ TComplexBooleanContentRemotable }
class procedure TComplexBooleanContentRemotable.SaveValue(
@ -6359,6 +6477,11 @@ begin
);
end;
function TStringBufferRemotable.wstHasValue() : Boolean;
begin
Result := (Data <> '');
end;
{ TRemotableRecordEncoder }
class procedure TRemotableRecordEncoder.Save(
@ -6741,6 +6864,13 @@ begin
end;
end;
function TDurationRemotable.wstHasValue() : Boolean;
begin
Result := (FData.Year <> 0) or (FData.Month <> 0) or (FData.Day <> 0) or
(FData.Hour <> 0) or (FData.Minute <> 0) or (FData.Second <> 0) or
(FData.FractionalSecond <> 0);
end;
procedure TDurationRemotable.Clear();
begin
FData := ZERO_DURATION;
@ -6868,6 +6998,11 @@ begin
CompareMem(Pointer(Self.BinaryData),Pointer(TAbstractEncodedStringRemotable(ACompareTo).BinaryData),Length(Self.BinaryData));
end;
function TAbstractEncodedStringRemotable.wstHasValue() : Boolean;
begin
Result := (Length(FBinaryData) > 0);
end;
procedure TAbstractEncodedStringRemotable.LoadFromStream(AStream: TStream);
begin
BinaryData := LoadBufferFromStream(AStream);
@ -6937,6 +7072,11 @@ begin
CompareMem(Pointer(Self.BinaryData),Pointer(TAbstractEncodedStringExtRemotable(ACompareTo).BinaryData),Length(Self.BinaryData));
end;
function TAbstractEncodedStringExtRemotable.wstHasValue: Boolean;
begin
Result := (Length(FBinaryData) > 0);
end;
procedure TAbstractEncodedStringExtRemotable.LoadFromStream(AStream: TStream);
begin
BinaryData := LoadBufferFromStream(AStream);
@ -7145,6 +7285,12 @@ begin
end;
end;
function TTimeRemotable.wstHasValue: Boolean;
begin
Result := (Data.Hour <> 0) or (Data.Minute <> 0) or (Data.Second <> 0) or
(Data.HourOffset <> 0) or (Data.MinuteOffset <> 0);
end;
procedure TTimeRemotable.Clear();
begin
Data := ZERO_TIME;

71
wst/trunk/base_soap_formatter.pas
View File

@ -56,6 +56,8 @@ type
TStackItem = class
private
FAttributeFormUnqualified: Boolean;
FElementFormUnqualified: Boolean;
FEmbeddedScopeCount: Integer;
FNameSpace: string;
FScopeObject: TDOMNode;
@ -77,6 +79,9 @@ type
function EndEmbeddedScope() : Integer;
function GetScopeItemNames(const AReturnList : TStrings) : Integer;virtual;
property ElementFormUnqualified : Boolean read FElementFormUnqualified write FElementFormUnqualified;
property AttributeFormUnqualified : Boolean read FAttributeFormUnqualified write FAttributeFormUnqualified;
End;
{ TObjectStackItem }
@ -623,12 +628,10 @@ end;
{ TSOAPBaseFormatter }
procedure TSOAPBaseFormatter.ClearStack();
Var
i, c : Integer;
begin
c := FStack.Count;
For I := 1 To c Do
FStack.Pop().Free();
while HasScope() do begin
EndScope();
end;
end;
function TSOAPBaseFormatter.PushStack(AScopeObject : TDOMNode) : TStackItem;
@ -686,8 +689,8 @@ begin
if ( FHeaderEnterCount <= 0 ) then begin
Inc(FHeaderEnterCount);
Prepare();
BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone);
SetStyleAndEncoding(Document,Literal);
BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR,stObject,asNone);
end;
end;
@ -846,7 +849,10 @@ function TSOAPBaseFormatter.FindXMLNodeWithNamespaceInSubScope(
if FindAttributeByValueInNode(ANameSpace, ANode, AttrName) then begin
if not IsStrEmpty(AttrName) then begin
AttrName := ExtractNameSpaceShortName(AttrName);
if not IsStrEmpty(AttrName) then begin
if IsStrEmpty(AttrName) then begin
if (ANode.NodeName = ANodeName) then
Result := ANode;
end else begin
if(ANode.NodeName = AttrName + ':' + ANodeName) then
Result := ANode;
end;
@ -881,7 +887,11 @@ Var
regItem : TTypeRegistryItem;
begin
strNodeName := AName;
if ( Style = Document ) then begin
if (Style = Document) and
( ( (FSerializationStyle = ssNodeSerialization) and not(StackTop().ElementFormUnqualified) ) or
( (FSerializationStyle = ssAttibuteSerialization) and not(StackTop().AttributeFormUnqualified))
)
then begin
namespaceLongName := ANameSpace;
if ( namespaceLongName <> '' ) then begin
s := FindAttributeByValueInScope(namespaceLongName);
@ -1063,7 +1073,13 @@ var
namespaceShortName, strNodeName, s : string;
begin
strNodeName := AName;
if ( Style = Document ) then begin
if (Style = Document) and
( not(HasScope()) or
( ( (FSerializationStyle = ssNodeSerialization) and not(StackTop().ElementFormUnqualified) ) or
( (FSerializationStyle = ssAttibuteSerialization) and not(StackTop().AttributeFormUnqualified))
)
)
then begin
if ( ANameSpace <> '' ) then begin
{if ( ANameSpace = '' ) then
s := StackTop().NameSpace
@ -1341,8 +1357,8 @@ end;
destructor TSOAPBaseFormatter.Destroy();
begin
ReleaseDomNode(FDoc);
ClearStack();
ReleaseDomNode(FDoc);
FStack.Free();
inherited Destroy();
end;
@ -1389,7 +1405,11 @@ begin
End;
End;
if ( Style = Document ) then begin
if not(HasScope()) or
( (Style = Document) and
not(StackTop().ElementFormUnqualified)
)
then begin
strNodeName := nmspcSH + ':' + AName;
end else begin
strNodeName := AName;
@ -1405,6 +1425,7 @@ begin
AddScopeAttribute(xsiNmspcSH + sTYPE,Format('%s:%s',[GetNameSpaceShortName(typData.NameSpace,True),typData.DeclaredName]));
end;
StackTop().SetNameSpace(nmspc);
StackTop().ElementFormUnqualified := trioUnqualifiedElement in typData.Options;
end;
procedure TSOAPBaseFormatter.BeginArray(
@ -1536,7 +1557,13 @@ begin
End Else Begin
nsStr := Copy(nsStr,Succ(AnsiPos(':',nsStr)),MaxInt);
End;
scpStr := nsStr + ':' + scpStr;
if not(HasScope()) or
( (Style = Document) and
not(StackTop().ElementFormUnqualified)
)
then begin
scpStr := nsStr + ':' + scpStr;
end;
End;
e := FDoc.CreateElement(scpStr);
@ -1572,6 +1599,8 @@ var
nmspc,nmspcSH : string;
strNodeName : string;
begin
nmspcSH := '';
strNodeName := AScopeName;
if ( Style = Document ) then begin
typData := GetTypeRegistry().Find(ATypeInfo,False);
if not Assigned(typData) then begin
@ -1592,7 +1621,7 @@ begin
nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt);
end;
end;
if IsStrEmpty(nmspcSH) then begin
{if IsStrEmpty(nmspcSH) then begin
strNodeName := AScopeName
end else begin
if ( Pos(':',AScopeName) < 1 ) then begin
@ -1600,10 +1629,15 @@ begin
end else begin
strNodeName := AScopeName;
end;
end;}
if not(IsStrEmpty(nmspcSH)) and
( not(HasScope()) or
not(StackTop().ElementFormUnqualified)
)
then begin
if ( Pos(':',AScopeName) < 1 ) then
strNodeName := nmspcSH + ':' + AScopeName;
end;
end else begin
nmspcSH := '';
strNodeName := AScopeName;
end;
stk := StackTop();
@ -1627,6 +1661,11 @@ begin
end;
if ( Style = Document ) then begin
StackTop().SetNameSpace(nmspc);
if (AScopeType = stObject) or
( (AScopeType = stArray) and (AStyle = asScoped) )
then begin
StackTop().ElementFormUnqualified := trioUnqualifiedElement in typData.Options;
end;
end;
Result := StackTop().GetItemsCount();
if ( Result = 0 ) and ( AScopeType = stArray ) then begin

54
wst/trunk/object_serializer.pas
View File

@ -736,8 +736,16 @@ var
begin
locName := APropInfo.ExternalName;
locData := GetObjectProp(AObject,APropInfo.PropInfo);
if ( locData <> nil ) or ( APropInfo.PersisteType = pstAlways ) then
if (APropInfo.PersisteType = pstAlways) or
( (APropInfo.PersisteType = pstOptional) and
(locData <> nil) and
( not(locData.InheritsFrom(TBaseRemotable)) or
TBaseRemotable(locData).wstHasValue()
)
)
then begin
AStore.Put(locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end;
end;
procedure FloatWriter(
@ -947,8 +955,16 @@ var
begin
locName := APropInfo.ExternalName;
locData := GetObjectProp(AObject,APropInfo.PropInfo);
if ( locData <> nil ) or ( APropInfo.PersisteType = pstAlways ) then
if (APropInfo.PersisteType = pstAlways) or
( (APropInfo.PersisteType = pstOptional) and
(locData <> nil) and
( not(locData.InheritsFrom(TBaseRemotable)) or
TBaseRemotable(locData).wstHasValue()
)
)
then begin
AStore.Put(APropInfo.NameSpace,locName,APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locData);
end;
end;
procedure FloatWriterQualified(
@ -1322,6 +1338,7 @@ var
regPropItem : TPropertyItem;
st : TPropStoreType;
clPL : PPropList;
eltFormEmpty, attFormEmpty, qualifiedElt, qualifiedAtt : Boolean;
begin
FSerializationInfos.Clear();
locTypeInfo := PTypeInfo(Target.ClassInfo);
@ -1335,6 +1352,10 @@ begin
cl := Target;
thisRegItem := ATypeRegistry.ItemByTypeInfo[locTypeInfo];
regItem := thisRegItem;
eltFormEmpty := ([trioQualifiedElement,trioUnqualifiedElement]*regItem.Options) = [];
attFormEmpty := ([trioQualifiedAttribute,trioUnqualifiedAttribute]*regItem.Options) = [];
qualifiedElt := (trioQualifiedElement in regItem.Options) and not(trioUnqualifiedElement in regItem.Options);
qualifiedAtt := (trioQualifiedAttribute in regItem.Options) and not(trioUnqualifiedAttribute in regItem.Options);
GetPropList(locTypeInfo,FRawPropList);
try
for i := 0 to Pred(c) do begin
@ -1355,18 +1376,16 @@ begin
end else begin
serInfo.FStyle := ssNodeSerialization;
end;
if ( regPropItem <> nil ) then begin
serInfo.FExternalName := regPropItem.ExternalName;
if ( trioNonQualifiedName in regPropItem.Options ) then begin
serInfo.FNameSpace := '';
serInfo.FQualifiedName := True;
end;
end else begin
if ( regPropItem <> nil ) then
serInfo.FExternalName := regPropItem.ExternalName
else
serInfo.FExternalName := serInfo.FName;
if ( trioNonQualifiedName in regItem.Options ) then begin
serInfo.FQualifiedName := True;
serInfo.FNameSpace := '';
end;
if (serInfo.FStyle = ssNodeSerialization) then begin
if not(eltFormEmpty) then
serInfo.FQualifiedName := qualifiedElt;
end else begin
if not(attFormEmpty) then
serInfo.FQualifiedName := qualifiedAtt;
end;
if serInfo.QualifiedName then begin
serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Qualified;
@ -1552,6 +1571,7 @@ var
thisRegItem, regItem : TTypeRegistryItem;
serArray : array of TPropSerializationInfo;
cl : TClass;
attFormEmpty, qualifiedAtt : Boolean;
procedure InitPropItem(const APropInfo : PPropInfo);
var
@ -1574,7 +1594,8 @@ var
serInfo.FNameSpace := '';
if ( regPropItem <> nil ) then begin
serInfo.FExternalName := regPropItem.ExternalName;
if not ( trioNonQualifiedName in regPropItem.Options ) then begin
//if not ( trioNonQualifiedName in regPropItem.Options ) then begin
if not(attFormEmpty) and qualifiedAtt then begin
serInfo.FNameSpace := regItem.NameSpace;
serInfo.FQualifiedName := True;
end;
@ -1598,7 +1619,8 @@ var
if ( serInfo <> nil ) then begin
regPropItem := regItem.FindProperty(APropInfo^.Name,pntInternalName);
if ( regPropItem <> nil ) then begin
if not ( trioNonQualifiedName in regPropItem.Options ) then begin
//if not ( trioNonQualifiedName in regPropItem.Options ) then begin
if not(attFormEmpty) and qualifiedAtt then begin
serInfo.FNameSpace := regItem.NameSpace;
serInfo.FQualifiedName := True;
end;
@ -1633,6 +1655,8 @@ begin
cl := Target;
thisRegItem := ATypeRegistry.ItemByTypeInfo[locTypeInfo];
regItem := thisRegItem;
attFormEmpty := ([trioQualifiedAttribute,trioUnqualifiedAttribute]*regItem.Options) = [];
qualifiedAtt := (trioQualifiedAttribute in regItem.Options) and not(trioUnqualifiedAttribute in regItem.Options);
GetPropList(locTypeInfo,FRawPropList);
try
for i := 0 to Pred(c) do begin

1
wst/trunk/server_service_soap.pas
View File

@ -178,6 +178,7 @@ begin
Else
m := AErrorMsg;
Clear();
Style := Document;
BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV',stObject,asNone);
AddScopeAttribute('xmlns:xsi',sXSI_NS);
AddScopeAttribute('xmlns:'+sXSD, sXSD_NS);

11
wst/trunk/soap_formatter.pas
View File

@ -71,12 +71,17 @@ procedure TSOAPFormatter.BeginCall(
ATarget : string;
ACallContext : ICallContext
);
var
locOldStyle : TSOAPDocumentStyle;
begin
Prepare();
WriteHeaders(ACallContext);
BeginScope('Body',sSOAP_ENV,'',stObject,asNone);
if ( Style = RPC ) then
BeginScope(AProcName,ATarget,'',stObject,asNone);
locOldStyle := Style;
Style := Document;
BeginScope('Body',sSOAP_ENV,'',stObject,asNone);
if (locOldStyle = RPC) then
BeginScope(AProcName,ATarget,'',stObject,asNone);
Style := locOldStyle;
FCallTarget := ATarget;
FCallProcedureName := AProcName;

35
wst/trunk/tests/test_suite/files/complex_class_group.wsdl Normal file
View File

@ -0,0 +1,35 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

21
wst/trunk/tests/test_suite/files/complex_class_group.xsd Normal file
View File

@ -0,0 +1,21 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

36
wst/trunk/tests/test_suite/files/complex_class_group2.wsdl Normal file
View File

@ -0,0 +1,36 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

22
wst/trunk/tests/test_suite/files/complex_class_group2.xsd Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

36
wst/trunk/tests/test_suite/files/complex_class_group3.wsdl Normal file
View File

@ -0,0 +1,36 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
</xsd:schema>
</types>
</definitions>

22
wst/trunk/tests/test_suite/files/complex_class_group3.xsd Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
</xsd:schema>

44
wst/trunk/tests/test_suite/files/complex_class_group4.wsdl Normal file
View File

@ -0,0 +1,44 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
<xsd:group ref="n:TJobGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:group name="TJobGroupType">
<xsd:sequence>
<xsd:element name="jobPosition" type="xsd:string" />
<xsd:element name="employer" type="xsd:string" />
</xsd:sequence>
</xsd:group>
</xsd:schema>
</types>
</definitions>

31
wst/trunk/tests/test_suite/files/complex_class_group4.xsd Normal file
View File

@ -0,0 +1,31 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
<xsd:group ref="n:TJobGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:group name="TJobGroupType">
<xsd:sequence>
<xsd:element name="jobPosition" type="xsd:string" />
<xsd:element name="employer" type="xsd:string" />
</xsd:sequence>
</xsd:group>
</xsd:schema>

43
wst/trunk/tests/test_suite/files/complex_class_group5.wsdl Normal file
View File

@ -0,0 +1,43 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="occupation" type="n:TJobType" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TJobType">
<xsd:sequence>
<xsd:element name="jobPosition" type="xsd:string" />
<xsd:element name="employer" type="xsd:string" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

30
wst/trunk/tests/test_suite/files/complex_class_group5.xsd Normal file
View File

@ -0,0 +1,30 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="occupation" type="n:TJobType" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TJobType">
<xsd:sequence>
<xsd:element name="jobPosition" type="xsd:string" />
<xsd:element name="employer" type="xsd:string" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

37
wst/trunk/tests/test_suite/files/complex_class_group6.wsdl Normal file
View File

@ -0,0 +1,37 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="otherName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

23
wst/trunk/tests/test_suite/files/complex_class_group6.xsd Normal file
View File

@ -0,0 +1,23 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:sequence>
<xsd:element name="firstName" type="xsd:string" />
<xsd:element name="lastName" type="xsd:string" />
<xsd:element name="otherName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="Age" type="xsd:int" />
</xsd:sequence>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType"/>
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

36
wst/trunk/tests/test_suite/files/complex_class_group7.wsdl Normal file
View File

@ -0,0 +1,36 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:choice>
<xsd:element name="firstName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="lastName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="otherName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
</xsd:choice>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

22
wst/trunk/tests/test_suite/files/complex_class_group7.xsd Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:group name="TContactGroupType">
<xsd:choice>
<xsd:element name="firstName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="lastName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
<xsd:element name="otherName" type="xsd:string" minOccurs="0" maxOccurs="unbounded" />
</xsd:choice>
</xsd:group>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
<xsd:group ref="n:TContactGroupType" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

33
wst/trunk/tests/test_suite/files/complex_class_group_att.wsdl Normal file
View File

@ -0,0 +1,33 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

19
wst/trunk/tests/test_suite/files/complex_class_group_att.xsd Normal file
View File

@ -0,0 +1,19 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

34
wst/trunk/tests/test_suite/files/complex_class_group_att2.wsdl Normal file
View File

@ -0,0 +1,34 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

20
wst/trunk/tests/test_suite/files/complex_class_group_att2.xsd Normal file
View File

@ -0,0 +1,20 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
</xsd:complexType>
</xsd:schema>

34
wst/trunk/tests/test_suite/files/complex_class_group_att3.wsdl Normal file
View File

@ -0,0 +1,34 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
</xsd:complexType>
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
</xsd:schema>
</types>
</definitions>

20
wst/trunk/tests/test_suite/files/complex_class_group_att3.xsd Normal file
View File

@ -0,0 +1,20 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
</xsd:complexType>
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
</xsd:schema>

40
wst/trunk/tests/test_suite/files/complex_class_group_att4.wsdl Normal file
View File

@ -0,0 +1,40 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
<xsd:attributeGroup ref="n:TJobGroupType" />
</xsd:complexType>
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
<xsd:attributeGroup name="TJobGroupType">
<xsd:attribute name="jobPosition" type="xsd:string" />
<xsd:attribute name="employer" type="xsd:string" />
</xsd:attributeGroup>
</xsd:schema>
</types>
</definitions>

27
wst/trunk/tests/test_suite/files/complex_class_group_att4.xsd Normal file
View File

@ -0,0 +1,27 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
<xsd:attributeGroup ref="n:TJobGroupType" />
</xsd:complexType>
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attribute name="Age" type="xsd:int" />
</xsd:attributeGroup>
<xsd:attributeGroup name="TJobGroupType">
<xsd:attribute name="jobPosition" type="xsd:string" />
<xsd:attribute name="employer" type="xsd:string" />
</xsd:attributeGroup>
</xsd:schema>

39
wst/trunk/tests/test_suite/files/complex_class_group_att5.wsdl Normal file
View File

@ -0,0 +1,39 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
</xsd:complexType>
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attributeGroup ref="n:TJobGroupType" />
</xsd:attributeGroup>
<xsd:attributeGroup name="TJobGroupType">
<xsd:attribute name="jobPosition" type="xsd:string" />
<xsd:attribute name="employer" type="xsd:string" />
</xsd:attributeGroup>
</xsd:schema>
</types>
</definitions>

26
wst/trunk/tests/test_suite/files/complex_class_group_att5.xsd Normal file
View File

@ -0,0 +1,26 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
<xsd:attributeGroup ref="n:TContactGroupType" />
</xsd:complexType>
<xsd:attributeGroup name="TContactGroupType">
<xsd:attribute name="firstName" type="xsd:string" />
<xsd:attribute name="lastName" type="xsd:string" />
<xsd:attributeGroup ref="n:TJobGroupType" />
</xsd:attributeGroup>
<xsd:attributeGroup name="TJobGroupType">
<xsd:attribute name="jobPosition" type="xsd:string" />
<xsd:attribute name="employer" type="xsd:string" />
</xsd:attributeGroup>
</xsd:schema>

27
wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.wsdl Normal file
View File

@ -0,0 +1,27 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

13
wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.xsd Normal file
View File

@ -0,0 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

26
wst/trunk/tests/test_suite/files/complex_mixed.wsdl Normal file
View File

@ -0,0 +1,26 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TSampleType" mixed="true">
<xsd:sequence>
<xsd:any namespace="##other" processContents="lax" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

12
wst/trunk/tests/test_suite/files/complex_mixed.xsd Normal file
View File

@ -0,0 +1,12 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TSampleType" mixed="true">
<xsd:sequence>
<xsd:any namespace="##other" processContents="lax" minOccurs="0" maxOccurs="unbounded" />
</xsd:sequence>
</xsd:complexType>
</xsd:schema>

27
wst/trunk/tests/test_suite/files/complex_mixed2.wsdl Normal file
View File

@ -0,0 +1,27 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TSampleType" mixed="true">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

13
wst/trunk/tests/test_suite/files/complex_mixed2.xsd Normal file
View File

@ -0,0 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TSampleType" mixed="true">
<xsd:sequence>
<xsd:element name="intField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="strField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

27
wst/trunk/tests/test_suite/files/schema_defaultelementform1.wsdl Normal file
View File

@ -0,0 +1,27 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

13
wst/trunk/tests/test_suite/files/schema_defaultelementform1.xsd Normal file
View File

@ -0,0 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

29
wst/trunk/tests/test_suite/files/schema_defaultelementform2.wsdl Normal file
View File

@ -0,0 +1,29 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test"
elementFormDefault="qualified"
>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

14
wst/trunk/tests/test_suite/files/schema_defaultelementform2.xsd Normal file
View File

@ -0,0 +1,14 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test"
elementFormDefault="qualified">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

29
wst/trunk/tests/test_suite/files/schema_defaultelementform3.wsdl Normal file
View File

@ -0,0 +1,29 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test"
attributeFormDefault="unqualified"
>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

14
wst/trunk/tests/test_suite/files/schema_defaultelementform3.xsd Normal file
View File

@ -0,0 +1,14 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test"
attributeFormDefault="unqualified">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

30
wst/trunk/tests/test_suite/files/schema_defaultelementform4.wsdl Normal file
View File

@ -0,0 +1,30 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="library1"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="urn:wst-test">
<types>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test"
elementFormDefault="qualified"
attributeFormDefault="unqualified"
>
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

15
wst/trunk/tests/test_suite/files/schema_defaultelementform4.xsd Normal file
View File

@ -0,0 +1,15 @@
<?xml version="1.0" encoding="UTF-8"?>
<xsd:schema xmlns:n="urn:wst-test"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
targetNamespace="urn:wst-test"
elementFormDefault="qualified"
attributeFormDefault="unqualified">
<xsd:complexType name="TClassSampleType">
<xsd:sequence>
<xsd:element name="SomeField" type="xsd:int" />
</xsd:sequence>
<xsd:attribute name="SomeField" type="xsd:string"/>
</xsd:complexType>
</xsd:schema>

1507
wst/trunk/tests/test_suite/test_parsers.pas
View File

File diff suppressed because it is too large Load Diff

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

@ -155,6 +155,7 @@ type
FImpTempStream : ISourceStream;
FImpLastStream : ISourceStream;
FRttiFunc : ISourceStream;
FFormOptions : string;
private
procedure WriteDocumentation(AElement : TPasElement);
procedure WriteDocIfEnabled(AElement : TPasElement);{$IFDEF USE_INLINE}inline;{$ENDIF}
@ -188,7 +189,7 @@ type
implementation
uses parserutils, Contnrs, logger_intf;
uses parserutils, Contnrs, logger_intf, xsd_consts, strutils;
const sLOCAL_TYPE_REGISTER_REFERENCE = 'typeRegistryInstance';
sPROXY_BASE_CLASS = 'TBaseProxy';
@ -2642,6 +2643,8 @@ var
end;
end;
var
strBuffer : string;
begin
locParentIsEnum := False;
locPropList := TObjectList.Create(False);
@ -2658,10 +2661,15 @@ begin
DecIndent();
FImpTempStream.Indent();
FImpTempStream.WriteLn(
'%s.Register(%s,TypeInfo(%s),%s);',
[sLOCAL_TYPE_REGISTER_REFERENCE,sNAME_SPACE,ASymbol.Name,QuotedStr(SymbolTable.GetExternalName(ASymbol))]
);
strBuffer := Format(
'%s.Register(%s,TypeInfo(%s),%s)',
[ sLOCAL_TYPE_REGISTER_REFERENCE,sNAME_SPACE,ASymbol.Name,
QuotedStr(SymbolTable.GetExternalName(ASymbol))]
);
if (FFormOptions <> '') then
strBuffer := Format('%s.AddOptions(%s)',[strBuffer,FFormOptions]);
strBuffer := strBuffer + ';';
FImpTempStream.WriteLn(strBuffer);
SetCurrentStream(FImpStream);
WriteImp();
@ -3270,6 +3278,8 @@ begin
end;
procedure TInftGenerator.PrepareModule();
var
s : string;
begin
FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec');
FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp');
@ -3280,6 +3290,21 @@ begin
FImpFirstStream.IncIndent();
FImpTempStream.IncIndent();
FImpLastStream.IncIndent();
FFormOptions := '';
s := SymbolTable.Properties.GetValue(SymbolTable.CurrentModule,s_elementFormDefault);
if (AnsiIndexStr(s,[s_unqualified,s_qualified]) >= 0) then
FFormOptions := Format('trio%sElement',[s]);
s := SymbolTable.Properties.GetValue(SymbolTable.CurrentModule,s_attributeFormDefault);
if (AnsiIndexStr(s,[s_unqualified,s_qualified]) >= 0) then begin
s := Format('trio%sAttribute',[s]);
if (FFormOptions <> '') then
FFormOptions := Format('%s, %s',[FFormOptions,s])
else
FFormOptions := s;
end;
if (FFormOptions <> '') then
FFormOptions := '[' + FFormOptions + ']';
end;
procedure TInftGenerator.Execute();

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

@ -21,6 +21,7 @@ uses
const
sEMBEDDED_TYPE = '_E_T_';
sIS_GROUP = '_IS_GROUP_';
sEXTERNAL_NAME = '_E_N_';
sATTRIBUTE = '_ATTRIBUTE_';
sARRAY_ITEM_NAME = 'ARRAY_ITEM_NAME';
@ -491,6 +492,7 @@ begin
Result.InterfaceSection := TInterfaceSection(AContainer.CreateElement(TInterfaceSection,'',Result,visDefault,'',0));
AddSystemSymbol(Result,AContainer,AContainer.XsdStringMaping);
AddClassDef(Result,'TBaseRemotable','',TPasNativeClassType);
AddClassDef(Result,'TStringBufferRemotable','TBaseRemotable',TPasNativeClassType);
AContainer.RegisterExternalAlias(AddClassDef(Result,'anyType_Type','TBaseRemotable',TPasNativeClassType),'anyType');
AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable',TPasNativeClassType);
AContainer.RegisterExternalAlias(AddClassDef(Result,'schema_Type','TAbstractSimpleRemotable'),'schema');

282
wst/trunk/ws_helper/ws_parser_imp.pas
View File

@ -107,7 +107,9 @@ type
function IndexOf(const AProp : TPasProperty) : Integer;
function GetCount() : Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
end;
TComplexTypeKind = (ctkComplexType, ctkGroup, ctkAttributeGroup);
{ TComplexTypeParser }
TComplexTypeParser = class(TAbstractTypeParser)
@ -121,11 +123,13 @@ type
FDerivationNode : TDOMNode;
FSequenceType : TSequenceType;
FHints : TParserTypeHints;
FKind : TComplexTypeKind;
FMixed : Boolean;
private
//helper routines
function ExtractElementCursor(
AParentNode : TDOMNode;
out AAttCursor : IObjectCursor;
out AAttCursor, AGroupCursor, AAttGroupCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode
):IObjectCursor;
procedure ExtractExtendedMetadata(const AItem : TPasElement; const ANode : TDOMNode);
@ -140,9 +144,13 @@ type
) : TPasArrayType;
function IsHeaderBlock() : Boolean;
function IsSimpleContentHeaderBlock() : Boolean;
procedure SetAsGroupType(AType : TPasType; const AValue : Boolean);
procedure AddGroup(ADest, AGroup : TPasClassType);
procedure ParseGroups(AClassDef : TPasClassType; AGroupCursor : IObjectCursor);
private
procedure CreateNodeCursors();
procedure ExtractTypeName();
procedure ExtractMixedStatus();
procedure ExtractContentType();
procedure ExtractBaseType();
function ParseSimpleContent(const ATypeName : string):TPasType;
@ -425,9 +433,12 @@ end;
{ TComplexTypeParser }
function TComplexTypeParser.ExtractElementCursor(
AParentNode : TDOMNode;
out AAttCursor : IObjectCursor;
out AAnyNode, AAnyAttNode : TDOMNode
AParentNode : TDOMNode;
out AAttCursor,
AGroupCursor,
AAttGroupCursor : IObjectCursor;
out AAnyNode,
AAnyAttNode : TDOMNode
) : IObjectCursor;
var
frstCrsr : IObjectCursor;
@ -437,6 +448,7 @@ var
locTmpCrs : IObjectCursor;
locTmpNode : TDOMNode;
begin
Result := nil;
locTmpCrs := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_all,Context.GetXsShortNames()),TDOMNodeRttiExposer)
@ -451,6 +463,10 @@ var
ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
Result := locTmpCrs;
AGroupCursor := CreateCursorOn(
CreateChildrenCursor(locTmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_group,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
end;
end;
end;
@ -496,6 +512,12 @@ var
tmpCursor.Reset();
if tmpCursor.MoveNext() then
AAnyNode := TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject;
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_group,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
AGroupCursor := tmpCursor;
end;
end
end;
@ -506,8 +528,12 @@ var
begin
Result := nil;
AAttCursor := nil;
AGroupCursor := nil;
AAttGroupCursor := nil;
AAnyNode := nil;
AAnyAttNode := nil;
if FMixed then
exit;
parentNode := AParentNode;
if (parentNode = nil) then begin
case FDerivationMode of
@ -517,10 +543,16 @@ begin
end;
end;
if parentNode.HasChildNodes() then begin;
AAttCursor := CreateCursorOn(
CreateChildrenCursor(parentNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
AAttCursor :=
CreateCursorOn(
CreateChildrenCursor(parentNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
AAttGroupCursor :=
CreateCursorOn(
CreateChildrenCursor(parentNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attributeGroup,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
crs := CreateChildrenCursor(parentNode,cetRttiNode);
if ( crs <> nil ) then begin
crs := CreateCursorOn(
@ -688,6 +720,120 @@ begin
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
procedure TComplexTypeParser.SetAsGroupType(
AType : TPasType;
const AValue : Boolean
);
var
s : string;
begin
if AValue then
s := '1'
else
s := '';
FSymbols.Properties.SetValue(AType,sIS_GROUP,s);
end;
procedure TComplexTypeParser.AddGroup(ADest, AGroup: TPasClassType);
var
i, k : Integer;
src, dest : TPasProperty;
locIsAttribute, locHasInternalName : Boolean;
locInternalEltName : string;
begin
for i := 0 to AGroup.Members.Count-1 do begin
if TObject(AGroup.Members[i]).InheritsFrom(TPasProperty) then begin
src := TPasProperty(AGroup.Members[i]);
locHasInternalName := False;
locIsAttribute := FSymbols.IsAttributeProperty(src);
locInternalEltName := src.Name;
if (FindMember(ADest,locInternalEltName) <> nil) then begin
locHasInternalName := True;
k := 0;
while True do begin
if locIsAttribute then
locInternalEltName := Format('%sAtt',[src.Name])
else
locInternalEltName := Format('%sElt',[src.Name]);
if (k > 0) then
locInternalEltName := locInternalEltName+IntToStr(k);
if (FindMember(ADest,locInternalEltName) = nil) then
break;
k := k+1;
end;
end;
dest := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,ADest,visPublished,'',0));
ADest.Members.Add(dest);
dest.VarType := src.VarType;
dest.VarType.AddRef();
if locHasInternalName or FSymbols.HasExternalName(src) then
FSymbols.RegisterExternalAlias(dest,FSymbols.GetExternalName(src));
if not locHasInternalName then begin
dest.ReadAccessorName := src.ReadAccessorName;
dest.WriteAccessorName := src.WriteAccessorName;
dest.StoredAccessorName := src.StoredAccessorName;
end else begin
dest.ReadAccessorName := StringReplace(src.ReadAccessorName,src.Name,dest.Name,[rfReplaceAll]);
dest.WriteAccessorName := StringReplace(src.WriteAccessorName,src.Name,dest.Name,[rfReplaceAll]);
dest.StoredAccessorName := StringReplace(src.StoredAccessorName,src.Name,dest.Name,[rfReplaceAll]);
end;
if locIsAttribute then
FSymbols.SetPropertyAsAttribute(dest,True);
{$IFDEF HAS_EXP_TREE}
if (src.DefaultExpr <> nil) and
src.DefaultExpr.InheritsFrom(TPrimitiveExpr)
then begin
dest.DefaultExpr :=
TPrimitiveExpr.Create(dest,pekString,TPrimitiveExpr(src.DefaultExpr).Value);
end;
{$ENDIF HAS_EXP_TREE}
end;
end;
end;
procedure TComplexTypeParser.ParseGroups(
AClassDef : TPasClassType;
AGroupCursor : IObjectCursor
);
var
locNode : TDOMNode;
locAttCursor, locRefCursor : IObjectCursor;
s, locNS, locLN, locLongNS : string;
elt : TPasElement;
locParser : IXsdPaser;
begin
if (AGroupCursor <> nil) then begin
AGroupCursor.Reset();
while AGroupCursor.MoveNext() do begin
locNode := (AGroupCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
locAttCursor := CreateAttributesCursor(locNode,cetRttiNode);
locRefCursor :=
CreateCursorOn(
locAttCursor.Clone() as IObjectCursor,
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_ref)]),TDOMNodeRttiExposer)
);
locRefCursor.Reset();
if locRefCursor.MoveNext() then begin
s := (locRefCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
ExplodeQName(s,locLN,locNS);
if not Context.FindNameSpace(locNS,locLongNS) then
locLongNS := locNS;
elt := FSymbols.FindElementNS(locLN,locLongNS);
if (elt = nil) then begin
locParser := Context.FindParser(locLongNS);
if (locParser <> nil) then
elt := locParser.ParseType(locLN,ExtractNameFromQName(locNode.NodeName));
end;
if (elt <> nil) then begin
if not elt.InheritsFrom(TPasClassType) then
raise EXsdInvalidElementDefinitionException.CreateFmt(SERR_UnableToResolveGroupRef,[FTypeName,elt.Name]);
AddGroup(AClassDef,elt as TPasClassType)
end;
end
end;
end;
end;
procedure TComplexTypeParser.CreateNodeCursors();
begin
FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode);
@ -712,6 +858,26 @@ begin
raise EXsdParserException.Create(SERR_InvalidTypeName);
end;
procedure TComplexTypeParser.ExtractMixedStatus();
var
locCrs : IObjectCursor;
locValue : string;
begin
FMixed := False;
if (FAttCursor <> nil) then begin
locCrs := CreateCursorOn(
FAttCursor.Clone() as IObjectCursor,
ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_mixed)]),TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
locValue := Trim((locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
if (locValue = 'true') then
FMixed := True;
end;
end;
end;
procedure TComplexTypeParser.ExtractContentType();
var
locCrs : IObjectCursor;
@ -753,6 +919,11 @@ var
locBaseTypeLocalSpace, locBaseTypeLocalName, locBaseTypeInternalName, locFilterStr : string;
locBaseTypeLocalSpaceExpanded : string;
begin
if FMixed then begin
FDerivationMode := dmNone;
FDerivationNode := nil;
exit;
end;
locFilterStr := CreateQualifiedNameFilterStr(s_extension,Context.GetXsShortNames());
locContentChildCrs := CreateChildrenCursor(FContentNode,cetRttiNode);
locCrs := CreateCursorOn(
@ -910,6 +1081,8 @@ var
locIsRefElement : Boolean;
locTypeHint : string;
locTypeAddRef : Boolean;
locIsAttribute : Boolean;
k : Integer;
begin
locType := nil;
locTypeName := '';
@ -992,6 +1165,22 @@ var
locInternalEltName := Format('_%s',[locInternalEltName]);
end;
locIsAttribute := AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName));
if (FindMember(classDef,locInternalEltName) <> nil) then begin
locHasInternalName := True;
k := 0;
while True do begin
if locIsAttribute then
locInternalEltName := Format('%sAtt',[locInternalEltName])
else
locInternalEltName := Format('%sElt',[locInternalEltName]);
if (k > 0) then
locInternalEltName := locInternalEltName+IntToStr(k);
if (FindMember(classDef,locInternalEltName) = nil) then
break;
k := k+1;
end;
end;
locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0));
classDef.Members.Add(locProp);
locProp.VarType := locType as TPasType;
@ -1004,7 +1193,7 @@ var
TPasEmentCrack(locType).SetName(locType.Name + '_Type');
end;}
if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin
if locIsAttribute then begin
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
@ -1022,18 +1211,17 @@ var
locMinOccur := 0;
end;
end else begin
if ABoundInfos.Valid then begin
locMinOccur := ABoundInfos.MinOccurs;
end else begin
if ABoundInfos.Valid then
locMinOccur := ABoundInfos.MinOccurs
else
locMinOccur := 1;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
end;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
if not TryStrToInt((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue,locMinOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMinOccursValue,[FTypeName,locName]);
end;
end;
locProp.ReadAccessorName := 'F' + locProp.Name;
@ -1052,18 +1240,18 @@ var
end else begin
locMaxOccur := 1;
locMaxOccurUnbounded := False;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
if AnsiSameText(locStrBuffer,s_unbounded) then begin
locMaxOccurUnbounded := True;
end else begin
if not TryStrToInt(locStrBuffer,locMaxOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
end;
end;
locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_maxOccurs)]),TDOMNodeRttiExposer));
locPartCursor.Reset();
if locPartCursor.MoveNext() then begin
locStrBuffer := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
if AnsiSameText(locStrBuffer,s_unbounded) then begin
locMaxOccurUnbounded := True;
end else begin
if not TryStrToInt(locStrBuffer,locMaxOccur) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
if ( locMinOccur < 0 ) then
raise EXsdParserException.CreateFmt(SERR_InvalidMaxOccursValue,[FTypeName,locName]);
end;
end;
isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 );
@ -1191,7 +1379,7 @@ var
end;
var
eltCrs, eltAttCrs : IObjectCursor;
eltCrs, eltAttCrs, grpCrs, attGrpCrs : IObjectCursor;
internalName : string;
hasInternalName : Boolean;
arrayDef : TPasArrayType;
@ -1207,7 +1395,7 @@ var
locTempNode : TDOMNode;
begin
ExtractBaseType();
eltCrs := ExtractElementCursor(nil,eltAttCrs,locAnyNode,locAnyAttNode);
eltCrs := ExtractElementCursor(nil,eltAttCrs,grpCrs,attGrpCrs,locAnyNode,locAnyAttNode);
internalName := ExtractIdentifier(ATypeName);
hasInternalName := IsReservedKeyWord(internalName) or
@ -1236,7 +1424,9 @@ begin
end;
locDefaultAncestorUsed := False;
if ( classDef.AncestorType = nil ) then begin
if IsHeaderBlock() then begin
if FMixed then begin
classDef.AncestorType := FSymbols.FindElementInModule('TStringBufferRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
end else if IsHeaderBlock() then begin
classDef.AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
end else if IsSimpleContentHeaderBlock() then begin
classDef.AncestorType := FSymbols.FindElementInModule('TSimpleContentHeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
@ -1267,6 +1457,8 @@ begin
end;
end;
ParseElementsAndAttributes(eltCrs,eltAttCrs,locBoundInfos);
ParseGroups(classDef,grpCrs);
ParseGroups(classDef,attGrpCrs);
if ( arrayItems.GetCount() > 0 ) then begin
if ( arrayItems.GetCount() = 1 ) and locDefaultAncestorUsed and
( GetElementCount(classDef.Members,TPasProperty) = 1 )
@ -1586,12 +1778,22 @@ function TComplexTypeParser.Parse() : TPasType;
var
locSym : TPasElement;
locContinue : Boolean;
locTagName : string;
begin
if not AnsiSameText(ExtractNameFromQName(FTypeNode.NodeName),s_complexType) then
locTagName := ExtractNameFromQName(FTypeNode.NodeName);
if (locTagName = s_complexType) then
FKind := ctkComplexType
else if (locTagName = s_group) then
FKind := ctkGroup
else if (locTagName = s_attributeGroup) then
FKind := ctkAttributeGroup
else
raise EXsdParserAssertException.CreateFmt(SERR_ExpectedButFound,[s_complexType,ExtractNameFromQName(FTypeNode.NodeName)]);
Result := nil;
CreateNodeCursors();
ExtractTypeName();
if (FKind = ctkComplexType) then
ExtractMixedStatus();
locContinue := True;
locSym := FSymbols.FindElement(FTypeName);
if Assigned(locSym) then begin
@ -1604,10 +1806,10 @@ begin
end;
if locContinue then begin
ExtractContentType();
if IsStrEmpty(FContentType) then begin
if IsStrEmpty(FContentType) and (FKind = ctkComplexType) then begin
Result := ParseEmptyContent(FTypeName);
end else begin
if AnsiSameText(FContentType,s_complexContent) then
if (FContentType = s_complexContent) or (FKind in [ctkGroup,ctkAttributeGroup]) then
Result := ParseComplexContent(FTypeName)
else
Result := ParseSimpleContent(FTypeName);
@ -1615,6 +1817,8 @@ begin
if ( Result <> nil ) then begin
if ( IsEmbeddedType(Result) <> FEmbededDef ) then
SetAsEmbeddedType(Result,FEmbededDef);
if (FKind in [ctkGroup,ctkAttributeGroup]) then
SetAsGroupType(Result,True);
end;
{$IFDEF WST_HANDLE_DOC}
if ( Result <> nil ) then

40
wst/trunk/ws_helper/wsdl_parser.pas
View File

@ -81,6 +81,7 @@ type
ANode : TDOMNode;
const ASoapBindingStyle : string
) : TPasProcedure;
function FindParser(const ANamespace : string) : IXsdPaser;
function GetParser(const ANamespace : string) : IXsdPaser;
function ParseType(
const AName : string;
@ -913,6 +914,27 @@ begin
Result := locMthd;
end;
function TWsdlParser.FindParser(const ANamespace: string): IXsdPaser;
var
i : Integer;
p, p1 : IXsdPaser;
begin
Result := nil;
i := FXsdParsers.IndexOf(ANamespace);
if ( i >= 0 ) then begin
Result := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser;
end else begin
for i := 0 to Pred(FXsdParsers.Count) do begin
p := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser;
p1 := p.FindParser(ANamespace);
if (p1 <> nil) then begin
Result := p1;
Break;
end;
end;
end;
end;
procedure TWsdlParser.ParsePort(ANode: TDOMNode);
function FindBindingNode(const AName : WideString):TDOMNode;
@ -1467,24 +1489,8 @@ begin
end;
function TWsdlParser.GetParser(const ANamespace: string): IXsdPaser;
var
i : Integer;
p, p1 : IXsdPaser;
begin
Result := nil;
i := FXsdParsers.IndexOf(ANamespace);
if ( i >= 0 ) then begin
Result := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser;
end else begin
for i := 0 to Pred(FXsdParsers.Count) do begin
p := (FXsdParsers.Objects[i] as TIntfObjectRef).Intf as IXsdPaser;
p1 := p.FindParser(ANamespace);
if (p1 <> nil) then begin
Result := p1;
Break;
end;
end;
end;
Result := FindParser(ANamespace);
if (Result = nil) then
raise EXsdParserAssertException.CreateFmt('Unable to find the parser, namespace : "%s".',[ANamespace]);
end;

7
wst/trunk/ws_helper/xsd_consts.pas
View File

@ -26,6 +26,8 @@ const
s_array : WideString = 'array';
s_arrayType : WideString = 'arrayType';
s_attribute : WideString = 'attribute';
s_attributeFormDefault = 'attributeFormDefault';
s_attributeGroup = 'attributeGroup';
s_base : WideString = 'base';
s_binding : WideString = 'binding';
s_body : WideString = 'body';
@ -38,9 +40,11 @@ const
s_document : WideString = 'document';
s_documentation = 'documentation';
s_element : WideString = 'element';
s_elementFormDefault = 'elementFormDefault';
s_enumeration : WideString = 'enumeration';
s_extension : WideString = 'extension';
s_guid : WideString = 'GUID';
s_group = 'group';
s_import = 'import';
s_include = 'include';
s_input : WideString = 'input';
@ -50,6 +54,7 @@ const
s_message : WideString = 'message';
s_maxOccurs : WideString = 'maxOccurs';
s_minOccurs : WideString = 'minOccurs';
s_mixed = 'mixed';
s_name : WideString = 'name';
s_namespace = 'namespace';
s_operation = 'operation';
@ -61,6 +66,8 @@ const
s_portType = 'portType';
s_processContents = 'processContents';
s_prohibited = 'prohibited';
s_qualified = 'qualified';
s_unqualified = 'unqualified';
s_ref : WideString = 'ref';
s_required : WideString = 'required';

38
wst/trunk/ws_helper/xsd_parser.pas
View File

@ -49,6 +49,7 @@ type
poParsingIncludeSchema
);
TParserOptions = set of TParserOption;
IXsdPaser = interface;
IParserContext = interface
['{F400BA9E-41AC-456C-ABF9-CEAA75313685}']
function GetXsShortNames() : TStrings;
@ -65,6 +66,7 @@ type
procedure AddIncludedDoc(ADocLocation : string);
function IsIncludedDoc(ADocLocation : string) : Boolean;
function FindParser(const ANamespace : string) : IXsdPaser;
end;
IXsdPaser = interface
@ -708,7 +710,7 @@ var
Result := '';
end;
function FindTypeNode(out ASimpleTypeAlias : TPasType) : Boolean;
function FindTypeNode(out ASimpleTypeAlias : TPasType; out AIsAlias : Boolean) : Boolean;
var
nd, oldTypeNode : TDOMNode;
crs : IObjectCursor;
@ -716,6 +718,7 @@ var
locHintedType : TPasType;
begin
ASimpleTypeAlias := nil;
AIsAlias := False;
Result := True;
if ( ATypeNode <> nil ) then
typNd := ATypeNode
@ -729,6 +732,7 @@ var
crs := CreateCursorOn(CreateAttributesCursor(typNd,cetRttiNode),ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
crs.Reset();
if crs.MoveNext() then begin
AIsAlias := True;
nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
ASimpleTypeAlias := FindElement(ExtractNameFromQName(nd.NodeValue)) as TPasType;
if Assigned(ASimpleTypeAlias) then begin
@ -833,7 +837,8 @@ var
sct : TPasSection;
shortNameSpace, longNameSpace : string;
typeModule : TPasModule;
locTypeNodeFound : Boolean;
locTypeNodeFound, IsAlias : Boolean;
locNodeTag : string;
begin
Prepare(True);
if not FImportParsed then
@ -859,7 +864,7 @@ begin
if (Result <> nil) and (not Result.InheritsFrom(TPasUnresolvedTypeRef)) then
Exit;
Init();
locTypeNodeFound := FindTypeNode(aliasType);
locTypeNodeFound := FindTypeNode(aliasType,IsAlias);
if ( Result <> nil ) and ( typeModule = FModule ) and
( not Result.InheritsFrom(TPasUnresolvedTypeRef) )
then begin
@ -874,9 +879,12 @@ begin
Result := nil;
Init();
if locTypeNodeFound {FindTypeNode(aliasType)} then begin
if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin
locNodeTag := ExtractNameFromQName(typNd.NodeName);
if (locNodeTag = s_complexType) or (locNodeTag = s_group) or
(locNodeTag = s_attributeGroup)
then begin
Result := ParseComplexType();
end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin
end else if (locNodeTag = s_simpleType) then begin
Result := ParseSimpleType();
end;
if Assigned(Result) then begin
@ -899,6 +907,11 @@ begin
sct.Types.Add(Result);
if Result.InheritsFrom(TPasClassType) then
sct.Classes.Add(Result);
if IsAlias and (aliasType = nil) then begin
Result := CreateTypeAlias(Result);
sct.Declarations.Add(Result);
sct.Types.Add(Result);
end;
end;
except
on e : EXsdTypeNotFoundException do begin
@ -1012,11 +1025,13 @@ begin
if Assigned(FChildCursor) then begin
crsSchemaChild := FChildCursor.Clone() as IObjectCursor;
typFilterStr := Format(
'%s or %s or %s or %s',
'%s or %s or %s or %s or %s or %s',
[ CreateQualifiedNameFilterStr(s_complexType,FXSShortNames),
CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames),
CreateQualifiedNameFilterStr(s_element,FXSShortNames),
CreateQualifiedNameFilterStr(s_attribute,FXSShortNames)
CreateQualifiedNameFilterStr(s_attribute,FXSShortNames),
CreateQualifiedNameFilterStr(s_group,FXSShortNames),
CreateQualifiedNameFilterStr(s_attributeGroup,FXSShortNames)
]
);
crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(typFilterStr,TDOMNodeRttiExposer));
@ -1049,11 +1064,14 @@ var
i : Integer;
ls : TStrings;
ok : Boolean;
eltForm, attForm : string;
begin
if FPrepared then
exit;
FTargetNameSpace := '';
eltForm := '';
attForm := '';
ok := False;
if (FSchemaNode.Attributes <> nil) and (GetNodeListCount(FSchemaNode.Attributes) > 0) then begin
nd := FSchemaNode.Attributes.GetNamedItem(s_targetNamespace);
@ -1061,6 +1079,8 @@ begin
FTargetNameSpace := nd.NodeValue;
ok := True;
end;
eltForm := Trim(NodeValue(FSchemaNode.Attributes.GetNamedItem(s_elementFormDefault)));
attForm := Trim(NodeValue(FSchemaNode.Attributes.GetNamedItem(s_attributeFormDefault)));
end;
prntCtx := GetParentContext();
if not ok then begin
@ -1114,6 +1134,10 @@ begin
SymbolTable.RegisterExternalAlias(FModule,FTargetNameSpace);
FModule.InterfaceSection := TInterfaceSection(SymbolTable.CreateElement(TInterfaceSection,'',FModule,visDefault,'',0));
end;
if (eltForm <> '') then
SymbolTable.Properties.SetValue(FModule,s_elementFormDefault,eltForm);
if (attForm <> '') then
SymbolTable.Properties.SetValue(FModule,s_attributeFormDefault,attForm);
end;
{ TXsdParser }

1
wst/trunk/wst_consts.pas
View File

@ -102,6 +102,7 @@ resourcestring
SERR_TypeStyleNotSupported = 'This type style is not supported : "%s".';
SERR_UnableToFindNameTagInNode = 'Unable to find the <name> tag in the type/element node attributes.';
SERR_UnableToResolveNamespace = 'Unable to resolve namespace, short name = "%s".';
SERR_UnableToResolveGroupRef = 'Unable to resolve the group reference, type = "%s", ref= "%s".';
SERR_UnexpectedEndOfData = 'Unexpected end of data.';
SERR_UnknownProperty = 'Unknown property : "%s".';
SERR_UnsupportedOperation = 'Unsupported operation : "%s".';