paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* pas2jni: Do not include array element types from arrays, which is not processed.

Browse Source 
git-svn-id: trunk@34862 -
This commit is contained in:
yury 2016-11-10 14:39:58 +00:00
parent 860ad25430
commit 78914d9b20
2 changed files with 42 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
utils/pas2jni/def.pas
View File

@ -54,6 +54,7 @@ type
procedure AddRef;
procedure DecRef;
procedure SetExtUsed(ExtDef: TDef; AUsed: boolean; var HasRef: boolean);
function ShouldUseChild(d: TDef): boolean; virtual;
public
DefType: TDefType;
DefId: integer;
@ -87,6 +88,7 @@ type
FHasClassRef: boolean;
protected
procedure SetIsUsed(const AValue: boolean); override;
function ShouldUseChild(d: TDef): boolean; override;
public
CType: TClassType;
AncestorClass: TClassDef;
@ -169,6 +171,7 @@ type
FHasRetTypeRef: boolean;
protected
procedure SetIsUsed(const AValue: boolean); override;
function ShouldUseChild(d: TDef): boolean; override;
public
ProcType: TProcType;
ReturnType: TDef;
@ -224,6 +227,9 @@ type
const
ReplDefs = [dtField, dtProp, dtProc];
var
OnCanUseDef: function (def, refdef: TDef): boolean;
implementation
function IsSameType(t1, t2: TDef): boolean;
@ -370,6 +376,11 @@ begin
SetExtUsed(ReturnType, AValue, FHasRetTypeRef);
end;
function TProcDef.ShouldUseChild(d: TDef): boolean;
begin
Result:=d.DefType in [dtParam];
end;
procedure TProcDef.ResolveDefs;
begin
inherited ResolveDefs;
@ -407,6 +418,11 @@ begin
SetExtUsed(AncestorClass, AValue, FHasClassRef);
end;
function TClassDef.ShouldUseChild(d: TDef): boolean;
begin
Result:=d.DefType in [dtProc, dtField, dtProp];
end;
procedure TClassDef.ResolveDefs;
begin
inherited ResolveDefs;
@ -486,10 +502,13 @@ procedure TDef.SetIsUsed(const AValue: boolean);
var
i: integer;
f: boolean;
d: TDef;
begin
if FInSetUsed or (DefType = dtNone) or IsPrivate then
exit;
if AValue then begin
if Assigned(OnCanUseDef) and not OnCanUseDef(Self, Parent) then
exit;
AddRef;
f:=FRefCnt = 1;
end
@ -503,8 +522,11 @@ begin
// Update used mark of children only once
FInSetUsed:=True;
try
for i:=0 to Count - 1 do
Items[i].IsUsed:=AValue;
for i:=0 to Count - 1 do begin
d:=Items[i];
if ShouldUseChild(d) then
d.IsUsed:=AValue;
end;
finally
FInSetUsed:=False;
end;
@ -550,6 +572,8 @@ begin
if AUsed then begin
if HasRef then
exit;
if Assigned(OnCanUseDef) and not OnCanUseDef(ExtDef, Self) then
exit;
OldRefCnt:=ExtDef.RefCnt;
ExtDef.IsUsed:=True;
HasRef:=OldRefCnt <> ExtDef.RefCnt;
@ -561,6 +585,11 @@ begin
end;
end;
function TDef.ShouldUseChild(d: TDef): boolean;
begin
Result:=True;
end;
procedure TDef.SetItem(Index: Integer; const AValue: TDef);
begin
CheckItems;

12
utils/pas2jni/writer.pas
View File

@ -1495,12 +1495,12 @@ begin
if not d.IsUsed or not d.IsObjPtr then
exit;
if PreInfo then begin
WriteComment(d, 'pointer');
RegisterPseudoClass(d);
WriteClassInfoVar(d);
exit;
end;
WriteComment(d, 'pointer');
Fjs.WriteLn(Format('public static class %s extends %s {', [d.Name, d.PtrType.Name]));
Fjs.IncI;
if TClassDef(d.PtrType).CType in [ctObject, ctRecord] then
@ -2597,6 +2597,15 @@ begin
FRecords:=TObjectList.Create(False);
end;
function DoCanUseDef(def, refdef: TDef): boolean;
begin
Result:=True;
if (def.DefType = dtArray) and (refdef is TVarDef) then begin
// Arrays are supported only for variables, fields, properties and constants
Result:=refdef.DefType in [dtVar, dtProp, dtField, dtConst];
end;
end;
destructor TWriter.Destroy;
var
i: integer;
@ -2671,6 +2680,7 @@ begin
p:=TPPUParser.Create(SearchPath);
try
p.OnCheckItem:=@DoCheckItem;
OnCanUseDef:=@DoCanUseDef;
for i:=0 to Units.Count - 1 do
IncludeList.Add(ChangeFileExt(ExtractFileName(Units[i]), ''));
for i:=0 to Units.Count - 1 do