From 3c2298e4eb78add23c9d7412ecc771da1d9932a0 Mon Sep 17 00:00:00 2001 From: inoussa Date: Wed, 7 Oct 2009 17:41:09 +0000 Subject: [PATCH] Currency (native type) support. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@979 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_service_intf.pas | 35 +++++++++++ .../files/class_currency_property.wsdl | 22 +++++++ .../files/class_currency_property.xsd | 8 +++ .../tests/test_suite/test_generators.pas | 62 +++++++++++++++++++ wst/trunk/tests/test_suite/test_parsers.pas | 57 ++++++++++++++++- wst/trunk/ws_helper/pascal_parser_intf.pas | 3 +- wst/trunk/ws_helper/xsd_generator.pas | 24 ++++++- 7 files changed, 207 insertions(+), 4 deletions(-) create mode 100644 wst/trunk/tests/test_suite/files/class_currency_property.wsdl create mode 100644 wst/trunk/tests/test_suite/files/class_currency_property.xsd diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index a8e49ed24..a61de8b27 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -720,6 +720,18 @@ type property Value : Single read FValue write FValue; end; + { TComplexCurrencyContentRemotable } + + TComplexCurrencyContentRemotable = class(TBaseComplexSimpleContentRemotable) + private + FValue: Currency; + protected + class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override; + class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override; + public + property Value : Currency read FValue write FValue; + end; + TComplexAnsiCharContentRemotable = class(TBaseComplexSimpleContentRemotable) private FValue: AnsiChar; @@ -5911,6 +5923,28 @@ begin (AObject as TComplexFloatSingleContentRemotable).Value := i; end; +{ TComplexCurrencyContentRemotable } + +class procedure TComplexCurrencyContentRemotable.SaveValue( + AObject : TBaseRemotable; + AStore : IFormatterBase +); +begin + AStore.PutScopeInnerValue(TypeInfo(Currency),(AObject as TComplexCurrencyContentRemotable).Value); +end; + +class procedure TComplexCurrencyContentRemotable.LoadValue( + var AObject : TObject; + AStore : IFormatterBase +); +var + i : Currency; +begin + i := 0; + AStore.GetScopeInnerValue(TypeInfo(Currency),i); + (AObject as TComplexCurrencyContentRemotable).Value := i; +end; + { TComplexInt64SContentRemotable } class procedure TComplexInt64SContentRemotable.SaveValue( @@ -6943,6 +6977,7 @@ begin Result := xsd_TimeToStr(AValue); end; + initialization initialize_base_service_intf(); diff --git a/wst/trunk/tests/test_suite/files/class_currency_property.wsdl b/wst/trunk/tests/test_suite/files/class_currency_property.wsdl new file mode 100644 index 000000000..676d79917 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/class_currency_property.wsdl @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/class_currency_property.xsd b/wst/trunk/tests/test_suite/files/class_currency_property.xsd new file mode 100644 index 000000000..b3e282447 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/class_currency_property.xsd @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas index 18ba7d861..cff9c048d 100644 --- a/wst/trunk/tests/test_suite/test_generators.pas +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -44,6 +44,7 @@ type {$ENDIF WST_UNICODESTRING} procedure class_ansichar_property(); procedure class_widechar_property(); + procedure class_currency_property(); procedure array_sequence_collection(); procedure class_sequence_open_type_any(); @@ -1112,6 +1113,67 @@ begin end; end; +procedure TTest_CustomXsdGenerator.class_currency_property(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + cltyp : TPasClassType; + + procedure AddProperty( + const AName, + ATypeName, + ADefault : string; + const AKind : TPropertyType + ); + var + p : TPasProperty; + begin + p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0)); + cltyp.Members.Add(p); + p.ReadAccessorName := 'F' + AName; + p.WriteAccessorName := 'F' + AName; + p.VarType := tr.FindElement(ATypeName) as TPasType; + Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName])); + p.VarType.AddRef(); + p.DefaultValue := ADefault; + p.Visibility := visPublished; + p.StoredAccessorName := 'True'; + if ( AKind = ptAttribute ) then + tr.SetPropertyAsAttribute(p,True); + end; + +var + g : IGenerator; + locDoc, locExistDoc : TXMLDocument; +begin + locDoc := nil; + locExistDoc := nil; + tr := TwstPasTreeContainer.Create(); + try + CreateWstInterfaceSymbolTable(tr); + mdl := TPasModule(tr.CreateElement(TPasModule,'class_currency_property',tr.Package,visDefault,'',0)); + tr.Package.Modules.Add(mdl); + mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleClass',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + AddProperty('elementProp','Currency','',ptField); + AddProperty('elementAtt','Currency','',ptAttribute); + + locDoc := CreateDoc(); + g := CreateGenerator(locDoc); + g.Execute(tr,mdl.Name); + //WriteXMLFile(locDoc,'.\class_currency_property.xsd'); + locExistDoc := LoadXmlFromFilesList('class_currency_property.xsd'); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + FreeAndNil(tr); + end; +end; + { TTest_XsdGenerator } function TTest_XsdGenerator.CreateGenerator(const ADoc: TXMLDocument): IXsdGenerator; diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 9fe6e5672..9fee5cc38 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -60,6 +60,7 @@ type function load_class_widestring_property() : TwstPasTreeContainer;virtual;abstract; function load_class_ansichar_property() : TwstPasTreeContainer;virtual;abstract; function load_class_widechar_property() : TwstPasTreeContainer;virtual;abstract; + function load_class_currency_property() : TwstPasTreeContainer;virtual;abstract; published procedure EmptySchema(); @@ -96,6 +97,7 @@ type procedure class_widestring_property(); procedure class_ansichar_property(); procedure class_widechar_property(); + procedure class_currency_property(); end; { TTest_XsdParser } @@ -136,6 +138,7 @@ type function load_class_widestring_property() : TwstPasTreeContainer;override; function load_class_ansichar_property() : TwstPasTreeContainer;override; function load_class_widechar_property() : TwstPasTreeContainer;override; + function load_class_currency_property() : TwstPasTreeContainer;override; end; { TTest_WsdlParser } @@ -176,6 +179,7 @@ type function load_class_widestring_property() : TwstPasTreeContainer;override; function load_class_ansichar_property() : TwstPasTreeContainer;override; function load_class_widechar_property() : TwstPasTreeContainer;override; + function load_class_currency_property() : TwstPasTreeContainer;override; published procedure no_binding_style(); procedure signature_last(); @@ -1859,6 +1863,47 @@ begin end; end; +procedure TTest_CustomXsdParser.class_currency_property(); +const s_class_name = 'TSampleClass'; +var + clsType : TPasClassType; + tr : TwstPasTreeContainer; + + procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : 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,prp.VarType.Name,'TypeName'); + CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName'); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + elt : TPasElement; +begin + tr := load_class_currency_property(); + try + mdl := tr.FindModule('class_currency_property'); + CheckNotNull(mdl,'class_currency_property'); + elt := tr.FindElement(s_class_name); + CheckNotNull(elt,s_class_name); + CheckEquals(s_class_name,elt.Name); + CheckEquals(s_class_name,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + CheckProperty('elementProp','Currency','decimal',ptField); + CheckProperty('elementAtt','Currency','decimal',ptAttribute); + finally + tr.Free(); + end; +end; + { TTest_XsdParser } function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; @@ -1989,7 +2034,12 @@ begin Result := ParseDoc('class_ansichar_property'); end; -function TTest_XsdParser.load_class_widechar_property: TwstPasTreeContainer; +function TTest_XsdParser.load_class_currency_property() : TwstPasTreeContainer; +begin + Result := ParseDoc('class_currency_property'); +end; + +function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer; begin Result := ParseDoc('class_widechar_property'); end; @@ -2578,6 +2628,11 @@ begin Result := ParseDoc('class_widechar_property'); end; +function TTest_WsdlParser.load_class_currency_property() : TwstPasTreeContainer; +begin + Result := ParseDoc('class_currency_property'); +end; + initialization RegisterTest('XSD parser',TTest_XsdParser.Suite); RegisterTest('WSDL parser',TTest_WsdlParser.Suite); diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index c502dddf2..2f6c79b46 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -235,8 +235,9 @@ const ('TBase64StringRemotable', 'TBase64StringExtRemotable', 'base64Binary'), ('TBase16StringRemotable', 'TBase16StringExtRemotable', 'hexBinary') ); - SPECIAL_SIMPLE_TYPES_COUNT = 4 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; + SPECIAL_SIMPLE_TYPES_COUNT = 5 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; SPECIAL_SIMPLE_TYPES : Array[0..Pred(SPECIAL_SIMPLE_TYPES_COUNT)] Of array[0..2] of string = ( + ('Currency', 'TComplexCurrencyContentRemotable', 'decimal'), ('string', 'TComplexStringContentRemotable', 'string'), ('WideString', 'TComplexWideStringContentRemotable', 'string'), ('AnsiChar', 'TComplexAnsiCharContentRemotable', 'string'), diff --git a/wst/trunk/ws_helper/xsd_generator.pas b/wst/trunk/ws_helper/xsd_generator.pas index e8d294364..ae4e0cc95 100644 --- a/wst/trunk/ws_helper/xsd_generator.pas +++ b/wst/trunk/ws_helper/xsd_generator.pas @@ -201,6 +201,14 @@ type ASchemaNode : TDOMElement );override; end; + + TCurrencyHelper = class(TAbstractSpecialTypeHelper,IXsdSpecialTypeHelper) + protected + procedure HandleTypeUsage( + ATargetNode, + ASchemaNode : TDOMElement + );override; + end; {$IFDEF WST_UNICODESTRING} { TUnicodeStringHelper } @@ -439,6 +447,17 @@ begin ATargetNode.SetAttribute(Format('%s:%s',[s_WST,s_WST_typeHint]),'WideChar'); end; +{ TCurrencyHelper } + +procedure TCurrencyHelper.HandleTypeUsage(ATargetNode, ASchemaNode: TDOMElement); +var + strBuffer : string; +begin + if not FindAttributeByValueInNode(s_WST_base_namespace,ASchemaNode,strBuffer) then + ASchemaNode.SetAttribute(Format('%s:%s',[s_xmlns,s_WST]),s_WST_base_namespace); + ATargetNode.SetAttribute(Format('%s:%s',[s_WST,s_WST_typeHint]),'Currency'); +end; + {$IFDEF WST_UNICODESTRING} { TUnicodeStringHelper } @@ -519,9 +538,10 @@ function TXsdTypeHandlerRegistry.FindHelper( out AHelper: IXsdSpecialTypeHelper ) : Boolean; const - HELPER_COUNT = 3 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; + HELPER_COUNT = 4 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; HELPER_MAP : array[0..Pred(HELPER_COUNT)] of TSpecialTypeHelperRecord = ( - ( Name : 'widestring'; HelperClass : TWideStringHelper;), + ( Name : 'currency'; HelperClass : TCurrencyHelper;), + ( Name : 'widestring'; HelperClass : TWideStringHelper;), ( Name : 'ansichar'; HelperClass : TAnsiCharHelper;), ( Name : 'widechar'; HelperClass : TWideCharHelper;) {$IFDEF WST_UNICODESTRING}