webidl: fixed cloning pasnames of args

packages/fcl-base/src/pascodegen.pp

@@ -65,8 +65,8 @@ Type
     Procedure CreateUnitClause; virtual;
     Procedure Indent;
     Procedure Undent;
-    Function IsKeyWord (Const S : String) : Boolean;
-    Function EscapeKeyWord(Const S : String; ForceAmpersand : Boolean = false) : String;
+    Function IsKeyWord (Const S : String) : Boolean; virtual;
+    Function EscapeKeyWord(Const S : String; ForceAmpersand : Boolean = false) : String; virtual;
     Function MakePascalString(S: String; AddQuotes: Boolean=False): String;
     Function PrettyPrint(Const S: string): String;
     Procedure AddLn(Const Aline: string);

packages/webidl/src/webidltopas.pp

@@ -93,7 +93,7 @@ type
     // Auxiliary routines
     procedure GetOptions(L: TStrings; Full: boolean); virtual;
     procedure ProcessDefinitions; virtual;
-    function CreatePasName(aName: String; D: TIDLBaseObject): TPasData; virtual;
+    function CreatePasName(aName: String; D: TIDLBaseObject; Escape: boolean): TPasData; virtual;
     procedure AllocatePasNames(aList: TIDLDefinitionList; ParentName: String=''); virtual;
     function AllocatePasName(D: TIDLDefinition; ParentName: String=''): TPasData; virtual;
     procedure AddJSIdentifier(D: TIDLDefinition); virtual;
@@ -114,10 +114,11 @@ type
     function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String; virtual;
     function GetDictionaryDefHead(const CurClassName: string; Dict: TIDLDictionaryDefinition): String; virtual;
     function CheckUnionTypeDefinition(D: TIDLDefinition): TIDLUnionTypeDefDefinition; virtual;
-    procedure AddArgumentToOverloads(aList: TFPObjectlist; AName, ATypeName: String; PosEl: TIDLBaseObject); overload; virtual;
+    Function CloneArgument(Arg: TIDLArgumentDefinition): TIDLArgumentDefinition; virtual;
+    procedure AddArgumentToOverloads(aList: TFPObjectlist; aName, aPasName, aTypeName: String; PosEl: TIDLBaseObject); overload; virtual;
     procedure AddArgumentToOverloads(aList: TFPObjectlist; aDef: TIDLArgumentDefinition); overload; virtual;
-    procedure AddUnionOverloads(aList: TFPObjectlist; AName: String;  UT: TIDLUnionTypeDefDefinition); virtual;
-    procedure AddOverloads(aList: TFPObjectlist; adef: TIDLFunctionDefinition; aIdx: Integer); virtual;
+    procedure AddUnionOverloads(aList: TFPObjectlist; aName, aPasName: String;  UT: TIDLUnionTypeDefDefinition); virtual;
+    procedure AddOverloads(aList: TFPObjectlist; aDef: TIDLFunctionDefinition; aIdx: Integer); virtual;
     function CloneNonPartialArgumentList(aList: TFPObjectlist; ADest: TFPObjectlist= Nil; AsPartial: Boolean=True): integer; virtual;
     function GetOverloads(aDef: TIDLFunctionDefinition): TFPObjectlist; virtual;
     function GetArguments(aList: TIDLDefinitionList; ForceBrackets: Boolean): String; virtual;
@@ -167,6 +168,7 @@ type
     destructor Destroy; override;
     procedure Execute; virtual;
     procedure WriteOptions; virtual;
+    function IsKeyWord(const S: String): Boolean; override;
   Public
     Property InputFileName: String Read FInputFileName Write FInputFileName;
     Property OutputFileName: String Read FOutputFileName Write FOutputFileName;
@@ -505,7 +507,7 @@ begin
     FAutoTypes.Add(TN);
     DoLog('Automatically adding %s sequence definition for %s.',[TN,GetDefPos(ST)]);
     AddLn('%s = Array of %s;',[TN,GetTypeName(ST.ElementType)]);
-    ST.Data:=CreatePasName(TN,ST);
+    ST.Data:=CreatePasName(TN,ST,true);
     end;
 end;
 
@@ -553,7 +555,7 @@ Var
       BaseName:=GetName(Def);
       DoLog('Renaming duplicate identifier (%s) %s at %s to %s, other at %s',[Def.ClassName,BaseName,GetDefPos(Def),OrigName,GetDefPos(ConflictDef)]);
       // Original TPasName is in list, will be freed automatically
-      Def.Data:=CreatePasName(OrigName,Def);
+      Def.Data:=CreatePasName(OrigName,Def,false);
       end;
     if not IsOverload then
       L.Add(NewName,Def);
@@ -1022,26 +1024,26 @@ function TBaseWebIDLToPas.GetArguments(aList: TIDLDefinitionList;
 
 Var
   I, Def: TIDLDefinition;
-  A: TIDLArgumentDefinition absolute I;
-  Arg, aTypeName: string;
+  Arg: TIDLArgumentDefinition absolute I;
+  ArgName, aTypeName: string;
 
 begin
   Result:='';
   For I in aList do
     begin
-    Arg:=GetName(A);
-    aTypeName:=GetTypeName(A.ArgumentType);
-    Arg:=Arg+': '+aTypeName;
-    Def:=FindGlobalDef(A.ArgumentType.TypeName);
-    //writeln('TBaseWebIDLToPas.GetArguments Arg="',Arg,'" A.ArgumentType.TypeName=',A.ArgumentType.TypeName,' ',Def<>nil);
+    ArgName:=GetName(Arg);
+    aTypeName:=GetTypeName(Arg.ArgumentType);
+    ArgName:=ArgName+': '+aTypeName;
+    Def:=FindGlobalDef(Arg.ArgumentType.TypeName);
+    //writeln('TBaseWebIDLToPas.GetArguments Arg="',ArgName,'" A.ArgumentType.TypeName=',Arg.ArgumentType.TypeName,' ',Def<>nil);
     if (Def is TIDLFunctionDefinition)
         or (Def is TIDLDictionaryDefinition)
-        or (A.ArgumentType.TypeName='sequence')
+        or (Arg.ArgumentType.TypeName='sequence')
         or SameText(aTypeName,'UnicodeString') then
-      Arg:='const '+Arg;
+      ArgName:='const '+ArgName;
     if Result<>'' then
       Result:=Result+'; ';
-    Result:=Result+Arg;
+    Result:=Result+ArgName;
     end;
   if (Result<>'') or ForceBrackets then
     Result:='('+Result+')';
@@ -1078,17 +1080,16 @@ begin
       aDest.Add(CL);
       For J:=0 to DL.Count-1 do
         begin
-        CD:=(DL.Definitions[J] as TIDLArgumentDefinition).Clone(Nil);
+        CD:=CloneArgument(DL.Definitions[J] as TIDLArgumentDefinition);
         CL.Add(CD);
-        AllocatePasName(CD);
         end;
       end;
     Dec(I);
     end;
 end;
 
-procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; AName,
-  ATypeName: String; PosEl: TIDLBaseObject);
+procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; aName,
+  aPasName, aTypeName: String; PosEl: TIDLBaseObject);
 
 Var
   I: Integer;
@@ -1105,7 +1106,7 @@ begin
       CD.ArgumentType:=TIDLTypeDefDefinition.Create(CD,'',PosEl.SrcFile,PosEl.Line,PosEl.Column);
       CD.ArgumentType.TypeName:=aTypeName;
       DL.Add(CD);
-      AllocatePasName(cd,'');
+      CD.Data:=CreatePasName(aPasName,CD,false);
       end;
     end;
 end;
@@ -1123,17 +1124,14 @@ begin
     DL:=TIDLDefinitionList(aList[i]);
     if Not (DL is TIDLPartialDefinitionList) then
       begin
-      CD:=aDef.Clone(Nil);
+      CD:=CloneArgument(aDef);
       DL.Add(CD);
-      if aDef.Data<>Nil then
-        CD.Data:=CreatePasName(TPasData(aDef.Data).PasName,CD)
-      else
-        AllocatePasName(cd,'');
       end;
     end;
 end;
 
-procedure TBaseWebIDLToPas.AddUnionOverloads(aList: TFPObjectlist; AName: String; UT: TIDLUnionTypeDefDefinition);
+procedure TBaseWebIDLToPas.AddUnionOverloads(aList: TFPObjectlist; aName,
+  aPasName: String; UT: TIDLUnionTypeDefDefinition);
 
 Var
   L,L2: TFPObjectList;
@@ -1165,14 +1163,14 @@ begin
       // Clone list
       CloneNonPartialArgumentList(L,L2,False);
       // Add argument to cloned list
-      AddArgumentToOverloads(L2,aName,Dups[i],UT.Union[I]);
+      AddArgumentToOverloads(L2,aName,aPasName,Dups[i],UT.Union[I]);
       // Add overloads to original list
       For J:=0 to L2.Count-1 do
         aList.Add(L2[J]);
       L2.Clear;
       end;
     // Add first Union to original list
-    AddArgumentToOverloads(L,aName,Dups[0],UT.Union[0]);
+    AddArgumentToOverloads(L,aName,aPasName,Dups[0],UT.Union[0]);
   finally
     Dups.Free;
     L2.Free;
@@ -1195,8 +1193,16 @@ begin
     end
 end;
 
+function TBaseWebIDLToPas.CloneArgument(Arg: TIDLArgumentDefinition
+  ): TIDLArgumentDefinition;
+begin
+  Result:=Arg.Clone(nil);
+  if Arg.Data is TPasData then
+    Result.Data:=CreatePasName(GetName(Arg),Result,false);
+end;
+
 procedure TBaseWebIDLToPas.AddOverloads(aList: TFPObjectlist;
-  adef: TIDLFunctionDefinition; aIdx: Integer);
+  aDef: TIDLFunctionDefinition; aIdx: Integer);
 
 Var
   Arg: TIDLArgumentDefinition;
@@ -1204,9 +1210,9 @@ Var
   UT: TIDLUnionTypeDefDefinition;
 
 begin
- if aIdx>=ADef.Arguments.Count then
+ if aIdx>=aDef.Arguments.Count then
     exit;
-  Arg:=ADef.Argument[aIdx];
+  Arg:=aDef.Argument[aIdx];
   if Arg.IsOptional then
     CloneNonPartialArgumentList(aList);
   // Add current to list.
@@ -1217,7 +1223,7 @@ begin
   if UT=Nil then
     AddArgumentToOverloads(aList,Arg)
   else
-    AddUnionOverLoads(aList,Arg.Name,UT);
+    AddUnionOverLoads(aList,Arg.Name,GetName(Arg),UT);
   AddOverloads(aList,aDef,aIdx+1);
 end;
 
@@ -1227,7 +1233,7 @@ begin
   Result:=TFPObjectList.Create;
   try
     Result.Add(TIDLDefinitionList.Create(Nil,True));
-    AddOverloads(Result,adef,0);
+    AddOverloads(Result,aDef,0);
   except
     Result.Free;
     Raise;
@@ -1418,10 +1424,12 @@ begin
   Source.SaveToFile(OutputFileName);
 end;
 
-function TBaseWebIDLToPas.CreatePasName(aName: String; D: TIDLBaseObject
-  ): TPasData;
+function TBaseWebIDLToPas.CreatePasName(aName: String; D: TIDLBaseObject;
+  Escape: boolean): TPasData;
 begin
-  Result:=PasDataClass.Create(EscapeKeyWord(aName),D);
+  if Escape then
+    aName:=EscapeKeyWord(aName);
+  Result:=PasDataClass.Create(aName,D);
   FPasNameList.Add(Result);
 end;
 
@@ -1439,7 +1447,7 @@ begin
     if not TIDLInterfaceDefinition(D).IsPartial then
       AddJSIdentifier(D);
     CN:=ClassPrefix+CN+ClassSuffix;
-    Result:=CreatePasName(CN,D);
+    Result:=CreatePasName(CN,D,true);
     D.Data:=Result;
     AllocatePasNames((D as TIDLInterfaceDefinition).Members,D.Name);
     end
@@ -1449,7 +1457,7 @@ begin
       AddJSIdentifier(D);
     if coDictionaryAsClass in BaseOptions then
       CN:=ClassPrefix+CN+ClassSuffix;
-    Result:=CreatePasName(EscapeKeyWord(CN),D);
+    Result:=CreatePasName(EscapeKeyWord(CN),D,true);
     D.Data:=Result;
     AllocatePasNames((D as TIDLDictionaryDefinition).Members,D.Name);
     end
@@ -1462,7 +1470,7 @@ begin
       CN:=TypePrefix+CN;
       AddJSIdentifier(D);
       end;
-    Result:=CreatePasName(CN,D);
+    Result:=CreatePasName(CN,D,true);
     D.Data:=Result;
     if D Is TIDLFunctionDefinition then
       AllocatePasNames((D as TIDLFunctionDefinition).Arguments,D.Name);
@@ -1518,7 +1526,7 @@ procedure TBaseWebIDLToPas.ResolveTypeDef(D: TIDLDefinition);
       begin
       Data:=TPasData(D.Data);
       if Data=nil then
-        Data:=CreatePasName('',D);
+        Data:=CreatePasName('',D,false);
       Data.Resolved:=Def;
       end;
   end;
@@ -1718,5 +1726,14 @@ begin
   end;
 end;
 
+function TBaseWebIDLToPas.IsKeyWord(const S: String): Boolean;
+Const
+   KW=';class;finalization;function;initialization;procedure;';
+begin
+  Result:=inherited IsKeyWord(S);
+  if Result then exit;
+  Result:=Pos(';'+lowercase(S)+';',KW)<>0;
+end;
+
 end.