From 420a28dc1def52b4902e982f47296a0996d38525 Mon Sep 17 00:00:00 2001 From: inoussa Date: Wed, 2 Sep 2009 12:24:19 +0000 Subject: [PATCH] Preparing Type name and Element disambiguation git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@950 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_service_intf.pas | 102 ++++++++++-------- wst/trunk/date_utils.pas | 30 ++++++ wst/trunk/ide/lazarus/wst_indy.lpk | 2 +- wst/trunk/indy_http_protocol.pas | 56 +++++++++- wst/trunk/synapse_http_protocol.pas | 2 +- .../test_suite/test_generators_runtime.pas | 4 +- wst/trunk/ws_helper/pascal_parser_intf.pas | 2 + wst/trunk/ws_helper/ws_parser_imp.pas | 19 +++- wst/trunk/ws_helper/wsdl_parser.pas | 29 +++-- wst/trunk/ws_helper/xsd_parser.pas | 62 +++++++++-- 10 files changed, 240 insertions(+), 68 deletions(-) diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index a8b4ca818..71c355333 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -50,7 +50,7 @@ type {$IFNDEF WST_HAS_TTIMEREMOTABLE} time = type string; {$ENDIF WST_HAS_TTIMEREMOTABLE} - + TScopeType = Integer; TArrayStyle = ( asScoped, asEmbeded, asNone ); TInstanceOption = ( ioAlwaysSerialize ); @@ -76,7 +76,7 @@ type EServiceConfigException = class(EServiceException) end; - + ETypeRegistryException = class(EServiceConfigException) end; @@ -144,7 +144,7 @@ type End; TSerializationStyle = ( ssNodeSerialization, ssAttibuteSerialization ); - + IFormatterBase = Interface ['{2AB3BF54-B7D6-4C46-8245-133C8775E9C1}'] function GetPropertyManager():IPropertyManager; @@ -219,7 +219,7 @@ type function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean; //Please use this method if and _only_ if you do not have another way achieve your aim! procedure WriteBuffer(const AValue : string); - + procedure SaveToStream(AStream : TStream); procedure LoadFromStream(AStream : TStream); @@ -383,6 +383,7 @@ type class function ToStr(const ADate : TDateTime):string;overload; class function ToStr(const ADate : TDateTimeRec):string;overload;virtual;abstract; class function Parse(const ABuffer : string):TDateTimeRec;virtual;abstract; + class function ParseToUTC(const ABuffer : string):TDateTime; procedure Assign(Source: TPersistent); override; function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; @@ -403,8 +404,8 @@ type public class function ToStr(const ADate : TDateTimeRec):string;override; class function Parse(const ABuffer : string):TDateTimeRec;override; - end; - + end; + { TDateTimeRemotable } TDateTimeRemotable = class(TBaseDateRemotable) @@ -417,7 +418,7 @@ type property Minute : Integer index 4 read GetDatepart; property Second : Integer index 5 read GetDatepart; end; - + { TDurationRemotable } TDurationRemotable = class(TAbstractSimpleRemotable) @@ -507,7 +508,7 @@ type property Data : TTimeRec read FData write FData; property AsString : string read GetAsString write SetAsString; end; - + TAbstractComplexRemotableClass = class of TAbstractComplexRemotable; { TAbstractComplexRemotable } @@ -546,7 +547,7 @@ type end; TRemotableRecordEncoderClass = class of TRemotableRecordEncoder; - + { TRemotableRecordEncoder } TRemotableRecordEncoder = class(TPersistent) @@ -564,7 +565,7 @@ type const ATypeInfo : PTypeInfo );virtual; end; - + { TBaseComplexSimpleContentRemotable } TBaseComplexSimpleContentRemotable = class(TAbstractComplexRemotable) @@ -599,7 +600,7 @@ type end; { TComplexInt8SContentRemotable } - + TComplexInt8SContentRemotable = class(TBaseComplexSimpleContentRemotable) private FValue: ShortInt; @@ -631,7 +632,7 @@ type public property Value : Word read FValue write FValue; end; - + { TComplexInt32SContentRemotable } TComplexInt32SContentRemotable = class(TBaseComplexSimpleContentRemotable) @@ -655,7 +656,7 @@ type public property Value : LongWord read FValue write FValue; end; - + { TComplexInt64SContentRemotable } TComplexInt64SContentRemotable = class(TBaseComplexSimpleContentRemotable) @@ -823,7 +824,7 @@ type public property Value : Boolean read FValue write FValue; end; - + THeaderBlockClass = class of THeaderBlock; { THeaderBlock } @@ -1453,7 +1454,7 @@ type property Intf : IInterface read FIntf; property Used : Boolean read FUsed write FUsed; end; - + TIntfPool = class private FList : TObjectList; @@ -1478,7 +1479,7 @@ type property Min : PtrInt read FMin; property Max : PtrInt read FMax; end; - + { TSimpleItemFactoryEx } TSimpleItemFactoryEx = class(TSimpleItemFactory,IInterface,IItemFactory,IItemFactoryEx) @@ -1522,7 +1523,7 @@ type TTypeRegistry = class; TTypeRegistryItem = class; TTypeRegistryItemClass = class of TTypeRegistryItem; - + TRemotableTypeInitializerClass = class of TRemotableTypeInitializer; { TRemotableTypeInitializer } @@ -1538,7 +1539,7 @@ type ) : Boolean;virtual;abstract; {$ENDIF TRemotableTypeInitializer_Initialize} end; - + { TTypeRegistryItem } TTypeRegistryItem = class @@ -1568,11 +1569,11 @@ type function AddExternalSynonym(const ASynonym : string):TTypeRegistryItem; function IsSynonym(const APascalTypeName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} function IsExternalSynonym(const AExternalName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} - + procedure RegisterExternalPropertyName(const APropName, AExtPropName : string); virtual; function GetExternalPropertyName(const APropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF} function GetInternalPropertyName(const AExtPropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF} - + procedure RegisterObject(const APropName : string; const AObject : TObject); function GetObject(const APropName : string) : TObject; @@ -1624,7 +1625,7 @@ type end; TPropStoreType = ( pstNever, pstOptional, pstAlways ); - + EPropertyException = class(Exception) end; @@ -1680,7 +1681,7 @@ const procedure initialize_base_service_intf(); procedure finalize_base_service_intf(); - + {$IFDEF HAS_FORMAT_SETTINGS} var wst_FormatSettings : TFormatSettings; @@ -1693,7 +1694,7 @@ uses type PObject = ^TObject; - + var TypeRegistryInstance : TTypeRegistry = Nil; @@ -1789,13 +1790,13 @@ begin r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatDoubleRemotable),'TArrayOfFloatDoubleRemotable').AddPascalSynonym('TArrayOfFloatDoubleRemotable'); r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatExtendedRemotable),'TArrayOfFloatExtendedRemotable').AddPascalSynonym('TArrayOfFloatExtendedRemotable'); r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatCurrencyRemotable),'TArrayOfFloatCurrencyRemotable').AddPascalSynonym('TArrayOfFloatCurrencyRemotable'); - + r.Register(sXSD_NS,TypeInfo(TComplexInt64SContentRemotable),'long').AddPascalSynonym('TComplexInt64SContentRemotable'); r.Register(sXSD_NS,TypeInfo(TComplexInt64UContentRemotable),'unsignedLong').AddPascalSynonym('TComplexInt64UContentRemotable'); - + r.Register(sXSD_NS,TypeInfo(TComplexInt32SContentRemotable),'int').AddPascalSynonym('TComplexInt32SContentRemotable'); r.Register(sXSD_NS,TypeInfo(TComplexInt32UContentRemotable),'unsignedInt').AddPascalSynonym('TComplexInt32UContentRemotable'); - + r.Register(sXSD_NS,TypeInfo(TComplexInt16SContentRemotable),'short').AddPascalSynonym('TComplexInt16SContentRemotable'); r.Register(sXSD_NS,TypeInfo(TComplexInt16UContentRemotable),'unsignedShort').AddPascalSynonym('TComplexInt16UContentRemotable'); @@ -1805,7 +1806,7 @@ begin r.Register(sXSD_NS,TypeInfo(TComplexFloatExtendedContentRemotable),'decimal').AddPascalSynonym('TComplexFloatExtendedContentRemotable'); r.Register(sXSD_NS,TypeInfo(TComplexFloatDoubleContentRemotable),'double').AddPascalSynonym('TComplexFloatDoubleContentRemotable'); r.Register(sXSD_NS,TypeInfo(TComplexFloatSingleContentRemotable),'Single').AddPascalSynonym('TComplexFloatSingleContentRemotable'); - + r.Register(sXSD_NS,TypeInfo(TComplexStringContentRemotable),'string').AddPascalSynonym('TComplexStringContentRemotable'); r.Register(sXSD_NS,TypeInfo(TComplexWideStringContentRemotable),'widestring').AddPascalSynonym('TComplexWideStringContentRemotable'); {$IFDEF WST_UNICODESTRING} @@ -2018,14 +2019,14 @@ Type var SerializeOptionsRegistryInstance : TSerializeOptionsRegistry = nil; - + function GetSerializeOptionsRegistry():TSerializeOptionsRegistry; begin if not Assigned(SerializeOptionsRegistryInstance) then SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create(); Result := SerializeOptionsRegistryInstance; end; - + { TSerializeOptionsRegistry } function TSerializeOptionsRegistry.GetCount: Integer; @@ -2094,7 +2095,7 @@ begin else Result := nil; end; - + { TSerializeOptions } procedure TSerializeOptions.AddAttributeField(const AAttributeField: string); @@ -2132,10 +2133,10 @@ begin Result := ( FAttributeFieldList.IndexOf(AField) >= 0 ); end; -destructor TBaseComplexRemotable.Destroy(); +destructor TBaseComplexRemotable.Destroy(); begin FreeObjectProperties(); - inherited Destroy(); + inherited Destroy(); end; class procedure TBaseComplexRemotable.Save( @@ -2511,10 +2512,10 @@ begin end; {$ENDIF USE_SERIALIZE} -procedure TBaseComplexRemotable.FreeObjectProperties(); +procedure TBaseComplexRemotable.FreeObjectProperties(); begin //Derived classes should override this method to free their object(s) and array(s). -end; +end; { TBaseObjectArrayRemotable } @@ -3095,7 +3096,7 @@ destructor TTypeRegistryItem.Destroy(); obj.Free(); end; end; - + begin if ( FExternalNames <> nil ) and ( FExternalNames.Count > 0 ) then FreeObjects(); @@ -3279,13 +3280,19 @@ begin end; function TTypeRegistry.IndexOf(Const ATypeInfo: PTypeInfo): Integer; +var + i : Integer; begin - For Result := 0 To Pred(Count) Do Begin - If ( ATypeInfo^.Kind = Item[Result].DataType^.Kind ) And + for i := 0 to Pred(Count) do begin + if ( ATypeInfo = Item[i].DataType ) then begin + Result := i; + Exit; + end; + {If ( ATypeInfo^.Kind = Item[Result].DataType^.Kind ) And AnsiSameText(ATypeInfo^.Name,Item[Result].DataType^.Name) Then - Exit; - End; + Exit;} + end; Result := -1; end; @@ -4733,10 +4740,12 @@ class procedure TSimpleContentHeaderBlock.Save( ); var locSerializer : TObjectSerializer; + locOptionChanged : Boolean; begin locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer(); if ( locSerializer <> nil ) then begin - if not ( osoDontDoBeginWrite in locSerializer.Options ) then + locOptionChanged := not ( osoDontDoBeginWrite in locSerializer.Options ); + if locOptionChanged then locSerializer.Options := locSerializer.Options + [osoDontDoBeginWrite]; AStore.BeginObject(AName,ATypeInfo); try @@ -4745,6 +4754,8 @@ begin locSerializer.Save(AObject,AStore,AName,ATypeInfo); finally AStore.EndScope(); + if locOptionChanged then + locSerializer.Options := locSerializer.Options - [osoDontDoBeginWrite]; end; end else begin raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name]) @@ -5655,12 +5666,12 @@ end; { TDateRemotable } -class function TDateRemotable.ToStr(const ADate : TDateTimeRec) : string; +class function TDateRemotable.ToStr(const ADate : TDateTimeRec) : string; begin Result := xsd_DateTimeToStr(ADate,xdkDate); end; -class function TDateRemotable.Parse(const ABuffer : string) : TDateTimeRec; +class function TDateRemotable.Parse(const ABuffer : string) : TDateTimeRec; begin Result := xsd_StrToDate(ABuffer,xdkDate); end; @@ -5822,6 +5833,11 @@ begin Result := ToStr(locTemp); end; +class function TBaseDateRemotable.ParseToUTC(const ABuffer : string) : TDateTime; +begin + Result := NormalizeToUTC(Parse(ABuffer)); +end; + { TComplexInt8SContentRemotable } class procedure TComplexInt8SContentRemotable.SaveValue( @@ -6590,7 +6606,7 @@ begin end; class procedure TComplexWideCharContentRemotable.SaveValue( - AObject: TBaseRemotable; + AObject: TBaseRemotable; AStore: IFormatterBase ); begin diff --git a/wst/trunk/date_utils.pas b/wst/trunk/date_utils.pas index bfa9ee2dd..5831fe39f 100644 --- a/wst/trunk/date_utils.pas +++ b/wst/trunk/date_utils.pas @@ -67,6 +67,10 @@ const type TXsdDateKind = ( xdkDateTime, xdkDate ); + TValueCompareKind = ( + vckEqual, vckLessThan, vckGreaterThan, vckNotEqual, + vckEqualOrLessThan, vckEqualOrGreaterThan + ); function xsd_TryStrToDate( const AStr : string; @@ -123,6 +127,11 @@ type function ValueEquals(const AA,AB: TTimeRec) : Boolean; overload; function ValueEquals(const AA,AB: TDurationRec) : Boolean; overload; + function CompareValue( + const AA,AB : TDateTimeRec; + const ACompareKind : TValueCompareKind + ) : Boolean; + resourcestring SERR_InvalidDate = '"%s" is not a valid date.'; SERR_InvalidTime = '"%s" is not a valid time.'; @@ -200,6 +209,27 @@ begin ( a.MinuteOffset = b.MinuteOffset ); end; +function CompareValue( + const AA,AB : TDateTimeRec; + const ACompareKind : TValueCompareKind +) : Boolean; +var + locA, locB : TDateTime; +begin + case ACompareKind of + vckEqual : Result := ValueEquals(AA,AB); + vckLessThan : Result := ( NormalizeToUTC(AA) < NormalizeToUTC(AB) ); + vckGreaterThan : Result := ( NormalizeToUTC(AA) > NormalizeToUTC(AB) ); + vckNotEqual : Result := not ValueEquals(AA,AB); + vckEqualOrLessThan : Result := ValueEquals(AA,AB) or ( NormalizeToUTC(AA) < NormalizeToUTC(AB) ); + vckEqualOrGreaterThan : Result := ValueEquals(AA,AB) or ( NormalizeToUTC(AA) > NormalizeToUTC(AB) ); + else begin + Assert(False); // To suppress the warning + Result := False; + end; + end; +end; + function xsd_TryStrToDate( const AStr : string; out ADate : TDateTimeRec; diff --git a/wst/trunk/ide/lazarus/wst_indy.lpk b/wst/trunk/ide/lazarus/wst_indy.lpk index fe1d5caeb..a787764df 100644 --- a/wst/trunk/ide/lazarus/wst_indy.lpk +++ b/wst/trunk/ide/lazarus/wst_indy.lpk @@ -8,7 +8,7 @@ - + diff --git a/wst/trunk/indy_http_protocol.pas b/wst/trunk/indy_http_protocol.pas index 3fad713f8..0e36b7215 100644 --- a/wst/trunk/indy_http_protocol.pas +++ b/wst/trunk/indy_http_protocol.pas @@ -4,7 +4,7 @@ This file is provide under modified LGPL licence ( the files COPYING.modifiedLGPL and COPYING.LGPL). - + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -24,7 +24,7 @@ uses Const sTRANSPORT_NAME = 'HTTP'; - + Type {$M+} @@ -36,12 +36,15 @@ Type FConnection : TidHttp; FSoapAction: string; FContentType: string; + private function GetAddress: string; + function GetProtocolVersion : string; function GetProxyPassword: string; function GetProxyPort: Integer; function GetProxyServer: string; function GetProxyUsername: string; procedure SetAddress(const AValue: string); + procedure SetProtocolVersion(const AValue : string); procedure SetProxyPassword(const AValue: string); procedure SetProxyPort(const AValue: Integer); procedure SetProxyServer(const AValue: string); @@ -60,13 +63,37 @@ Type property ProxyPassword : string read GetProxyPassword write SetProxyPassword; property SoapAction : string read FSoapAction write FSoapAction; property Format : string read FFormat write FFormat; + property ProtocolVersion : string read GetProtocolVersion write SetProtocolVersion; End; {$M+} procedure INDY_RegisterHTTP_Transport(); - + implementation - +uses + wst_consts; + +const + ProtocolVersionMAP : array[TIdHTTPProtocolVersion] of string = ('1.0', '1.1'); + +function TryStrToProtocolVersion( + const AStr : string; + out ARes : TIdHTTPProtocolVersion +) : Boolean; +var + i : TIdHTTPProtocolVersion; +begin + for i := Low(TIdHTTPProtocolVersion) to High(TIdHTTPProtocolVersion) do begin + if ( AStr = ProtocolVersionMAP[i] ) then begin + ARes := i; + Result := True; + Exit; + end; + end; + Result := False; +end; + + { THTTPTransport } function THTTPTransport.GetAddress: string; @@ -74,6 +101,11 @@ begin Result := FConnection.Request.URL; end; +function THTTPTransport.GetProtocolVersion : string; +begin + Result := ProtocolVersionMAP[FConnection.ProtocolVersion]; +end; + function THTTPTransport.GetProxyPassword: string; begin Result := FConnection.ProxyParams.ProxyPassword; @@ -99,6 +131,17 @@ begin FConnection.Request.URL := AValue; end; +procedure THTTPTransport.SetProtocolVersion(const AValue : string); +var + locValue : TIdHTTPProtocolVersion; +begin + if not TryStrToProtocolVersion(AValue,locValue) then + raise ETransportExecption.CreateFmt(SERR_InvalidPropertyValue,['ProtocolVersion',AValue]); + FConnection.ProtocolVersion := locValue; + if not ( hoKeepOrigProtocol in FConnection.HTTPOptions ) then + FConnection.HTTPOptions := FConnection.HTTPOptions + [hoKeepOrigProtocol]; +end; + procedure THTTPTransport.SetProxyPassword(const AValue: string); begin FConnection.ProxyParams.ProxyPassword := AValue; @@ -151,8 +194,11 @@ begin FConnection.ProxyParams.BasicAuthentication := True; end; FConnection.Request.CustomHeaders.Clear(); - FConnection.Request.CustomHeaders.Values['soapAction'] := SoapAction; + FConnection.Request.CustomHeaders.Values['SOAPAction'] := SoapAction; FConnection.Request.ContentType := ContentType; +{$IFDEF WST_DBG} + TMemoryStream(ARequest).SaveToFile('request.log'); +{$ENDIF WST_DBG} FConnection.Post(Address,ARequest, AResponse); {$IFDEF WST_DBG} i := AResponse.Size; diff --git a/wst/trunk/synapse_http_protocol.pas b/wst/trunk/synapse_http_protocol.pas index 5c7c45be8..72af95493 100644 --- a/wst/trunk/synapse_http_protocol.pas +++ b/wst/trunk/synapse_http_protocol.pas @@ -163,7 +163,7 @@ procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream); {else ShowMessage(AStr)}; end; - + var s : TBinaryString; {$ENDIF} diff --git a/wst/trunk/tests/test_suite/test_generators_runtime.pas b/wst/trunk/tests/test_suite/test_generators_runtime.pas index c2651b73a..8abe75b40 100644 --- a/wst/trunk/tests/test_suite/test_generators_runtime.pas +++ b/wst/trunk/tests/test_suite/test_generators_runtime.pas @@ -310,10 +310,10 @@ begin RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString'); end; {$IFNDEF WST_RECORD_RTTI} - typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); + typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); {$ENDIF WST_RECORD_RTTI} {$IFDEF WST_RECORD_RTTI} - typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); + typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); {$ENDIF WST_RECORD_RTTI} (typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetObject(FIELDS_STRING) as TRecordRttiDataObject).GetField('fieldWord')^.IsAttribute := True; handlerReg := CreateWsdlTypeHandlerRegistry(typeReg); diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index 931578cd0..85b4293e9 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -20,6 +20,7 @@ uses pparser, pastree; const + sEMBEDDED_TYPE = '_E_T_'; sEXTERNAL_NAME = '_E_N_'; sATTRIBUTE = '_ATTRIBUTE_'; sARRAY_ITEM_NAME = 'ARRAY_ITEM_NAME'; @@ -409,6 +410,7 @@ begin AddSystemSymbol(Result,AContainer); AddClassDef(Result,'TBaseRemotable','',TPasNativeClassType); AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable',TPasNativeClassType); + AContainer.RegisterExternalAlias(AddClassDef(Result,'schema_Type','TAbstractSimpleRemotable'),'schema'); AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateRemotable','TAbstractSimpleRemotable'),'date'); AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateTimeRemotable','TAbstractSimpleRemotable'),'dateTime'); {$IFDEF WST_HAS_TDURATIONREMOTABLE} diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas index fe46ed631..6c47bc716 100644 --- a/wst/trunk/ws_helper/ws_parser_imp.pas +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -51,6 +51,8 @@ type ) : TPasElement;{$IFDEF USE_INLINE}inline;{$ENDIF} function FindElementWithHint(const AName, AHint : string; const ASpace : TSearchSpace) : TPasElement; function ExtractTypeHint(AElement : TDOMNode) : string;{$IFDEF USE_INLINE}inline;{$ENDIF} + procedure SetAsEmbeddedType(AType : TPasType); + function IsEmbeddedType(AType : TPasType) : Boolean; {$IFDEF WST_HANDLE_DOC} procedure ParseDocumentation(AType : TPasType); {$ENDIF WST_HANDLE_DOC} @@ -353,6 +355,16 @@ begin Result := ''; end; +procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType); +begin + FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,'1'); +end; + +function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean; +begin + Result := ( FSymbols.Properties.GetValue(AType,sEMBEDDED_TYPE) = '1' ); +end; + {$IFDEF WST_HANDLE_DOC} procedure TAbstractTypeParser.ParseDocumentation(AType : TPasType); var @@ -1049,10 +1061,10 @@ begin internalName := ExtractIdentifier(ATypeName); hasInternalName := IsReservedKeyWord(internalName) or ( not IsValidIdent(internalName) ) or - //( FSymbols.IndexOf(internalName) <> -1 ) or + ( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ) or ( not AnsiSameText(internalName,ATypeName) ); if hasInternalName then begin - internalName := Format('_%s',[internalName]); + internalName := Format('%s_Type',[internalName]); end; if ( pthDeriveFromSoapArray in FHints ) or @@ -1379,7 +1391,8 @@ begin if Assigned(locSym) then begin if not locSym.InheritsFrom(TPasType) then raise EXsdParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]); - locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef); + locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef) or + ( IsEmbeddedType(TPasType(locSym)) <> FEmbededDef ); if not locContinue then; Result := locSym as TPasType; end; diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas index 47951d591..0ec3fdd05 100644 --- a/wst/trunk/ws_helper/wsdl_parser.pas +++ b/wst/trunk/ws_helper/wsdl_parser.pas @@ -75,7 +75,11 @@ type const ASoapBindingStyle : string ) : TPasProcedure; function GetParser(const ANamespace : string) : IXsdPaser; - function ParseType(const AName : string; const AHint : string = '') : TPasType; + function ParseType( + const AName : string; + const AHint : string = ''; + const ATypeOrElement : string = '' + ) : TPasType; procedure ParseTypes(); protected function GetXsShortNames() : TStrings; @@ -300,6 +304,7 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin schmNode, tmpNode : TDOMNode; s : string; typeList : TList; + locXsdParser : IXsdPaser; begin if Assigned(FSchemaCursor) then begin FSchemaCursor.Reset(); @@ -323,7 +328,8 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin tmpNode := FindNamedNode(typeCursor,FSymbols.GetExternalName(sym)); if Assigned(tmpNode) then begin //symNew := ParseType(FSymbols.GetExternalName(sym)); - symNew := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue).ParseType(FSymbols.GetExternalName(sym)); + locXsdParser := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue); + symNew := locXsdParser.ParseType(FSymbols.GetExternalName(sym),tmpNode); //symNew := ParseType(tmpNode.Attributes.GetNamedItem(s_name).NodeValue); if ( sym <> symNew ) then begin FModule.InterfaceSection.Declarations.Extract(sym); @@ -460,7 +466,7 @@ function TWsdlParser.ParseOperation( function GetDataType(const AName, ATypeOrElement : string; const ATypeHint : string = ''):TPasType; begin try - Result := ParseType(AName,ATypeHint); + Result := ParseType(AName,ATypeHint,ATypeOrElement); except on e : Exception do begin DoOnMessage(mtError, e.Message + ' ' + AName + ' ' + ATypeOrElement); @@ -578,7 +584,9 @@ function TWsdlParser.ParseOperation( prmName := ExtractNameFromQName(prmTypeName); end; prmInternameName := Trim(prmName); - if AnsiSameText(prmInternameName,tmpMthd.Name) then begin + if AnsiSameText(prmInternameName,tmpMthd.Name) or + AnsiSameText(prmInternameName,ExtractNameFromQName(prmTypeName)) + then begin prmInternameName := prmInternameName + 'Param'; end; prmHasInternameName := IsReservedKeyWord(prmInternameName) or @@ -1176,11 +1184,16 @@ begin end; end; -function TWsdlParser.ParseType(const AName : string; const AHint : string) : TPasType; +function TWsdlParser.ParseType( + const AName : string; + const AHint : string; + const ATypeOrElement : string +) : TPasType; var localName, spaceShort, spaceLong : string; locPrs : IXsdPaser; xsdModule : TPasModule; + locTypeKind : string; begin ExplodeQName(AName,localName,spaceShort); if ( FXSShortNames.IndexOf(spaceShort) >= 0 ) then begin @@ -1196,7 +1209,11 @@ begin if not FindNameSpace(spaceShort,spaceLong) then raise EXsdParserAssertException.CreateFmt('Unable to resolve the namespace : "%s".',[spaceShort]); locPrs := GetParser(spaceLong); - Result := locPrs.ParseType(AName); + if ( ATypeOrElement = s_element ) then + locTypeKind := s_element + else + locTypeKind := ''; + Result := locPrs.ParseType(AName,locTypeKind); end; end; diff --git a/wst/trunk/ws_helper/xsd_parser.pas b/wst/trunk/ws_helper/xsd_parser.pas index 3cfcac9fd..8ef319e93 100644 --- a/wst/trunk/ws_helper/xsd_parser.pas +++ b/wst/trunk/ws_helper/xsd_parser.pas @@ -55,7 +55,14 @@ type IXsdPaser = interface ['{F0CEC726-A068-4CCC-B1E7-D31F018415B2}'] - function ParseType(const AName : string) : TPasType; + function ParseType( + const AName, + ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" } + ) : TPasType; overload; + function ParseType( + const AName : string; + const ATypeNode : TDOMNode + ) : TPasType; overload; procedure ParseTypes(); procedure SetNotifier(ANotifier : TOnParserMessage); end; @@ -90,6 +97,10 @@ type function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; procedure SetNotifier(ANotifier : TOnParserMessage); + function InternalParseType( + const AName : string; + const ATypeNode : TDOMNode + ) : TPasType; public constructor Create( ADoc : TXMLDocument; @@ -98,7 +109,15 @@ type AParentContext : IParserContext ); destructor Destroy();override; - function ParseType(const AName : string) : TPasType; + function ParseType( + const AName, + ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" } + ) : TPasType; overload; + function ParseType( + const AName : string; + const ATypeNode : TDOMNode + ) : TPasType; overload; + procedure ParseTypes(); function GetTargetNameSpace() : string; @@ -296,7 +315,23 @@ begin Result := FXSShortNames; end; -function TCustomXsdSchemaParser.ParseType(const AName: string): TPasType; +function TCustomXsdSchemaParser.ParseType(const AName, ATypeKind : string): TPasType; +begin + Result := InternalParseType(AName,nil); +end; + +function TCustomXsdSchemaParser.ParseType( + const AName : string; + const ATypeNode : TDOMNode +) : TPasType; +begin + Result := InternalParseType(AName,ATypeNode); +end; + +function TCustomXsdSchemaParser.InternalParseType( + const AName : string; + const ATypeNode : TDOMNode +): TPasType; var crsSchemaChild : IObjectCursor; typNd : TDOMNode; @@ -324,7 +359,10 @@ var begin ASimpleTypeAlias := nil; Result := True; - typNd := FindNamedNode(crsSchemaChild,localTypeName); + if ( ATypeNode <> nil ) then + typNd := ATypeNode + else + typNd := FindNamedNode(crsSchemaChild,localTypeName); if not Assigned(typNd) then raise EXsdTypeNotFoundException.CreateFmt('Type definition not found 1 : "%s"',[AName]); if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_element) then begin @@ -432,6 +470,7 @@ var sct : TPasSection; shortNameSpace, longNameSpace : string; typeModule : TPasModule; + locTypeNodeFound : Boolean; begin sct := nil; DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName])); @@ -449,6 +488,14 @@ begin if ( typeModule = nil ) then raise EXsdTypeNotFoundException.Create(AName); Result := SymbolTable.FindElementInModule(localTypeName,typeModule) as TPasType; + Init(); + locTypeNodeFound := FindTypeNode(aliasType); + if ( Result <> nil ) and ( typeModule = FModule ) and + ( not Result.InheritsFrom(TPasUnresolvedTypeRef) ) + then begin + if locTypeNodeFound and ( embededType <> ( SymbolTable.Properties.GetValue(Result,sEMBEDDED_TYPE) = '1' ) ) then + Result := nil; + end; if ( ( Result = nil ) or Result.InheritsFrom(TPasUnresolvedTypeRef) ) and ( typeModule = FModule ) then begin @@ -456,7 +503,7 @@ begin frwType := Result; Result := nil; Init(); - if FindTypeNode(aliasType) then begin + if locTypeNodeFound {FindTypeNode(aliasType)} then begin if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin Result := ParseComplexType(); end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin @@ -520,8 +567,9 @@ begin typTmpCrs := CreateCursorOn(typTmpCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); typTmpCrs.Reset(); if typTmpCrs.MoveNext() then begin - ParseType( - (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue + InternalParseType( + (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue, + typNode ); end; end;