diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index ca46105ae..5cddc7962 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -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; diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index 06a6b56b3..0404b8be6 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -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 diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas index 361515414..28d4c9c22 100644 --- a/wst/trunk/object_serializer.pas +++ b/wst/trunk/object_serializer.pas @@ -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 diff --git a/wst/trunk/server_service_soap.pas b/wst/trunk/server_service_soap.pas index b59682028..bea0a26eb 100644 --- a/wst/trunk/server_service_soap.pas +++ b/wst/trunk/server_service_soap.pas @@ -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); diff --git a/wst/trunk/soap_formatter.pas b/wst/trunk/soap_formatter.pas index dfd808873..9fc42f1e5 100644 --- a/wst/trunk/soap_formatter.pas +++ b/wst/trunk/soap_formatter.pas @@ -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; diff --git a/wst/trunk/tests/test_suite/files/complex_class_group.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group.wsdl new file mode 100644 index 000000000..23aaa934b --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group.wsdl @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group.xsd b/wst/trunk/tests/test_suite/files/complex_class_group.xsd new file mode 100644 index 000000000..111263529 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group.xsd @@ -0,0 +1,21 @@ + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group2.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group2.wsdl new file mode 100644 index 000000000..f0f9078e8 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group2.wsdl @@ -0,0 +1,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group2.xsd b/wst/trunk/tests/test_suite/files/complex_class_group2.xsd new file mode 100644 index 000000000..4364d9395 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group2.xsd @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group3.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group3.wsdl new file mode 100644 index 000000000..535097bae --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group3.wsdl @@ -0,0 +1,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group3.xsd b/wst/trunk/tests/test_suite/files/complex_class_group3.xsd new file mode 100644 index 000000000..c425f4ec4 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group3.xsd @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group4.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group4.wsdl new file mode 100644 index 000000000..4692ad22c --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group4.wsdl @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group4.xsd b/wst/trunk/tests/test_suite/files/complex_class_group4.xsd new file mode 100644 index 000000000..a0b5ba624 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group4.xsd @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group5.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group5.wsdl new file mode 100644 index 000000000..db5ce7e58 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group5.wsdl @@ -0,0 +1,43 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group5.xsd b/wst/trunk/tests/test_suite/files/complex_class_group5.xsd new file mode 100644 index 000000000..81d916bab --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group5.xsd @@ -0,0 +1,30 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group6.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group6.wsdl new file mode 100644 index 000000000..871390fd0 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group6.wsdl @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group6.xsd b/wst/trunk/tests/test_suite/files/complex_class_group6.xsd new file mode 100644 index 000000000..a71fda3f7 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group6.xsd @@ -0,0 +1,23 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group7.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group7.wsdl new file mode 100644 index 000000000..685d9c99e --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group7.wsdl @@ -0,0 +1,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group7.xsd b/wst/trunk/tests/test_suite/files/complex_class_group7.xsd new file mode 100644 index 000000000..711a8209f --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group7.xsd @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group_att.wsdl new file mode 100644 index 000000000..c1798bf07 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att.wsdl @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att.xsd b/wst/trunk/tests/test_suite/files/complex_class_group_att.xsd new file mode 100644 index 000000000..96982f5f4 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att.xsd @@ -0,0 +1,19 @@ + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att2.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group_att2.wsdl new file mode 100644 index 000000000..47b4f42ae --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att2.wsdl @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att2.xsd b/wst/trunk/tests/test_suite/files/complex_class_group_att2.xsd new file mode 100644 index 000000000..46793249a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att2.xsd @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att3.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group_att3.wsdl new file mode 100644 index 000000000..5c2748a44 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att3.wsdl @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att3.xsd b/wst/trunk/tests/test_suite/files/complex_class_group_att3.xsd new file mode 100644 index 000000000..25b886512 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att3.xsd @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att4.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group_att4.wsdl new file mode 100644 index 000000000..27f4a3e9c --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att4.wsdl @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att4.xsd b/wst/trunk/tests/test_suite/files/complex_class_group_att4.xsd new file mode 100644 index 000000000..9979c459c --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att4.xsd @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att5.wsdl b/wst/trunk/tests/test_suite/files/complex_class_group_att5.wsdl new file mode 100644 index 000000000..ec955b693 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att5.wsdl @@ -0,0 +1,39 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_group_att5.xsd b/wst/trunk/tests/test_suite/files/complex_class_group_att5.xsd new file mode 100644 index 000000000..7407d8ece --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_group_att5.xsd @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.wsdl b/wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.wsdl new file mode 100644 index 000000000..99543f87a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.wsdl @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.xsd b/wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.xsd new file mode 100644 index 000000000..807d18d3b --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_class_same_name_elt_att.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_mixed.wsdl b/wst/trunk/tests/test_suite/files/complex_mixed.wsdl new file mode 100644 index 000000000..bf5fe7435 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_mixed.wsdl @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_mixed.xsd b/wst/trunk/tests/test_suite/files/complex_mixed.xsd new file mode 100644 index 000000000..eef3ca49a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_mixed.xsd @@ -0,0 +1,12 @@ + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_mixed2.wsdl b/wst/trunk/tests/test_suite/files/complex_mixed2.wsdl new file mode 100644 index 000000000..9df788098 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_mixed2.wsdl @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_mixed2.xsd b/wst/trunk/tests/test_suite/files/complex_mixed2.xsd new file mode 100644 index 000000000..e09221ecd --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_mixed2.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform1.wsdl b/wst/trunk/tests/test_suite/files/schema_defaultelementform1.wsdl new file mode 100644 index 000000000..99543f87a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform1.wsdl @@ -0,0 +1,27 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform1.xsd b/wst/trunk/tests/test_suite/files/schema_defaultelementform1.xsd new file mode 100644 index 000000000..807d18d3b --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform1.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform2.wsdl b/wst/trunk/tests/test_suite/files/schema_defaultelementform2.wsdl new file mode 100644 index 000000000..34ed57e75 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform2.wsdl @@ -0,0 +1,29 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform2.xsd b/wst/trunk/tests/test_suite/files/schema_defaultelementform2.xsd new file mode 100644 index 000000000..fada27381 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform2.xsd @@ -0,0 +1,14 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform3.wsdl b/wst/trunk/tests/test_suite/files/schema_defaultelementform3.wsdl new file mode 100644 index 000000000..9d66c29ab --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform3.wsdl @@ -0,0 +1,29 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform3.xsd b/wst/trunk/tests/test_suite/files/schema_defaultelementform3.xsd new file mode 100644 index 000000000..6ac78adfa --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform3.xsd @@ -0,0 +1,14 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform4.wsdl b/wst/trunk/tests/test_suite/files/schema_defaultelementform4.wsdl new file mode 100644 index 000000000..e386c88ac --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform4.wsdl @@ -0,0 +1,30 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/schema_defaultelementform4.xsd b/wst/trunk/tests/test_suite/files/schema_defaultelementform4.xsd new file mode 100644 index 000000000..86f1bfd53 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/schema_defaultelementform4.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index a83f120cf..6923da54b 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -56,9 +56,24 @@ type function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_SameNameOfElementAndAttributeSchema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Group() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Group2() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Group3() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Group4() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Group5() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Group6() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_Group7() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Mixed() : TwstPasTreeContainer;virtual;abstract; + function LoadComplexType_Mixed2() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_ArraySequence_ItemName_Schema() : TwstPasTreeContainer;virtual;abstract; @@ -87,6 +102,10 @@ type function load_schema_case_sensitive() : TwstPasTreeContainer;virtual;abstract; function load_schema_case_sensitive2() : TwstPasTreeContainer;virtual;abstract; function load_schema_case_sensitive_import() : TwstPasTreeContainer;virtual;abstract; + function load_schema_default_elt_att_form() : TwstPasTreeContainer;virtual;abstract; + function load_schema_default_elt_qualified_form() : TwstPasTreeContainer;virtual;abstract; + function load_schema_default_att_unqualified_form() : TwstPasTreeContainer;virtual;abstract; + function load_schema_default_elt_att_form_present() : TwstPasTreeContainer;virtual;abstract; function load_global_attribute() : TwstPasTreeContainer;virtual;abstract; published @@ -112,9 +131,24 @@ type procedure ComplexType_Class_Choice2(); procedure ComplexType_Class_Choice3(); procedure ComplexType_Class_Choice4(); + procedure ComplexType_Class_SameNameOfElementAndAttributeSchema(); + procedure ComplexType_Class_Group(); + procedure ComplexType_Class_Group_use(); + procedure ComplexType_Class_Group_use_forwarded(); + procedure ComplexType_Class_Group_multi_use(); + procedure ComplexType_Class_Group_use_forwarded_type(); + procedure ComplexType_Class_Group_use_array(); + procedure ComplexType_Class_Group_use_array_choice(); + procedure ComplexType_Class_AttGroup(); + procedure ComplexType_Class_AttGroup_use(); + procedure ComplexType_Class_AttGroup_use_forwarded(); + procedure ComplexType_Class_AttGroup_multi_use(); + procedure ComplexType_Class_AttGroup_use_forwarded_type(); procedure ComplexType_Record(); procedure ComplexType_Record_Embedded(); + procedure ComplexType_Mixed(); + procedure ComplexType_Mixed2(); procedure ComplexType_ArraySequence(); procedure ComplexType_ArraySequence_ItemName_Schema(); @@ -137,6 +171,10 @@ type procedure schema_include_fail_namespace(); procedure schema_include_circular1(); procedure schema_include_circular2(); + procedure schema_default_elt_att_form(); + procedure schema_default_elt_qualified_form(); + procedure schema_default_att_unqualified_form(); + procedure schema_default_elt_att_form_present(); procedure case_sensitive(); procedure case_sensitive2(); @@ -169,9 +207,24 @@ type function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_SameNameOfElementAndAttributeSchema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group2() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group3() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group4() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group5() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group6() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group7() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;override; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Mixed() : TwstPasTreeContainer;override; + function LoadComplexType_Mixed2() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_ItemName_Schema() : TwstPasTreeContainer; override; @@ -200,6 +253,10 @@ type function load_schema_case_sensitive() : TwstPasTreeContainer;override; function load_schema_case_sensitive2() : TwstPasTreeContainer;override; function load_schema_case_sensitive_import() : TwstPasTreeContainer;override; + function load_schema_default_elt_att_form() : TwstPasTreeContainer;override; + function load_schema_default_elt_qualified_form() : TwstPasTreeContainer;override; + function load_schema_default_att_unqualified_form() : TwstPasTreeContainer;override; + function load_schema_default_elt_att_form_present() : TwstPasTreeContainer;override; function load_global_attribute() : TwstPasTreeContainer;override; end; @@ -228,9 +285,24 @@ type function LoadComplexType_Class_Choice2_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Choice3_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Class_Choice4_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_SameNameOfElementAndAttributeSchema() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group2() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group3() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group4() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group5() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group6() : TwstPasTreeContainer;override; + function LoadComplexType_Class_Group7() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer;override; + function LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer;override; function LoadComplexType_Record_Schema() : TwstPasTreeContainer;override; function LoadComplexType_Record_Embedded_Schema() : TwstPasTreeContainer;override; + function LoadComplexType_Mixed() : TwstPasTreeContainer;override; + function LoadComplexType_Mixed2() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_ItemName_Schema() : TwstPasTreeContainer; override; @@ -259,6 +331,10 @@ type function load_schema_case_sensitive() : TwstPasTreeContainer;override; function load_schema_case_sensitive2() : TwstPasTreeContainer;override; function load_schema_case_sensitive_import() : TwstPasTreeContainer;override; + function load_schema_default_elt_att_form() : TwstPasTreeContainer;override; + function load_schema_default_elt_qualified_form() : TwstPasTreeContainer;override; + function load_schema_default_att_unqualified_form() : TwstPasTreeContainer;override; + function load_schema_default_elt_att_form_present() : TwstPasTreeContainer;override; function load_global_attribute() : TwstPasTreeContainer;override; published @@ -1284,6 +1360,1072 @@ begin end; end; +procedure TTest_CustomXsdParser.ComplexType_Class_SameNameOfElementAndAttributeSchema(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty( + const AName,ATypeName : string; const AFieldType : TPropertyType; + const AExternalName : string = '' + ); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + if IsStrEmpty(AExternalName) then + CheckEquals(AName,tr.GetExternalName(prp)) + else + CheckEquals(AExternalName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_SameNameOfElementAndAttributeSchema(); + + mdl := tr.FindModule('complex_class_same_name_elt_att'); + CheckNotNull(mdl); + CheckEquals('complex_class_same_name_elt_att',mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count); + elt := tr.FindElement(x_complexType_SampleClassType); + CheckNotNull(elt,x_complexType_SampleClassType); + CheckEquals(x_complexType_SampleClassType,elt.Name); + CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty('SomeField','int',ptField); + CheckProperty('SomeFieldAtt','string',ptAttribute,'SomeField'); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Group(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Group(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2,ls.Count,'Declarations.Count'); + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Group_use(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Group2(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(5,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_forwarded(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Group3(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(5,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Group_multi_use(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Group4(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + + elt := tr.FindElement('TJobGroupType'); + CheckNotNull(elt,'TJobGroupType'); + CheckEquals('TJobGroupType',elt.Name); + CheckEquals('TJobGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TJobGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty('jobPosition','string',ptField); + CheckProperty('employer','string',ptField); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals((2+3+2),prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + CheckProperty('jobPosition','string',ptField); + CheckProperty('employer','string',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_forwarded_type(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Group5(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('occupation','TJobType',ptField); + + elt := tr.FindElement('TJobType'); + CheckNotNull(elt,'TJobType'); + CheckEquals('TJobType',elt.Name); + CheckEquals('TJobType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TJobType:'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty('jobPosition','string',ptField); + CheckProperty('employer','string',ptField); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals((2+3),prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('occupation','TJobType',ptField); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_array(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + + procedure CheckArrayProperty(const AName,ATypeName : string); + var + prp : TPasProperty; + at : TPasArrayType; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.'); + at := prp.VarType as TPasArrayType; + CheckEquals(ATypeName,tr.GetExternalName(at.ElType)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Group6(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2+1{array def},ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(4,prpLs.Count); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + CheckArrayProperty('otherName','string'); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals((2+4),prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptField); + CheckProperty('lastName','string',ptField); + CheckProperty('Age','int',ptField); + CheckArrayProperty('otherName','string'); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_Group_use_array_choice(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + + procedure CheckArrayProperty(const AName,ATypeName : string); + var + prp : TPasProperty; + at : TPasArrayType; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckIs(prp.VarType,TPasArrayType,AName + ' should be an array.'); + at := prp.VarType as TPasArrayType; + CheckEquals(ATypeName,tr.GetExternalName(at.ElType)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_Group7(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckArrayProperty('firstName','string'); + CheckArrayProperty('lastName','string'); + CheckArrayProperty('otherName','string'); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals((2+3),prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckArrayProperty('firstName','string'); + CheckArrayProperty('lastName','string'); + CheckArrayProperty('otherName','string'); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_AttGroup(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2,ls.Count,'Declarations.Count'); + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('Age','int',ptAttribute); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_use(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_AttGroup2(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('Age','int',ptAttribute); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(5,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('Age','int',ptAttribute); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_use_forwarded(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_AttGroup3(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(2,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('Age','int',ptAttribute); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(5,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('Age','int',ptAttribute); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_multi_use(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_AttGroup4(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(3,prpLs.Count); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('Age','int',ptAttribute); + + elt := tr.FindElement('TJobGroupType'); + CheckNotNull(elt,'TJobGroupType'); + CheckEquals('TJobGroupType',elt.Name); + CheckEquals('TJobGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TJobGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty('jobPosition','string',ptAttribute); + CheckProperty('employer','string',ptAttribute); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals((2+3+2),prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('Age','int',ptAttribute); + CheckProperty('jobPosition','string',ptAttribute); + CheckProperty('employer','string',ptAttribute); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_AttGroup_use_forwarded_type(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Class_AttGroup5(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count,'Declarations.Count'); + + elt := tr.FindElement('TContactGroupType'); + CheckNotNull(elt,'TContactGroupType'); + CheckEquals('TContactGroupType',elt.Name); + CheckEquals('TContactGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + Check((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TContactGroupType'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(4,prpLs.Count); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('jobPosition','string',ptAttribute); + CheckProperty('employer','string',ptAttribute); + + elt := tr.FindElement('TJobGroupType'); + CheckNotNull(elt,'TJobGroupType'); + CheckEquals('TJobGroupType',elt.Name); + CheckEquals('TJobGroupType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckTrue((tr.Properties.GetValue(elt,sIS_GROUP)='1'),'TJobGroupType:'+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(2,prpLs.Count); + CheckProperty('jobPosition','string',ptAttribute); + CheckProperty('employer','string',ptAttribute); + + elt := tr.FindElement('TClassSampleType'); + CheckNotNull(elt,'TClassSampleType'); + CheckEquals('TClassSampleType',elt.Name); + CheckEquals('TClassSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + CheckFalse(tr.Properties.HasValue(elt,sIS_GROUP),'TClassSampleType: '+sIS_GROUP); + clsType := elt as TPasClassType; + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals((2+4),prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptAttribute); + CheckProperty('firstName','string',ptAttribute); + CheckProperty('lastName','string',ptAttribute); + CheckProperty('jobPosition','string',ptAttribute); + CheckProperty('employer','string',ptAttribute); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + procedure TTest_CustomXsdParser.ComplexType_Record(); var tr : TwstPasTreeContainer; @@ -1464,6 +2606,88 @@ begin end; end; +procedure TTest_CustomXsdParser.ComplexType_Mixed(); +var + tr : TwstPasTreeContainer; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + clsType : TPasClassType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Mixed(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count,'Declarations.Count'); + elt := tr.FindElement('TSampleType'); + CheckNotNull(elt,'TSampleType'); + CheckEquals('TSampleType',elt.Name); + CheckEquals('TSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + CheckNotNull(clsType.AncestorType,'AncestorType'); + CheckEquals('TStringBufferRemotable',clsType.AncestorType.Name,'AncestorType.Name'); + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(0,prpLs.Count,'Should not have properties.'); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Mixed2(); +var + tr : TwstPasTreeContainer; + +var + mdl : TPasModule; + ls : TList2; + elt : TPasElement; + clsType : TPasClassType; + i : Integer; + prpLs : TList; +begin + tr := nil; + prpLs := TList.Create(); + try + tr := LoadComplexType_Mixed2(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(1,ls.Count,'Declarations.Count'); + elt := tr.FindElement('TSampleType'); + CheckNotNull(elt,'TSampleType'); + CheckEquals('TSampleType',elt.Name); + CheckEquals('TSampleType',tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + CheckNotNull(clsType.AncestorType,'AncestorType'); + CheckEquals('TStringBufferRemotable',clsType.AncestorType.Name,'AncestorType.Name'); + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(0,prpLs.Count,'Should not have properties.'); + finally + FreeAndNil(prpLs); + FreeAndNil(tr); + end; +end; + procedure TTest_CustomXsdParser.ComplexType_ArraySequence(); var tr : TwstPasTreeContainer; @@ -2453,6 +3677,99 @@ begin end; end; +procedure TTest_CustomXsdParser.schema_default_elt_att_form(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; +begin + tr := load_schema_default_elt_att_form(); + try + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckFalse( + tr.Properties.HasValue(mdl,s_elementFormDefault), + 'Should not have '+s_elementFormDefault + ); + CheckFalse( + tr.Properties.HasValue(mdl,s_attributeFormDefault), + 'Should not have '+s_attributeFormDefault + ); + finally + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.schema_default_elt_qualified_form(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; +begin + tr := load_schema_default_elt_qualified_form(); + try + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckTrue( + tr.Properties.HasValue(mdl,s_elementFormDefault), + 'Should have '+s_elementFormDefault + ); + CheckEquals(s_qualified,tr.Properties.GetValue(mdl,s_elementFormDefault)); + CheckFalse( + tr.Properties.HasValue(mdl,s_attributeFormDefault), + 'Should not have '+s_attributeFormDefault + ); + finally + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.schema_default_att_unqualified_form(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; +begin + tr := load_schema_default_att_unqualified_form(); + try + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckTrue( + tr.Properties.HasValue(mdl,s_attributeFormDefault), + 'Should have '+s_attributeFormDefault + ); + CheckEquals(s_unqualified,tr.Properties.GetValue(mdl,s_attributeFormDefault)); + CheckFalse( + tr.Properties.HasValue(mdl,s_elementFormDefault), + 'Should not have '+s_elementFormDefault + ); + finally + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.schema_default_elt_att_form_present(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; +begin + tr := load_schema_default_elt_att_form_present(); + try + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckTrue( + tr.Properties.HasValue(mdl,s_attributeFormDefault), + 'Should have '+s_attributeFormDefault + ); + CheckEquals(s_unqualified,tr.Properties.GetValue(mdl,s_attributeFormDefault)); + + CheckTrue( + tr.Properties.HasValue(mdl,s_attributeFormDefault), + 'Should have '+s_attributeFormDefault + ); + CheckEquals(s_unqualified,tr.Properties.GetValue(mdl,s_attributeFormDefault)); + finally + FreeAndNil(tr); + end; +end; + procedure TTest_CustomXsdParser.case_sensitive(); var tr : TwstPasTreeContainer; @@ -2842,6 +4159,16 @@ begin Result := ParseDoc(x_complexType_record_embedded); end; +function TTest_XsdParser.LoadComplexType_Mixed() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_mixed'); +end; + +function TTest_XsdParser.LoadComplexType_Mixed2() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_mixed2'); +end; + function TTest_XsdParser.LoadComplexType_ArraySequence_Schema(): TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_array_sequence); @@ -2957,6 +4284,26 @@ begin Result := ParseDoc('case_sensitive3',True); end; +function TTest_XsdParser.load_schema_default_elt_att_form() : TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform1'); +end; + +function TTest_XsdParser.load_schema_default_elt_qualified_form: TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform2'); +end; + +function TTest_XsdParser.load_schema_default_att_unqualified_form: TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform3'); +end; + +function TTest_XsdParser.load_schema_default_elt_att_form_present: TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform4'); +end; + function TTest_XsdParser.load_global_attribute() : TwstPasTreeContainer; begin Result := ParseDoc('global_attribute'); @@ -2997,6 +4344,71 @@ begin Result := ParseDoc('complex_class_choice4'); end; +function TTest_XsdParser.LoadComplexType_Class_SameNameOfElementAndAttributeSchema: TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_same_name_elt_att'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Group: TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Group2() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group2'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Group3() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group3'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Group4() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group4'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Group5() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group5'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Group6() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group6'); +end; + +function TTest_XsdParser.LoadComplexType_Class_Group7() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group7'); +end; + +function TTest_XsdParser.LoadComplexType_Class_AttGroup() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att'); +end; + +function TTest_XsdParser.LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att2'); +end; + +function TTest_XsdParser.LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att3'); +end; + +function TTest_XsdParser.LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att4'); +end; + +function TTest_XsdParser.LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att5'); +end; + { TTest_WsdlParser } function TTest_WsdlParser.ParseDoc( @@ -3089,6 +4501,71 @@ begin Result := ParseDoc('complex_class_choice4'); end; +function TTest_WsdlParser.LoadComplexType_Class_SameNameOfElementAndAttributeSchema: TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_same_name_elt_att'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Group(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Group2() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group2'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Group3() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group3'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Group4() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group4'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Group5() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group5'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Group6() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group6'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_Group7() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group7'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_AttGroup() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_AttGroup2() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att2'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_AttGroup3() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att3'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_AttGroup4() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att4'); +end; + +function TTest_WsdlParser.LoadComplexType_Class_AttGroup5() : TwstPasTreeContainer; +begin + Result := ParseDoc('complex_class_group_att5'); +end; + function TTest_WsdlParser.LoadComplexType_Record_Schema(): TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_record); @@ -3099,6 +4576,16 @@ begin Result := ParseDoc(x_complexType_record_embedded); end; +function TTest_WsdlParser.LoadComplexType_Mixed(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_mixed'); +end; + +function TTest_WsdlParser.LoadComplexType_Mixed2(): TwstPasTreeContainer; +begin + Result := ParseDoc('complex_mixed2'); +end; + function TTest_WsdlParser.LoadComplexType_ArraySequence_Schema(): TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_array_sequence); @@ -3788,6 +5275,26 @@ begin Result := ParseDoc('case_sensitive3',True); end; +function TTest_WsdlParser.load_schema_default_elt_att_form: TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform1'); +end; + +function TTest_WsdlParser.load_schema_default_elt_qualified_form: TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform2'); +end; + +function TTest_WsdlParser.load_schema_default_att_unqualified_form: TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform3'); +end; + +function TTest_WsdlParser.load_schema_default_elt_att_form_present: TwstPasTreeContainer; +begin + Result := ParseDoc('schema_defaultelementform4'); +end; + function TTest_WsdlParser.load_global_attribute() : TwstPasTreeContainer; begin Result := ParseDoc('global_attribute',True); diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index 4541e3351..9f9823165 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -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(); diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index 401a12668..95edf042c 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -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'); diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas index 03ac42cf3..44c9c564e 100644 --- a/wst/trunk/ws_helper/ws_parser_imp.pas +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -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 diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas index e7450eb75..c4a91f4b6 100644 --- a/wst/trunk/ws_helper/wsdl_parser.pas +++ b/wst/trunk/ws_helper/wsdl_parser.pas @@ -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; diff --git a/wst/trunk/ws_helper/xsd_consts.pas b/wst/trunk/ws_helper/xsd_consts.pas index 6b3936a83..660659097 100644 --- a/wst/trunk/ws_helper/xsd_consts.pas +++ b/wst/trunk/ws_helper/xsd_consts.pas @@ -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'; diff --git a/wst/trunk/ws_helper/xsd_parser.pas b/wst/trunk/ws_helper/xsd_parser.pas index 269657299..c57121da0 100644 --- a/wst/trunk/ws_helper/xsd_parser.pas +++ b/wst/trunk/ws_helper/xsd_parser.pas @@ -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 } diff --git a/wst/trunk/wst_consts.pas b/wst/trunk/wst_consts.pas index 2136c653d..b2146245e 100644 --- a/wst/trunk/wst_consts.pas +++ b/wst/trunk/wst_consts.pas @@ -102,6 +102,7 @@ resourcestring SERR_TypeStyleNotSupported = 'This type style is not supported : "%s".'; SERR_UnableToFindNameTagInNode = 'Unable to find the 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".';