From ac7aeb38c88bc3bb7a696dc23bb4152483b6d6c7 Mon Sep 17 00:00:00 2001 From: inoussa Date: Mon, 29 Aug 2011 02:59:57 +0000 Subject: [PATCH] XSD's "include" handling, better "uses" generation for schema files translalted to pascal, better generated file names, handling of "import" and "include" in sub-directories, Handling of TComplexEnumContentRemotable git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1856 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/tests/test_suite/files/include.xsd | 18 ++ .../tests/test_suite/files/include2.wsdl | 20 ++ wst/trunk/tests/test_suite/files/include2.xsd | 10 + wst/trunk/tests/test_suite/files/include3.xsd | 8 + .../tests/test_suite/files/include_a_b.xsd | 15 + .../tests/test_suite/files/include_b_a.xsd | 15 + .../tests/test_suite/files/include_cir1.xsd | 15 + .../tests/test_suite/files/include_cir2.xsd | 15 + .../tests/test_suite/files/include_cir3.xsd | 15 + .../test_suite/files/include_circular1.wsdl | 25 ++ .../test_suite/files/include_circular1.xsd | 15 + .../test_suite/files/include_circular2.wsdl | 26 ++ .../test_suite/files/include_circular2.xsd | 15 + .../tests/test_suite/files/include_error.wsdl | 18 ++ .../tests/test_suite/files/include_error.xsd | 8 + .../tests/test_suite/files/include_no_ns.xsd | 11 + .../test_suite/files/include_schema.wsdl | 28 ++ wst/trunk/tests/test_suite/files/includea.xsd | 13 + wst/trunk/tests/test_suite/files/includeb.xsd | 13 + wst/trunk/tests/test_suite/files/includec.xsd | 13 + .../tests/test_suite/files/includens.xsd | 13 + wst/trunk/tests/test_suite/test_parsers.pas | 211 ++++++++++++++- .../tests/test_suite/testformatter_unit.pas | 93 ++++++- wst/trunk/ws_helper/generator.pas | 67 ++++- wst/trunk/ws_helper/locators.pas | 57 +++- wst/trunk/ws_helper/wsdl_parser.pas | 55 +++- wst/trunk/ws_helper/xsd_consts.pas | 1 + wst/trunk/ws_helper/xsd_parser.pas | 256 +++++++++++++++--- wst/trunk/wst_consts.pas | 5 +- 29 files changed, 1022 insertions(+), 52 deletions(-) create mode 100644 wst/trunk/tests/test_suite/files/include.xsd create mode 100644 wst/trunk/tests/test_suite/files/include2.wsdl create mode 100644 wst/trunk/tests/test_suite/files/include2.xsd create mode 100644 wst/trunk/tests/test_suite/files/include3.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_a_b.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_b_a.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_cir1.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_cir2.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_cir3.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_circular1.wsdl create mode 100644 wst/trunk/tests/test_suite/files/include_circular1.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_circular2.wsdl create mode 100644 wst/trunk/tests/test_suite/files/include_circular2.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_error.wsdl create mode 100644 wst/trunk/tests/test_suite/files/include_error.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_no_ns.xsd create mode 100644 wst/trunk/tests/test_suite/files/include_schema.wsdl create mode 100644 wst/trunk/tests/test_suite/files/includea.xsd create mode 100644 wst/trunk/tests/test_suite/files/includeb.xsd create mode 100644 wst/trunk/tests/test_suite/files/includec.xsd create mode 100644 wst/trunk/tests/test_suite/files/includens.xsd diff --git a/wst/trunk/tests/test_suite/files/include.xsd b/wst/trunk/tests/test_suite/files/include.xsd new file mode 100644 index 000000000..d253ef4eb --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include.xsd @@ -0,0 +1,18 @@ + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include2.wsdl b/wst/trunk/tests/test_suite/files/include2.wsdl new file mode 100644 index 000000000..8eaab14fb --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include2.wsdl @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include2.xsd b/wst/trunk/tests/test_suite/files/include2.xsd new file mode 100644 index 000000000..5558acc25 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include2.xsd @@ -0,0 +1,10 @@ + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include3.xsd b/wst/trunk/tests/test_suite/files/include3.xsd new file mode 100644 index 000000000..228371fd5 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include3.xsd @@ -0,0 +1,8 @@ + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_a_b.xsd b/wst/trunk/tests/test_suite/files/include_a_b.xsd new file mode 100644 index 000000000..834a643a6 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_a_b.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_b_a.xsd b/wst/trunk/tests/test_suite/files/include_b_a.xsd new file mode 100644 index 000000000..d5d0a0178 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_b_a.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_cir1.xsd b/wst/trunk/tests/test_suite/files/include_cir1.xsd new file mode 100644 index 000000000..6eb72fd3a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_cir1.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_cir2.xsd b/wst/trunk/tests/test_suite/files/include_cir2.xsd new file mode 100644 index 000000000..24caf08d1 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_cir2.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_cir3.xsd b/wst/trunk/tests/test_suite/files/include_cir3.xsd new file mode 100644 index 000000000..68f58846a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_cir3.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_circular1.wsdl b/wst/trunk/tests/test_suite/files/include_circular1.wsdl new file mode 100644 index 000000000..85d68d0f0 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_circular1.wsdl @@ -0,0 +1,25 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_circular1.xsd b/wst/trunk/tests/test_suite/files/include_circular1.xsd new file mode 100644 index 000000000..f8dbe16cd --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_circular1.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_circular2.wsdl b/wst/trunk/tests/test_suite/files/include_circular2.wsdl new file mode 100644 index 000000000..e27217d57 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_circular2.wsdl @@ -0,0 +1,26 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_circular2.xsd b/wst/trunk/tests/test_suite/files/include_circular2.xsd new file mode 100644 index 000000000..9dd6bd606 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_circular2.xsd @@ -0,0 +1,15 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_error.wsdl b/wst/trunk/tests/test_suite/files/include_error.wsdl new file mode 100644 index 000000000..3de694f43 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_error.wsdl @@ -0,0 +1,18 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_error.xsd b/wst/trunk/tests/test_suite/files/include_error.xsd new file mode 100644 index 000000000..4fca73938 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_error.xsd @@ -0,0 +1,8 @@ + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_no_ns.xsd b/wst/trunk/tests/test_suite/files/include_no_ns.xsd new file mode 100644 index 000000000..51556c225 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_no_ns.xsd @@ -0,0 +1,11 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/include_schema.wsdl b/wst/trunk/tests/test_suite/files/include_schema.wsdl new file mode 100644 index 000000000..7fba132a3 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/include_schema.wsdl @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/includea.xsd b/wst/trunk/tests/test_suite/files/includea.xsd new file mode 100644 index 000000000..522aaa97a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/includea.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/includeb.xsd b/wst/trunk/tests/test_suite/files/includeb.xsd new file mode 100644 index 000000000..118d7e190 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/includeb.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/includec.xsd b/wst/trunk/tests/test_suite/files/includec.xsd new file mode 100644 index 000000000..3fd3221c8 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/includec.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/includens.xsd b/wst/trunk/tests/test_suite/files/includens.xsd new file mode 100644 index 000000000..db705e0ae --- /dev/null +++ b/wst/trunk/tests/test_suite/files/includens.xsd @@ -0,0 +1,13 @@ + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index b69e1e336..3699c9ea3 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -64,6 +64,11 @@ type function load_class_property_composed_name() : TwstPasTreeContainer;virtual;abstract; function load_schema_import() : TwstPasTreeContainer;virtual;abstract; + function load_schema_include() : TwstPasTreeContainer;virtual;abstract; + function load_schema_include_parent_no_types() : TwstPasTreeContainer;virtual;abstract; + function load_schema_include_fail_namespace() : TwstPasTreeContainer;virtual;abstract; + function load_schema_include_circular1() : TwstPasTreeContainer;virtual;abstract; + function load_schema_include_circular2() : TwstPasTreeContainer;virtual;abstract; published procedure EmptySchema(); @@ -102,8 +107,12 @@ type procedure class_widechar_property(); procedure class_currency_property(); procedure class_property_composed_name(); - procedure schema_import(); + procedure schema_include(); + procedure schema_include_parent_no_types(); + procedure schema_include_fail_namespace(); + procedure schema_include_circular1(); + procedure schema_include_circular2(); end; { TTest_XsdParser } @@ -148,6 +157,11 @@ type function load_class_property_composed_name() : TwstPasTreeContainer;override; function load_schema_import() : TwstPasTreeContainer;override; + function load_schema_include() : TwstPasTreeContainer;override; + function load_schema_include_parent_no_types() : TwstPasTreeContainer;override; + function load_schema_include_fail_namespace() : TwstPasTreeContainer;override; + function load_schema_include_circular1() : TwstPasTreeContainer;override; + function load_schema_include_circular2() : TwstPasTreeContainer;override; end; { TTest_WsdlParser } @@ -192,6 +206,11 @@ type function load_class_property_composed_name() : TwstPasTreeContainer;override; function load_schema_import() : TwstPasTreeContainer;override; + function load_schema_include() : TwstPasTreeContainer;override; + function load_schema_include_parent_no_types() : TwstPasTreeContainer;override; + function load_schema_include_fail_namespace() : TwstPasTreeContainer;override; + function load_schema_include_circular1() : TwstPasTreeContainer;override; + function load_schema_include_circular2() : TwstPasTreeContainer;override; published procedure no_binding_style(); procedure signature_last(); @@ -2005,6 +2024,146 @@ begin FreeAndNil(tr); end; +procedure TTest_CustomXsdParser.schema_include(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + ls : TList; + elt, prpElt : TPasElement; + prp : TPasProperty; + baseType, scdClass : TPasClassType; +begin + tr := load_schema_include(); + try + mdl := tr.FindModule('urn:include'); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(4,ls.Count,'type count'); + elt := tr.FindElement('TypeA'); + CheckNotNull(elt,'TypeA'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TypeB'); + CheckNotNull(elt,'TypeB'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TypeC'); + CheckNotNull(elt,'TypeC'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TClassSample'); + CheckNotNull(elt,'TClassSample'); + CheckIs(elt,TPasClassType); + finally + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.schema_include_parent_no_types(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + ls : TList; + elt, prpElt : TPasElement; + prp : TPasProperty; + baseType, scdClass : TPasClassType; +begin + tr := load_schema_include_parent_no_types(); + try + mdl := tr.FindModule('urn:include'); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count,'type count'); + elt := tr.FindElement('TypeA'); + CheckNotNull(elt,'TypeA'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TypeB'); + CheckNotNull(elt,'TypeB'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TypeC'); + CheckNotNull(elt,'TypeC'); + CheckIs(elt,TPasEnumType); + finally + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.schema_include_fail_namespace(); +var + tr : TwstPasTreeContainer; + ok : Boolean; +begin + tr := nil; + ok := False; + try + tr := load_schema_include_fail_namespace(); + ok := True; + except + on e : EXsdParserAssertException do + ok := True; + end; + FreeAndNil(tr); + Check(ok); +end; + +procedure TTest_CustomXsdParser.schema_include_circular1(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + ls : TList; + elt, prpElt : TPasElement; + prp : TPasProperty; + baseType, scdClass : TPasClassType; +begin + tr := load_schema_include_circular1(); + try + mdl := tr.FindModule('urn:include'); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(3,ls.Count,'type count'); + elt := tr.FindElement('TypeA'); + CheckNotNull(elt,'TypeA'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TypeB'); + CheckNotNull(elt,'TypeB'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TClassSample'); + CheckNotNull(elt,'TClassSample'); + CheckIs(elt,TPasClassType); + finally + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdParser.schema_include_circular2(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + ls : TList; + elt, prpElt : TPasElement; + prp : TPasProperty; + baseType, scdClass : TPasClassType; +begin + tr := load_schema_include_circular2(); + try + mdl := tr.FindModule('urn:include'); + CheckNotNull(mdl); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(4,ls.Count,'type count'); + elt := tr.FindElement('TypeA'); + CheckNotNull(elt,'TypeA'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TypeB'); + CheckNotNull(elt,'TypeB'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TypeC'); + CheckNotNull(elt,'TypeC'); + CheckIs(elt,TPasEnumType); + elt := tr.FindElement('TClassSample'); + CheckNotNull(elt,'TClassSample'); + CheckIs(elt,TPasClassType); + finally + FreeAndNil(tr); + end; +end; + { TTest_XsdParser } function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; @@ -2153,6 +2312,31 @@ begin Result := ParseDoc('import_second_library'); end; +function TTest_XsdParser.load_schema_include() : TwstPasTreeContainer; +begin + Result := ParseDoc('include'); +end; + +function TTest_XsdParser.load_schema_include_parent_no_types() : TwstPasTreeContainer; +begin + Result := ParseDoc('include2'); +end; + +function TTest_XsdParser.load_schema_include_fail_namespace() : TwstPasTreeContainer; +begin + Result := ParseDoc('include_error'); +end; + +function TTest_XsdParser.load_schema_include_circular1() : TwstPasTreeContainer; +begin + Result := ParseDoc('include_circular1'); +end; + +function TTest_XsdParser.load_schema_include_circular2() : TwstPasTreeContainer; +begin + Result := ParseDoc('include_circular2'); +end; + function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer; begin Result := ParseDoc('class_widechar_property'); @@ -2895,6 +3079,31 @@ begin Result := ParseDoc('import_second_library'); end; +function TTest_WsdlParser.load_schema_include() : TwstPasTreeContainer; +begin + Result := ParseDoc('include_schema'); +end; + +function TTest_WsdlParser.load_schema_include_parent_no_types() : TwstPasTreeContainer; +begin + Result := ParseDoc('include2'); +end; + +function TTest_WsdlParser.load_schema_include_fail_namespace() : TwstPasTreeContainer; +begin + Result := ParseDoc('include_error'); +end; + +function TTest_WsdlParser.load_schema_include_circular1() : TwstPasTreeContainer; +begin + Result := ParseDoc('include_circular1'); +end; + +function TTest_WsdlParser.load_schema_include_circular2() : TwstPasTreeContainer; +begin + Result := ParseDoc('include_circular2'); +end; + initialization RegisterTest('XSD parser',TTest_XsdParser.Suite); RegisterTest('WSDL parser',TTest_WsdlParser.Suite); diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 1a6158e10..c7eda5189 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -229,7 +229,26 @@ type property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; - end; + end; + + { T_ComplexTestEnumContent } + + T_ComplexTestEnumContent = class(TComplexEnumContentRemotable) + private + FBoolSimpleAtt_Exemple: Boolean; + FIntSimpleAtt_Exemple: Integer; + FStrSimpleAtt_Exemple: string; + FValue : TTestEnum; + protected + class function GetEnumTypeInfo() : PTypeInfo;override; + function GetValueAddress() : Pointer;override; + public + property Value : TTestEnum read FValue write FValue; + published + property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; + property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; + property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; + end; T_ComplexFloatExtendedContent = class(TComplexFloatExtendedContentRemotable) private @@ -294,6 +313,7 @@ type private FElt_Exemple: string; FVal_CplxDouble: T_ComplexFloatDoubleContent; + FVal_CplxEnum : T_ComplexTestEnumContent; FVal_CplxInt16S: T_ComplexInt16SContent; FVal_CplxInt16U: T_ComplexInt16UContent; FVal_CplxInt32S: T_ComplexInt32SContent; @@ -324,6 +344,8 @@ type property Val_CplxInt8U : T_ComplexInt8UContent read FVal_CplxInt8U write FVal_CplxInt8U; property Val_CplxInt8S : T_ComplexInt8SContent read FVal_CplxInt8S write FVal_CplxInt8S; + property Val_CplxEnum : T_ComplexTestEnumContent read FVal_CplxEnum write FVal_CplxEnum; + property Val_CplxExtended : T_ComplexFloatExtendedContent read FVal_CplxExtended write FVal_CplxExtended; property Val_CplxDouble : T_ComplexFloatDoubleContent read FVal_CplxDouble write FVal_CplxDouble; property Val_CplxString : T_ComplexStringContent read FVal_CplxString write FVal_CplxString; @@ -492,6 +514,8 @@ type procedure Test_CplxInt16SimpleContent_WithClass; procedure Test_CplxInt8SimpleContent_WithClass; + procedure Test_CplxEnumSimpleContent_WithClass; + procedure Test_CplxFloatExtendedSimpleContent_WithClass; procedure Test_CplxStringSimpleContent_WithClass; procedure Test_CplxWideStringSimpleContent_WithClass; @@ -808,6 +832,18 @@ begin end; end; +{ T_ComplexTestEnumContent } + +class function T_ComplexTestEnumContent.GetEnumTypeInfo() : PTypeInfo; +begin + Result := TypeInfo(TTestEnum); +end; + +function T_ComplexTestEnumContent.GetValueAddress() : Pointer; +begin + Result := @FValue; +end; + function TTestFormatterSimpleType.Support_ComplextType_with_SimpleContent( ): Boolean; begin Result := True; @@ -2680,6 +2716,59 @@ begin end; end; +procedure TTestFormatter.Test_CplxEnumSimpleContent_WithClass; +const VAL_S = teTwo; VAL_U = teThree; +var + f : IFormatterBase; + s : TMemoryStream; + a : TClass_CplxSimpleContent; + ns : T_ComplexTestEnumContent; + x : string; +begin + if not Support_ComplextType_with_SimpleContent() then + Exit; + + s := nil; + ns := T_ComplexTestEnumContent.Create(); + a := TClass_CplxSimpleContent.Create(); + try + a.Val_CplxEnum := T_ComplexTestEnumContent.Create(); + a.Val_CplxEnum.Value := VAL_S; + ns.Value := VAL_U; + + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); + f.Put('ns',TypeInfo(T_ComplexTestEnumContent),ns); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + + ns.Value := teOne; + a := TClass_CplxSimpleContent.Create(); + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginObjectRead(x,TypeInfo(TClass_Int)); + x := 'o1'; + f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); + x := 'ns'; + f.Get(TypeInfo(TComplexInt8SContentRemotable),x,ns); + f.EndScopeRead(); + + CheckEquals(Ord(VAL_S),Ord(a.Val_CplxEnum.Value),'a.Val_CplxEnum.Value'); + CheckEquals(Ord(VAL_U),Ord(ns.Value),'ns.Value'); + finally + FreeAndNil(ns); + a.Free(); + s.Free(); + end; +end; + procedure TTestFormatter.Test_CplxFloatExtendedSimpleContent_WithClass; const VAL_S : Extended = -12.10; VAL_U : Double = 10.76; var @@ -5681,6 +5770,7 @@ end; procedure TClass_CplxSimpleContent.FreeObjectProperties(); begin + FreeAndNil(FVal_CplxEnum); FreeAndNil(FVal_CplxInt64S); FreeAndNil(FVal_CplxInt64U); FreeAndNil(FVal_CplxInt32U); @@ -6486,6 +6576,7 @@ initialization GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8SContent),'T_ComplexInt8SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8UContent),'T_ComplexInt8UContent'); + GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexTestEnumContent),'T_ComplexTestEnumContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatExtendedContent),'T_ComplexFloatExtendedContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatDoubleContent),'T_ComplexFloatDoubleContent'); diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index e79b52eb7..49cbb2e4d 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -1115,7 +1115,7 @@ begin Delete(Result,1,1); end; -function TBaseGenerator.GenerateExtraUses() : string; +{function TBaseGenerator.GenerateExtraUses() : string; var m : TPasModule; k, currentModuleIndex : Integer; @@ -1134,6 +1134,23 @@ begin end; if ( Length(Result) > 0 ) then Delete(Result,1,2); +end;} +function TBaseGenerator.GenerateExtraUses() : string; +var + locUsesList : TList; + locModule : TPasElement; + i : Integer; +begin + Result := ''; + locUsesList := SymbolTable.CurrentModule.InterfaceSection.UsesList; + if (locUsesList.Count > 0) then begin + for i := 0 to Pred(locUsesList.Count) do begin + locModule := TPasElement(locUsesList[i]); + Result := Result + ', ' + locModule.Name; + end; + if ( Length(Result) > 0 ) then + Delete(Result,1,2); + end; end; constructor TBaseGenerator.Create(ASymTable: TwstPasTreeContainer; ASrcMngr: ISourceManager); @@ -2339,6 +2356,7 @@ procedure TInftGenerator.GenerateClass(ASymbol: TPasClassType); var locClassPropNbr, locOptionalPropsNbr, locArrayPropsNbr, locPropCount : Integer; locPropList : TObjectList; + locParentIsEnum : Boolean; procedure Prepare(); var @@ -2393,7 +2411,11 @@ var then begin trueAncestor := TPasNativeSimpleType(trueAncestor).ExtendableType; end; - s := Format('%s',[trueAncestor.Name]); + locParentIsEnum := trueAncestor.InheritsFrom(TPasEnumType); + if locParentIsEnum then + s := 'TComplexEnumContentRemotable' + else + s := Format('%s',[trueAncestor.Name]); end; end; if IsStrEmpty(s) then begin @@ -2458,6 +2480,10 @@ var end;} WritePropertyField(p); end; + if locParentIsEnum then begin + Indent(); + WriteLn('FValue : %s;',[ASymbol.AncestorType.Name]); + end; DecIndent(); // if ( locOptionalPropsNbr > 0 ) then begin @@ -2474,7 +2500,16 @@ var DecIndent(); end; // - if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) then begin + if locParentIsEnum then begin + Indent(); + WriteLn('protected'); + IncIndent(); + Indent(); WriteLn('class function GetEnumTypeInfo() : PTypeInfo;override;'); + Indent(); WriteLn('function GetValueAddress() : Pointer;override;'); + DecIndent(); + end; + // + if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) or locParentIsEnum then begin Indent(); WriteLn('public'); end; @@ -2483,7 +2518,13 @@ var Indent(); WriteLn('constructor Create();override;'); Indent(); WriteLn('procedure FreeObjectProperties();override;'); DecIndent(); - end; + end; + if locParentIsEnum then begin + IncIndent(); + Indent(); + WriteLn('property Value : %s read FValue write FValue;',[ASymbol.AncestorType.Name]); + DecIndent(); + end; // Indent(); @@ -2592,9 +2633,27 @@ var WriteLn('end;'); end; end; + if locParentIsEnum then begin + NewLine(); + WriteLn('class function %s.GetEnumTypeInfo() : PTypeInfo;',[ASymbol.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := TypeInfo(%s);',[ASymbol.AncestorType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('function %s.GetValueAddress() : Pointer;',[ASymbol.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := @FValue;'); + DecIndent(); + WriteLn('end;'); + end; end; begin + locParentIsEnum := False; locPropList := TObjectList.Create(False); try Prepare(); diff --git a/wst/trunk/ws_helper/locators.pas b/wst/trunk/ws_helper/locators.pas index 7671fa0b8..112c992fc 100644 --- a/wst/trunk/ws_helper/locators.pas +++ b/wst/trunk/ws_helper/locators.pas @@ -33,20 +33,43 @@ type private FBasePath : string; protected + function FindFileName(ADocLocation : string) : string; property BasePath : string read FBasePath; protected function Find( const ADocLocation : string; out ADoc : TXMLDocument ) : Boolean; + function FindPath(ADocLocation : string) : string; + + function GetBasePath() : string; + procedure SetBasePath(AValue : string); + function Clone() : IDocumentLocator; public - constructor Create(const ABasePath : string); + constructor Create(const ABasePath : string);virtual; end; - + TFileDocumentLocatorClass = class of TFileDocumentLocator; + implementation { TFileDocumentLocator } +function TFileDocumentLocator.FindFileName(ADocLocation : string) : string; +var + locFileName : string; +begin + //locFileName := BasePath + ExtractFileName(ADocLocation); + locFileName := StringReplace(ADocLocation,'\',PathDelim,[rfIgnoreCase,rfReplaceAll]); + locFileName := StringReplace(locFileName,'/',PathDelim,[rfIgnoreCase,rfReplaceAll]); + + locFileName := BasePath + locFileName; + //locFileName := ExpandFileName(locFileName); + if FileExists(locFileName) then + Result := locFileName + else + Result := ''; +end; + function TFileDocumentLocator.Find( const ADocLocation: string; out ADoc: TXMLDocument @@ -54,16 +77,38 @@ function TFileDocumentLocator.Find( var locFileName : string; begin - locFileName := BasePath + ExtractFileName(ADocLocation); - locFileName := ExpandFileName(locFileName); - Result := FileExists(locFileName); + locFileName := FindFileName(ADocLocation); + Result := (locFileName <> ''); if Result then ReadXMLFile(ADoc,locFileName); end; +function TFileDocumentLocator.FindPath(ADocLocation : string) : string; +begin + Result := FindFileName(ADocLocation); + if (Result <> '') then + Result := ExtractFilePath(Result); +end; + +function TFileDocumentLocator.GetBasePath() : string; +begin + Result := BasePath; +end; + +procedure TFileDocumentLocator.SetBasePath(AValue : string); +begin + if (FBasePath <> AValue) then + FBasePath := AValue; +end; + +function TFileDocumentLocator.Clone() : IDocumentLocator; +begin + Result := TFileDocumentLocatorClass(Self.ClassType).Create(FBasePath) as IDocumentLocator; +end; + constructor TFileDocumentLocator.Create(const ABasePath: string); begin - FBasePath := IncludeTrailingPathDelimiter(ABasePath); + SetBasePath(IncludeTrailingPathDelimiter(ABasePath)); end; end. diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas index 8755b15fe..6d697ea1d 100644 --- a/wst/trunk/ws_helper/wsdl_parser.pas +++ b/wst/trunk/ws_helper/wsdl_parser.pas @@ -60,9 +60,11 @@ type FSchemaCursor : IObjectCursor; FOnMessage: TOnParserMessage; FSimpleOptions : TParserOptions; + FIncludeList : TStringList; private procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); function AddNameSpace(const AValue : string) : TStrings; + procedure CreateIncludeList(); private function CreateWsdlNameFilter(const AName : WideString):IObjectFilter; function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; @@ -93,9 +95,11 @@ type function GetTargetNameSpace() : string; function GetTargetModule() : TPasModule; function GetDocumentLocator() : IDocumentLocator; - procedure SetDocumentLocator(const ALocator : IDocumentLocator); + procedure SetDocumentLocator(ALocator : IDocumentLocator); function GetSimpleOptions() : TParserOptions; procedure SetSimpleOptions(const AValue : TParserOptions); + procedure AddIncludedDoc(ADocLocation : string); + function IsIncludedDoc(ADocLocation : string) : Boolean; public constructor Create( ADoc : TXMLDocument; @@ -148,6 +152,15 @@ begin end; end; +procedure TWsdlParser.CreateIncludeList(); +begin + if (FIncludeList = nil) then begin + FIncludeList := TStringList.Create(); + FIncludeList.Duplicates := dupIgnore; + FIncludeList.Sorted := True; + end; +end; + constructor TWsdlParser.Create( ADoc : TXMLDocument; ASymbols : TwstPasTreeContainer; @@ -193,6 +206,7 @@ destructor TWsdlParser.Destroy(); end; begin + FreeAndNil(FIncludeList); FreeList(FXsdParsers); FreeList(FNameSpaceList); inherited; @@ -285,7 +299,7 @@ begin Result := FDocumentLocator; end; -procedure TWsdlParser.SetDocumentLocator(const ALocator: IDocumentLocator); +procedure TWsdlParser.SetDocumentLocator(ALocator: IDocumentLocator); begin FDocumentLocator := ALocator; end; @@ -301,6 +315,18 @@ begin FSimpleOptions := AValue; end; +procedure TWsdlParser.AddIncludedDoc(ADocLocation : string); +begin + if (FIncludeList = nil) then + CreateIncludeList(); + FIncludeList.Add(ADocLocation); +end; + +function TWsdlParser.IsIncludedDoc(ADocLocation : string) : Boolean; +begin + Result := (FIncludeList <> nil) and (FIncludeList.IndexOf(ADocLocation) <> -1); +end; + function TWsdlParser.GetTargetNameSpace() : string; begin Result := FTargetNameSpace; @@ -391,6 +417,26 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin end; end; + procedure FixUsesList(); + var + locPrs : IParserContext; + k : PtrInt; + locModule : TPasModule; + locIntfUsesList : TList; + begin + locIntfUsesList := FModule.InterfaceSection.UsesList; + for k := 0 to Pred(FXsdParsers.Count) do begin + locPrs := (FXsdParsers.Objects[k] as TIntfObjectRef).Intf as IParserContext; + locModule := locPrs.GetTargetModule(); + if (locModule <> nil) and (locModule <> FModule) and + (locIntfUsesList.IndexOf(locModule) = -1) + then begin + locModule.AddRef(); + locIntfUsesList.Add(locModule); + end; + end; + end; + var locSrvcCrs : IObjectCursor; locObj : TDOMNodeRttiExposer; @@ -408,9 +454,10 @@ begin ParseTypes(); end; - ParseForwardDeclarations(); - ExtractNameSpace(); + ParseForwardDeclarations(); SymbolTable.SetCurrentModule(FModule); + ExtractNameSpace(); + FixUsesList(); end; function TWsdlParser.ParseOperation( diff --git a/wst/trunk/ws_helper/xsd_consts.pas b/wst/trunk/ws_helper/xsd_consts.pas index 738572316..2564cd0b2 100644 --- a/wst/trunk/ws_helper/xsd_consts.pas +++ b/wst/trunk/ws_helper/xsd_consts.pas @@ -47,6 +47,7 @@ const s_extension : WideString = 'extension'; s_guid : WideString = 'GUID'; s_import = 'import'; + s_include = 'include'; s_input : WideString = 'input'; s_item : WideString = 'item'; s_literal = 'literal'; diff --git a/wst/trunk/ws_helper/xsd_parser.pas b/wst/trunk/ws_helper/xsd_parser.pas index c529e87b5..397c029bc 100644 --- a/wst/trunk/ws_helper/xsd_parser.pas +++ b/wst/trunk/ws_helper/xsd_parser.pas @@ -48,10 +48,16 @@ type const ADocLocation : string; out ADoc : TXMLDocument ) : Boolean; + function FindPath(ADocLocation : string) : string; + + function GetBasePath() : string; + procedure SetBasePath(AValue : string); + function Clone() : IDocumentLocator; end; TParserOption = ( - poEnumAlwaysPrefix // Always prefix enum item with the enum name + poEnumAlwaysPrefix, // Always prefix enum item with the enum name + poParsingIncludeSchema ); TParserOptions = set of TParserOption; IParserContext = interface @@ -63,9 +69,12 @@ type function GetTargetNameSpace() : string; function GetTargetModule() : TPasModule; function GetDocumentLocator() : IDocumentLocator; - procedure SetDocumentLocator(const ALocator : IDocumentLocator); + procedure SetDocumentLocator(ALocator : IDocumentLocator); function GetSimpleOptions() : TParserOptions; procedure SetSimpleOptions(const AValue : TParserOptions); + + procedure AddIncludedDoc(ADocLocation : string); + function IsIncludedDoc(ADocLocation : string) : Boolean; end; IXsdPaser = interface @@ -103,12 +112,15 @@ type FSimpleOptions : TParserOptions; FImportParsed : Boolean; FXsdParsers : TStringList; + FIncludeList : TStringList; + FIncludeParsed : Boolean; + FPrepared : Boolean; private procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); private function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; function GetParentContext() : IParserContext;{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure Prepare(); + procedure Prepare(const AMustSucceed : Boolean); function FindElement(const AName: String) : TPasElement; {$IFDEF USE_INLINE}inline;{$ENDIF} protected function GetXsShortNames() : TStrings; @@ -117,9 +129,11 @@ type function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings; function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings; function GetDocumentLocator() : IDocumentLocator; - procedure SetDocumentLocator(const ALocator : IDocumentLocator); + procedure SetDocumentLocator(ALocator : IDocumentLocator); function GetSimpleOptions() : TParserOptions; procedure SetSimpleOptions(const AValue : TParserOptions); + procedure AddIncludedDoc(ADocLocation : string); + function IsIncludedDoc(ADocLocation : string) : Boolean; procedure SetNotifier(ANotifier : TOnParserMessage); function InternalParseType( @@ -128,6 +142,8 @@ type ) : TPasType; procedure CreateImportParsers(); procedure ParseImportDocuments(); virtual; + procedure CreateIncludeList(); + procedure ParseIncludeDocuments(); virtual; public constructor Create( ADoc : TXMLDocument; @@ -207,7 +223,7 @@ begin FNameSpaceList.Duplicates := dupError; FNameSpaceList.Sorted := True; - Prepare(); + Prepare(False); end; destructor TCustomXsdSchemaParser.Destroy(); @@ -227,6 +243,7 @@ destructor TCustomXsdSchemaParser.Destroy(); begin FParentContext := nil; + FreeAndNil(FIncludeList); FreeList(FNameSpaceList); FreeList(FXsdParsers); inherited; @@ -237,6 +254,7 @@ var i : PtrInt; p, p1 : IXsdPaser; begin + Prepare(True); Result := nil; if (ANamespace = FTargetNameSpace) then begin Result := Self; @@ -306,6 +324,101 @@ begin end; end; +procedure TCustomXsdSchemaParser.CreateIncludeList(); +begin + if (FIncludeList = nil) then begin + FIncludeList := TStringList.Create(); + FIncludeList.Duplicates := dupIgnore; + FIncludeList.Sorted := True; + end; +end; + +procedure TCustomXsdSchemaParser.ParseIncludeDocuments(); +var + crsSchemaChild : IObjectCursor; + strFilter, locFileName : string; + includeNode : TDOMElement; + includeDoc : TXMLDocument; + locParser : IXsdPaser; + locOldCurrentModule : TPasModule; + locLocator, locTempLocator : IDocumentLocator; + locContext : IParserContext; + locUsesList : TList; + locModule : TPasModule; + locName, s : string; + i : Integer; +begin + if FIncludeParsed then + exit; + Prepare(True); + if (poParsingIncludeSchema in FSimpleOptions) then begin + locContext := GetParentContext(); + if (locContext = nil) then + raise EXsdParserAssertException.CreateFmt(SERR_InvalidParserState,['"poParsingIncludeSchema" require a parent context']); + if not(IsStrEmpty(FTargetNameSpace)) and (FTargetNameSpace <> locContext.GetTargetNameSpace()) then + raise EXsdParserAssertException.Create(SERR_InvalidIncludeDirectiveNS); + end; + + FIncludeParsed := True; + locLocator := GetDocumentLocator(); + if (locLocator = nil) then + Exit; + + if Assigned(FChildCursor) then begin + locOldCurrentModule := SymbolTable.CurrentModule; + try + locUsesList := FModule.InterfaceSection.UsesList; + crsSchemaChild := FChildCursor.Clone() as IObjectCursor; + strFilter := CreateQualifiedNameFilterStr(s_include,FXSShortNames); + crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(strFilter,TDOMNodeRttiExposer)); + crsSchemaChild.Reset(); + while crsSchemaChild.MoveNext() do begin + includeNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject as TDOMElement; + if (includeNode.Attributes <> nil) and (includeNode.Attributes.Length > 0) then begin + locFileName := NodeValue(includeNode.Attributes.GetNamedItem(s_schemaLocation)); + if not(IsStrEmpty(locFileName) or IsIncludedDoc(locFileName)) then begin + if locLocator.Find(locFileName,includeDoc) then begin + AddIncludedDoc(locFileName); + locParser := TCustomXsdSchemaParserClass(Self.ClassType).Create( + includeDoc, + includeDoc.DocumentElement, + SymbolTable, + Self as IParserContext + ); + locContext := locParser as IParserContext; + locContext.SetSimpleOptions(locContext.GetSimpleOptions() + [poParsingIncludeSchema]); + locTempLocator := locLocator.Clone(); + locTempLocator.SetBasePath(locLocator.FindPath(locFileName)); + locContext.SetDocumentLocator(locTempLocator); + locParser.SetNotifier(FOnMessage); + locParser.ParseTypes(); + locModule := locContext.GetTargetModule(); + if (ExtractIdentifier(locContext.GetTargetNameSpace()) = locModule.Name) then begin + s := ChangeFileExt(ExtractFileName(locFileName),''); + i := 1; + locName := s; + while (FSymbols.FindModule(locName) <> nil) do begin + locName := Format('%s%d',[s,i]); + Inc(i); + end; + locModule.Name := locName; + end; + if (locModule <> FModule) and (locUsesList.IndexOf(locModule) = -1) then begin + locModule.AddRef(); + locUsesList.Add(locModule); + end; + end else begin + DoOnMessage(mtError,Format(SERR_FileNotFound,[locFileName])); + end; + end; + end; + end; + finally + SymbolTable.SetCurrentModule(locOldCurrentModule); + end; + end; +end; + function TCustomXsdSchemaParser.FindNamedNode( AList : IObjectCursor; const AName : WideString; @@ -385,7 +498,7 @@ begin Result := GetParentContext().GetDocumentLocator(); end; -procedure TCustomXsdSchemaParser.SetDocumentLocator(const ALocator: IDocumentLocator); +procedure TCustomXsdSchemaParser.SetDocumentLocator(ALocator: IDocumentLocator); begin FDocumentLocator := ALocator; end; @@ -401,6 +514,27 @@ begin FSimpleOptions := AValue; end; +procedure TCustomXsdSchemaParser.AddIncludedDoc(ADocLocation : string); +begin + if (poParsingIncludeSchema in FSimpleOptions) then begin + GetParentContext().AddIncludedDoc(ADocLocation); + exit; + end; + + if (FIncludeList = nil) then + CreateIncludeList(); + FIncludeList.Add(ADocLocation); +end; + +function TCustomXsdSchemaParser.IsIncludedDoc(ADocLocation : string) : Boolean; +begin + Result := False; + if (poParsingIncludeSchema in FSimpleOptions) then + Result := GetParentContext().IsIncludedDoc(ADocLocation); + if not Result then + Result := (FIncludeList <> nil) and (FIncludeList.IndexOf(ADocLocation) <> -1); +end; + procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage); begin FOnMessage := ANotifier; @@ -429,11 +563,13 @@ end; function TCustomXsdSchemaParser.GetTargetModule() : TPasModule; begin + Prepare(True); Result := FModule; end; function TCustomXsdSchemaParser.GetTargetNameSpace() : string; begin + Prepare(True); Result := FTargetNameSpace; end; @@ -599,8 +735,11 @@ var typeModule : TPasModule; locTypeNodeFound : Boolean; begin + Prepare(True); if not FImportParsed then ParseImportDocuments(); + if not FIncludeParsed then + ParseIncludeDocuments(); sct := nil; DoOnMessage(mtInfo, Format(SERR_Parsing,[AName])); try @@ -682,10 +821,16 @@ var locParser : IXsdPaser; locOldCurrentModule : TPasModule; locContinue : Boolean; - locLocator : IDocumentLocator; + locLocator, loctempLocator : IDocumentLocator; + locContext : IParserContext; + locUsesList : TList; + locModule : TPasModule; + locName, s : string; + i : Integer; begin if FImportParsed then Exit; + Prepare(True); locLocator := GetDocumentLocator(); if (locLocator = nil) then Exit; @@ -693,6 +838,7 @@ begin if Assigned(FChildCursor) then begin locOldCurrentModule := SymbolTable.CurrentModule; try + locUsesList := FModule.InterfaceSection.UsesList; crsSchemaChild := FChildCursor.Clone() as IObjectCursor; strFilter := CreateQualifiedNameFilterStr(s_import,FXSShortNames); crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(strFilter,TDOMNodeRttiExposer)); @@ -701,26 +847,45 @@ begin importNode := (crsSchemaChild.GetCurrent() as TDOMNodeRttiExposer).InnerObject as TDOMElement; if ( importNode.Attributes <> nil ) and ( importNode.Attributes.Length > 0 ) then begin locFileName := NodeValue(importNode.Attributes.GetNamedItem(s_schemaLocation)); - if ( not IsStrEmpty(locFileName) ) and - locLocator.Find(locFileName,importDoc) - then begin - locNameSpace := NodeValue(importNode.Attributes.GetNamedItem(s_namespace)); - locContinue := IsStrEmpty(locNameSpace) or (FXsdParsers = nil) or (FXsdParsers.IndexOf(locNameSpace) = -1);//( SymbolTable.FindModule(locNameSpace) = nil ); - if locContinue then begin - if (FXsdParsers = nil) then begin - FXsdParsers := TStringList.Create(); - FXsdParsers.Duplicates := dupIgnore; - FXsdParsers.Sorted := True; - end; - locParser := TCustomXsdSchemaParserClass(Self.ClassType).Create( - importDoc, - importDoc.DocumentElement, - SymbolTable, - Self as IParserContext - ); - FXsdParsers.AddObject(locNameSpace,TIntfObjectRef.Create(locParser)); - locParser.SetNotifier(FOnMessage); - //locParser.ParseTypes(); + if not IsStrEmpty(locFileName) then begin + if locLocator.Find(locFileName,importDoc) then begin + locNameSpace := NodeValue(importNode.Attributes.GetNamedItem(s_namespace)); + locContinue := IsStrEmpty(locNameSpace) or (FXsdParsers = nil) or (FXsdParsers.IndexOf(locNameSpace) = -1);//( SymbolTable.FindModule(locNameSpace) = nil ); + if locContinue then begin + if (FXsdParsers = nil) then begin + FXsdParsers := TStringList.Create(); + FXsdParsers.Duplicates := dupIgnore; + FXsdParsers.Sorted := True; + end; + locParser := TCustomXsdSchemaParserClass(Self.ClassType).Create( + importDoc, + importDoc.DocumentElement, + SymbolTable, + Self as IParserContext + ); + locContext := locParser as IParserContext; + loctempLocator := locLocator.Clone(); + loctempLocator.SetBasePath(locLocator.FindPath(locFileName)); + locContext.SetDocumentLocator(loctempLocator); + FXsdParsers.AddObject(locNameSpace,TIntfObjectRef.Create(locParser)); + locParser.SetNotifier(FOnMessage); + //locParser.ParseTypes(); + locModule := locContext.GetTargetModule(); + if (locModule <> FModule) and (locUsesList.IndexOf(locModule) = -1) then begin + s := ChangeFileExt(ExtractFileName(locFileName),''); + i := 1; + locName := s; + while (FSymbols.FindModule(locName) <> nil) do begin + locName := Format('%s%d',[s,i]); + Inc(i); + end; + locModule.Name := locName; + locModule.AddRef(); + locUsesList.Add(locModule); + end; + end; + end else begin + DoOnMessage(mtError,Format(SERR_FileNotFound,[locFileName])); end; end; end; @@ -737,6 +902,8 @@ var typFilterStr : string; typNode : TDOMNode; begin + Prepare(True); + ParseIncludeDocuments(); if Assigned(FChildCursor) then begin crsSchemaChild := FChildCursor.Clone() as IObjectCursor; typFilterStr := Format( @@ -766,20 +933,40 @@ begin end; end; -procedure TCustomXsdSchemaParser.Prepare(); +procedure TCustomXsdSchemaParser.Prepare(const AMustSucceed : Boolean); var locAttCursor : IObjectCursor; prntCtx : IParserContext; nd : TDOMNode; i : PtrInt; ls : TStrings; + ok : Boolean; begin - if ( FSchemaNode.Attributes = nil ) or ( GetNodeListCount(FSchemaNode.Attributes) = 0 ) then - raise EXsdParserAssertException.CreateFmt(SERR_SchemaNodeRequiredAttribute,[s_targetNamespace]); - nd := FSchemaNode.Attributes.GetNamedItem(s_targetNamespace); - if ( nd = nil ) then - raise EXsdParserAssertException.CreateFmt(SERR_SchemaNodeRequiredAttribute,[s_targetNamespace]); - FTargetNameSpace := nd.NodeValue; + if FPrepared then + exit; + + FTargetNameSpace := ''; + ok := False; + if (FSchemaNode.Attributes <> nil) and (GetNodeListCount(FSchemaNode.Attributes) > 0) then begin + nd := FSchemaNode.Attributes.GetNamedItem(s_targetNamespace); + if (nd <> nil) then begin + FTargetNameSpace := nd.NodeValue; + ok := True; + end; + end; + prntCtx := GetParentContext(); + if not ok then begin + if (poParsingIncludeSchema in FSimpleOptions) and (prntCtx <> nil) then begin + FTargetNameSpace := prntCtx.GetTargetNameSpace(); + ok := True; + end else begin + if not AMustSucceed then + exit; + raise EXsdParserAssertException.CreateFmt(SERR_SchemaNodeRequiredAttribute,[s_targetNamespace]); + end; + end; + + FPrepared := True; if IsStrEmpty(FModuleName) then FModuleName := ExtractIdentifier(FTargetNameSpace); if ( SymbolTable.FindModule(s_xs) = nil ) then begin @@ -790,7 +977,6 @@ begin locAttCursor := CreateAttributesCursor(FSchemaNode,cetRttiNode); BuildNameSpaceList(locAttCursor,FNameSpaceList); FXSShortNames := FindShortNamesForNameSpaceLocal(s_xs); - prntCtx := GetParentContext(); if ( FXSShortNames = nil ) then begin if ( prntCtx = nil ) then raise EXsdParserAssertException.CreateFmt(SERR_InvalidSchemaDoc_NamespaceNotFound,[s_xs]); diff --git a/wst/trunk/wst_consts.pas b/wst/trunk/wst_consts.pas index d8983d351..3c94380df 100644 --- a/wst/trunk/wst_consts.pas +++ b/wst/trunk/wst_consts.pas @@ -32,6 +32,7 @@ resourcestring SERR_ExpectedTypeDefinition = '"%s" was expected to be a type definition.'; SERR_ExpectingRemotableObjectClass = 'Expecting remotable object class but found "%s".'; SERR_FailedTransportRequest = '%s Request to %s failed.'; + SERR_FileNotFound = 'File not found : "%s" .'; SERR_HeaderNotUnderstood = 'Header "%s" not Understood.'; SERR_IllegalChar = 'Illegal character for that encoding : "%s".'; SERR_IndexOutOfBound = 'Index out of bound : %d.'; @@ -57,11 +58,13 @@ resourcestring SERR_InvalidEncodedData = 'Invalid encoded data.'; SERR_InvalidEnumItemNode_NoValueAttribute = 'Invalid "enum" item node : no value attribute, type = "%s".'; SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.'; + SERR_InvalidIncludeDirectiveNS = 'Invalid directive, "targetNamespace" must be absent or equals the parent''s one.'; SERR_InvalidMaxOccursValue = 'Invalid "maxOccurs" value : "%s.%s".'; SERR_InvalidMinOccursValue = 'Invalid "minOccurs" value : "%s.%s".'; SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.'; - SERR_InvalidEmbeddedScopeOperation = 'Invalid opération on scope, their are no embedded scope.'; + SERR_InvalidEmbeddedScopeOperation = 'Invalid operation on scope, their are no embedded scope.'; SERR_InvalidParameter = 'Invalid parameter : "%s".'; + SERR_InvalidParserState = 'Invalud parser state : %s.'; SERR_InvalidPropertyValue = 'Invalid property ("%s") value : "%s".'; SERR_InvalidParameterProc = 'Invalid parameter : "%s"; Procedure = "%s".'; SERR_InvalidParameters = 'Invalid parameters.';