mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 08:29:28 +02:00
Merged revision(s) 41314, 41320, 41323, 41371, 41374, 41391, 41396 from trunk:
* pas2jni: Added GetMemoryAsArray() and SetMemoryFromArray() utility functions. ........ * pas2jni: Removed obsolete code. ........ * pas2jni: Accept partial names in inclusion/exclusion lists. Use wildcard * at the end of a partial name. ........ * pas2jni: Properly handle Java exceptions when calling a callback Java method. ........ * pas2jni: Return null if a method pointer is empty. ........ * pas2jni: Fixed handling of array variables. * pas2jni: Fixed Java warning for the PascalInterface class. ........ * pas2jni: Fixed exception handling. ........ git-svn-id: branches/fixes_3_2@41614 -
This commit is contained in:
yury
parent
5ed8ce23a2
commit
cd3d2c2abc
@ -104,6 +104,7 @@ type
|
||||
procedure WriteClassTable;
|
||||
|
||||
procedure WriteFileComment(st: TTextOutStream);
|
||||
function FindInStringList(list: TStringList; const s: string): integer;
|
||||
|
||||
procedure ProcessRules(d: TDef; const Prefix: string = '');
|
||||
function GetUniqueNum: integer;
|
||||
@ -358,11 +359,11 @@ end;
|
||||
|
||||
function TWriter.DoCheckItem(const ItemName: string): TCheckItemResult;
|
||||
begin
|
||||
if IncludeList.IndexOf(ItemName) >= 0 then
|
||||
Result:=crInclude
|
||||
if FindInStringList(ExcludeList, ItemName) >= 0 then
|
||||
Result:=crExclude
|
||||
else
|
||||
if ExcludeList.IndexOf(ItemName) >= 0 then
|
||||
Result:=crExclude
|
||||
if FindInStringList(IncludeList, ItemName) >= 0 then
|
||||
Result:=crInclude
|
||||
else
|
||||
Result:=crDefault;
|
||||
end;
|
||||
@ -373,6 +374,36 @@ begin
|
||||
st.WriteLn('// Do not edit this file.');
|
||||
end;
|
||||
|
||||
function TWriter.FindInStringList(list: TStringList; const s: string): integer;
|
||||
var
|
||||
len, cnt: integer;
|
||||
ss: string;
|
||||
begin
|
||||
if list.Find(s, Result) or (Result < 0) then
|
||||
exit;
|
||||
if Result < list.Count then begin
|
||||
cnt:=3;
|
||||
if Result > 0 then
|
||||
Dec(Result)
|
||||
else
|
||||
Dec(cnt);
|
||||
if Result + cnt > list.Count then
|
||||
Dec(cnt);
|
||||
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
|
||||
exit;
|
||||
end;
|
||||
Inc(Result);
|
||||
Dec(cnt);
|
||||
end;
|
||||
end;
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
procedure TWriter.ProcessRules(d: TDef; const Prefix: string);
|
||||
var
|
||||
i: integer;
|
||||
@ -385,16 +416,11 @@ begin
|
||||
exit;
|
||||
end;
|
||||
s:=Prefix + d.Name;
|
||||
i:=IncludeList.IndexOf(s);
|
||||
if i >= 0 then begin
|
||||
i:=ptruint(IncludeList.Objects[i]);
|
||||
if (i = 0) or (d.Count = i - 1) then
|
||||
d.IsUsed:=True;
|
||||
end
|
||||
if FindInStringList(ExcludeList, s) >= 0 then
|
||||
d.SetNotUsed
|
||||
else
|
||||
if ExcludeList.IndexOf(s) >= 0 then begin
|
||||
d.SetNotUsed;
|
||||
end;
|
||||
if FindInStringList(IncludeList, s) >= 0 then
|
||||
d.IsUsed:=True;
|
||||
if not (d.DefType in [dtUnit, dtClass]) then
|
||||
exit;
|
||||
s:=s + '.';
|
||||
@ -1117,6 +1143,7 @@ procedure TWriter.WriteVar(d: TVarDef; AParent: TDef);
|
||||
if (VarType.DefType = dtType) and (TTypeDef(VarType).BasicType in [btByte, btShortInt, btSmallInt]) then
|
||||
VarType:=FIntegerType;
|
||||
VarOpt:=[voRead];
|
||||
IsUsed:=True;
|
||||
end;
|
||||
Result:=ad.ElType;
|
||||
ad:=TArrayDef(Result);
|
||||
@ -1425,6 +1452,8 @@ begin
|
||||
if d.ProcType = ptFunction then
|
||||
s:=Format('Result:=%s', [JniToPasType(d.ReturnType, s, False)]);
|
||||
Fps.WriteLn(s + ';');
|
||||
// Java exception check
|
||||
Fps.WriteLn('_HandleJavaException(_env);');
|
||||
// Processing var/out parameters
|
||||
for i:=0 to d.Count - 1 do begin
|
||||
vd:=TVarDef(d[i]);
|
||||
@ -1623,12 +1652,15 @@ begin
|
||||
|
||||
for i:=0 to u.Count - 1 do begin
|
||||
d:=u[i];
|
||||
if (d.DefType = dtType) and (TTypeDef(d).BasicType = btLongInt) then begin
|
||||
if (d.DefType = dtType) and (TTypeDef(d).BasicType = btLongInt) and (Copy(d.Name, 1, 1) <> '$') then begin
|
||||
FIntegerType:=d;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if FIntegerType = nil then
|
||||
raise Exception.Create('LongInt type has not been found in the System unit.');
|
||||
|
||||
if LibAutoLoad then begin
|
||||
Fjs.WriteLn('static private boolean _JniLibLoaded = false;');
|
||||
Fjs.WriteLn('public static void InitJni() {');
|
||||
@ -1639,10 +1671,16 @@ begin
|
||||
Fjs.WriteLn('}');
|
||||
end;
|
||||
|
||||
// Support functions
|
||||
// Public support functions
|
||||
Fjs.WriteLn('public native static long AllocMemory(int Size);');
|
||||
AddNativeMethod(u, '_AllocMemory', 'AllocMemory', '(I)J');
|
||||
|
||||
Fjs.WriteLn('public native static byte[] GetMemoryAsArray(long SrcBuf, int BufSize);');
|
||||
AddNativeMethod(u, '_GetMemoryAsArray', 'GetMemoryAsArray', '(JI)[B');
|
||||
|
||||
Fjs.WriteLn('public native static void SetMemoryFromArray(long DstBuf, byte[] SrcArray);');
|
||||
AddNativeMethod(u, '_SetMemoryFromArray', 'SetMemoryFromArray', '(J[B)V');
|
||||
|
||||
// Base object
|
||||
Fjs.WriteLn;
|
||||
Fjs.WriteLn('public static class PascalObject {');
|
||||
@ -1819,6 +1857,8 @@ begin
|
||||
Fps.WriteLn('var mpi: _TMethodPtrInfo;');
|
||||
Fps.WriteLn('begin');
|
||||
Fps.IncI;
|
||||
Fps.WriteLn('Result:=nil;');
|
||||
Fps.WriteLn('if (m.Data = nil) and (m.Code = nil) then exit;');
|
||||
Fps.WriteLn('_MethodPointersCS.Enter;');
|
||||
Fps.WriteLn('try');
|
||||
Fps.IncI;
|
||||
@ -2005,9 +2045,9 @@ begin
|
||||
|
||||
Fjs.WriteLn('private native static long InterfaceCast(long objptr, String objid);');
|
||||
Fjs.WriteLn;
|
||||
Fjs.WriteLn('public static class PascalInterface extends PascalObjectEx {');
|
||||
Fjs.WriteLn('public static abstract class PascalInterface extends PascalObjectEx {');
|
||||
Fjs.IncI;
|
||||
Fjs.WriteLn('protected void __Init() { }');
|
||||
Fjs.WriteLn('abstract protected void __Init();');
|
||||
Fjs.WriteLn('public void __TypeCast(PascalObject obj, String intfId) {');
|
||||
Fjs.WriteLn('if (obj != null) {', 1);
|
||||
Fjs.WriteLn('if (obj instanceof PascalInterface) {', 2);
|
||||
@ -2932,7 +2972,6 @@ begin
|
||||
Fps.WriteLn('begin');
|
||||
Fps.WriteLn('Result:=_CreateJavaObj(env, jlong(ptruint(PasObj)), ci, cleanup)', 1);
|
||||
Fps.WriteLn('end;');
|
||||
Fps.WriteLn;
|
||||
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('function _GetPasObj(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo; CheckNil: boolean): pointer;');
|
||||
@ -2968,6 +3007,7 @@ begin
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('procedure _HandleJNIException(env: PJNIEnv);');
|
||||
Fps.WriteLn('begin');
|
||||
Fps.WriteLn('if env^^.ExceptionCheck(env) <> 0 then exit;', 1);
|
||||
if p.OnExceptionProc <> nil then begin
|
||||
Fps.WriteLn(Format('%s.%s;', [p.OnExceptionProc.Parent.Name, p.OnExceptionProc.Name]), 1);
|
||||
p.OnExceptionProc.SetNotUsed;
|
||||
@ -2975,12 +3015,20 @@ begin
|
||||
Fps.WriteLn('env^^.ThrowNew(env, env^^.FindClass(env, ''java/lang/Exception''), PAnsiChar(Utf8Encode(Exception(ExceptObject).Message)));', 1);
|
||||
Fps.WriteLn('end;');
|
||||
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('procedure _HandleJavaException(env: PJNIEnv);');
|
||||
Fps.WriteLn('begin');
|
||||
Fps.WriteLn('if env^^.ExceptionCheck(env) <> 0 then raise Exception.Create(''Java exception.'');', 1);
|
||||
Fps.WriteLn('end;');
|
||||
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('procedure _RaiseVarParamException(const VarName: string);');
|
||||
Fps.WriteLn('begin');
|
||||
Fps.WriteLn('raise Exception.CreateFmt(''An array with only single element must be passed as parameter "%s".'', [VarName]);', 1);
|
||||
Fps.WriteLn('end;');
|
||||
|
||||
// Public support functions
|
||||
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('function _AllocMemory(env: PJNIEnv; jobj: jobject; size: jint): jlong;' + JniCaliing);
|
||||
Fps.WriteLn('var p: pointer;');
|
||||
@ -2990,6 +3038,19 @@ begin
|
||||
Fps.WriteLn('Result:=ptruint(p);', 1);
|
||||
Fps.WriteLn('end;');
|
||||
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('function _GetMemoryAsArray(env: PJNIEnv; jobj: jobject; SrcBuf: jlong; BufSize: jint): jarray;' + JniCaliing);
|
||||
Fps.WriteLn('begin');
|
||||
Fps.WriteLn('Result:=env^^.NewByteArray(env, BufSize);', 1);
|
||||
Fps.WriteLn('env^^.SetByteArrayRegion(env, Result, 0, BufSize, pointer(ptruint(SrcBuf)));', 1);
|
||||
Fps.WriteLn('end;');
|
||||
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('procedure _SetMemoryFromArray(env: PJNIEnv; jobj: jobject; DstBuf: jlong; SrcArray: jarray);' + JniCaliing);
|
||||
Fps.WriteLn('begin');
|
||||
Fps.WriteLn('env^^.GetByteArrayRegion(env, SrcArray, 0, env^^.GetArrayLength(env, SrcArray), pointer(ptruint(DstBuf)));', 1);
|
||||
Fps.WriteLn('end;');
|
||||
|
||||
// Set support
|
||||
Fps.WriteLn;
|
||||
Fps.WriteLn('function _GetIntObjValue(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo): longint;');
|
||||
|
||||
Loading…
Reference in New Issue
Block a user