mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 02:48:07 +02:00
* pas2jni: Filter out advanced methods and properties of RTL classes to prevent overbloated code.
git-svn-id: trunk@43386 -
This commit is contained in:
yury
parent
d3c5bd2a3e
commit
937683ec8f
@ -87,6 +87,8 @@ type
|
||||
function GetClassInfo(Index: integer): TClassInfo;
|
||||
end;
|
||||
|
||||
TMatchType = (mtNone, mtExact, mtWildcard, mtParams);
|
||||
|
||||
{ TWriter }
|
||||
|
||||
TWriter = class
|
||||
@ -105,6 +107,7 @@ type
|
||||
|
||||
procedure WriteFileComment(st: TTextOutStream);
|
||||
function FindInStringList(list: TStringList; const s: string): integer;
|
||||
function FindInStringListEx(list: TStringList; const s: string; AllMatch: boolean; out MatchType: TMatchType): integer;
|
||||
|
||||
procedure ProcessRules(d: TDef; const Prefix: string = '');
|
||||
function GetUniqueNum: integer;
|
||||
@ -193,14 +196,25 @@ const
|
||||
'system.fma', 'system.TExtended80Rec'
|
||||
);
|
||||
|
||||
ExcludeDelphi7: array[1..26] of string = (
|
||||
ExcludeDelphi7: array[1..57] of string = (
|
||||
'system.TObject.StringMessageTable', 'system.TObject.GetInterfaceEntryByStr', 'system.TObject.UnitName', 'system.TObject.Equals',
|
||||
'system.TObject.GetHashCode', 'system.TObject.ToString','system.TObject.QualifiedClassName','classes.TStream.ReadByte', 'classes.TStream.ReadWord',
|
||||
'system.TObject.GetHashCode', 'system.TObject.ToString','system.TObject.QualifiedClassName',
|
||||
'sysutils.TEncoding',
|
||||
'classes.TStream.ReadByte', 'classes.TStream.ReadWord',
|
||||
'classes.TStream.ReadDWord', 'classes.TStream.ReadQWord', 'classes.TStream.ReadAnsiString', 'classes.TStream.WriteByte',
|
||||
'classes.TStream.WriteWord', 'classes.TStream.WriteDWord', 'classes.TStream.WriteQWord', 'classes.TStream.WriteAnsiString',
|
||||
'classes.TStream.ReadData', 'classes.TStream.ReadBufferData', 'classes.TStream.WriteData', 'classes.TStream.WriteBufferData',
|
||||
'classes.TCollection.Exchange', 'classes.TStrings.Equals', 'classes.TStrings.GetNameValue', 'classes.TStrings.ExtractName',
|
||||
'classes.TStrings.TextLineBreakStyle', 'classes.TStrings.StrictDelimiter', 'classes.TStrings.GetEnumerator', 'classes.TStringList.OwnsObjects',
|
||||
'classes.TList.AddList'
|
||||
'classes.TStrings.Filter', 'classes.TStrings.ForEach', 'classes.TStrings.Reduce', 'classes.TStrings.Map', 'classes.TStrings.AddPair',
|
||||
'classes.TStrings.AddText', 'classes.TStrings.Fill', 'classes.TStrings.LastIndexOf', 'classes.TStrings.Pop', 'classes.TStrings.Reverse',
|
||||
'classes.TStrings.Shift', 'classes.TStrings.Slice', 'classes.TStrings.AlwaysQuote', 'classes.TStrings.LineBreak',
|
||||
'classes.TStrings.MissingNameValueSeparatorAction', 'classes.TStrings.SkipLastLineBreak', 'classes.TStrings.TrailingLineBreak', 'classes.TStrings.WriteBOM',
|
||||
'classes.TStrings.AddStrings#ClearFirst', 'classes.TStrings.IndexOf#aStart', 'classes.TStrings.LoadFromFile#IgnoreEncoding',
|
||||
'classes.TStrings.LoadFromStream#IgnoreEncoding',
|
||||
'classes.TStringList.SortStyle',
|
||||
'classes.TList.AddList', 'classes.TCustomMemoryStream.SizeBoundsSeek', 'classes.TBytesStream',
|
||||
'sortbase'
|
||||
);
|
||||
|
||||
SUnsupportedType = '<unsupported type>';
|
||||
@ -375,11 +389,23 @@ begin
|
||||
end;
|
||||
|
||||
function TWriter.FindInStringList(list: TStringList; const s: string): integer;
|
||||
var
|
||||
mt: TMatchType;
|
||||
begin
|
||||
Result:=FindInStringListEx(list, s, False, mt);
|
||||
end;
|
||||
|
||||
function TWriter.FindInStringListEx(list: TStringList; const s: string; AllMatch: boolean; out MatchType: TMatchType): integer;
|
||||
var
|
||||
len, cnt: integer;
|
||||
ss: string;
|
||||
begin
|
||||
if list.Find(s, Result) or (Result < 0) then
|
||||
MatchType:=mtNone;
|
||||
if list.Find(s, Result) then begin
|
||||
MatchType:=mtExact;
|
||||
exit;
|
||||
end;
|
||||
if Result < 0 then
|
||||
exit;
|
||||
if Result < list.Count then begin
|
||||
cnt:=3;
|
||||
@ -392,22 +418,36 @@ begin
|
||||
while cnt > 0 do begin
|
||||
ss:=list[Result];
|
||||
len:=Length(ss);
|
||||
if (len > 1) and (ss[len] = '*') then begin
|
||||
Dec(len);
|
||||
if AnsiCompareText(Copy(s, 1, len), Copy(ss, 1, len)) = 0 then
|
||||
if len > 1 then begin
|
||||
if ss[len] = '*' then begin
|
||||
Dec(len);
|
||||
MatchType:=mtWildcard;
|
||||
end
|
||||
else
|
||||
if AllMatch then begin
|
||||
len:=Pos('#', ss) - 1;
|
||||
MatchType:=mtParams;
|
||||
end
|
||||
else
|
||||
len:=0;
|
||||
|
||||
if (len > 0) and (AnsiCompareText(Copy(s, 1, len), Copy(ss, 1, len)) = 0) then
|
||||
exit;
|
||||
end;
|
||||
Inc(Result);
|
||||
Dec(cnt);
|
||||
end;
|
||||
end;
|
||||
MatchType:=mtNone;
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
procedure TWriter.ProcessRules(d: TDef; const Prefix: string);
|
||||
var
|
||||
i: integer;
|
||||
s: string;
|
||||
s, c: string;
|
||||
b: boolean;
|
||||
mt: TMatchType;
|
||||
begin
|
||||
if d.DefType = dtClass then
|
||||
with TClassDef(d) do
|
||||
@ -415,15 +455,31 @@ begin
|
||||
SetNotUsed;
|
||||
exit;
|
||||
end;
|
||||
s:=Prefix + d.Name;
|
||||
if FindInStringList(ExcludeList, s) >= 0 then
|
||||
d.SetNotUsed
|
||||
s:=Prefix + d.AliasName;
|
||||
if FindInStringListEx(ExcludeList, s, (d.DefType = dtProc), mt) >= 0 then begin
|
||||
if mt <> mtParams then begin
|
||||
if d.DefType = dtParam then
|
||||
d.Parent.SetNotUsed
|
||||
else
|
||||
d.SetNotUsed;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if FindInStringList(IncludeList, s) >= 0 then
|
||||
d.IsUsed:=True;
|
||||
if not (d.DefType in [dtUnit, dtClass]) then
|
||||
b:=not (d.DefType in [dtUnit, dtClass]);
|
||||
// Check exclusion rules for parameters of overloaded procs
|
||||
if (d.DefType = dtProc) and (mt = mtParams) then begin
|
||||
b:=False;
|
||||
c:='#';
|
||||
end
|
||||
else
|
||||
c:='.';
|
||||
|
||||
if b then
|
||||
exit;
|
||||
s:=s + '.';
|
||||
|
||||
s:=s + c;
|
||||
for i:=0 to d.Count - 1 do
|
||||
ProcessRules(d[i], s);
|
||||
end;
|
||||
@ -2317,6 +2373,14 @@ begin
|
||||
end;
|
||||
|
||||
function TWriter.JniToPasType(d: TDef; const v: string; CheckNil: boolean): string;
|
||||
|
||||
function _GetFullName(d: TDef): string;
|
||||
begin
|
||||
Result:=Format('%s.%s', [d.Parent.Name, d.Name]);
|
||||
if Result = 'types.TDuplicates' then
|
||||
Result:='classes.TDuplicates'; // Hack for Delphi 7 compatibility
|
||||
end;
|
||||
|
||||
var
|
||||
n: string;
|
||||
begin
|
||||
@ -2361,7 +2425,7 @@ begin
|
||||
dtProcType:
|
||||
Result:=Format('%sGetHandler(_env, %s, %s)', [GetClassPrefix(d), Result, GetTypeInfoVar(d)]);
|
||||
dtEnum:
|
||||
Result:=Format('%s.%s(_GetIntObjValue(_env, %s, %s))', [d.Parent.Name, d.Name, Result, GetTypeInfoVar(d)]);
|
||||
Result:=Format('%s(_GetIntObjValue(_env, %s, %s))', [_GetFullName(d), Result, GetTypeInfoVar(d)]);
|
||||
dtSet:
|
||||
Result:=Format('%s.%s(%s(_GetIntObjValue(_env, %s, %s)))', [d.Parent.Name, d.Name, GetPasIntType(TSetDef(d).Size), Result, GetTypeInfoVar(d)]);
|
||||
dtPointer:
|
||||
@ -2780,8 +2844,6 @@ begin
|
||||
end;
|
||||
}
|
||||
constructor TWriter.Create;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Units:=TStringList.Create;
|
||||
FClasses:=TClassList.Create;
|
||||
@ -2790,12 +2852,6 @@ begin
|
||||
IncludeList.Duplicates:=dupIgnore;
|
||||
ExcludeList:=TStringList.Create;
|
||||
ExcludeList.Duplicates:=dupIgnore;
|
||||
|
||||
for i:=Low(ExcludeStd) to High(ExcludeStd) do
|
||||
ExcludeList.Add(ExcludeStd[i]);
|
||||
for i:=Low(ExcludeDelphi7) to High(ExcludeDelphi7) do
|
||||
ExcludeList.Add(ExcludeDelphi7[i]);
|
||||
|
||||
FThisUnit:=TUnitDef.Create(nil, dtUnit);
|
||||
FRecords:=TObjectList.Create(False);
|
||||
FRealClasses:=TObjectList.Create(False);
|
||||
@ -2880,6 +2936,13 @@ begin
|
||||
ExcludeList[i]:=Trim(ExcludeList[i]);
|
||||
ExcludeList.Sorted:=True;
|
||||
|
||||
for i:=Low(ExcludeStd) to High(ExcludeStd) do
|
||||
if IncludeList.IndexOf(ExcludeStd[i]) < 0 then
|
||||
ExcludeList.Add(ExcludeStd[i]);
|
||||
for i:=Low(ExcludeDelphi7) to High(ExcludeDelphi7) do
|
||||
if IncludeList.IndexOf(ExcludeDelphi7[i]) < 0 then
|
||||
ExcludeList.Add(ExcludeDelphi7[i]);
|
||||
|
||||
FThisUnit.Name:=LibName;
|
||||
FThisUnit.AliasName:='system';
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user