paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 15:47:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow to specify list of banned classes.

Browse Source
This commit is contained in:
Michaël Van Canneyt 2025-03-04 17:54:41 +01:00
parent b4af922d15
commit 2484efc2e7
2 changed files with 79 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
packages/webidl/src/webidltopas.pp
View File

@ -133,6 +133,7 @@ type
FArrayPrefix: String;
FArraySuffix: String;
FAutoTypes: TStrings;
FBanned: TStrings;
FBaseOptions: TBaseConversionOptions;
FClassPrefix: String;
FClassSuffix: String;
@ -161,6 +162,7 @@ type
function GetUsed(D: TIDLDefinition): Boolean;
function InUsedList(D: TIDLDefinition): Boolean;
procedure ResolveCallbackInterfaces;
procedure SetBanned(AValue: TStrings);
procedure SetGlobalVars(const AValue: TStrings);
procedure SetIncludeImplementationCode(AValue: TStrings);
procedure SetIncludeInterfaceCode(AValue: TStrings);
@ -179,8 +181,8 @@ type
Function CreateContext: TWebIDLContext; virtual;
// Auxiliary routines
function CheckChromeOnly(D: TIDLDefinition): Boolean;
function MarkUsed(D: TIDLDefinition; ParentIsUsed: Boolean): Boolean;
procedure MarkUsedDefinitions(aList: TIDLDefinitionList; ParentIsUsed: Boolean);
function MarkUsed(D: TIDLDefinition; ParentIsUsed: Boolean; aContext: string): Boolean;
procedure MarkUsedDefinitions(aList: TIDLDefinitionList; ParentIsUsed: Boolean; const aContext: string);
procedure PropagateChromeOnly(aList: TIDLDefinitionList);
procedure AddFullMemberList(aParent: TIDLStructuredDefinition; AddToList: TIDLDefinitionList);
function GetFullMemberList(aParent: TIDLStructuredDefinition): TIDLDefinitionList;
@ -328,6 +330,7 @@ type
Property WebIDLVersion: TWebIDLVersion Read FWebIDLVersion Write FWebIDLVersion;
Property TypeAliases: TStrings Read FTypeAliases Write SetTypeAliases;
Property GlobalVars: TStrings Read FGlobalVars Write SetGlobalVars;
Property Banned: TStrings Read FBanned Write SetBanned;
Property IncludeInterfaceCode: TStrings Read FIncludeInterfaceCode Write SetIncludeInterfaceCode;
Property IncludeImplementationCode: TStrings Read FIncludeImplementationCode Write SetIncludeImplementationCode;
Property DictionaryClassParent: String Read FDictionaryClassParent Write FDictionaryClassParent;
@ -1235,11 +1238,13 @@ begin
FIncludeInterfaceCode:=TStringList.Create;
FIncludeImplementationCode:=TStringList.Create;
FGlobalDefs:=TFPObjectHashTable.Create(False);
FBanned:=TStringList.Create;
end;
destructor TBaseWebIDLToPas.Destroy;
begin
FreeAndNil(FBanned);
FreeAndNil(FUsedDefs);
FreeAndNil(FGlobalDefs);
FreeAndNil(FIncludeInterfaceCode);
@ -2996,17 +3001,11 @@ function TBaseWebIDLToPas.ConvertDef(D: TIDLDefinition): Boolean;
var
AD : TIDLAttributeDefinition absolute D;
FD : TIDLFunctionDefinition;
A,RT : TIDLDefinition;
FAD : TIDLArgumentDefinition absolute A;
RN,N : String;
ANT : TPascalNativeType;
isChrome : Boolean;
begin
isChrome:=False;
Result:=(coChromeWindow in BaseOptions) or Not D.HasSimpleAttribute('ChromeOnly');
isChrome:=D.HasSimpleAttribute('ChromeOnly');
Result:=(coChromeWindow in BaseOptions) or Not IsChrome;
if not Result then
exit;
if Result and (coOnlyUsed in BaseOptions) then
@ -3142,6 +3141,12 @@ begin
end;
procedure TBaseWebIDLToPas.SetBanned(AValue: TStrings);
begin
if FBanned=AValue then Exit;
FBanned.Assign(AValue);
end;
function TBaseWebIDLToPas.GetUsed(D: TIDLDefinition) : Boolean;
begin
@ -3155,7 +3160,16 @@ begin
Result:=FUsedDefs.Items[D.Name]<>Nil;
end;
function TBaseWebIDLToPas.MarkUsed(D: TIDLDefinition; ParentIsUsed : Boolean) : Boolean;
function TBaseWebIDLToPas.MarkUsed(D: TIDLDefinition; ParentIsUsed : Boolean; aContext : string) : Boolean;
function AddToContext(const aTerm : String) : string;
begin
if aContext<>'' then
Result:=aContext+'->'+aTerm
else
Result:=aTerm;
end;
// Return true if the definition 'used' status was change to true
function DoMark : Boolean;
@ -3172,6 +3186,11 @@ function TBaseWebIDLToPas.MarkUsed(D: TIDLDefinition; ParentIsUsed : Boolean) :
exit;
if ParentIsUsed or InUsedList(D) then
begin
if (FBanned.IndexOf(D.Name)<>-1) then
begin
DoLog('Banned definition %s found in context: %s',[D.Name,aContext]);
Raise Exception.CreateFmt('Banned definition %s found. Check log for more detail',[D.Name]);
end;
// Writeln('Marking ',D.GetNamePath,' as used');
TPasData(D.Data).Used:=True;
Result:=True;
@ -3185,7 +3204,7 @@ function TBaseWebIDLToPas.MarkUsed(D: TIDLDefinition; ParentIsUsed : Boolean) :
begin
lDef:=FindGlobalDef(aTypeName);
Result:=(lDef<>nil) and MarkUsed(lDef,True);
Result:=(lDef<>nil) and MarkUsed(lDef,True,AddToContext(aTypeName));
end;
var
@ -3205,25 +3224,25 @@ begin
// Mark sub-classes as used
if D Is TIDLInterfaceDefinition then
begin
MarkUsedDefinitions(TIDLInterfaceDefinition(D).Members,True);
MarkUsedDefinitions(TIDLInterfaceDefinition(D).Members,True,AddToContext(D.Name+'Members'));
P:=TIDLInterfaceDefinition(D).ParentInterface;
While Assigned(P) do
begin
MarkUsed(P,True);
MarkUsed(P,True,AddToContext(D.Name+'.Parent'));
P:=P.ParentInterface;
end;
P:=TIDLInterfaceDefinition(D);
For I:=0 to P.Partials.Count-1 do
MarkUsed(P.Partial[i],True);
MarkUsed(P.Partial[i],True,AddToContext(D.Name));
end
else if D Is TIDLNamespaceDefinition then
begin
MarkUsedDefinitions(TIDLNamespaceDefinition(D).Members,True);
MarkUsedDefinitions(TIDLNamespaceDefinition(D).Members,True,AddToContext(D.Name+'.Members'));
end
else if D Is TIDLDictionaryDefinition then
begin
MarkUsedDefinitions(TIDLDictionaryDefinition(D).Members,True);
MarkUsed(TIDLDictionaryDefinition(D).ParentDictionary,True);
MarkUsedDefinitions(TIDLDictionaryDefinition(D).Members,True,AddToContext(D.Name+'.Members'));
MarkUsed(TIDLDictionaryDefinition(D).ParentDictionary,True,AddToContext(D.Name+'.parent'));
end
else if D is TIDLIncludesDefinition then
begin
@ -3232,23 +3251,23 @@ begin
else if D Is TIDLFunctionDefinition then
begin
FD:=TIDLFunctionDefinition(D);
MarkUsedDefinitions(FD.Arguments,True);
MarkUsed(FD.ReturnType,True);
MarkUsedDefinitions(FD.Arguments,True,AddToContext(D.Name+'.Arguments'));
MarkUsed(FD.ReturnType,True,AddToContext(D.Name+'.ReturnType'));
end
else if D Is TIDLUnionTypeDefDefinition then
MarkUsedDefinitions(TIDLUnionTypeDefDefinition(D).Union,True)
MarkUsedDefinitions(TIDLUnionTypeDefDefinition(D).Union,True,AddToContext(D.Name+'.Elements'))
else if D is TIDLAttributeDefinition then
MarkUsed(TIDLAttributeDefinition(D).AttributeType,True)
MarkUsed(TIDLAttributeDefinition(D).AttributeType,True,AddToContext(D.Name+'.AttributeType'))
else if D is TIDLArgumentDefinition then
MarkUsed(TIDLArgumentDefinition(D).ArgumentType,True)
MarkUsed(TIDLArgumentDefinition(D).ArgumentType,True,AddToContext(D.Name+'.ArgumentType'))
else if D is TIDLSequenceTypeDefDefinition then
MarkUsed(TIDLSequenceTypeDefDefinition(D).ElementType,True)
MarkUsed(TIDLSequenceTypeDefDefinition(D).ElementType,True,AddToContext(D.Name+'.ElementType'))
else if D is TIDLPromiseTypeDefDefinition then
MarkUsed(TIDLPromiseTypeDefDefinition(D).ReturnType,True)
MarkUsed(TIDLPromiseTypeDefDefinition(D).ReturnType,True,AddToContext(D.Name+'.ReturnType'))
else if D is TIDLMapLikeDefinition then
begin
MarkUsed(TIDLMapLikeDefinition(D).KeyType,True);
MarkUsed(TIDLMapLikeDefinition(D).ValueType,True);
MarkUsed(TIDLMapLikeDefinition(D).KeyType,True,AddToContext(D.Name+'.KeyType'));
MarkUsed(TIDLMapLikeDefinition(D).ValueType,True,AddToContext(D.Name+'.ValueType'));
end
else if D is TIDLTypeDefDefinition then
begin
@ -3262,34 +3281,43 @@ begin
else if D is TIDLSerializerDefinition then
begin
SerializerD:=TIDLSerializerDefinition(D);
MarkUsed(SerializerD.SerializerFunction,True);
MarkUsed(SerializerD.SerializerFunction,True,AddToContext(D.Name+'.SerializerFunction'));
end
else if D is TIDLDictionaryMemberDefinition then
begin
DMD:=TIDLDictionaryMemberDefinition(D);
MarkUsed(DMD.MemberType,True);
MarkUsed(DMD.MemberType,True,AddToContext(D.Name+'.MemberType'));
// MarkUsed(DMD.DefaultValue,True);
end
else if D is TIDLEnumDefinition then
//
else if D is TIDLCallBackDefinition then
MarkUsed(TIDLCallBackDefinition(D).FunctionDef,True)
MarkUsed(TIDLCallBackDefinition(D).FunctionDef,True,AddToContext(D.Name+'.FunctionDef'))
else if D is TIDLSetlikeDefinition then
MarkUsed(TIDLSetlikeDefinition(D).ElementType,True)
MarkUsed(TIDLSetlikeDefinition(D).ElementType,True,AddToContext(D.Name+'.SetElement') )
else if D is TIDLImplementsOrIncludesDefinition then
//
else if D is TIDLIterableDefinition then
begin
IT:=TIDLIterableDefinition(D);
MarkUsed(IT.ValueType,True);
MarkUsed(IT.KeyType,True);
MarkUsed(IT.ValueType,True,AddToContext(D.Name+'.ValueType'));
MarkUsed(IT.KeyType,True,AddToContext(D.Name+'.KeyType'));
end
else {if Verbose then}
raise EConvertError.Create('[20220725172214] TBaseWebIDLToPas.ResolveTypeDef unknown '+D.Name+':'+D.ClassName+' at '+GetDefPos(D));
end;
procedure TBaseWebIDLToPas.MarkUsedDefinitions(aList : TIDLDefinitionList; ParentIsUsed : Boolean);
procedure TBaseWebIDLToPas.MarkUsedDefinitions(aList : TIDLDefinitionList; ParentIsUsed : Boolean; const aContext : string);
function AddToContext(aAdd : string) : string;
begin
if aContext<>'' then
Result:=aContext+'['+aAdd+']'
else
Result:=aAdd
end;
var
D : TIDLDefinition;
@ -3297,11 +3325,11 @@ var
begin
For D In aList do
begin
MarkUsed(D,ParentIsUsed);
MarkUsed(D,ParentIsUsed,AddToContext(D.Name));
end;
end;
Function TBaseWebIDLToPas.CheckChromeOnly(D : TIDLDefinition) : Boolean;
function TBaseWebIDLToPas.CheckChromeOnly(D: TIDLDefinition): Boolean;
Function IsChromeOnly(D : TIDLDefinition) : boolean; inline;
@ -3521,7 +3549,7 @@ begin
if (coOnlyUsed in BaseOptions) then
begin
DoLog('Marking used type definitions.');
MarkUsedDefinitions(FContext.Definitions,False);
MarkUsedDefinitions(FContext.Definitions,False,'');
end;
if Not (coChromeWindow in BaseOptions) then
begin

16
utils/pas2js/webidl2pas.pp
View File

@ -159,6 +159,16 @@ begin
else
FWebIDLToPas.GlobalVars.CommaText:=A;
A:=GetOptionValue('b','banned');
if (Copy(A,1,1)='@') then
begin
Delete(A,1,1);
FWebIDLToPas.Banned.LoadFromFile(A);
end
else
FWebIDLToPas.Banned.CommaText:=A;
if HasOption('l','list') then
begin
L:=TStringList.Create;
@ -230,7 +240,7 @@ end;
procedure TWebIDLToPasApplication.DoRun;
const
Short = 'ced::f:g:hi:m:n:o:pt:u:vw:x:rl:a';
Short = 'ced::f:g:hi:m:n:o:pt:u:vw:x:rl:ab';
Long : Array of string = (
'help',
'constexternal',
@ -250,7 +260,8 @@ const
'extra:',
'chrome',
'list:',
'private'
'private',
'banned:'
);
@ -354,6 +365,7 @@ begin
Writeln(StdErr,'-v --verbose Output some diagnostic information.');
Writeln(StdErr,'-w --webidlversion=V Set web IDL version. Allowed values: v1 or v2.');
Writeln(StdErr,'-x --extra=units Extra units to put in uses clause (comma separated list).');
Writeln(StdErr,'-b --banned=list List of classes that may not be added to the final file (exclude e.g. window classes for workers)');
ExitCode:=Ord(Msg<>'');
{AllowWriteln-}
end;