* Merging revisions r44346 from trunk:

    ------------------------------------------------------------------------
    r44346 | michael | 2020-03-23 14:53:24 +0100 (Mon, 23 Mar 2020) | 1 line
    
    * Add constructor (part of webidl 2 spec)
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46568 -

packages/webidl/src/webidldefs.pp

@@ -118,7 +118,7 @@ Type
   end;
 
   { TIDLConstDefinition }
-  TConstType = (ctFloat,ctInteger,ctBoolean,ctInfinity,ctNegInfinity,ctNan,ctNull,ctString,ctEmptyArray);
+  TConstType = (ctFloat,ctInteger,ctBoolean,ctInfinity,ctNegInfinity,ctNan,ctNull,ctString,ctEmptyArray,ctEmptyObject);
   TIDLConstDefinition = Class(TIDLDefinition)
   private
     FConstType: TConstType;
@@ -207,6 +207,7 @@ Type
   private
     FDefaultValue: String;
     FHasDefaultValue: Boolean;
+    FHasEllipsis: Boolean;
     FIsOptional: Boolean;
     FType: TIDLTypeDefDefinition;
     procedure SetType(AValue: TIDLTypeDefDefinition);
@@ -218,11 +219,12 @@ Type
     Property ArgumentType : TIDLTypeDefDefinition Read FType Write SetType;
     Property IsOptional : Boolean Read FIsOptional Write FIsOptional;
     Property HasDefaultValue : Boolean Read FHasDefaultValue Write FHasDefaultValue;
+    Property HasEllipsis : Boolean Read FHasEllipsis Write FHasEllipsis;
     Property DefaultValue : String Read FDefaultValue Write FDefaultValue;
   end;
 
   { TIDLFunctionDefinition }
-  TFunctionOption = (foCallBack,foStatic,foStringifier,foGetter, foSetter, foDeleter, foLegacyCaller);
+  TFunctionOption = (foCallBack,foStatic,foStringifier,foGetter, foSetter, foDeleter, foLegacyCaller, foConstructor);
   TFunctionOptions = Set of TFunctionOption;
 
   TIDLFunctionDefinition = Class(TIDLDefinition)

packages/webidl/src/webidlparser.pp

@@ -129,7 +129,7 @@ implementation
 Resourcestring
   SErrInvalidToken = 'Invalid token: expected "%s", got: "%s"';
   SErrInvalidTokenList = 'Invalid token: expected one of "%s", got: "%s"';
-  SExpectedOther = 'Unexpected token in attribute list: "%s".';
+  // SExpectedOther = 'Unexpected token in attribute list: "%s".';
   SErrUnExpectedToken = 'Unexpected token : "%s"';
   SErrTypeNotAllowed = 'Type "%s" not allowed in "%s" type.';
   SErrDictionaryNotFound = 'Dictionary %s not found';
@@ -349,6 +349,11 @@ begin
       GetToken;
       end;
     Result.ArgumentType:=ParseType(Result,False);
+    if CurrentToken=tkEllipsis then
+      begin
+      Result.HasEllipsis:=True;
+      GetToken;
+      end;
     CheckCurrentToken(tkIdentifier);
     Result.Name:=CurrentTokenString;
   except
@@ -428,7 +433,7 @@ function TWebIDLParser.ParseOperation(aParent: TIDLBaseObject): TIDLFunctionDefi
   on exit, we're on the final ) }
 
 Const
-  Specials = [tkGetter, tkSetter, tkDeleter, tkLegacyCaller];
+  Specials = [tkGetter, tkSetter, tkDeleter, tkLegacyCaller, tkConstructor];
 
 Var
   Opts : TFunctionOptions;
@@ -443,16 +448,22 @@ begin
       tkSetter : FO:=foSetter;
       tkDeleter : FO:=foDeleter;
       tkLegacyCaller : FO:=foLegacyCaller;
+      tkConstructor : fo:=foConstructor;
     end;
     Include(Opts,FO);
     GetToken;
     end;
   Result:=TIDLFunctionDefinition(Context.Add(aParent,TIDLFunctionDefinition,''));
   try
-    Result.ReturnType:=ParseType(Result,False,True);
-    CheckCurrentToken(tkIdentifier);
-    Result.Name:=CurrentTokenString;
-    GetToken;
+    if (foConstructor in Opts) then
+      Result.Name:='New'
+    else
+      begin
+      Result.ReturnType:=ParseType(Result,False,True);
+      CheckCurrentToken(tkIdentifier);
+      Result.Name:=CurrentTokenString;
+      GetToken;
+      end;
     ParseArguments(Result.Arguments);
     Result.Options:=Result.Options+Opts;
   except
@@ -605,7 +616,7 @@ function TWebIDLParser.ParseConstValue(out aValue: UTF8String;
 
 Const
   ValueTokens = [tkTrue,tkFalse,tkNumberFloat,tkNumberInteger,tkNull,tkInfinity,tkNegInfinity,tkNan];
-  ExtendedTokens = [tkSquaredBraceOpen,tkString];
+  ExtendedTokens = [tkSquaredBraceOpen,tkString, tkCurlyBraceOpen];
   ExtendedValueTokens = ExtendedTokens + ValueTokens;
   AllowedTokens : Array[Boolean] of TIDLTokens = (ValueTokens,ExtendedValueTokens);
 
@@ -634,6 +645,15 @@ begin
         end
       else
         Error(SErrUnExpectedToken,[CurrentTokenString]);
+    tkCurlyBraceOpen :
+      If aExtended then
+        begin
+        ExpectToken(tkCurlyBraceClose);
+        aValue:=AValue+CurrentTokenString;
+        Result:=ctEmptyObject
+        end
+      else
+        Error(SErrUnExpectedToken,[CurrentTokenString]);
   end;
 end;
 
@@ -903,11 +923,14 @@ Var
   aName : UTF8String;
 
 begin
+  aName:=CurrentTokenString;
   if version=v1 then
-    Result:=ParseImplements('',aParent)
+    begin
+    ExpectToken(tkImplements);
+    Result:=ParseImplements(aName,aParent)
+    end
   else
     begin
-    aName:=CurrentTokenString;
     ExpectTokens([tkImplements,tkIncludes]);
     case CurrentToken of
      tkIncludes: Result:=ParseIncludes(aName,aParent);
@@ -945,25 +968,28 @@ function TWebIDLParser.ParseDictionaryMember(aParent : TIDLBaseObject): TIDLDict
 Var
   Attrs : TAttributeList;
   tk : TIDLToken;
-  isRequired : Boolean;
+  isReq : Boolean;
   S : UTF8String;
 
 begin
   Attrs:=Nil;
   tk:=CurrentToken;
-  isRequired:=(tk=tkRequired);
-  if IsRequired then
+  isReq:=(tk=tkRequired);
+  if IsReq then
     tk:=GetToken;
   if tk=tkSquaredBraceOpen then
     begin
     Attrs:=ParseAttributes;
     tk:=GetToken;
+    isReq:=(tk=tkRequired);
+    if IsReq then
+      tk:=GetToken;
     end;
   Result:=TIDLDictionaryMemberDefinition(Context.Add(aParent,TIDLDictionaryMemberDefinition,''));
   try
     Result.Attributes:=Attrs;
-    Result.IsRequired:=isRequired;
-    Result.MemberType:=ParseType(Result,Assigned(Attrs),True);
+    Result.IsRequired:=isReq;
+    Result.MemberType:=ParseType(Result,False,True);
     CheckCurrentToken(tkIdentifier);
     Result.Name:=CurrentTokenString;
     tk:=GetToken;
@@ -1181,8 +1207,7 @@ Var
 begin
   if Version=V1 then
     begin
-    N:=CurrentTokenString;
-    ExpectToken(tkImplements);
+    N:=aName
     end
   else
     N:=aName;

packages/webidl/src/webidlscanner.pp

@@ -103,14 +103,15 @@ type
     tkMapLike,
     tkRecord,
     tkSetLike,
-    tkOther
+    tkOther,
+    tkConstructor
     );
   TIDLTokens = Set of TIDLToken;
   EWebIDLScanner = class(EParserError);
 
 Const
-  V2Tokens = [tkMixin,tkIncludes,tkMapLike,tkRecord,tkSetLike,tkFrozenArray];
-  V1Tokens = [];
+  V2Tokens = [tkMixin,tkIncludes,tkMapLike,tkRecord,tkSetLike,tkFrozenArray,tkConstructor];
+  V1Tokens = [tkImplements];
   VersionNonTokens : Array[TWebIDLVersion] of TIDLTokens = (V2Tokens,V1Tokens);
 
 Type
@@ -234,7 +235,8 @@ const
   'maplike',
   'record',
   'setlike',
-  'other'
+  'other',
+  'constructor'
   );
 
 Function GetTokenName(aToken : TIDLToken) : String;
@@ -666,6 +668,7 @@ begin
          inc(TokenStr);
          if TokenStr[0]<>'.' then
            Error(SErrInvalidEllipsis);
+         inc(TokenStr);
          FCurTokenString:='...';
          Result:=tkEllipsis;
          end;

packages/webidl/src/webidltopas.pp

@@ -252,7 +252,7 @@ function TWebIDLToPas.WriteConst(aConst: TIDLConstDefinition): Boolean;
 
 Const
   ConstTypes : Array[TConstType] of String =
-     ('Double','NativeInt','Boolean','JSValue','JSValue','JSValue','JSValue','String','JSValue');
+     ('Double','NativeInt','Boolean','JSValue','JSValue','JSValue','JSValue','String','JSValue','JSValue');
 Var
   S : String;
 
@@ -452,7 +452,6 @@ Var
 
   var
     I : integer;
-    P : TPasData;
     NOrig,N,N2 : String;
     isDup : Boolean;
     D2 : TIDLDefinition;
@@ -672,6 +671,7 @@ begin
     'long long': TN:=UsePascalType('NativeInt');
     'unsigned short': TN:=UsePascalType('Cardinal');
     'unrestricted float': TN:=UsePascalType('Double');
+    'unrestricted double': TN:=UsePascalType('Double');
     'unsigned long': TN:=UsePascalType('NativeInt');
     'unsigned long long': TN:=UsePascalType('NativeInt');
     'octet': TN:=UsePascalType('Byte');
@@ -1131,21 +1131,34 @@ Var
 
 begin
   Result:=True;
-  FN:=GetName(aDef);
-  if FN<>aDef.Name then
-    Suff:=Format('; external name ''%s''',[aDef.Name]);
-  RT:=GetTypeName(aDef.ReturnType,False);
-  if (RT='void') then
-    RT:='';
+  if not (foConstructor in aDef.Options) then
+    begin
+    FN:=GetName(aDef);
+    if FN<>aDef.Name then
+      Suff:=Format('; external name ''%s''',[aDef.Name]);
+    RT:=GetTypeName(aDef.ReturnType,False);
+    if (RT='void') then
+      RT:='';
+    end
+  else
+    FN:='New';
   Overloads:=GetOverloads(ADef);
   try
+    for I:=0 to aDef.Arguments.Count-1 do
+      if aDef.Argument[i].HasEllipsis then
+        Suff:='; varargs';
     if Overloads.Count>1 then
       Suff:=Suff+'; overload';
     For I:=0 to Overloads.Count-1 do
       begin
       Args:=GetArguments(TIDLDefinitionList(Overloads[i]),False);
       if (RT='') then
-        AddLn('Procedure %s%s%s;',[FN,Args,Suff])
+        begin
+        if not (foConstructor in aDef.Options) then
+          AddLn('Procedure %s%s%s;',[FN,Args,Suff])
+        else
+          AddLn('constructor %s%s%s;',[FN,Args,Suff]);
+        end
       else
         AddLn('function %s%s: %s%s;',[FN,Args,RT,Suff])
       end;
@@ -1181,8 +1194,9 @@ begin
   EnsureSection(csType);
   for D in aList do
     if D is TIDLDictionaryDefinition then
-      if WriteDictionaryDef(DD) then
-        Inc(Result);
+      if not TIDLDictionaryDefinition(D).IsPartial then
+        if WriteDictionaryDef(DD) then
+          Inc(Result);
 end;
 
 function TWebIDLToPas.WriteInterfaceDefs(aList: TIDLDefinitionList): Integer;
@@ -1196,8 +1210,9 @@ begin
   EnsureSection(csType);
   for D in aList do
     if D is TIDLInterfaceDefinition then
-      if WriteInterfaceDef(ID) then
-        Inc(Result);
+      if not TIDLInterfaceDefinition(D).IsPartial then
+        if WriteInterfaceDef(ID) then
+          Inc(Result);
 end;
 
 procedure TWebIDLToPas.Getoptions(L : TStrings);
@@ -1363,7 +1378,6 @@ procedure TWebIDLToPas.ProcessDefinitions;
 begin
   FContext.AppendPartials;
   FContext.AppendIncludes;
-
   AllocatePasNames(FContext.Definitions);
 end;
 

packages/webidl/tests/tcidlparser.pp

@@ -245,6 +245,7 @@ Type
     Procedure ParseSingleSimpleElement;
     Procedure ParseSingleSimpleElementInheritance;
     Procedure ParseSingleSimpleElementAttributes;
+    Procedure ParseSingleSimpleElementAttributes2;
     Procedure ParseSingleSimpleElementRequired;
     Procedure ParseSingleSimpleElementDefaultString;
     Procedure ParseSingleSimpleElementRequiredDefaultString;
@@ -699,6 +700,7 @@ Var
 begin
   Src:=AName+' implements '+aImplements+';'+sLineBreak;
   InitSource(Src);
+  Parser.Version:=V1;
   Parser.Parse;
   AssertEquals('Correct class',TIDLImplementsDefinition,Definitions[0].ClassType);
   Result:=Definitions[0] as TIDLImplementsDefinition;
@@ -895,7 +897,16 @@ end;
 procedure TTestDictionaryParser.ParseSingleSimpleElementAttributes;
 begin
   ParseDictionary('A','',['[Replaceable] required string B']);
-  AssertMember(0,'B','string','',ctNull,False);
+  AssertMember(0,'B','string','',ctNull,True);
+  AssertTrue('Has attributes',Dict[0].HasAttributes);
+  AssertEquals('Attribute count',1,Dict[0].Attributes.Count);
+  AssertEquals('Has attributes','Replaceable',Dict[0].Attributes[0]);
+end;
+
+procedure TTestDictionaryParser.ParseSingleSimpleElementAttributes2;
+begin
+  ParseDictionary('A','',['[Replaceable] octet B']);
+  AssertMember(0,'B','octet','',ctNull,False);
   AssertTrue('Has attributes',Dict[0].HasAttributes);
   AssertEquals('Attribute count',1,Dict[0].Attributes.Count);
   AssertEquals('Has attributes','Replaceable',Dict[0].Attributes[0]);
@@ -1175,7 +1186,7 @@ Var
 
 begin
   Version:=v2;
-  D:=TestTypeDef(aDef ,'A','record'});
+  D:=TestTypeDef(aDef ,'A','record');
   AssertEquals('Correct class',TIDLRecordDefinition,D.ClassType);
   R:=TIDLRecordDefinition(D);
   AssertNotNull('Have key type',R.KeyType);