mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 06:49:23 +02:00
* pas2jni: Do not include array element types from arrays, which is not processed.
git-svn-id: trunk@34862 -
This commit is contained in:
parent
860ad25430
commit
78914d9b20
@ -54,6 +54,7 @@ type
|
|||||||
procedure AddRef;
|
procedure AddRef;
|
||||||
procedure DecRef;
|
procedure DecRef;
|
||||||
procedure SetExtUsed(ExtDef: TDef; AUsed: boolean; var HasRef: boolean);
|
procedure SetExtUsed(ExtDef: TDef; AUsed: boolean; var HasRef: boolean);
|
||||||
|
function ShouldUseChild(d: TDef): boolean; virtual;
|
||||||
public
|
public
|
||||||
DefType: TDefType;
|
DefType: TDefType;
|
||||||
DefId: integer;
|
DefId: integer;
|
||||||
@ -87,6 +88,7 @@ type
|
|||||||
FHasClassRef: boolean;
|
FHasClassRef: boolean;
|
||||||
protected
|
protected
|
||||||
procedure SetIsUsed(const AValue: boolean); override;
|
procedure SetIsUsed(const AValue: boolean); override;
|
||||||
|
function ShouldUseChild(d: TDef): boolean; override;
|
||||||
public
|
public
|
||||||
CType: TClassType;
|
CType: TClassType;
|
||||||
AncestorClass: TClassDef;
|
AncestorClass: TClassDef;
|
||||||
@ -169,6 +171,7 @@ type
|
|||||||
FHasRetTypeRef: boolean;
|
FHasRetTypeRef: boolean;
|
||||||
protected
|
protected
|
||||||
procedure SetIsUsed(const AValue: boolean); override;
|
procedure SetIsUsed(const AValue: boolean); override;
|
||||||
|
function ShouldUseChild(d: TDef): boolean; override;
|
||||||
public
|
public
|
||||||
ProcType: TProcType;
|
ProcType: TProcType;
|
||||||
ReturnType: TDef;
|
ReturnType: TDef;
|
||||||
@ -224,6 +227,9 @@ type
|
|||||||
const
|
const
|
||||||
ReplDefs = [dtField, dtProp, dtProc];
|
ReplDefs = [dtField, dtProp, dtProc];
|
||||||
|
|
||||||
|
var
|
||||||
|
OnCanUseDef: function (def, refdef: TDef): boolean;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
function IsSameType(t1, t2: TDef): boolean;
|
function IsSameType(t1, t2: TDef): boolean;
|
||||||
@ -370,6 +376,11 @@ begin
|
|||||||
SetExtUsed(ReturnType, AValue, FHasRetTypeRef);
|
SetExtUsed(ReturnType, AValue, FHasRetTypeRef);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TProcDef.ShouldUseChild(d: TDef): boolean;
|
||||||
|
begin
|
||||||
|
Result:=d.DefType in [dtParam];
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TProcDef.ResolveDefs;
|
procedure TProcDef.ResolveDefs;
|
||||||
begin
|
begin
|
||||||
inherited ResolveDefs;
|
inherited ResolveDefs;
|
||||||
@ -407,6 +418,11 @@ begin
|
|||||||
SetExtUsed(AncestorClass, AValue, FHasClassRef);
|
SetExtUsed(AncestorClass, AValue, FHasClassRef);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TClassDef.ShouldUseChild(d: TDef): boolean;
|
||||||
|
begin
|
||||||
|
Result:=d.DefType in [dtProc, dtField, dtProp];
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TClassDef.ResolveDefs;
|
procedure TClassDef.ResolveDefs;
|
||||||
begin
|
begin
|
||||||
inherited ResolveDefs;
|
inherited ResolveDefs;
|
||||||
@ -486,10 +502,13 @@ procedure TDef.SetIsUsed(const AValue: boolean);
|
|||||||
var
|
var
|
||||||
i: integer;
|
i: integer;
|
||||||
f: boolean;
|
f: boolean;
|
||||||
|
d: TDef;
|
||||||
begin
|
begin
|
||||||
if FInSetUsed or (DefType = dtNone) or IsPrivate then
|
if FInSetUsed or (DefType = dtNone) or IsPrivate then
|
||||||
exit;
|
exit;
|
||||||
if AValue then begin
|
if AValue then begin
|
||||||
|
if Assigned(OnCanUseDef) and not OnCanUseDef(Self, Parent) then
|
||||||
|
exit;
|
||||||
AddRef;
|
AddRef;
|
||||||
f:=FRefCnt = 1;
|
f:=FRefCnt = 1;
|
||||||
end
|
end
|
||||||
@ -503,8 +522,11 @@ begin
|
|||||||
// Update used mark of children only once
|
// Update used mark of children only once
|
||||||
FInSetUsed:=True;
|
FInSetUsed:=True;
|
||||||
try
|
try
|
||||||
for i:=0 to Count - 1 do
|
for i:=0 to Count - 1 do begin
|
||||||
Items[i].IsUsed:=AValue;
|
d:=Items[i];
|
||||||
|
if ShouldUseChild(d) then
|
||||||
|
d.IsUsed:=AValue;
|
||||||
|
end;
|
||||||
finally
|
finally
|
||||||
FInSetUsed:=False;
|
FInSetUsed:=False;
|
||||||
end;
|
end;
|
||||||
@ -550,6 +572,8 @@ begin
|
|||||||
if AUsed then begin
|
if AUsed then begin
|
||||||
if HasRef then
|
if HasRef then
|
||||||
exit;
|
exit;
|
||||||
|
if Assigned(OnCanUseDef) and not OnCanUseDef(ExtDef, Self) then
|
||||||
|
exit;
|
||||||
OldRefCnt:=ExtDef.RefCnt;
|
OldRefCnt:=ExtDef.RefCnt;
|
||||||
ExtDef.IsUsed:=True;
|
ExtDef.IsUsed:=True;
|
||||||
HasRef:=OldRefCnt <> ExtDef.RefCnt;
|
HasRef:=OldRefCnt <> ExtDef.RefCnt;
|
||||||
@ -561,6 +585,11 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TDef.ShouldUseChild(d: TDef): boolean;
|
||||||
|
begin
|
||||||
|
Result:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TDef.SetItem(Index: Integer; const AValue: TDef);
|
procedure TDef.SetItem(Index: Integer; const AValue: TDef);
|
||||||
begin
|
begin
|
||||||
CheckItems;
|
CheckItems;
|
||||||
|
@ -1495,12 +1495,12 @@ begin
|
|||||||
if not d.IsUsed or not d.IsObjPtr then
|
if not d.IsUsed or not d.IsObjPtr then
|
||||||
exit;
|
exit;
|
||||||
if PreInfo then begin
|
if PreInfo then begin
|
||||||
WriteComment(d, 'pointer');
|
|
||||||
RegisterPseudoClass(d);
|
RegisterPseudoClass(d);
|
||||||
WriteClassInfoVar(d);
|
WriteClassInfoVar(d);
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
WriteComment(d, 'pointer');
|
||||||
Fjs.WriteLn(Format('public static class %s extends %s {', [d.Name, d.PtrType.Name]));
|
Fjs.WriteLn(Format('public static class %s extends %s {', [d.Name, d.PtrType.Name]));
|
||||||
Fjs.IncI;
|
Fjs.IncI;
|
||||||
if TClassDef(d.PtrType).CType in [ctObject, ctRecord] then
|
if TClassDef(d.PtrType).CType in [ctObject, ctRecord] then
|
||||||
@ -2597,6 +2597,15 @@ begin
|
|||||||
FRecords:=TObjectList.Create(False);
|
FRecords:=TObjectList.Create(False);
|
||||||
end;
|
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;
|
destructor TWriter.Destroy;
|
||||||
var
|
var
|
||||||
i: integer;
|
i: integer;
|
||||||
@ -2671,6 +2680,7 @@ begin
|
|||||||
p:=TPPUParser.Create(SearchPath);
|
p:=TPPUParser.Create(SearchPath);
|
||||||
try
|
try
|
||||||
p.OnCheckItem:=@DoCheckItem;
|
p.OnCheckItem:=@DoCheckItem;
|
||||||
|
OnCanUseDef:=@DoCanUseDef;
|
||||||
for i:=0 to Units.Count - 1 do
|
for i:=0 to Units.Count - 1 do
|
||||||
IncludeList.Add(ChangeFileExt(ExtractFileName(Units[i]), ''));
|
IncludeList.Add(ChangeFileExt(ExtractFileName(Units[i]), ''));
|
||||||
for i:=0 to Units.Count - 1 do
|
for i:=0 to Units.Count - 1 do
|
||||||
|
Loading…
Reference in New Issue
Block a user