* synchronize with trunk

git-svn-id: branches/unicodekvm@41380 -

packages/fcl-passrc/src/pparser.pp

@@ -450,7 +450,8 @@ type
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
     procedure ParseProcAsmBlock(Parent: TProcedureBody);
     // Function/Procedure declaration
-    function  ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
+    function ParseProcedureOrFunctionDecl(Parent: TPasElement;
+      ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
     procedure ParseArgList(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       EndToken: TToken);
@@ -2300,7 +2301,7 @@ begin
         ProcType:=ptAnonymousFunction;
       try
         ProcExpr:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
-        ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType));
+        ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType,false));
         Result:=ProcExpr;
       finally
         if Result=nil then
@@ -3413,7 +3414,7 @@ begin
       SetBlock(declNone);
       SaveComments;
       pt:=GetProcTypeFromToken(CurToken);
-      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt));
+      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, false));
       end;
     tkClass:
       begin
@@ -3423,7 +3424,7 @@ begin
         If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
           begin
           pt:=GetProcTypeFromToken(CurToken,True);
-          AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt));
+          AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, false));
           end
         else
           CheckToken(tkprocedure);
@@ -3533,9 +3534,8 @@ begin
         end;
       end;
     tkGeneric:
-      begin
-        if CurBlock <> declType then
-          ParseExcSyntaxError;
+      if CurBlock = declType then
+        begin
         TypeName := ExpectIdentifier;
         NamePos:=CurSourcePos;
         List:=TFPList.Create;
@@ -3593,7 +3593,41 @@ begin
             TPasElement(List[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
           List.Free;
         end;
-      end;
+        end
+      else if CurBlock = declNone then
+        begin
+        if msDelphi in CurrentModeswitches then
+          ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
+        SetBlock(declNone);
+        SaveComments;
+        NextToken;
+        case CurToken of
+        tkclass:
+          begin
+          // generic class ...
+          NextToken;
+          if not (CurToken in [tkprocedure,tkfunction]) then
+            ParseExcSyntaxError;
+          // generic class procedure ...
+          pt:=GetProcTypeFromToken(CurToken,true);
+          AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, true));
+          end;
+        tkprocedure,tkfunction:
+          begin
+          // generic procedure ...
+          SetBlock(declNone);
+          SaveComments;
+          pt:=GetProcTypeFromToken(CurToken);
+          AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, true));
+          end;
+        else
+          ParseExcSyntaxError;
+        end;
+        end
+      else
+        begin
+        ParseExcSyntaxError;
+        end;
     tkbegin:
       begin
       if Declarations is TProcedureBody then
@@ -6112,7 +6146,8 @@ begin
 end;
 
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
-  ProcType: TProcType; AVisibility: TPasMemberVisibility): TPasProcedure;
+  ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility
+  ): TPasProcedure;
 
   function ExpectProcName: string;
 
@@ -6124,13 +6159,15 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
     Result:=ExpectIdentifier;
     //writeln('ExpectProcName ',Parent.Classname);
     if Parent is TImplementationSection then
-    begin
+      begin
       NextToken;
       repeat
         if CurToken=tkDot then
           Result:=Result+'.'+ExpectIdentifier
         else if CurToken=tkLessThan then
           begin // <> can be ignored, we read the list but discard its content
+          if (not MustBeGeneric) and not (msDelphi in CurrentModeswitches) then
+            ParseExcTokenError('('); // e.g. "generic" is missing in mode objfpc
           UnGetToken;
           L:=TFPList.Create;
           Try
@@ -6146,7 +6183,7 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
         NextToken;
       until false;
       UngetToken;
-    end;
+      end;
   end;
 
 var
@@ -6158,6 +6195,8 @@ begin
   case ProcType of
   ptOperator,ptClassOperator:
     begin
+    if MustBeGeneric then
+      ParseExcTokenError('procedure');
     NextToken;
     IsTokenBased:=CurToken<>tkIdentifier;
     if IsTokenBased then
@@ -6169,7 +6208,11 @@ begin
     Name:=OperatorNames[Ot];
     end;
   ptAnonymousProcedure,ptAnonymousFunction:
+    begin
     Name:='';
+    if MustBeGeneric then
+      ParseExcTokenError('generic'); // inconsistency
+    end
   else
     Name:=ExpectProcName;
   end;
@@ -6376,7 +6419,7 @@ begin
         if Not AllowMethods then
           ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
         ProcType:=GetProcTypeFromToken(CurToken,isClass);
-        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
+        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,false,v);
         if Proc.Parent is TPasOverloadedProc then
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
         else
@@ -6519,7 +6562,7 @@ var
   ProcType: TProcType;
 begin
   ProcType:=GetProcTypeFromToken(CurToken,isClass);
-  Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,AVisibility);
+  Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,false,AVisibility);
   if Proc.Parent is TPasOverloadedProc then
     TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
   else

packages/fcl-passrc/src/pscanner.pp

@@ -3400,9 +3400,15 @@ begin
   'OBJFPC':
     SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
   'DELPHI':
+    begin
     SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
+    SetNonToken(tkgeneric);
+    end;
   'DELPHIUNICODE':
+    begin
     SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
+    SetNonToken(tkgeneric);
+    end;
   'TP':
     SetMode(msTP7,TPModeSwitches,false);
   'MACPAS':

packages/fcl-passrc/tests/tcgenerics.pp

@@ -219,13 +219,12 @@ end;
 
 procedure TTestGenerics.TestGenericFunction;
 begin
-  exit; // ToDo
   Add([
   'generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;',
   'begin',
   'end;',
   'begin',
-  '  IfThen<word>(true,2,3);',
+  '  specialize IfThen<word>(true,2,3);',
   '']);
   ParseModule;
 end;

utils/pas2jni/writer.pas

@@ -1451,6 +1451,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]);
@@ -1851,6 +1853,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;
@@ -2184,6 +2188,8 @@ begin
   Fps.WriteLn('Result:=JNI_ERR;');
   Fps.WriteLn('if vm^^.GetEnv(vm, @env, JNI_VERSION_1_6) <> JNI_OK then exit;');
   Fps.WriteLn('CurJavaVM:=vm;');
+  Fps.WriteLn('_JavaExceptionClass:=env^^.FindClass(env, ''java/lang/Exception'');');
+  Fps.WriteLn('if _JavaExceptionClass = nil then exit;');
 
   d:=TTypeDef.Create(nil, dtType);
   try
@@ -2964,7 +2970,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;');
@@ -2997,14 +3002,23 @@ begin
     Fps.DecI;
     Fps.WriteLn('end;');
 
+    Fps.WriteLn;
+    Fps.WriteLn('var _JavaExceptionClass: jclass;');
     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;
     end;
-    Fps.WriteLn('env^^.ThrowNew(env, env^^.FindClass(env, ''java/lang/Exception''), PAnsiChar(Utf8Encode(Exception(ExceptObject).Message)));', 1);
+    Fps.WriteLn('env^^.ThrowNew(env, _JavaExceptionClass, 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;