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.';