From 5276962d0246508d110844590839ac845c658945 Mon Sep 17 00:00:00 2001 From: inoussa Date: Thu, 11 Sep 2008 02:12:27 +0000 Subject: [PATCH] Fix empty complexType parsing git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@552 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../files/class_headerblock_derived.wsdl | 2 + .../files/class_headerblock_derived.xsd | 3 ++ .../tests/test_suite/test_generators.pas | 7 ++++ wst/trunk/tests/test_suite/test_parsers.pas | 11 +++++- wst/trunk/ws_helper/ws_parser_imp.pas | 37 +++++++++++-------- 5 files changed, 44 insertions(+), 16 deletions(-) diff --git a/wst/trunk/tests/test_suite/files/class_headerblock_derived.wsdl b/wst/trunk/tests/test_suite/files/class_headerblock_derived.wsdl index a3fd2f586..5f0802357 100644 --- a/wst/trunk/tests/test_suite/files/class_headerblock_derived.wsdl +++ b/wst/trunk/tests/test_suite/files/class_headerblock_derived.wsdl @@ -10,6 +10,8 @@ + + diff --git a/wst/trunk/tests/test_suite/files/class_headerblock_derived.xsd b/wst/trunk/tests/test_suite/files/class_headerblock_derived.xsd index b2b1b6867..0c0e31fa9 100644 --- a/wst/trunk/tests/test_suite/files/class_headerblock_derived.xsd +++ b/wst/trunk/tests/test_suite/files/class_headerblock_derived.xsd @@ -1,5 +1,8 @@ + + + diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas index 15fc6d859..a630b4441 100644 --- a/wst/trunk/tests/test_suite/test_generators.pas +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -300,6 +300,13 @@ begin mdl := TPasModule(tr.CreateElement(TPasModule,'class_headerblock_derived',tr.Package,visDefault,'',0)); tr.Package.Modules.Add(mdl); mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TEmptyHeader',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + cltyp.AncestorType := tr.FindElementNS('THeaderBlock',s_xs) as TPasType; + cltyp.AncestorType.AddRef(); + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleHeader',mdl.InterfaceSection,visDefault,'',0)); cltyp.ObjKind := okClass; cltyp.AncestorType := tr.FindElementNS('THeaderBlock',s_xs) as TPasType; diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 3a486f823..a214be363 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -1172,7 +1172,7 @@ begin end; procedure TTest_CustomXsdParser.class_headerblock_derived(); -const s_class_name = 'TSampleHeader'; +const s_class_name = 'TSampleHeader'; s_emty_class_name = 'TEmptyHeader'; var tr : TwstPasTreeContainer; mdl : TPasModule; @@ -1183,6 +1183,14 @@ begin try mdl := tr.FindModule('class_headerblock_derived'); CheckNotNull(mdl,'class_headerblock_derived'); + elt := tr.FindElement(s_emty_class_name); + CheckNotNull(elt,s_emty_class_name); + CheckEquals(s_emty_class_name,elt.Name); + CheckEquals(s_emty_class_name,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + CheckNotNull(clsType.AncestorType,'AncestorType is null'); + CheckSame(tr.FindElementNS('THeaderBlock',sXSD_NS),clsType.AncestorType); elt := tr.FindElement(s_class_name); CheckNotNull(elt,s_class_name); CheckEquals(s_class_name,elt.Name); @@ -1191,6 +1199,7 @@ begin clsType := elt as TPasClassType; CheckNotNull(clsType.AncestorType,'AncestorType is null'); CheckSame(tr.FindElementNS('THeaderBlock',sXSD_NS),clsType.AncestorType); + finally tr.Free(); end; diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas index 30f8b830b..d4903f1c1 100644 --- a/wst/trunk/ws_helper/ws_parser_imp.pas +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -125,6 +125,8 @@ type const AInternalName : string; const AHasInternalName : Boolean ) : TPasArrayType; + function IsHeaderBlock() : Boolean; + function IsSimpleContentHeaderBlock() : Boolean; private procedure CreateNodeCursors(); procedure ExtractTypeName(); @@ -554,6 +556,20 @@ begin FSymbols.RegisterExternalAlias(Result,ATypeName); end; +function TComplexTypeParser.IsHeaderBlock() : Boolean; +var + strBuffer : string; +begin + Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer)); +end; + +function TComplexTypeParser.IsSimpleContentHeaderBlock() : Boolean; +var + strBuffer : string; +begin + Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer)); +end; + procedure TComplexTypeParser.CreateNodeCursors(); begin FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode); @@ -866,20 +882,6 @@ var ExtractExtendedMetadata(locProp,AElement); end; - function IsHeaderBlock() : Boolean; - var - strBuffer : string; - begin - Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer)); - end; - - function IsSimpleContentHeaderBlock() : Boolean; - var - strBuffer : string; - begin - Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer)); - end; - function IsRecordType() : Boolean; var strBuffer : string; @@ -1213,7 +1215,12 @@ begin TPasClassType(Result).ObjKind := okClass; if hasInternalName then FSymbols.RegisterExternalAlias(Result,ATypeName); - TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; + if IsHeaderBlock() then + TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType + else if IsSimpleContentHeaderBlock() then + TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TSimpleContentHeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType + else + TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; TPasClassType(Result).AncestorType.AddRef(); end;