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

Currency (native type) support.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@979 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-10-07 17:41:09 +00:00
parent b6b09eca44
commit 3c2298e4eb
7 changed files with 207 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
wst/trunk/base_service_intf.pas
View File

@ -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();

22
wst/trunk/tests/test_suite/files/class_currency_property.wsdl Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="class_currency_property"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="class_currency_property"
xmlns:wst="urn:wst_base">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="class_currency_property">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:decimal" wst:TypeHint="Currency"/>
</xsd:sequence>
<xsd:attribute use="required" name="elementAtt" type="xsd:decimal" wst:TypeHint="Currency"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

8
wst/trunk/tests/test_suite/files/class_currency_property.xsd Normal file
View File

@ -0,0 +1,8 @@
<schema targetNamespace="class_currency_property" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="class_currency_property" xmlns:wst="urn:wst_base">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:decimal" wst:TypeHint="Currency"/>
</xsd:sequence>
<xsd:attribute name="elementAtt" type="xsd:decimal" wst:TypeHint="Currency" use="required"/>
</xsd:complexType>
</schema>

62
wst/trunk/tests/test_suite/test_generators.pas
View File

@ -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;

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

@ -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);

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

@ -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'),

24
wst/trunk/ws_helper/xsd_generator.pas
View File

@ -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}