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 -

utils/pas2jni/writer.pas

@@ -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;');