ws_helper code generation option -gEP : enum type''s items are prefixed with the enum name

Add more Object Pascal keywords to the parser

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1020 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-11-26 10:39:50 +00:00
parent 1f8c09c225
commit 85e796e962
6 changed files with 131 additions and 57 deletions

View File

@ -30,7 +30,7 @@ Type
cloInterface, cloProxy, cloImp, cloBinder, cloWsdl, cloXsd,
cloOutPutDirRelative, cloOutPutDirAbsolute, cloHandleWrappedParameters,
cloGenerateDocAsComments, cloGenerateObjectCollection,
cloFileRenaming
cloFileRenaming, cloPrefixEnum
);
TComandLineOptions = set of TComandLineOption;
@ -81,9 +81,14 @@ begin
'd' : Include(AAppOptions,cloGenerateDocAsComments);
'g' :
begin
Include(AAppOptions,cloGenerateObjectCollection);
OptionsArgsMAP[cloGenerateObjectCollection] := OptArg;
end;
if ( Pos('A',OptArg) = 1 ) or ( Pos('C',OptArg) = 1 ) then begin
Include(AAppOptions,cloGenerateObjectCollection);
OptionsArgsMAP[cloGenerateObjectCollection] := OptArg;
end else if ( Pos('E',OptArg) = 1 ) then begin
Include(AAppOptions,cloPrefixEnum);
OptionsArgsMAP[cloPrefixEnum] := OptArg;
end;
end;
'f' :
begin
Include(AAppOptions,cloFileRenaming);

View File

@ -95,24 +95,27 @@ type
implementation
uses StrUtils, rtti_filters;
const LANGAGE_TOKEN : array[0..108] of string = (
'ABSTRACT', 'AND', 'ARRAY', 'AS', 'ASM',
const LANGAGE_TOKEN : array[0..127] of string = (
'ABSOLUTE', 'ABSTRACT', 'AND', 'ARRAY', 'AS', 'ASM',
'BEGIN', 'BOOLEAN', 'BYTE',
'CASE', 'CDECL', 'CHAR', 'CLASS', 'COMP', 'CONST', 'CONSTRUCTOR', 'CONTAINS', 'CURRENCY',
'DEFAULT', 'DESTRUCTOR', 'DIV', 'DO', 'DOUBLE', 'DOWNTO', 'DYNAMIC',
'END', 'EXPORT', 'EXPORTS', 'EXTERNAL',
'FAR', 'FILE', 'FINALLY', 'FOR', 'FORWARD', 'FUNCTION', 'GOTO',
'ELSE', 'EXCEPT', 'EXTENDED',
'IF', 'IMPLEMENTATION', 'IMPLEMENTS', 'IN', 'INHERITED', 'INT64', 'INITIALIZATION',
'INTEGER', 'INTERFACE', 'IS',
'CASE', 'CDECL', 'CHAR', 'CLASS', 'COMP', 'CONST', 'CONSTRUCTOR', 'CONTAINS',
'CURRENCY', 'DEFAULT', 'DEPRECATED', 'DESTRUCTOR', 'DISPINTERFACE', 'DISPOSE', 'DIV', 'DO',
'DOUBLE', 'DOWNTO', 'DYNAMIC', 'END', 'EXCEPT', 'EXIT', 'EXPORT', 'EXPORTS',
'EXTERNAL', 'FALSE', 'FAR', 'FILE', 'FINALIZATION', 'FINALLY', 'FOR',
'FORWARD', 'FUNCTION', 'GOTO', 'ELSE', 'EXCEPT', 'EXTENDED',
'IF', 'IMPLEMENTATION', 'IMPLEMENTS', 'IN', 'INHERITED', 'INLINE', 'INT64',
'INITIALIZATION', 'INTEGER', 'INTERFACE', 'IS',
'LABEL', 'LIBRARY', 'LOCAL', 'LONGINT', 'LONGWORD',
'MOD', 'NEAR', 'NIL', 'NODEFAULT', 'NOT',
'OBJECT', 'OF', 'OLEVARIANT', 'OR', 'OUT', 'OVERLOAD', 'OVERRIDE',
'PACKAGE', 'PACKED', 'PASCAL', 'PCHAR', 'PRIVATE', 'PROCEDURE', 'PROGRAM', 'PUBLISHED',
'RAISE', 'READ', 'REAL', 'RECORD', 'REGISTER', 'REINTRODUCE', 'REPEAT', 'REQUIRES', 'RESULT',
'SAFECALL', 'SET', 'SHL', 'SHORTINT', 'SHR', 'SINGLE', 'SMALLINT', 'STDCALL', 'STORED', 'STRING',
'THEN', 'TO', 'TRY', 'TYPE', 'UNIT', 'UNTIL', 'USES',
'VAR', 'VARARGS', 'VARIANT', 'VIRTUAL', 'WHILE', 'WIDECHAR', 'WITH', 'WORD', 'WRITE', 'XOR'
'MOD', 'NEAR', 'NEW', 'NIL', 'NODEFAULT', 'NOT',
'OBJECT', 'OF', 'OLEVARIANT', 'ON', 'OPERATOR', 'OR', 'OUT', 'OVERLOAD',
'OVERRIDE','PACKAGE', 'PACKED', 'PASCAL', 'PCHAR', 'PRIVATE', 'PROCEDURE',
'PROGRAM', 'PROPERTY', 'PROTECTED', 'PUBLIC', 'PUBLISHED',
'RAISE', 'READ', 'REAL', 'RECORD', 'REGISTER', 'REINTRODUCE', 'REPEAT',
'REQUIRES', 'RESOURCESTRING', 'RESULT', 'SAFECALL', 'SELF', 'SET', 'SHL',
'SHORTINT', 'SHR', 'SINGLE', 'SMALLINT', 'STDCALL', 'STORED', 'STRING',
'THEN', 'THREADVAR', 'TO', 'TRUE', 'TRY', 'TYPE', 'UNIT', 'UNTIL', 'USES',
'VAR', 'VARARGS', 'VARIANT', 'VIRTUAL', 'WHILE', 'WIDECHAR', 'WITH', 'WORD',
'WRITE', 'XOR'
);
const WST_RESERVED_TOKEN : array[0..1] of string = ( 'Item', 'Item' );
function IsReservedKeyWord(const AValue : string):Boolean ;

View File

@ -4,8 +4,10 @@ resourcestring
' -u MODE Generate the pascal translation of the WSDL input file ' + sNEW_LINE +
' MODE value may be U for used types or A for all types' + sNEW_LINE +
' -g Code generation option, with the following options : ' + sNEW_LINE +
' A : object arrays are generated as "array" derived from TBaseObjectArrayRemotable' + sNEW_LINE +
' C : object arrays are generated as "collection" derived from TObjectCollectionRemotable' + sNEW_LINE +
' A : object arrays are generated as "array" derived from TBaseObjectArrayRemotable' + sNEW_LINE +
' C : object arrays are generated as "collection" derived from TObjectCollectionRemotable' + sNEW_LINE +
' EP : enum type''s items are prefixed with the enum name' + sNEW_LINE +
' EN : enum type''s items are not prefixed with the enum name, the default' + sNEW_LINE +
' -p Generate service proxy' + sNEW_LINE +
' -b Generate service binder' + sNEW_LINE +
' -i Generate service minimal implementation. This will erase any existing implementation file!' + sNEW_LINE +
@ -82,17 +84,29 @@ var
begin
ParseSource(symtable,inFileName,osParam,targetParam);
end;
function GetParserSimpleOptions( ) : TParserOptions;
begin
Result := [];
if ( cloPrefixEnum in AppOptions ) then begin
if ( Pos('P',GetOptionArg(cloPrefixEnum)) = 2 ) then
Result := Result + [poEnumAlwaysPrefix];
end;
end;
procedure ParseWsdlFile();
var
locDoc : TXMLDocument;
prsrW : IParser;
prsrCtx : IParserContext;
begin
ReadXMLFile(locDoc,inFileName);
{$IFNDEF WST_INTF_DOM}
try
{$ENDIF}
prsrW := TWsdlParser.Create(locDoc,symtable);// as IParser;
prsrCtx := prsrW as IParserContext;
prsrCtx.SetSimpleOptions(GetParserSimpleOptions());
prsrW.Execute(parserMode,ChangeFileExt(ExtractFileName(inFileName),''));
{$IFNDEF WST_INTF_DOM}
finally
@ -116,6 +130,7 @@ var
prsr := TXsdParser.Create(locDoc,symtable,ChangeFileExt(ExtractFileName(inFileName),'')) as IXsdPaser;
prsrCtx := prsr as IParserContext;
prsrCtx.SetDocumentLocator(TFileDocumentLocator.Create(ExtractFilePath(ExpandFileName(inFileName))));
prsrCtx.SetSimpleOptions(GetParserSimpleOptions());
prsr.ParseTypes();
{$IFNDEF WST_INTF_DOM}
finally

View File

@ -51,7 +51,7 @@ type
) : TPasElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
function FindElementWithHint(const AName, AHint : string; const ASpace : TSearchSpace) : TPasElement;
function ExtractTypeHint(AElement : TDOMNode) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure SetAsEmbeddedType(AType : TPasType);
procedure SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
function IsEmbeddedType(AType : TPasType) : Boolean;
{$IFDEF WST_HANDLE_DOC}
procedure ParseDocumentation(AType : TPasType);
@ -75,6 +75,7 @@ type
class function GetRegisteredParser(const AIndex : Integer):TAbstractTypeParserClass;
function Parse():TPasType;virtual;abstract;
property Module : TPasModule read GetModule;
property Context : IParserContext read FContext;
end;
TDerivationMode = ( dmNone, dmExtension, dmRestriction );
@ -310,7 +311,7 @@ begin
if ( ASpaceType = nvtExpandValue ) then begin
locNS := ANameSpace
end else begin
if not FContext.FindNameSpace(ANameSpace,locNS) then
if not Context.FindNameSpace(ANameSpace,locNS) then
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[ANameSpace]);
end;
Result := FSymbols.FindElementNS(ALocalName,locNS);
@ -318,7 +319,7 @@ end;
function TAbstractTypeParser.GetModule : TPasModule;
begin
Result := FContext.GetTargetModule();
Result := Context.GetTargetModule();
end;
function TAbstractTypeParser.FindElement(
@ -351,13 +352,19 @@ end;
function TAbstractTypeParser.ExtractTypeHint(AElement: TDOMNode): string;
begin
if not wst_findCustomAttributeXsd(FContext.GetXsShortNames(),AElement,s_WST_typeHint,Result) then
if not wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_typeHint,Result) then
Result := '';
end;
procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType);
procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType; const AValue : Boolean);
var
s : string;
begin
FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,'1');
if AValue then
s := '1'
else
s := '';
FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,s);
end;
function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean;
@ -377,14 +384,14 @@ begin
if FTypeNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(FTypeNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_annotation,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_annotation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if ( tmpCursor <> nil ) then begin
tmpCursor.Reset();
if tmpCursor.MoveNext() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(TDOMNodeRttiExposer(tmpCursor.GetCurrent()).InnerObject,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_documentation,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if ( tmpCursor <> nil ) then begin
tmpCursor.Reset();
@ -430,7 +437,7 @@ var
begin
locTmpCrs := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_all,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_all,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locTmpCrs.Reset();
if locTmpCrs.MoveNext() then begin
@ -439,7 +446,7 @@ var
if locTmpNode.HasChildNodes() then begin
locTmpCrs := CreateCursorOn(
CreateChildrenCursor(locTmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
Result := locTmpCrs;
end;
@ -454,7 +461,7 @@ var
ARes := nil;
tmpCursor := CreateCursorOn(
frstCrsr.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_sequence,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_sequence,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
Result := tmpCursor.MoveNext();
@ -464,12 +471,12 @@ var
if tmpNode.HasChildNodes() then begin
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_element,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
ARes := tmpCursor;
tmpCursor := CreateCursorOn(
CreateChildrenCursor(tmpNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_any,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_any,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
tmpCursor.Reset();
if tmpCursor.MoveNext() then
@ -494,13 +501,13 @@ begin
if parentNode.HasChildNodes() then begin;
AAttCursor := CreateCursorOn(
CreateChildrenCursor(parentNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
crs := CreateChildrenCursor(parentNode,cetRttiNode);
if ( crs <> nil ) then begin
crs := CreateCursorOn(
crs,
ParseFilter(CreateQualifiedNameFilterStr(s_anyAttribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_anyAttribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if ( crs <> nil ) then begin
crs.Reset();
@ -531,12 +538,12 @@ begin
e := ls.Item[k];
if ( Pos(':', e.NodeName) > 1 ) then begin
ExplodeQName(e.NodeName,localName,ns_short);
if FContext.FindNameSpace(ns_short, ns_long) then begin
if Context.FindNameSpace(ns_short, ns_long) then begin
locBuffer := e.NodeValue;
ExplodeQName(locBuffer,locBufferLocalName,locBufferNS);
if IsStrEmpty(locBufferNS) then
locBuffer := locBufferLocalName
else if FContext.FindNameSpace(locBufferNS, locBufferNS_long) then
else if Context.FindNameSpace(locBufferNS, locBufferNS_long) then
locBuffer := Format('%s#%s',[locBufferNS_long,locBufferLocalName]);
FSymbols.Properties.SetValue(AItem,Format('%s#%s',[ns_long,localName]),locBuffer);
end;
@ -596,7 +603,7 @@ begin
end;
crs := CreateCursorOn(
CreateChildrenCursor(FDerivationNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_attribute,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
ls := TStringList.Create();
try
@ -650,14 +657,14 @@ function TComplexTypeParser.IsHeaderBlock() : Boolean;
var
strBuffer : string;
begin
Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer));
Result := wst_findCustomAttributeXsd(Context.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));
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
procedure TComplexTypeParser.CreateNodeCursors();
@ -692,7 +699,7 @@ begin
if Assigned(FChildCursor) then begin
locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_complexContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
if Assigned(locCrs) then begin
locCrs.Reset();
@ -702,7 +709,7 @@ begin
end else begin
locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_simpleContent,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_simpleContent,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
@ -725,7 +732,7 @@ var
locBaseTypeLocalSpace, locBaseTypeLocalName, locBaseTypeInternalName, locFilterStr : string;
locBaseTypeLocalSpaceExpanded : string;
begin
locFilterStr := CreateQualifiedNameFilterStr(s_extension,FContext.GetXsShortNames());
locFilterStr := CreateQualifiedNameFilterStr(s_extension,Context.GetXsShortNames());
locContentChildCrs := CreateChildrenCursor(FContentNode,cetRttiNode);
locCrs := CreateCursorOn(
locContentChildCrs.Clone() as IObjectCursor,
@ -736,7 +743,7 @@ begin
FDerivationMode := dmExtension;
FDerivationNode := (locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject;
end else begin
locFilterStr := CreateQualifiedNameFilterStr(s_restriction,FContext.GetXsShortNames());
locFilterStr := CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames());
locCrs := CreateCursorOn(
locContentChildCrs.Clone() as IObjectCursor,
ParseFilter(locFilterStr,TDOMNodeRttiExposer)
@ -779,7 +786,7 @@ begin
end else begin
if ( FDerivationMode = dmRestriction ) and
( locBaseTypeLocalName = 'Array' ) and
( FContext.FindNameSpace(locBaseTypeLocalSpace,locBaseTypeLocalSpaceExpanded) and
( Context.FindNameSpace(locBaseTypeLocalSpace,locBaseTypeLocalSpaceExpanded) and
( locBaseTypeLocalSpaceExpanded = s_soapEncodingNameSpace )
)
then begin
@ -808,7 +815,7 @@ var
var
strBuffer : string;
begin
Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer));
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
procedure ParseElement(AElement : TDOMNode);
@ -856,7 +863,7 @@ var
locTypeHint := ExtractTypeHint(AElement);
end else begin
locTypeName := Format('%s_%s_Type',[FTypeName,locName]);
locType := TAbstractTypeParser.ExtractEmbeddedTypeFromElement(FContext,AElement,FSymbols,locTypeName);
locType := TAbstractTypeParser.ExtractEmbeddedTypeFromElement(Context,AElement,FSymbols,locTypeName);
if ( locType = nil ) then begin
raise EXsdInvalidElementDefinitionException.CreateFmt('Invalid <element> definition : unable to determine the type.'#13'Type name : "%s"; Element name :"%s".',[FTypeName,locName]);
end;
@ -979,7 +986,7 @@ var
var
strBuffer : string;
begin
Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer));
Result := wst_findCustomAttributeXsd(Context.GetXsShortNames(),FTypeNode,s_WST_record,strBuffer) and AnsiSameText('true',Trim(strBuffer));
end;
procedure ParseElementsAndAttributes(AEltCrs, AEltAttCrs : IObjectCursor);
@ -1213,7 +1220,7 @@ function TComplexTypeParser.ParseSimpleContent(const ATypeName : string) : TPasT
Result := nil;
parentNode := FContentNode;
if parentNode.HasChildNodes() then begin;
xsShortNameList := FContext.GetXsShortNames();
xsShortNameList := Context.GetXsShortNames();
frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode);
locFilterStr := CreateQualifiedNameFilterStr(s_extension,xsShortNameList) + ' or ' +
CreateQualifiedNameFilterStr(s_restriction,xsShortNameList) ;
@ -1407,6 +1414,10 @@ begin
else
Result := ParseSimpleContent(FTypeName);
end;
if ( Result <> nil ) then begin
if ( IsEmbeddedType(Result) <> FEmbededDef ) then
SetAsEmbeddedType(Result,FEmbededDef);
end;
{$IFDEF WST_HANDLE_DOC}
if ( Result <> nil ) then
ParseDocumentation(Result);
@ -1448,7 +1459,7 @@ var
begin
locCrs := CreateCursorOn(
FChildCursor.Clone() as IObjectCursor,
ParseFilter(CreateQualifiedNameFilterStr(s_restriction,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_restriction,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
@ -1466,14 +1477,14 @@ begin
FBaseNameSpace := '';
if Assigned(tmpNode) then begin
ExplodeQName(tmpNode.NodeValue,FBaseName,spaceShort);
if not FContext.FindNameSpace(spaceShort,FBaseNameSpace) then
if not Context.FindNameSpace(spaceShort,FBaseNameSpace) then
raise EXsdParserAssertException.CreateFmt(SERR_CannotResolveNamespace,[spaceShort]);
end;
locCrs := CreateChildrenCursor(FRestrictionNode,cetRttiNode) as IObjectCursor;
if Assigned(locCrs) then begin
locCrs := CreateCursorOn(
locCrs,
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
locCrs.Reset();
if locCrs.MoveNext() then begin
@ -1501,13 +1512,14 @@ function TSimpleTypeParser.ParseEnumContent(): TPasType;
begin
Result := CreateCursorOn(
CreateChildrenCursor(FRestrictionNode,cetRttiNode),
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,FContext.GetXsShortNames()),TDOMNodeRttiExposer)
ParseFilter(CreateQualifiedNameFilterStr(s_enumeration,Context.GetXsShortNames()),TDOMNodeRttiExposer)
);
end;
var
locRes : TPasEnumType;
locOrder : Integer;
prefixItems : Boolean;
procedure ParseEnumItem(AItemNode : TDOMNode);
var
@ -1533,7 +1545,8 @@ var
locInternalItemName := ExtractIdentifier(locItemName);
if IsStrEmpty(locInternalItemName) then
locInternalItemName := 'EmptyItem';
locHasInternalName := IsReservedKeyWord(locInternalItemName) or
locHasInternalName := prefixItems or
IsReservedKeyWord(locInternalItemName) or
( not IsValidIdent(locInternalItemName) ) or
( FSymbols.FindElementInModule(locInternalItemName,Self.Module) <> nil ) or
FSymbols.IsEnumItemNameUsed(locInternalItemName,Self.Module) or
@ -1559,6 +1572,7 @@ var
intrName : string;
hasIntrnName : Boolean;
begin
prefixItems := ( poEnumAlwaysPrefix in Context.GetSimpleOptions() );
locEnumCrs := ExtractEnumCursor();
intrName := FTypeName;

View File

@ -59,6 +59,7 @@ type
FTypesCursor : IObjectCursor;
FSchemaCursor : IObjectCursor;
FOnMessage: TOnParserMessage;
FSimpleOptions : TParserOptions;
private
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
function AddNameSpace(const AValue : string) : TStrings;
@ -93,6 +94,8 @@ type
function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions);
public
constructor Create(
ADoc : TXMLDocument;
@ -299,6 +302,17 @@ begin
FDocumentLocator := ALocator;
end;
function TWsdlParser.GetSimpleOptions(): TParserOptions;
begin
Result := FSimpleOptions;
end;
procedure TWsdlParser.SetSimpleOptions(const AValue: TParserOptions);
begin
if ( AValue <> FSimpleOptions ) then
FSimpleOptions := AValue;
end;
function TWsdlParser.GetTargetNameSpace() : string;
begin
Result := FTargetNameSpace;
@ -819,6 +833,7 @@ begin
locMthd := nil;
if not ExtractOperationName(mthdName) then
raise EXsdParserAssertException.CreateFmt('Operation Attribute not found : "%s"',[s_name]);
DoOnMessage(mtInfo,Format('Parsing operation "%s"',[mthdName]));
if SameText(s_document,ASoapBindingStyle) then begin
ExtractMethod(mthdName,locMthd);
if ( locMthd <> nil ) then begin
@ -1151,6 +1166,7 @@ begin
ansiStrBuffer := locObj.NodeValue;
elt := SymbolTable.FindElementInModule(ansiStrBuffer,SymbolTable.CurrentModule);
if ( elt = nil ) then begin
DoOnMessage(mtInfo,Format('Parsing the port type "%s"',[ansiStrBuffer]));
locIntf := TPasClassType(SymbolTable.CreateElement(TPasClassType,ansiStrBuffer,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
FModule.InterfaceSection.Declarations.Add(locIntf);
FModule.InterfaceSection.Types.Add(locIntf);
@ -1276,6 +1292,7 @@ procedure TWsdlParser.Prepare(const AModuleName: string);
locPrs.SetNotifier(FOnMessage);
locPrsCtx := locPrs as IParserContext;
locPrsCtx.SetDocumentLocator(locDocLocator);
locPrsCtx.SetSimpleOptions(Self.GetSimpleOptions());
ns := (locPrs as IParserContext).GetTargetNameSpace();
FXsdParsers.AddObject(ns,TIntfObjectRef.Create(locPrs));
end;

View File

@ -50,6 +50,10 @@ type
) : Boolean;
end;
TParserOption = (
poEnumAlwaysPrefix // Always prefix enum item with the enum name
);
TParserOptions = set of TParserOption;
IParserContext = interface
['{F400BA9E-41AC-456C-ABF9-CEAA75313685}']
function GetXsShortNames() : TStrings;
@ -60,6 +64,8 @@ type
function GetTargetModule() : TPasModule;
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions);
end;
IXsdPaser = interface
@ -93,6 +99,7 @@ type
FChildCursor : IObjectCursor;
FOnMessage: TOnParserMessage;
FDocumentLocator : IDocumentLocator;
FSimpleOptions : TParserOptions;
FImportParsed : Boolean;
private
procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
@ -109,6 +116,8 @@ type
function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(const ALocator : IDocumentLocator);
function GetSimpleOptions() : TParserOptions;
procedure SetSimpleOptions(const AValue : TParserOptions);
procedure SetNotifier(ANotifier : TOnParserMessage);
function InternalParseType(
@ -363,6 +372,17 @@ begin
FDocumentLocator := ALocator;
end;
function TCustomXsdSchemaParser.GetSimpleOptions(): TParserOptions;
begin
Result := FSimpleOptions;
end;
procedure TCustomXsdSchemaParser.SetSimpleOptions(const AValue: TParserOptions);
begin
if ( AValue <> FSimpleOptions ) then
FSimpleOptions := AValue;
end;
procedure TCustomXsdSchemaParser.SetNotifier(ANotifier: TOnParserMessage);
begin
FOnMessage := ANotifier;