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

* Remove duplicated class' properties(Complex type restriction case)

Browse Source 
* Add the "_" prefix or the "_Type" suffix only when necessary
* Search module by namespace if a namespace is provided (FindModule)
* Parse schema's imported documents

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2840 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2013-11-19 11:04:25 +00:00
parent 048ad30635
commit 0a2294b0d7
4 changed files with 182 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

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

9
wst/trunk/ws_helper/ws_parser_imp.pas
View File

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

16
wst/trunk/ws_helper/wsdl_parser.pas
View File

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

112
wst/trunk/ws_helper/xsd_parser.pas
View File

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