diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index aeeffd700..42e9960b1 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -238,7 +238,15 @@ type function FindMember(AClass : TPasRecordType; const AName : string) : TPasElement ; overload; function GetElementCount(AList : TList2; AElementClass : TPTreeElement):Integer ; - function GetUltimeType(AType : TPasType) : TPasType; + function GetUltimeType(AType : TPasType) : TPasType;overload; + function GetUltimeType( + AType : TPasType; + AContainer : TwstPasTreeContainer + ) : TPasType;overload; + function FindActualType( + AType : TPasType; + AContainer : TwstPasTreeContainer + ) : TPasType; function MakeInternalSymbolNameFrom(const AName : string) : string ; @@ -514,6 +522,31 @@ begin end; end; +function GetUltimeType( + AType : TPasType; + AContainer : TwstPasTreeContainer +) : TPasType; +var + e : TPasElement; +begin + Result := AType; + if (Result <> nil) then begin + while True do begin + if Result.InheritsFrom(TPasUnresolvedTypeRef) then begin + e := AContainer.FindElement(AContainer.GetExternalName(Result)); + if (e <> nil) and e.InheritsFrom(TPasType) then + Result := TPasType(e); + end; + if Result.InheritsFrom(TPasAliasType) and + (TPasAliasType(Result).DestType <> nil) + then + Result := TPasAliasType(Result).DestType + else + Break; + end; + end; +end; + function GetUltimeType(AType : TPasType) : TPasType; begin Result := AType; @@ -526,6 +559,21 @@ begin end; end; +function FindActualType( + AType : TPasType; + AContainer : TwstPasTreeContainer +) : TPasType; +var + e : TPasElement; +begin + Result := AType; + if Result.InheritsFrom(TPasUnresolvedTypeRef) then begin + e := AContainer.FindElement(AContainer.GetExternalName(Result)); + if (e <> nil) and e.InheritsFrom(TPasType) then + Result := TPasType(e); + end; +end; + function GetElementCount(AList : TList2; AElementClass : TPTreeElement):Integer ; var i : Integer; @@ -867,13 +915,25 @@ function TwstPasTreeContainer.FindModule(const AName: String): TPasModule; var i , c : Integer; mdl : TList2; + s : string; begin Result := nil; + s := ExtractIdentifier(AName); mdl := Package.Modules; c := mdl.Count; - for i := 0 to Pred(c) do begin - if SameName(TPasModule(mdl[i]),AName) then begin - Result := TPasModule(mdl[i]); + if (s = AName) then begin + for i := 0 to Pred(c) do begin + if SameName(TPasModule(mdl[i]),AName) then begin + Result := TPasModule(mdl[i]); + Break; + end; + end; + end else begin + for i := 0 to Pred(c) do begin + if (GetExternalName(TPasModule(mdl[i])) = AName) then begin + Result := TPasModule(mdl[i]); + Break; + end; end; end; end; diff --git a/wst/trunk/ws_helper/ws_parser_imp.pas b/wst/trunk/ws_helper/ws_parser_imp.pas index 17549c678..6907fc3ab 100644 --- a/wst/trunk/ws_helper/ws_parser_imp.pas +++ b/wst/trunk/ws_helper/ws_parser_imp.pas @@ -1209,11 +1209,11 @@ begin internalName := ExtractIdentifier(ATypeName); hasInternalName := IsReservedKeyWord(internalName) or ( not IsValidIdent(internalName) ) or - ( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ) or - ( not AnsiSameText(internalName,ATypeName) ); + ( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ); if hasInternalName then begin internalName := Format('%s_Type',[internalName]); end; + hasInternalName := hasInternalName or not(AnsiSameText(internalName,ATypeName)); if ( pthDeriveFromSoapArray in FHints ) or ( ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) ) @@ -1354,6 +1354,9 @@ begin FreeAndNil(tmpClassDef); end; + if (FDerivationMode = dmRestriction) and Result.InheritsFrom(TPasClassType) then + Context.AddTypeToCheck(Result); + if ( locAnyNode <> nil ) or ( locAnyAttNode <> nil ) then ProcessXsdAnyDeclarations(locAnyNode,locAnyAttNode,Result); except @@ -1807,7 +1810,7 @@ begin // todo : implement TSimpleTypeParser.ParseOtherContent if ( tmpElement <> nil ) and ( not tmpElement.InheritsFrom(TPasUnresolvedTypeRef) ) then hasIntrnName := True; end; - if hasIntrnName then + if IsReservedKeyWord(intrName){hasIntrnName} then intrName := '_' + intrName; Result := TPasTypeAliasType(FSymbols.CreateElement(TPasTypeAliasType,intrName,Self.Module.InterfaceSection,visDefault,'',0)); if ( intrName <> FTypeName ) then diff --git a/wst/trunk/ws_helper/wsdl_parser.pas b/wst/trunk/ws_helper/wsdl_parser.pas index f0c49e38d..e2b0e010a 100644 --- a/wst/trunk/ws_helper/wsdl_parser.pas +++ b/wst/trunk/ws_helper/wsdl_parser.pas @@ -60,6 +60,7 @@ type FSchemaCursor : IObjectCursor; FOnMessage: TOnParserMessage; FSimpleOptions : TParserOptions; + FCheckedTypes : TList2; FIncludeList : TStringList; private procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); @@ -98,6 +99,7 @@ type procedure SetDocumentLocator(ALocator : IDocumentLocator); function GetSimpleOptions() : TParserOptions; procedure SetSimpleOptions(const AValue : TParserOptions); + procedure AddTypeToCheck(AType : TPasType); procedure AddIncludedDoc(ADocLocation : string); function IsIncludedDoc(ADocLocation : string) : Boolean; public @@ -183,6 +185,7 @@ begin FXsdParsers.Sorted := True; FSymbols := ASymbols; + FCheckedTypes := TList2.Create(); end; function TWsdlParser.CreateWsdlNameFilter(const AName: WideString): IObjectFilter; @@ -206,6 +209,7 @@ destructor TWsdlParser.Destroy(); end; begin + FCheckedTypes.Free(); FreeAndNil(FIncludeList); FreeList(FXsdParsers); FreeList(FNameSpaceList); @@ -315,6 +319,16 @@ begin FSimpleOptions := AValue; end; +procedure TWsdlParser.AddTypeToCheck(AType: TPasType); +begin + if (AType = nil) then + exit; + if (FCheckedTypes = nil) then + FCheckedTypes := TList2.Create(); + if (FCheckedTypes.IndexOf(AType) = -1) then + FCheckedTypes.Add(AType); +end; + procedure TWsdlParser.AddIncludedDoc(ADocLocation : string); begin if (FIncludeList = nil) then @@ -462,6 +476,8 @@ begin SymbolTable.SetCurrentModule(FModule); ExtractNameSpace(); FixUsesList(); + if (FCheckedTypes.Count > 0) then + CheckDuplicatedProperties(FCheckedTypes,SymbolTable); finally FSymbols.DefaultSearchNameKinds := locOldNameKinds; end; diff --git a/wst/trunk/ws_helper/xsd_parser.pas b/wst/trunk/ws_helper/xsd_parser.pas index cc8d70e2f..532d89cf1 100644 --- a/wst/trunk/ws_helper/xsd_parser.pas +++ b/wst/trunk/ws_helper/xsd_parser.pas @@ -72,6 +72,7 @@ type procedure SetDocumentLocator(ALocator : IDocumentLocator); function GetSimpleOptions() : TParserOptions; procedure SetSimpleOptions(const AValue : TParserOptions); + procedure AddTypeToCheck(AType : TPasType); procedure AddIncludedDoc(ADocLocation : string); function IsIncludedDoc(ADocLocation : string) : Boolean; @@ -110,6 +111,7 @@ type FOnMessage: TOnParserMessage; FDocumentLocator : IDocumentLocator; FSimpleOptions : TParserOptions; + FCheckedTypes : TList2; FImportParsed : Boolean; FXsdParsers : TStringList; FIncludeList : TStringList; @@ -121,6 +123,7 @@ type private function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; function GetParentContext() : IParserContext;{$IFDEF USE_INLINE}inline;{$ENDIF} + function HasParentContext() : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} procedure Prepare(const AMustSucceed : Boolean); function FindElement(const AName: String) : TPasElement; overload;{$IFDEF USE_INLINE}inline;{$ENDIF} function FindElement(const AName: String; const ANameKinds : TElementNameKinds) : TPasElement; overload;{$IFDEF USE_INLINE}inline;{$ENDIF} @@ -134,6 +137,7 @@ type procedure SetDocumentLocator(ALocator : IDocumentLocator); function GetSimpleOptions() : TParserOptions; procedure SetSimpleOptions(const AValue : TParserOptions); + procedure AddTypeToCheck(AType : TPasType); procedure AddIncludedDoc(ADocLocation : string); function IsIncludedDoc(ADocLocation : string) : Boolean; @@ -185,6 +189,11 @@ type ); end; + procedure CheckDuplicatedProperties( + AClassList : TList2; + ASymbolTable : TwstPasTreeContainer + ); + implementation uses ws_parser_imp, dom_cursors, parserutils, xsd_consts, wst_consts {$IFDEF FPC} @@ -200,6 +209,50 @@ begin Result := ANode.NodeValue; end; +procedure CheckDuplicatedProperties( + AClassList : TList2; + ASymbolTable : TwstPasTreeContainer +); +var + i, k : Integer; + locItem : TPasClassType; + locAncestor : TPasType; + e : TPasElement; +begin + for i := 0 to AClassList.Count-1 do begin + locItem := TPasClassType(AClassList[i]); + if (locItem.Members.Count = 0) then + Continue; + locAncestor := locItem.AncestorType; + while (locAncestor <> nil) do begin + if locAncestor.InheritsFrom(TPasUnresolvedTypeRef) then begin + e := ASymbolTable.FindElement(ASymbolTable.GetExternalName(locAncestor)); + if (e = nil) or not(e.InheritsFrom(TPasType)) then + Break; + locAncestor := e as TPasType; + end; + if not locAncestor.InheritsFrom(TPasClassType) then + Break; + if (TPasClassType(locAncestor).Members.Count = 0) then + Break; + k := 0; + while (k < locItem.Members.Count) do begin + e := TPasElement(locItem.Members[k]); + if not e.InheritsFrom(TPasProperty) then + Continue; + if (TPasClassType(locAncestor).FindMember(TPasProperty,e.Name) <> nil) then begin + locItem.Members.Delete(k); + e.Release(); + Continue; + end; + k := k + 1; + end; + locAncestor := TPasClassType(locAncestor).AncestorType; + end; + end; +end; + + { TCustomXsdSchemaParser } constructor TCustomXsdSchemaParser.Create( @@ -251,7 +304,8 @@ begin FParentContext := nil; FreeAndNil(FIncludeList); FreeList(FNameSpaceList); - FreeList(FXsdParsers); + FreeList(FXsdParsers); + FCheckedTypes.Free(); inherited; end; @@ -530,6 +584,20 @@ begin FSimpleOptions := AValue; end; +procedure TCustomXsdSchemaParser.AddTypeToCheck(AType: TPasType); +begin + if (AType = nil) then + exit; + if HasParentContext() then begin + GetParentContext().AddTypeToCheck(AType); + exit; + end; + if (FCheckedTypes = nil) then + FCheckedTypes := TList2.Create(); + if (FCheckedTypes.IndexOf(AType) = -1) then + FCheckedTypes.Add(AType); +end; + procedure TCustomXsdSchemaParser.AddIncludedDoc(ADocLocation : string); begin if (poParsingIncludeSchema in FSimpleOptions) then begin @@ -572,6 +640,11 @@ begin Result := IParserContext(FParentContext); end; +function TCustomXsdSchemaParser.HasParentContext() : Boolean; +begin + Result := (FParentContext <> nil); +end; + function TCustomXsdSchemaParser.GetSymbolTable() : TwstPasTreeContainer; begin Result := FSymbols; @@ -716,16 +789,18 @@ var function CreateTypeAlias(const ABase : TPasType): TPasType; var - hasInternameName : Boolean; - internameName : string; + hasInterName : Boolean; + baseName,internalName : string; begin - internameName := ExtractNameFromQName(AName); - hasInternameName := IsReservedKeyWord(internameName) or - ( not IsValidIdent(internameName) ); - if hasInternameName then begin - internameName := '_' + internameName; + baseName := ExtractNameFromQName(AName); + internalName := ExtractIdentifier(baseName); + hasInterName := IsReservedKeyWord(internalName) or + ( not IsValidIdent(internalName) ); + if hasInterName then begin + internalName := '_' + internalName; end; - Result := TPasType(SymbolTable.CreateElement(TPasAliasType,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + Result := TPasType(SymbolTable.CreateElement(TPasAliasType,internalName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + SymbolTable.RegisterExternalAlias(Result,baseName); TPasAliasType(Result).DestType := ABase; ABase.AddRef(); end; @@ -733,17 +808,18 @@ var function CreateUnresolveType(): TPasType; var hasInternameName : Boolean; - internameName : string; + internameName, baseName : string; begin - internameName := ExtractNameFromQName(AName); - hasInternameName := IsReservedKeyWord(internameName) or - ( not IsValidIdent(internameName) ); + baseName := ExtractNameFromQName(AName); + internameName := ExtractIdentifier(baseName); + hasInternameName := IsReservedKeyWord(baseName) or + (not IsValidIdent(internameName)); if hasInternameName then begin internameName := '_' + internameName; end; Result := TPasUnresolvedTypeRef(SymbolTable.CreateElement(TPasUnresolvedTypeRef,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); - if not AnsiSameText(internameName,AName) then - SymbolTable.RegisterExternalAlias(Result,AName); + if not AnsiSameText(internameName,baseName) then + SymbolTable.RegisterExternalAlias(Result,baseName); end; var @@ -890,7 +966,8 @@ begin //locParser.ParseTypes(); locModule := locContext.GetTargetModule(); if (locModule <> FModule) and (locUsesList.IndexOf(locModule) = -1) then begin - s := ChangeFileExt(ExtractFileName(locFileName),''); + s := ChangeFileExt(ExtractFileName(locFileName),''); + s := ExtractIdentifier(s); i := 1; locName := s; while (FSymbols.FindModule(locName) <> nil) do begin @@ -921,6 +998,7 @@ var typNode : TDOMNode; begin Prepare(True); + ParseImportDocuments(); ParseIncludeDocuments(); if Assigned(FChildCursor) then begin crsSchemaChild := FChildCursor.Clone() as IObjectCursor; @@ -950,6 +1028,8 @@ begin end; end; end; + if (FCheckedTypes <> nil) and (FCheckedTypes.Count > 0) then + CheckDuplicatedProperties(FCheckedTypes,FSymbols); end; procedure TCustomXsdSchemaParser.Prepare(const AMustSucceed : Boolean);