ws_helper code generation : "-gSS" (resp. "-gSU") to map XSD' "string" to Object Pascal "String" (resp. "UnicodeString").

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

wst/trunk/ws_helper/command_line_parser.pas

@@ -24,7 +24,8 @@ Type
     cloInterface, cloProxy, cloImp, cloBinder, cloWsdl, cloXsd,
     cloOutPutDirRelative, cloOutPutDirAbsolute, cloHandleWrappedParameters,
     cloGenerateDocAsComments, cloGenerateObjectCollection,
-    cloFileRenaming, cloPrefixEnum, cloParserCaseSensitive
+    cloFileRenaming, cloPrefixEnum, cloParserCaseSensitive,
+    cloStringMaping
   );
   TComandLineOptions = set of TComandLineOption;
 
@@ -81,6 +82,9 @@ begin
           end else if ( Pos('E',OptArg) = 1 ) then begin
             Include(AAppOptions,cloPrefixEnum);
             OptionsArgsMAP[cloPrefixEnum] := OptArg;
+          end else if ( Pos('S',OptArg) = 1 ) then begin
+            Include(AAppOptions,cloStringMaping);
+            OptionsArgsMAP[cloStringMaping] := OptArg;
           end;
         end;
       'f' :

wst/trunk/ws_helper/pascal_parser_intf.pas

@@ -60,6 +60,8 @@ type
   TElementNameKinds = set of TElementNameKind;
 
   TBindingStyle = ( bsDocument, bsRPC, bsUnknown );
+
+  TXSDStringMaping = (xsmUnicodeString, xsmString);
   
 const
   BindingStyleNames : array[TBindingStyle] of string = ( 'Document', 'RPC', 'Unknown' );
@@ -120,6 +122,7 @@ type
     FProperties : TPropertyHolder;
     FCaseSensitive : Boolean;
     FDefaultSearchNameKinds: TElementNameKinds;
+    FXsdStringMaping: TXSDStringMaping;
   private
     function GetBinding(AIndex : Integer): TwstBinding;
     function GetBindingCount: Integer;
@@ -192,6 +195,7 @@ type
         read FDefaultSearchNameKinds
        write FDefaultSearchNameKinds
      default NAME_KINDS_DEFAULT;
+    property XsdStringMaping : TXSDStringMaping read FXsdStringMaping write FXsdStringMaping;
   end;
 
   TPasNativeModule = class(TPasModule)
@@ -253,7 +257,6 @@ type
   ) : TPasType;
   function MakeInternalSymbolNameFrom(const AName : string) : string ;
 
-
   function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
   procedure CreateDefaultBindingForIntf(ATree : TwstPasTreeContainer);
   
@@ -297,8 +300,9 @@ const
      );
 
 procedure AddSystemSymbol(
-  ADest : TPasModule;
-  AContainer : TwstPasTreeContainer
+  ADest      : TPasModule;
+  AContainer : TwstPasTreeContainer;
+  AXsdString : TXSDStringMaping
 );
 
   procedure RegisterSpecialSimpleTypes();
@@ -308,13 +312,34 @@ procedure AddSystemSymbol(
     syb : TPasNativeSpecialSimpleContentClassType;
     s : string;
     typlst : array[0..Pred(SPECIAL_SIMPLE_TYPES_COUNT)] of TPasNativeSpecialSimpleType;
+    typeOrders : array[0..Pred(SPECIAL_SIMPLE_TYPES_COUNT)] of Byte;
+    typeNameArray : array[0..Pred(SPECIAL_SIMPLE_TYPES_COUNT)] of array[0..2] of string;
   begin
-    for i := Low(SPECIAL_SIMPLE_TYPES) to High(SPECIAL_SIMPLE_TYPES) do begin
-      splTyp := TPasNativeSpecialSimpleType(AContainer.CreateElement(TPasNativeSpecialSimpleType,SPECIAL_SIMPLE_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0));
+    typeOrders[0] := 0;
+    i := 1;
+{$IFDEF WST_UNICODESTRING}
+    if (AXsdString = xsmString) then begin
+      typeOrders[1] := 2;
+      typeOrders[2] := 1;
+    end else begin
+      typeOrders[1] := 1;
+      typeOrders[2] := 2;
+    end;
+    i := 3;
+{$ENDIF WST_UNICODESTRING}
+    for i := i to High(typeOrders) do
+      typeOrders[i] := i;
+    for i := Low(typeOrders) to High(typeOrders) do begin
+      typeNameArray[i][0] := SPECIAL_SIMPLE_TYPES[typeOrders[i]][0];
+      typeNameArray[i][1] := SPECIAL_SIMPLE_TYPES[typeOrders[i]][1];
+      typeNameArray[i][2] := SPECIAL_SIMPLE_TYPES[typeOrders[i]][2];
+    end;
+    for i := Low(typeNameArray) to High(typeNameArray) do begin
+      splTyp := TPasNativeSpecialSimpleType(AContainer.CreateElement(TPasNativeSpecialSimpleType,typeNameArray[i][0],ADest.InterfaceSection,visPublic,'',0));
       ADest.InterfaceSection.Declarations.Add(splTyp);
       ADest.InterfaceSection.Types.Add(splTyp);
       typlst[i] := splTyp;
-      s := SPECIAL_SIMPLE_TYPES[i][1];
+      s := typeNameArray[i][1];
       if not IsStrEmpty(s) then begin
         syb := AContainer.FindElementInModule(s,ADest) as TPasNativeSpecialSimpleContentClassType;
         if not Assigned(syb) then begin
@@ -325,12 +350,12 @@ procedure AddSystemSymbol(
         splTyp.SetExtendableType(syb);
       end;
     end;
-    for i := Low(SPECIAL_SIMPLE_TYPES) to High(SPECIAL_SIMPLE_TYPES) do begin
+    for i := Low(typeNameArray) to High(typeNameArray) do begin
       splTyp := typlst[i];
-      if not IsStrEmpty(SPECIAL_SIMPLE_TYPES[i][2]) then begin
-        AContainer.RegisterExternalAlias(splTyp,SPECIAL_SIMPLE_TYPES[i][2]);
+      if not IsStrEmpty(typeNameArray[i][2]) then begin
+        AContainer.RegisterExternalAlias(splTyp,typeNameArray[i][2]);
         if ( splTyp.ExtendableType <> nil ) then begin
-          AContainer.RegisterExternalAlias(splTyp.ExtendableType,SPECIAL_SIMPLE_TYPES[i][2]);
+          AContainer.RegisterExternalAlias(splTyp.ExtendableType,typeNameArray[i][2]);
         end;
       end;
     end;
@@ -415,6 +440,7 @@ begin
 end;
 
 function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule;
+
   function AddClassDef(
           ATable      : TPasModule;
     const AClassName,
@@ -463,7 +489,7 @@ begin
       AContainer.Package.Modules.Add(Result);
       AContainer.RegisterExternalAlias(Result,sXSD_NS);
       Result.InterfaceSection := TInterfaceSection(AContainer.CreateElement(TInterfaceSection,'',Result,visDefault,'',0));
-      AddSystemSymbol(Result,AContainer);
+      AddSystemSymbol(Result,AContainer,AContainer.XsdStringMaping);
       AddClassDef(Result,'TBaseRemotable','',TPasNativeClassType);
         AContainer.RegisterExternalAlias(AddClassDef(Result,'anyType_Type','TBaseRemotable',TPasNativeClassType),'anyType');
         AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable',TPasNativeClassType);

wst/trunk/ws_helper/ws_helper_prog.inc

@@ -19,6 +19,8 @@ resourcestring
            '        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 +
+           '        SS : XSD''string type is mapped to Object Pascal'' String' + sNEW_LINE +
+           '        SU : XSD''string type is mapped to Object Pascal'' UnicodeString' + 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 +
@@ -368,6 +370,8 @@ var
     raise Exception.Create(AMsg);
   end;
 
+var
+  tmpString : string;
 begin
 {$IFDEF FPC}
   {$IF Declared(SetHeapTraceOutput) }
@@ -393,6 +397,16 @@ begin
       end;
       symtable := TwstPasTreeContainer.Create();
       symtable.CaseSensitive := cloParserCaseSensitive in AppOptions;
+      if (cloStringMaping in AppOptions) then begin
+        tmpString := Trim(GetOptionArg(cloStringMaping));
+        tmpString := UpperCase(Copy(tmpString,2,Length(tmpString)));
+        if (tmpString = 'S') then
+          symtable.XsdStringMaping := xsmString
+        else if (tmpString = 'U') then
+          symtable.XsdStringMaping := xsmUnicodeString
+        else
+          Error('Invalid argument for "-gS" option: "' + tmpString + '".');
+      end;
       srcMngr := CreateSourceManager();
 
       if not GenerateSymbolTable() then begin