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

Be case insensitive while parsing Pascal Code, log warning on XDS generation, fix AV (TPasUnresolvedTypeRef handling)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3823 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2014-12-04 13:11:07 +00:00
parent 49b8618253
commit 00128bbf70
7 changed files with 104 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
wst/trunk/type_lib_edtr/typ_lib_edtr.lpi
View File

@ -123,6 +123,7 @@
<Filename Value="uprocedit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="fProcEdit"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uprocedit"/>
</Unit13>
@ -135,6 +136,7 @@
<Filename Value="uargedit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="fArgEdit"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uargedit"/>
</Unit15>
@ -164,6 +166,7 @@
<Filename Value="ufarrayedit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="fArrayEdit"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ufarrayedit"/>
</Unit19>
@ -171,6 +174,7 @@
<Filename Value="uftypealiasedit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="fTypeAliasEdit"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uftypealiasedit"/>
</Unit20>
@ -178,6 +182,7 @@
<Filename Value="ufrecordedit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="fRecordEdit"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ufrecordedit"/>
</Unit21>

2
wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm
View File

@ -12,7 +12,7 @@ object fWstTypeLibraryEdit: TfWstTypeLibraryEdit
OnDropFiles = FormDropFiles
OnShow = FormShow
Position = poDesktopCenter
LCLVersion = '1.2.2.0'
LCLVersion = '1.2.5.0'
object SB: TStatusBar
Left = 0
Height = 20

19
wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas
View File

@ -306,6 +306,7 @@ begin
end;
Result := TwstPasTreeContainer.Create();
try
Result.CaseSensitive := False; // Pascal is Case Insensitive !
DoNotify(mtInfo,Format('Parsing file %s ...',[AFileName]));
CreateWstInterfaceSymbolTable(Result);
ParseSource(Result,AFileName,s_ostype,'');
@ -535,7 +536,8 @@ end;
procedure GenerateWSDL_ToStream(
ASymbol : TwstPasTreeContainer;
ADest : TStream;
const ADestPath : string
const ADestPath : string;
const ANotifier : TOnParserMessage
);
var
g : IGenerator;
@ -547,6 +549,8 @@ begin
g := TWsdlGenerator.Create(doc);
locLocator := TFileDocumentLocator.Create(IncludeTrailingPathDelimiter(ADestPath));
g.SetDocumentLocator(locLocator);
if Assigned(ANotifier) then
g.SetNotificationHandler(ANotifier);
g.Execute(ASymbol,ASymbol.CurrentModule.Name);
WriteXML(doc,ADest);
finally
@ -557,7 +561,8 @@ end;
procedure GenerateXSD_ToStream(
ASymbol : TwstPasTreeContainer;
ADest : TStream;
const ADestPath : string
const ADestPath : string;
const ANotifier : TOnParserMessage
);
var
g : IGenerator;
@ -569,6 +574,8 @@ begin
g := TXsdGenerator.Create(doc);
locLocator := TFileDocumentLocator.Create(IncludeLeadingPathDelimiter(ADestPath));
g.SetDocumentLocator(locLocator);
if Assigned(ANotifier) then
g.SetNotificationHandler(ANotifier);
g.Execute(ASymbol,ASymbol.CurrentModule.Name);
WriteXML(doc,ADest);
finally
@ -1234,7 +1241,9 @@ var
begin
mstrm := TMemoryStream.Create();
try
GenerateWSDL_ToStream(FSymbolTable,mstrm,ExtractFilePath(FCurrentFileName));
GenerateWSDL_ToStream(
FSymbolTable,mstrm,ExtractFilePath(FCurrentFileName),@ShowStatusMessage
);
mstrm.Position := 0;
srcWSDL.Lines.LoadFromStream(mstrm);
finally
@ -1380,9 +1389,9 @@ begin
mstrm := TMemoryStream.Create();
try
if SameText('.xsd',ExtractFileExt(AFileName)) then
GenerateXSD_ToStream(FSymbolTable,mstrm,ExtractFilePath(FCurrentFileName))
GenerateXSD_ToStream(FSymbolTable,mstrm,ExtractFilePath(FCurrentFileName),@ShowStatusMessage)
else
GenerateWSDL_ToStream(FSymbolTable,mstrm,ExtractFilePath(FCurrentFileName));
GenerateWSDL_ToStream(FSymbolTable,mstrm,ExtractFilePath(FCurrentFileName),@ShowStatusMessage);
mstrm.SaveToFile(AFileName);
finally
FreeAndNil(mstrm);

8
wst/trunk/ws_helper/logger_intf.pas
View File

@ -20,13 +20,17 @@ uses
type
TMessageType = ( mtInfo, mtError );
TMessageType = ( mtInfo, mtWarning, mtError );
const
MessageTypeNames : array[TMessageType] of string = ( 'Information', 'Error' );
MessageTypeNames : array[TMessageType] of string = (
'Information', 'Warning', 'Error'
);
type
TOnLogMessageEvent = procedure (const AMsgType : TMessageType; const AMsg : string) of object;
ILogger = interface
['{158C90B5-BAC3-40A1-B471-C9327692A3BF}']
procedure Log(const AMsgType : TMessageType; const AMsg : string);overload;

17
wst/trunk/ws_helper/wsdl_generator.pas
View File

@ -18,7 +18,7 @@ interface
uses
Classes, SysUtils, TypInfo,
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF},
pastree, pascal_parser_intf, xsd_generator, locators;
pastree, pascal_parser_intf, xsd_generator, locators, logger_intf;
type
@ -43,6 +43,7 @@ type
FTypesNode : TDOMElement;
FDefinitionsNode : TDOMElement;
FDocumentLocator : IDocumentLocator;
FMessageHandler : TOnLogMessageEvent;
private
procedure GenerateTypes(ASymTable : TwstPasTreeContainer; AModule : TPasModule);
procedure GenerateServiceMessages(
@ -70,6 +71,8 @@ type
ARootNode : TDOMElement
);
protected
function GetNotificationHandler() : TOnLogMessageEvent;
procedure SetNotificationHandler(const AValue : TOnLogMessageEvent);
procedure Prepare(ASymTable : TwstPasTreeContainer; AModule : TPasModule);
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(ALocator : IDocumentLocator);
@ -174,6 +177,8 @@ begin
locLocator := GetDocumentLocator();
if (locLocator <> nil) then
g.SetDocumentLocator(locLocator);
if not Assigned(g.GetNotificationHandler()) then
g.SetNotificationHandler(Self.GetNotificationHandler());
for i := 0 to Pred(mdlLs.Count) do begin
mdl := TPasModule(mdlLs[i]);
if (mdl <> AModule) then begin
@ -448,6 +453,16 @@ begin
soapAdrNode.SetAttribute(s_location,ABinding.Address);
end;
function TWsdlGenerator.GetNotificationHandler: TOnLogMessageEvent;
begin
Result := FMessageHandler;
end;
procedure TWsdlGenerator.SetNotificationHandler(const AValue: TOnLogMessageEvent);
begin
FMessageHandler := AValue;
end;
procedure TWsdlGenerator.Prepare(ASymTable : TwstPasTreeContainer; AModule : TPasModule);
function CreateRootNode():TDOMElement;

66
wst/trunk/ws_helper/xsd_generator.pas
View File

@ -18,7 +18,7 @@ interface
uses
Classes, SysUtils, TypInfo,
{$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM, wst_fpc_xml{$ENDIF},
pastree, pascal_parser_intf, locators;
pastree, pascal_parser_intf, locators, logger_intf;
type
@ -37,6 +37,8 @@ type
);
function GetDocumentLocator() : IDocumentLocator;
procedure SetDocumentLocator(ALocator : IDocumentLocator);
function GetNotificationHandler() : TOnLogMessageEvent;
procedure SetNotificationHandler(const AValue : TOnLogMessageEvent);
end;
IXsdGenerator = interface(IGenerator)
@ -91,11 +93,13 @@ type
FOptions: TGeneratorOptions;
FShortNames : TStrings;
FDocumentLocator : IDocumentLocator;
FMessageHandler : TOnLogMessageEvent;
protected
procedure GenerateImports(
ASymTable : TwstPasTreeContainer;
AModule : TPasModule
);
procedure NotifyMessage(const AMsgType : TMessageType; const AMsg : string);
protected
function GetSchemaNode(ADocument : TDOMDocument) : TDOMNode;virtual;abstract;
procedure SetPreferedShortNames(const ALongName, AShortName : string);
@ -106,6 +110,8 @@ type
ASymTable : TwstPasTreeContainer;
AModuleName : string
);
function GetNotificationHandler() : TOnLogMessageEvent;
procedure SetNotificationHandler(const AValue : TOnLogMessageEvent);
procedure Prepare(
ASymTable : TwstPasTreeContainer;
@ -139,6 +145,7 @@ type
FOwner : Pointer;
FRegistry : IXsdTypeHandlerRegistry;
protected
procedure NotifyMessage(const AMsgType : TMessageType; const AMsg : string);
procedure Generate(
AContainer : TwstPasTreeContainer;
const ASymbol : TPasElement;
@ -166,6 +173,9 @@ type
function GetXsdTypeHandlerRegistry():IXsdTypeHandlerRegistry;
function CreateElement(const ANodeName : DOMString; AParent : TDOMNode; ADoc : TDOMDocument):TDOMElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
resourcestring
SERR_SimpleTypeCannotHaveNotAttributeProp = 'Invalid type definition, a simple type cannot have "not attribute" properties : "%s.%s". Correction to Attribute done.';
implementation
uses
xsd_consts, Contnrs, StrUtils, wst_types, parserutils;
@ -644,6 +654,18 @@ end;
{ TBaseTypeHandler }
procedure TBaseTypeHandler.NotifyMessage(
const AMsgType : TMessageType;
const AMsg : string
);
var
locEventHandler : TOnLogMessageEvent;
begin
locEventHandler := GetOwner().GetNotificationHandler();
if Assigned(locEventHandler) then
locEventHandler(AMsgType,AMsg);
end;
function TBaseTypeHandler.GetOwner(): IXsdGenerator;
begin
Result := IXsdGenerator(FOwner);
@ -760,8 +782,11 @@ begin
{$ENDIF WST_HANDLE_DOC}
trueDestType := typItm.DestType;
if trueDestType.InheritsFrom(TPasUnresolvedTypeRef) then
if trueDestType.InheritsFrom(TPasUnresolvedTypeRef) then begin
trueDestType := AContainer.FindElement(AContainer.GetExternalName(typItm.DestType)) as TPasType;
if (trueDestType = nil) then
trueDestType := typItm.DestType;
end;
baseUnitExternalName := GetTypeNameSpace(AContainer,trueDestType);
s := GetNameSpaceShortName(baseUnitExternalName,defSchemaNode,GetOwner().GetPreferedShortNames());
s := Format('%s:%s',[s,AContainer.GetExternalName(trueDestType)]);
@ -857,9 +882,16 @@ procedure TClassTypeDefinition_TypeHandler.Generate(
p := TPasProperty(AClassType.Members[k]);
if not AContainer.IsAttributeProperty(p) then begin
if ( ACategory = tcSimpleContent ) then begin
raise EXsdGeneratorException.CreateFmt('Invalid type definition, a simple type cannot have "not attribute" properties : "%s"',[AContainer.GetExternalName(AClassType)]);
AContainer.SetPropertyAsAttribute(p,True);
NotifyMessage(
mtWarning,
Format(
SERR_SimpleTypeCannotHaveNotAttributeProp,
[AContainer.GetExternalName(AClassType),AContainer.GetExternalName(p)])
);
end else begin;
Result := True;
end;
Result := True;
end;
end;
end;
@ -970,7 +1002,8 @@ var
begin
p := AProp;
if AnsiSameText(sWST_PROP_STORE_PREFIX,Copy(p.StoredAccessorName,1,Length(sWST_PROP_STORE_PREFIX))) or
AnsiSameText('True',p.StoredAccessorName)
AnsiSameText('True',p.StoredAccessorName) or
(p.StoredAccessorName = '')
then begin
if AContainer.IsAttributeProperty(p) then begin
s := Format('%s:%s',[s_xs_short,s_attribute]);
@ -1371,6 +1404,16 @@ begin
end;
end;
function TCustomXsdGenerator.GetNotificationHandler: TOnLogMessageEvent;
begin
Result := FMessageHandler;
end;
procedure TCustomXsdGenerator.SetNotificationHandler(const AValue: TOnLogMessageEvent);
begin
FMessageHandler := AValue;
end;
procedure TCustomXsdGenerator.Prepare(ASymTable : TwstPasTreeContainer; AModule : TPasModule);
begin
@ -1440,6 +1483,19 @@ begin
end;
end;
procedure TCustomXsdGenerator.NotifyMessage(
const AMsgType : TMessageType;
const AMsg : string
);
begin
if Assigned(FMessageHandler) then begin
FMessageHandler(AMsgType,AMsg);
end else if IsConsole then begin
if HasLogger() then
GetLogger().Log(AMsgType, AMsg);
end;
end;
procedure TCustomXsdGenerator.SetPreferedShortNames(const ALongName, AShortName: string);
begin
FShortNames.Values[ALongName] := AShortName;

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

@ -40,7 +40,7 @@ type
EXsdInvalidElementDefinitionException = class(EXsdInvalidDefinitionException)
end;
TOnParserMessage = procedure (const AMsgType : TMessageType; const AMsg : string) of object;
TOnParserMessage = TOnLogMessageEvent;
IDocumentLocator = locators.IDocumentLocator;