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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3823 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/type_lib_edtr/typ_lib_edtr.lpi

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

wst/trunk/type_lib_edtr/uwsttypelibraryedit.lfm

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

wst/trunk/type_lib_edtr/uwsttypelibraryedit.pas

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

wst/trunk/ws_helper/logger_intf.pas

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

wst/trunk/ws_helper/wsdl_generator.pas

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

wst/trunk/ws_helper/xsd_generator.pas

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

wst/trunk/ws_helper/xsd_parser.pas

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