webidltopas: show source positions

packages/webidl/src/webidldefs.pp

@@ -47,10 +47,14 @@ Type
   TIDLTypeDefDefinition = Class;
   TIDLDefinitionClass = Class of TIDLDefinition;
 
+  { TIDLBaseObject }
+
   TIDLBaseObject = Class
   Public
+    Line, Column: integer;
+    SrcFile: string;
     // The IDLBaseobject is owner of the newly created instance !
-    Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String) : TIDLDefinition; virtual; abstract;
+    Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; virtual; abstract;
     Function AsString(Full : Boolean): UTF8String; virtual; abstract;
   end;
 
@@ -63,8 +67,8 @@ Type
     function GetAttributes: TExtAttributeList;
     procedure SetAttributes(AValue: TExtAttributeList);
   Public
-    Constructor Create(aParent : TIDLDefinition;Const aName : UTF8String); virtual;
-    Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String) : TIDLDefinition; override;
+    Constructor Create(aParent : TIDLDefinition; Const aName : UTF8String; const aFile: string; aLine, aCol: integer); virtual;
+    Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; override;
     Destructor Destroy; override;
     // This definition extens an existing one. It will not be in the lookup list of symbols
     Function IsExtension : Boolean; virtual;
@@ -108,7 +112,7 @@ Type
     function AsString(const aSep, aStart, aEnd, aIndent: String; aFull,
       AppendSep: Boolean): UTF8String;
     Function AsString(Full : Boolean): UTF8String; override;
-    Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String) : TIDLDefinition; override;
+    Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; override;
     Function Add(aItem : TIDLDefinition) : Integer;
     function GetEnumerator: TIDLDefinitionEnumerator;
     Property Parent : TIDLDefinition Read FParent;
@@ -170,7 +174,7 @@ Type
     Function GetFullMemberList(aList : TIDLDefinitionList) : Integer;
     Function HasMembers : Boolean;
     // Members are owned by this instance.
-    Property members : TIDLDefinitionList Read GetMembers;
+    Property Members : TIDLDefinitionList Read GetMembers;
     Property Member[Aindex : Integer] : TIDLDefinition Read GetMember; default;
     Function HasPartials : Boolean;
     // Partials are NOT owned by this instance
@@ -304,7 +308,7 @@ Type
   private
     FValues: TStrings;
   Public
-    Constructor Create(aParent : TIDLDefinition;Const aName : UTF8String); override;
+    Constructor Create(aParent : TIDLDefinition;Const aName : UTF8String; const aFile: string; aLine, aCol: integer); override;
     Destructor Destroy; override;
     Procedure AddValue(Const aValue : String);
     Property Values : TStrings Read FValues;
@@ -403,7 +407,7 @@ Type
   private
     FUnion: TIDLDefinitionList;
   Public
-    Constructor Create(aParent : TIDLDefinition;Const aName : UTF8String); override;
+    Constructor Create(aParent : TIDLDefinition;Const aName : UTF8String; const aFile: string; aLine, aCol: integer); override;
     Destructor Destroy; override;
     Function Clone (aParent : TIDLDefinition) : TIDLTypeDefDefinition; override;
     Function AsString(Full: Boolean): UTF8String; override;
@@ -594,7 +598,7 @@ begin
   if Not HasMembers then
     Result:=Result+' {'+sLineBreak+'}'
   else
-    Result:=Result+' '+members.AsString(true);
+    Result:=Result+' '+Members.AsString(true);
 
   if aFull and HasAttributes then
     Result:=Attributes.AsString(true)+' '+Result;
@@ -604,7 +608,7 @@ end;
 
 function TIDLTypeDefDefinition.Clone(aParent: TIDLDefinition): TIDLTypeDefDefinition;
 begin
-  Result:=TIDLTypeDefDefinitionClass(Self.ClassType).Create(aParent,Name);
+  Result:=TIDLTypeDefDefinitionClass(Self.ClassType).Create(aParent,Name,aParent.SrcFile,aParent.Line,aParent.Column);
   Result.TypeName:=Self.TypeName;
 end;
 
@@ -765,7 +769,7 @@ end;
 function TIDLArgumentDefinition.Clone(aType: TIDLTypeDefDefinition): TIDLArgumentDefinition;
 
 begin
-  Result:=TIDLArgumentDefinition.Create(Nil,Self.Name);
+  Result:=TIDLArgumentDefinition.Create(Nil,Name,SrcFile,Line,Column);
   if (AType=Nil) and Assigned(ArgumentType) then
     begin
     AType:=ArgumentType.Clone(Result);
@@ -862,7 +866,7 @@ begin
   if Not HasMembers then
     Result:=Result+' {'+sLineBreak+'}'
   else
-    Result:=Result+' '+members.AsString(true);
+    Result:=Result+' '+Members.AsString(true);
   if Full and HasAttributes then
     Result:=Attributes.AsString(True)+' '+Result
 end;
@@ -962,9 +966,9 @@ end;
 { TIDLUnionTypeDefDefinition }
 
 constructor TIDLUnionTypeDefDefinition.Create(aParent: TIDLDefinition;
-  const aName: UTF8String);
+  const aName: UTF8String; const aFile: string; aLine, aCol: integer);
 begin
-  inherited Create(aParent, aName);
+  inherited Create(aParent, aName, aFile, aLine, aCol);
   FUnion:=TIDLDefinitionList.Create(Self,True);
 end;
 
@@ -1001,9 +1005,9 @@ end;
 { TIDLEnumDefinition }
 
 constructor TIDLEnumDefinition.Create(aParent: TIDLDefinition;
-  const aName: UTF8String);
+  const aName: UTF8String; const aFile: string; aLine, aCol: integer);
 begin
-  inherited Create(aParent, aName);
+  inherited Create(aParent, aName, aFile, aLine, aCol);
   FValues:=TStringList.Create;
 end;
 
@@ -1208,9 +1212,9 @@ begin
 end;
 
 function TIDLDefinitionList.Add(aClass: TIDLDefinitionClass;
-  const AName: UTF8String): TIDLDefinition;
+  const AName: UTF8String; const aFile: string; aLine, aCol: integer): TIDLDefinition;
 begin
-  Result:=aClass.Create(FParent,aName);
+  Result:=aClass.Create(FParent,aName,aFile,aLine,aCol);
   FList.Add(Result);
 end;
 
@@ -1242,16 +1246,20 @@ begin
   Result:=Fattributes;
 end;
 
-constructor TIDLDefinition.Create(aParent : TIDLDefinition; const aName: UTF8String);
+constructor TIDLDefinition.Create(aParent: TIDLDefinition;
+  const aName: UTF8String; const aFile: string; aLine, aCol: integer);
 begin
   FName:=AName;
   FParent:=AParent;
+  SrcFile:=aFile;
+  Line:=aLine;
+  Column:=aCol;
 end;
 
-function TIDLDefinition.Add(aClass: TIDLDefinitionClass; const AName: UTF8String
-  ): TIDLDefinition;
+function TIDLDefinition.Add(aClass: TIDLDefinitionClass;
+  const AName: UTF8String; const aFile: string; aLine, aCol: integer): TIDLDefinition;
 begin
-  Result:=aClass.Create(Self,AName);
+  Result:=aClass.Create(Self,AName,aFile,aLine,aCol);
 end;
 
 destructor TIDLDefinition.Destroy;

packages/webidl/src/webidlparser.pp

@@ -48,8 +48,8 @@ Type
     function IndexOfDefinition(const AName: String): Integer;
     Function FindDefinition(const AName : String) : TIDLDefinition;
     Function AsString(Full: Boolean): UTF8String; override;
-    Function Add(aClass : TIDLDefinitionClass; const AName : UTF8String) : TIDLDefinition; override;
-    Function Add(aParent : TIDLBaseObject; aClass : TIDLDefinitionClass; const AName : UTF8String) : TIDLDefinition; virtual;
+    Function Add(aClass : TIDLDefinitionClass; const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; override;
+    Function Add(aParent : TIDLBaseObject; aClass : TIDLDefinitionClass; const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; virtual;
     Property Definitions : TIDLDefinitionList Read FDefinitions;
     Property Aliases : TStrings Read FAliases Write FAliases;
   end;
@@ -72,6 +72,9 @@ Type
     function CurrentToken: TIDLToken; virtual;
     function GetToken: TIDLToken; virtual;
     function CurrentTokenString: UTF8String;
+    function CurrentRow: integer; virtual;
+    function CurrentColumn: integer; virtual;
+    function CurrentFile: string; virtual;
     // Get next token, see if it is valid. Raise exception if not.
     procedure MaybeFree(Result: TIDLDefinition; aParent: TIDLBaseObject);
     Procedure CheckCurrentToken(aToken: TIDLToken);
@@ -83,6 +86,7 @@ Type
     procedure ParseExtAttributes(aList: TExtAttributeList; aTerminator: TIDLToken; ForSerializer: Boolean=False); virtual;
     // Definitions
     // Type is a type without name of the type
+    function AddDefinition(aParent : TIDLBaseObject; aClass : TIDLDefinitionClass; const AName : UTF8String) : TIDLDefinition; virtual;
     function ParseAttribute(aParent: TIDLBaseObject): TIDLAttributeDefinition; virtual;
     function ParseArgument(aParent: TIDLBaseObject): TIDLArgumentDefinition; virtual;
     procedure ParseArguments(aParent: TIDLBaseObject);virtual;
@@ -204,6 +208,21 @@ begin
   Result:=Fscanner.CurTokenString;
 end;
 
+function TWebIDLParser.CurrentRow: integer;
+begin
+  Result:=FScanner.CurRow;
+end;
+
+function TWebIDLParser.CurrentColumn: integer;
+begin
+  Result:=FScanner.CurColumn;
+end;
+
+function TWebIDLParser.CurrentFile: string;
+begin
+  Result:=FScanner.CurFile;
+end;
+
 procedure TWebIDLParser.CheckCurrentToken(aToken: TIDLToken);
 begin
   if (aToken<>CurrentToken) then
@@ -317,6 +336,12 @@ begin
   AddToList(S);
 end;
 
+function TWebIDLParser.AddDefinition(aParent: TIDLBaseObject;
+  aClass: TIDLDefinitionClass; const AName: UTF8String): TIDLDefinition;
+begin
+  Result:=Context.Add(aParent,aClass,AName,CurrentFile,CurrentRow,CurrentColumn);
+end;
+
 function TWebIDLParser.ParseExtAttributes: TExtAttributeList;
 
 var
@@ -341,7 +366,7 @@ function TWebIDLParser.ParseArgument(aParent : TIDLBaseObject): TIDLArgumentDefi
 var
   ok: Boolean;
 begin
-  Result:=TIDLArgumentDefinition(Context.Add(aParent,TIDLArgumentDefinition,''));
+  Result:=TIDLArgumentDefinition(AddDefinition(aParent,TIDLArgumentDefinition,''));
   ok:=false;
   try
     if CurrentToken=tkOptional then
@@ -377,7 +402,7 @@ function TWebIDLParser.ParseFunction(aParent : TIDLBaseObject): TIDLFunctionDefi
 var
   ok: Boolean;
 begin
-  Result:=TIDLFunctionDefinition(Context.Add(aParent,TIDLFunctionDefinition,CurrentTokenString));
+  Result:=TIDLFunctionDefinition(AddDefinition(aParent,TIDLFunctionDefinition,CurrentTokenString));
   ok:=false;
   try
     ExpectToken(tkEqual);
@@ -467,7 +492,7 @@ begin
     Include(Opts,FO);
     GetToken;
     end;
-  Result:=TIDLFunctionDefinition(Context.Add(aParent,TIDLFunctionDefinition,''));
+  Result:=TIDLFunctionDefinition(AddDefinition(aParent,TIDLFunctionDefinition,''));
   ok:=false;
   try
     if (foConstructor in Opts) then
@@ -518,7 +543,7 @@ begin
   tkSemiColon:
     begin
     // stringifier;
-    Result:=TIDLAttributeDefinition(Context.Add(aParent,TIDLAttributeDefinition,''));
+    Result:=TIDLAttributeDefinition(AddDefinition(aParent,TIDLAttributeDefinition,''));
     With TIDLAttributeDefinition(Result) do
       Options:=Options+[aoStringifier];
     end;
@@ -541,7 +566,7 @@ begin
   ExpectToken(tkLess);
   T1:=Nil;
   T2:=nil;
-  Result:=TIDLIterableDefinition(Context.Add(aParent,TIDLIterableDefinition,''));
+  Result:=TIDLIterableDefinition(AddDefinition(aParent,TIDLIterableDefinition,''));
   ok:=false;
   try
     T1:=ParseType(Result,True,True);
@@ -564,7 +589,7 @@ begin
   end;
 end;
 
-function TWebIDLParser.CompleteSimpleType(tk: TIDLToken; Var S: UTF8String; out
+function TWebIDLParser.CompleteSimpleType(tk: TIDLToken; var S: UTF8String; out
   IsNull: Boolean): TIDLToken;
 
 begin
@@ -606,7 +631,7 @@ function TWebIDLParser.ParseMapLikeMember(aParent: TIDLBaseObject): TIDLMaplikeD
 var
   ok: Boolean;
 begin
-  Result:=TIDLMaplikeDefinition(Context.Add(aParent,TIDLMaplikeDefinition,''));
+  Result:=TIDLMaplikeDefinition(AddDefinition(aParent,TIDLMaplikeDefinition,''));
   ok:=false;
   try
     Result.TypeName:='maplike';
@@ -628,7 +653,7 @@ function TWebIDLParser.ParseSetLikeMember(aParent: TIDLBaseObject): TIDLSetlikeD
 var
   ok: Boolean;
 begin
-  Result:=TIDLSetlikeDefinition(Context.Add(aParent,TIDLSetlikeDefinition,''));
+  Result:=TIDLSetlikeDefinition(AddDefinition(aParent,TIDLSetlikeDefinition,''));
   ok:=false;
   try
     ExpectToken(tkLess);
@@ -647,7 +672,7 @@ function TWebIDLParser.ParseRecordTypeDef(aParent: TIDLBaseObject): TIDLRecordDe
 var
   ok: Boolean;
 begin
-  Result:=TIDLRecordDefinition(Context.Add(aParent,TIDLRecordDefinition,''));
+  Result:=TIDLRecordDefinition(AddDefinition(aParent,TIDLRecordDefinition,''));
   ok:=false;
   try
     Result.TypeName:='record';
@@ -733,7 +758,7 @@ begin
   // Unsigned
   Tk:=CompleteSimpleType(tk,S,IsNull);
   CheckCurrentToken(tkIdentifier);
-  Result:=TIDLConstDefinition(Context.Add(aParent,TIDLConstDefinition,CurrentTokenString));
+  Result:=TIDLConstDefinition(AddDefinition(aParent,TIDLConstDefinition,CurrentTokenString));
   ok:=false;
   try
     Result.TypeName:=S;
@@ -780,7 +805,7 @@ begin
     GetToken;
     end;
   CheckCurrentToken(tkAttribute);
-  Result:=TIDLAttributeDefinition(Context.Add(aParent,TIDLAttributeDefinition,''));
+  Result:=TIDLAttributeDefinition(AddDefinition(aParent,TIDLAttributeDefinition,''));
   ok:=false;
   try
     Result.AttributeType:=ParseType(Result,True,True);
@@ -830,7 +855,7 @@ begin
   tk:=GetToken;
   if tk=tkSemiColon then
     exit;
-  Result:=TIDLSerializerDefinition(Context.Add(aParent,TIDLSerializerDefinition,''));
+  Result:=TIDLSerializerDefinition(AddDefinition(aParent,TIDLSerializerDefinition,''));
   ok:=false;
   try
     if tk<>tkEqual then
@@ -880,7 +905,7 @@ begin
   isMixin:=CurrentToken=tkMixin;
   if CurrentToken=tkMixin then
     ExpectToken(tkIdentifier);
-  Result:=TIDLInterfaceDefinition(Context.Add(aParent,TIDLInterfaceDefinition,CurrentTokenString));
+  Result:=TIDLInterfaceDefinition(AddDefinition(aParent,TIDLInterfaceDefinition,CurrentTokenString));
   ok:=false;
   try
     Result.IsMixin:=IsMixin;
@@ -1023,7 +1048,7 @@ Var
 
 begin
   ExpectToken(tkIdentifier);
-  Result:=TIDLEnumDefinition(Context.Add(aParent,TIDLEnumDefinition,CurrentTokenString));
+  Result:=TIDLEnumDefinition(AddDefinition(aParent,TIDLEnumDefinition,CurrentTokenString));
   ExpectToken(tkCurlyBraceOpen);
   Repeat
     tk:=ExpectTokens([tkCurlyBraceClose,tkString]);
@@ -1060,7 +1085,7 @@ begin
     if IsReq then
       tk:=GetToken;
     end;
-  Result:=TIDLDictionaryMemberDefinition(Context.Add(aParent,TIDLDictionaryMemberDefinition,''));
+  Result:=TIDLDictionaryMemberDefinition(AddDefinition(aParent,TIDLDictionaryMemberDefinition,''));
   ok:=false;
   try
     Result.Attributes:=Attrs;
@@ -1071,7 +1096,7 @@ begin
     tk:=GetToken;
     if tk=tkEqual then
       begin
-      Result.DefaultValue:=TIDLConstDefinition(Context.Add(Result,TIDLConstDefinition,''));
+      Result.DefaultValue:=TIDLConstDefinition(AddDefinition(Result,TIDLConstDefinition,''));
       Result.DefaultValue.ConstType:=ParseConstValue(S,True);
       Result.DefaultValue.Value:=S;
       tk:=GetToken;
@@ -1104,7 +1129,7 @@ begin
     tk:=GetToken;
     end;
   CheckCurrentToken(tkCurlyBraceOpen);
-  Result:=TIDLDictionaryDefinition(Context.Add(aParent,TIDLDictionaryDefinition,Name));
+  Result:=TIDLDictionaryDefinition(AddDefinition(aParent,TIDLDictionaryDefinition,Name));
   Result.ParentName:=ParentName;
   GetToken;
   While (CurrentToken<>tkCurlyBraceClose) do
@@ -1122,7 +1147,7 @@ function TWebIDLParser.ParseSequenceTypeDef(aParent : TIDLBaseObject): TIDLSeque
 var
   ok: Boolean;
 begin
-  Result:=TIDLSequenceTypeDefDefinition(Context.Add(aParent,TIDLSequenceTypeDefDefinition,''));
+  Result:=TIDLSequenceTypeDefDefinition(AddDefinition(aParent,TIDLSequenceTypeDefDefinition,''));
   ok:=false;
   try
     Result.TypeName:='sequence';
@@ -1149,7 +1174,7 @@ Var
 
 begin
   Attr:=Nil;
-  Result:=TIDLUnionTypeDefDefinition(Context.Add(aParent,TIDLUnionTypeDefDefinition,''));
+  Result:=TIDLUnionTypeDefDefinition(AddDefinition(aParent,TIDLUnionTypeDefDefinition,''));
   ok:=false;
   try
     Result.TypeName:='union';
@@ -1185,7 +1210,7 @@ function TWebIDLParser.ParsePromiseTypeDef(aParent: TIDLBaseObject): TIDLPromise
 var
   ok: Boolean;
 begin
-  Result:=TIDLPromiseTypeDefDefinition(Context.Add(aParent,TIDLPromiseTypeDefDefinition,''));
+  Result:=TIDLPromiseTypeDefDefinition(AddDefinition(aParent,TIDLPromiseTypeDefDefinition,''));
   ok:=false;
   try
     Result.TypeName:='Promise';
@@ -1242,7 +1267,7 @@ begin
         Error(SErrInvalidToken,[LegacyDOMString,CurrentTokenString]);
       ExpectToken(tkSquaredBraceClose);
       ExpectToken(tkDOMString);
-      Result:=TIDLTypeDefDefinition(Context.Add(aParent,TIDLTypeDefDefinition,''));
+      Result:=TIDLTypeDefDefinition(AddDefinition(aParent,TIDLTypeDefDefinition,''));
       Result.TypeName:='DOMString';
       Result.Attributes.Add(LegacyDOMString);
       GetToken;
@@ -1258,7 +1283,7 @@ begin
     if (tk in SimplePrefixTokens) then
       begin
       tk:=CompleteSimpleType(tk,TypeName,isNull);
-      Result:=TIDLTypeDefDefinition(Context.Add(aParent,TIDLTypeDefDefinition,''));
+      Result:=TIDLTypeDefDefinition(AddDefinition(aParent,TIDLTypeDefDefinition,''));
       end
     else
       begin
@@ -1269,7 +1294,7 @@ begin
         tkPromise : Result:=ParsePromiseTypeDef(aParent);
         tkBracketOpen : Result:=ParseUnionTypeDef(aParent);
       else
-        Result:=TIDLTypeDefDefinition(Context.Add(aParent,TIDLTypeDefDefinition,''));
+        Result:=TIDLTypeDefDefinition(AddDefinition(aParent,TIDLTypeDefDefinition,''));
       end;
       tk:=GetToken;
       end;
@@ -1322,7 +1347,7 @@ begin
     end
   else
     N:=aName;
-  Result:=TIDLImplementsDefinition(Context.Add(aParent,TIDLImplementsDefinition,N));
+  Result:=TIDLImplementsDefinition(AddDefinition(aParent,TIDLImplementsDefinition,N));
   try
     ExpectToken(tkIdentifier);
     Result.ImplementedInterface:=CurrentTokenString;
@@ -1337,7 +1362,7 @@ function TWebIDLParser.ParseIncludes(const aName: UTF8String;
 (* On entry, we're on the identifier. On Exit, we're on the last identifier *)
 
 begin
-  Result:=TIDLIncludesDefinition(Context.Add(aParent,TIDLIncludesDefinition,aName));
+  Result:=TIDLIncludesDefinition(AddDefinition(aParent,TIDLIncludesDefinition,aName));
   try
     ExpectToken(tkIdentifier);
     Result.IncludedInterface:=CurrentTokenString;
@@ -1603,17 +1628,21 @@ begin
   Result:=Definitions.AsString(';'+sLineBreak,'','','',Full,True);
 end;
 
-function TWebIDLContext.Add(aClass: TIDLDefinitionClass; const AName: UTF8String): TIDLDefinition;
+function TWebIDLContext.Add(aClass: TIDLDefinitionClass;
+  const AName: UTF8String; const aFile: string; aLine, aCol: integer
+  ): TIDLDefinition;
 begin
-  Result:=Add(FDefinitions,aClass,AName);
+  Result:=Add(FDefinitions,aClass,AName,aFile,aLine,aCol);
 end;
 
-function TWebIDLContext.Add(aParent: TIDLBaseObject; aClass: TIDLDefinitionClass; const AName: UTF8String): TIDLDefinition;
+function TWebIDLContext.Add(aParent: TIDLBaseObject;
+  aClass: TIDLDefinitionClass; const AName: UTF8String; const aFile: string;
+  aLine, aCol: integer): TIDLDefinition;
 begin
   if Assigned(aParent) then
-    Result:=aParent.Add(aClass,aName)
+    Result:=aParent.Add(aClass,aName,aFile,aLine,aCol)
   else
-    Result:=aClass.Create(Nil,aName)
+    Result:=aClass.Create(Nil,aName,aFile,aLine,aCol);
 end;
 
 end.

packages/webidl/src/webidlscanner.pp

@@ -242,6 +242,7 @@ Type
 
   TWebIDLScanner = class
   private
+    FCurFile: UTF8String;
     FEvaluator: TDirectiveEvaluator;
     FSource : TStringList;
     FCurRow: Integer;
@@ -295,6 +296,7 @@ Type
     property CurLine: UTF8String read FCurLine;
     property CurRow: Integer read FCurRow;
     property CurColumn: Integer read GetCurColumn;
+    property CurFile: UTF8String read FCurFile write FCurFile;
 
     property CurToken: TIDLToken read FCurToken;
     property CurTokenString: UTF8String read FCurTokenString;
@@ -1140,8 +1142,9 @@ end;
 
 constructor TWebIDLScanner.CreateFile(const aFileName: UTF8String);
 begin
-  FSource:=TStringList.Create;
+  Init;
   FSource.LoadFromFile(aFileName);
+  FCurFile:=aFileName;
 end;
 
 destructor TWebIDLScanner.Destroy;
@@ -1354,7 +1357,8 @@ end;
 
 function TWebIDLScanner.GetErrorPos: String;
 begin
-  Result:=Format('Scanner error at line %d, pos %d: ',[CurRow,CurColumn]);
+  Result:=CurFile+'('+IntToStr(CurRow)+','+IntToStr(CurColumn)+')';
+  Result:=Format('Scanner error at %s: ',[Result]);
 end;
 
 function TWebIDLScanner.ReadComment : UTF8String;

packages/webidl/src/webidltopas.pp

@@ -31,7 +31,9 @@ Type
   private
     FPasName: String;
   Public
-    Constructor Create(APasName : String);
+    Line, Column: integer;
+    SrcFile: string;
+    Constructor Create(APasName : String; const aFile: string; aLine, aCol: integer);
     Property PasName : String read FPasName;
   end;
 
@@ -79,9 +81,11 @@ type
     // Auxiliary routines
     procedure GetOptions(L: TStrings; Full: boolean); virtual;
     procedure ProcessDefinitions; virtual;
-    function CreatePasName(aName: String): TPasData; virtual;
+    function CreatePasName(aName: String; D: TIDLBaseObject): TPasData; virtual;
     procedure AllocatePasNames(aList: TIDLDefinitionList; ParentName: String=''); virtual;
-    Function AllocatePasName(D: TIDLDefinition; ParentName: String=''): TPasData; virtual;
+    function AllocatePasName(D: TIDLDefinition; ParentName: String=''): TPasData; virtual;
+    function GetDefPos(Def: TIDLBaseObject; WithoutFile: boolean = false): string; virtual;
+    function GetPasDataPos(D: TPasData; WithoutFile: boolean = false): string; virtual;
     procedure EnsureUniqueNames(ML: TIDLDefinitionList); virtual;
     function WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
     function WriteAttributeImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
@@ -91,9 +95,9 @@ type
     function GetTypeName(Const aTypeName: String; ForTypeDef: Boolean=False): String; virtual;
     function GetTypeName(aTypeDef: TIDLTypeDefDefinition; ForTypeDef: Boolean=False): String; virtual;
     function CheckUnionTypeDefinition(D: TIDLDefinition): TIDLUnionTypeDefDefinition; virtual;
-    procedure AddArgumentToOverloads(aList: TFPObjectlist; AName, ATypeName: String); virtual;
+    procedure AddArgumentToOverloads(aList: TFPObjectlist; AName, ATypeName: String; PosEl: TIDLBaseObject); virtual;
+    procedure AddArgumentToOverloads(aList: TFPObjectlist; aDef: TIDLArgumentDefinition); virtual;
     procedure AddUnionOverloads(aList: TFPObjectlist; AName: String;  UT: TIDLUnionTypeDefDefinition); virtual;
-    procedure AddArgumentToOverloads(aList: TFPObjectlist; adef: TIDLArgumentDefinition); 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;
@@ -136,7 +140,7 @@ type
     procedure WriteIncludeInterfaceCode; virtual;
     Property Context : TWebIDLContext Read FContext;
   Public
-    constructor Create(Aowner : TComponent); override;
+    constructor Create(TheOwner : TComponent); override;
     destructor Destroy; override;
     procedure Execute; virtual;
     procedure WriteOptions; virtual;
@@ -193,36 +197,82 @@ type
   Public
     Property Pas2jsOptions : TPas2jsConversionOptions Read FPas2jsOptions Write FPas2jsOptions;
   Published
+    Property BaseOptions;
+    Property ClassPrefix;
+    Property ClassSuffix;
+    Property DictionaryClassParent;
+    Property FieldPrefix;
+    Property IncludeImplementationCode;
+    Property IncludeInterfaceCode;
     Property InputFileName;
     Property OutputFileName;
+    Property TypeAliases;
     Property Verbose;
-    Property FieldPrefix;
-    Property ClassPrefix;
-    Property ClassSuffix;
     Property WebIDLVersion;
-    Property TypeAliases;
-    Property IncludeInterfaceCode;
-    Property IncludeImplementationCode;
-    Property DictionaryClassParent;
   end;
 
+type
+
+  TJOB_JSValueKind = (
+    jjvkUndefined,
+    jjvkBoolean,
+    jjvkDouble,
+    jjvkString,
+    jjvkObject,
+    jivkMethod
+    );
+  TJOB_JSValueKinds = set of TJOB_JSValueKind;
+
+const
+  JOB_JSValueKindNames: array[TJOB_JSValueKind] of string = (
+    'Undefined',
+    'Boolean',
+    'Double',
+    'String',
+    'Object',
+    'Method'
+    );
+  JOB_JSValueTypeNames: array[TJOB_JSValueKind] of string = (
+    'TJOB_JSValue',
+    'TJOB_JSValueBoolean',
+    'TJOB_JSValueDouble',
+    'TJOB_JSValueString',
+    'TJOB_JSValueObject',
+    'TJOB_JSValueMethod'
+    );
 type
 
   { TWebIDLToPasWasmJob }
 
   TWebIDLToPasWasmJob = class(TBaseWebIDLToPas)
+  Protected
+    // Auxiliary routines
+    function AllocatePasName(D: TIDLDefinition; ParentName: String=''): TPasData; override;
+    procedure GetOptions(L: TStrings; Full: boolean); override;
+    function GetTypeName(const aTypeName: String; ForTypeDef: Boolean=False
+      ): String; override;
+    // Code generation routines. Return the number of actually written defs.
+    function WriteForwardClassDefs(aList: TIDLDefinitionList): Integer;
+      override;
+    // Definitions. Return true if a definition was written.
+    function WriteConst(aConst: TIDLConstDefinition): Boolean; override;
+    function WriteDictionaryDef(aDict: TIDLDictionaryDefinition): Boolean;
+      override;
+  Public
+    constructor Create(ThOwner: TComponent); override;
   Published
+    Property BaseOptions;
+    Property ClassPrefix;
+    Property ClassSuffix;
+    Property DictionaryClassParent;
+    Property FieldPrefix;
+    Property IncludeImplementationCode;
+    Property IncludeInterfaceCode;
     Property InputFileName;
     Property OutputFileName;
+    Property TypeAliases;
     Property Verbose;
-    Property FieldPrefix;
-    Property ClassPrefix;
-    Property ClassSuffix;
     Property WebIDLVersion;
-    Property TypeAliases;
-    Property IncludeInterfaceCode;
-    Property IncludeImplementationCode;
-    Property DictionaryClassParent;
   end;
 
 function BaseConversionOptionsToStr(Opts: TBaseConversionOptions): string;
@@ -258,6 +308,52 @@ begin
   Result:='['+Result+']';
 end;
 
+{ TWebIDLToPasWasmJob }
+
+function TWebIDLToPasWasmJob.AllocatePasName(D: TIDLDefinition;
+  ParentName: String): TPasData;
+begin
+  Result:=inherited AllocatePasName(D, ParentName);
+end;
+
+procedure TWebIDLToPasWasmJob.GetOptions(L: TStrings; Full: boolean);
+begin
+  inherited GetOptions(L, Full);
+end;
+
+function TWebIDLToPasWasmJob.GetTypeName(const aTypeName: String;
+  ForTypeDef: Boolean): String;
+begin
+  Case aTypeName of
+    'union',
+    'any': Result:=JOB_JSValueTypeNames[jjvkUndefined];
+  else
+    Result:=inherited GetTypeName(aTypeName,ForTypeDef);
+  end;
+end;
+
+function TWebIDLToPasWasmJob.WriteForwardClassDefs(aList: TIDLDefinitionList
+  ): Integer;
+begin
+  Result:=inherited WriteForwardClassDefs(aList);
+end;
+
+function TWebIDLToPasWasmJob.WriteConst(aConst: TIDLConstDefinition): Boolean;
+begin
+  Result:=inherited WriteConst(aConst);
+end;
+
+function TWebIDLToPasWasmJob.WriteDictionaryDef(aDict: TIDLDictionaryDefinition
+  ): Boolean;
+begin
+  Result:=inherited WriteDictionaryDef(aDict);
+end;
+
+constructor TWebIDLToPasWasmJob.Create(ThOwner: TComponent);
+begin
+  inherited Create(ThOwner);
+end;
+
 { TWebIDLToPas2js }
 
 function TWebIDLToPas2js.AllocatePasName(D: TIDLDefinition; ParentName: String
@@ -265,36 +361,38 @@ function TWebIDLToPas2js.AllocatePasName(D: TIDLDefinition; ParentName: String
 
 Var
   CN : String;
+  aData: TPasData;
 
 begin
   if D Is TIDLInterfaceDefinition then
     begin
     CN:=ClassPrefix+D.Name+ClassSuffix;
-    Result:=CreatePasname(CN);
+    Result:=CreatePasname(CN,D);
     D.Data:=Result;
-    AllocatePasNames((D as TIDLInterfaceDefinition).members,D.Name);
+    AllocatePasNames((D as TIDLInterfaceDefinition).Members,D.Name);
     end
   else if D Is TIDLDictionaryDefinition then
     begin
     CN:=D.Name;
     if p2jcoDictionaryAsClass in Pas2jsOptions then
       CN:=ClassPrefix+CN+ClassSuffix;
-    Result:=CreatePasname(EscapeKeyWord(CN));
+    Result:=CreatePasname(EscapeKeyWord(CN),D);
     D.Data:=Result;
-    AllocatePasNames((D as TIDLDictionaryDefinition).members,D.Name);
+    AllocatePasNames((D as TIDLDictionaryDefinition).Members,D.Name);
     end
   else
     begin
-    Result:=CreatePasName(D.Name);
+    Result:=CreatePasName(D.Name,D);
     D.Data:=Result;
     if D Is TIDLFunctionDefinition then
       AllocatePasNames((D as TIDLFunctionDefinition).Arguments,D.Name);
     end;
-  if Verbose and (TPasData(D.Data).PasName<>D.Name) then
+  aData:=TPasData(D.Data);
+  if Verbose and (aData.PasName<>D.Name) then
     begin
     if (ParentName<>'') then
       ParentName:=ParentName+'.';
-    DoLog('Renamed %s to %s',[ParentName+D.Name,TPasData(D.Data).PasName]);
+    DoLog('Renamed %s to %s for %s',[ParentName+D.Name,aData.PasName,GetPasDataPos(aData)]);
     end;
 end;
 
@@ -421,9 +519,13 @@ end;
 
 { TPasData }
 
-constructor TPasData.Create(APasName: String);
+constructor TPasData.Create(APasName: String; const aFile: string; aLine,
+  aCol: integer);
 begin
   FPasName:=APasName;
+  SrcFile:=aFile;
+  Line:=aLine;
+  Column:=aCol;
 end;
 
 { TBaseWebIDLToPas }
@@ -449,21 +551,24 @@ end;
 procedure TBaseWebIDLToPas.Parse;
 
 Var
-  F : TFileStream;
+  ms: TMemoryStream;
   S : TWebIDLScanner;
   P : TWebIDLParser;
 
 begin
   P:=Nil;
-  F:=TFileStream.Create(InputFileName,fmOpenRead or fmShareDenyWrite);
+  ms:=TMemoryStream.Create;
   try
-    S:=CreateScanner(F);
+    ms.LoadFromFile(InputFileName);
+    ms.Position:=0;
+    S:=CreateScanner(ms);
+    S.CurFile:=InputFileName;
     P:=CreateParser(Context,S);
     P.Parse;
   finally
     P.Free;
     S.Free;
-    F.Free;
+    ms.Free;
   end;
 end;
 
@@ -619,9 +724,9 @@ begin
   if Result then
     begin
     FAutoTypes.Add(TN);
-    DoLog('Automatically adding %s sequence definition.',[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.Data:=CreatePasName(TN,ST);
     end;
 end;
 
@@ -698,45 +803,49 @@ procedure TBaseWebIDLToPas.EnsureUniqueNames(ML : TIDLDefinitionList);
 Var
   L : TFPObjectHashTable;
 
-  Procedure CheckRename(aD : TIDLDefinition);
+  Procedure CheckRename(Def : TIDLDefinition);
 
   var
     I : integer;
-    NOrig,N,N2 : String;
-    isDup : Boolean;
-    D2 : TIDLDefinition;
+    OrigName,BaseName,NewName : String;
+    IsOverload : Boolean;
+    CurDef , ConflictDef: TIDLDefinition;
 
   begin
-    NOrig:=GetName(aD);
-    N:=LowerCase(NOrig);
-    N2:=N;
+    OrigName:=GetName(Def);
+    BaseName:=LowerCase(OrigName);
+    NewName:=BaseName;
     I:=0;
-    isDup:=False;
+    IsOverload:=False;
+    ConflictDef:=nil;
     Repeat
-      D2:=TIDLDefinition(L.Items[N2]);
-      if (D2<>Nil) then
+      CurDef:=TIDLDefinition(L.Items[NewName]);
+      if (CurDef<>Nil) then
         // Overloads
         begin
-        isDup:=((D2 is TIDLFunctionDefinition) and (ad is TIDLFunctionDefinition));
-        if IsDup then
-          D2:=Nil
+        IsOverload:=((CurDef is TIDLFunctionDefinition) and (Def is TIDLFunctionDefinition));
+        if IsOverload then
+          CurDef:=Nil
         else
           begin
+          ConflictDef:=CurDef;
           inc(I);
-          N2:=KeywordPrefix+N+KeywordSuffix;
-          Norig:=KeywordPrefix+NOrig+KeywordSuffix;
+          if I>1 then
+            raise EConvertError.Create('Duplicate identifier '+GetDefPos(Def)+' and '+GetDefPos(CurDef)+' (20220620073704)');
+          NewName:=KeywordPrefix+BaseName+KeywordSuffix;
+          OrigName:=KeywordPrefix+OrigName+KeywordSuffix;
           end;
         end;
-    Until (D2=Nil);
-    if (N<>N2) then
+    Until (CurDef=Nil);
+    if (BaseName<>NewName) then
       begin
-      N:=GetName(aD);
-      DoLog('Renaming duplicate identifier (%s) %s to %s',[aD.ClassName,N,Norig]);
+      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
-      aD.Data:=CreatePasName(NOrig);
+      Def.Data:=CreatePasName(OrigName,Def);
       end;
-    if not IsDup then
-      L.Add(N2,aD);
+    if not IsOverload then
+      L.Add(NewName,Def);
   end;
 
 var
@@ -812,9 +921,9 @@ begin
   Result:=aDict<>nil;
 end;
 
-constructor TBaseWebIDLToPas.Create(Aowner: TComponent);
+constructor TBaseWebIDLToPas.Create(TheOwner: TComponent);
 begin
-  inherited Create(Aowner);
+  inherited Create(TheOwner);
   WebIDLVersion:=v2;
   FieldPrefix:='F';
   ClassPrefix:='T';
@@ -1169,7 +1278,8 @@ begin
     end;
 end;
 
-procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; AName,ATypeName : String);
+procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; AName,
+  ATypeName: String; PosEl: TIDLBaseObject);
 
 Var
   I : Integer;
@@ -1182,8 +1292,8 @@ begin
     DL:=TIDLDefinitionList(alist[i]);
     if Not (DL is TIDLPartialDefinitionList) then
       begin
-      CD:=TIDLArgumentDefinition.Create(Nil,aName);
-      CD.ArgumentType:=TIDLTypeDefDefinition.Create(CD,'');
+      CD:=TIDLArgumentDefinition.Create(Nil,aName,PosEl.SrcFile,PosEl.Line,PosEl.Column);
+      CD.ArgumentType:=TIDLTypeDefDefinition.Create(CD,'',PosEl.SrcFile,PosEl.Line,PosEl.Column);
       CD.ArgumentType.TypeName:=aTypeName;
       DL.Add(CD);
       AllocatePasName(cd,'');
@@ -1191,7 +1301,7 @@ begin
     end;
 end;
 
-procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; adef: TIDLArgumentDefinition);
+procedure TBaseWebIDLToPas.AddArgumentToOverloads(aList: TFPObjectlist; aDef: TIDLArgumentDefinition);
 
 Var
   I : Integer;
@@ -1201,13 +1311,13 @@ Var
 begin
   For I:=0 to aList.Count-1 do
     begin
-    DL:=TIDLDefinitionList(alist[i]);
+    DL:=TIDLDefinitionList(aList[i]);
     if Not (DL is TIDLPartialDefinitionList) then
       begin
       CD:=aDef.Clone(Nil);
       DL.Add(CD);
       if aDef.Data<>Nil then
-        CD.Data:=CreatePasName(TPasData(aDef.Data).PasName)
+        CD.Data:=CreatePasName(TPasData(aDef.Data).PasName,CD)
       else
         AllocatePasName(cd,'');
       end;
@@ -1231,29 +1341,29 @@ begin
   try
     L2:=TFPObjectList.Create(False);
     // Collect non partial argument lists
-    for I:=0 to AList.Count-1 do
+    for I:=0 to aList.Count-1 do
       begin
-      D:=TIDLDefinitionList(alist[i]);
+      D:=TIDLDefinitionList(aList[i]);
       if Not (D is TIDLPartialDefinitionList) then
         L.Add(D);
       end;
     // Collect unique pascal types. Note that this can reduce the list to 1 element...
     For I:=0 to UT.Union.Count-1 do
-      Dups.AddObject(GetTypeName(UT.Union[I] as TIDLTypeDefDefinition),UT.Union[I]);
+      Dups.Add(GetTypeName(UT.Union[I] as TIDLTypeDefDefinition));
     // First, clone list and add argument to cloned lists
     For I:=1 to Dups.Count-1 do
       begin
       // Clone list
       CloneNonPartialArgumentList(L,L2,False);
       // Add argument to cloned list
-      AddArgumentToOverloads(L2,aName,Dups[i]);
+      AddArgumentToOverloads(L2,aName,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]);
+    AddArgumentToOverloads(L,aName,Dups[0],UT.Union[0]);
   finally
     Dups.Free;
     L2.Free;
@@ -1531,10 +1641,11 @@ begin
   Result:='SysUtils, JS'
 end;
 
-function TBaseWebIDLToPas.CreatePasName(aName: String): TPasData;
+function TBaseWebIDLToPas.CreatePasName(aName: String; D: TIDLBaseObject
+  ): TPasData;
 
 begin
-  Result:=TPasData.Create(EscapeKeyWord(aName));
+  Result:=TPasData.Create(EscapeKeyWord(aName),D.SrcFile,D.Line,D.Column);
   FPasNameList.Add(Result);
 end;
 
@@ -1545,6 +1656,22 @@ begin
   if ParentName='' then ;
 end;
 
+function TBaseWebIDLToPas.GetDefPos(Def: TIDLBaseObject; WithoutFile: boolean
+  ): string;
+begin
+  Result:='('+IntToStr(Def.Line)+','+IntToStr(Def.Column)+')';
+  if not WithoutFile then
+    Result:=Def.SrcFile+Result;
+end;
+
+function TBaseWebIDLToPas.GetPasDataPos(D: TPasData; WithoutFile: boolean
+  ): string;
+begin
+  Result:='('+IntToStr(D.Line)+','+IntToStr(D.Column)+')';
+  if not WithoutFile then
+    Result:=D.SrcFile+Result;
+end;
+
 procedure TBaseWebIDLToPas.SetTypeAliases(AValue: TStrings);
 begin
   if FTypeAliases=AValue then Exit;
@@ -1573,7 +1700,6 @@ begin
     AllocatePasName(D,ParentName);
 end;
 
-
 procedure TBaseWebIDLToPas.ProcessDefinitions;
 
 begin

utils/pas2js/webidl2pas.lpi

@@ -7,7 +7,6 @@
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
-        <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
         <CompatibilityMode Value="True"/>
       </Flags>