fcl-passrc: mode objfpc: error on specialize without keyword

git-svn-id: trunk@42951 -

packages/fcl-passrc/src/pparser.pp

@@ -1570,7 +1570,8 @@ begin
         ParseExcSyntaxError;
       UnGetToken;
       end
-    else if (CurToken = tkLessThan) then // A = B<t>;
+    else if (CurToken = tkLessThan)
+        and (MustBeSpecialize or (msDelphi in CurrentModeswitches)) then // A = B<t>;
       begin
       Result:=ParseSpecializeType(Parent,TypeName,Name,Expr);
       ok:=true;

packages/fcl-passrc/tests/tcgenerics.pp

@@ -97,7 +97,7 @@ begin
     '  b : T;',
     'end;',
     'Generic TBird<T: class> = class',
-    '  c : TBird<T>;',
+    '  c : specialize TBird<T>;',
     'end;',
     'Generic TEagle<T: record> = class',
     'end;',
@@ -116,11 +116,11 @@ begin
     'TBird = class(TInterfacedObject,TIntfA,TIntfB) end;',
     'Generic TAnt<T: TIntfA, TIntfB> = class',
     '  b: T;',
-    '  c: TAnt<T>;',
+    '  c: specialize TAnt<T>;',
     'end;',
     'Generic TFly<T: TIntfA, TIntfB; S> = class',
     '  b: S;',
-    '  c: TFly<T>;',
+    '  c: specialize TFly<T>;',
     'end;',
     '']);
   ParseDeclarations;
@@ -148,6 +148,7 @@ end;
 
 procedure TTestGenerics.TestSpecializationDelphi;
 begin
+  Add('{$mode delphi}');
   ParseType('TFPGList<integer>',TPasSpecializeType,'');
 end;
 

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -147,7 +147,7 @@ begin
   StartProgram(false);
   Add([
   'type generic TBird<T> = record end;',
-  'var b: TBird<word, byte>;',
+  'var b: specialize TBird<word, byte>;',
   'begin',
   '']);
   CheckResolverException('identifier not found "TBird<,>"',
@@ -523,9 +523,9 @@ begin
   '  for i in m do ;',
   'end;',
   'var',
-  '  a: TAnt<word>;',
+  '  a: specialize TAnt<word>;',
   '  w: word;',
-  '  b: TBird<word,specialize TAnt<word>>;',
+  '  b: specialize TBird<word,specialize TAnt<word>>;',
   'begin',
   '  for w in a do ;',
   '  for w in b.m do ;',
@@ -800,12 +800,12 @@ begin
   '  generic TAnt<T> = class;',
   '  generic TFish<U> = class',
   '    private type AliasU = U;',
-  '    var a: TAnt<AliasU>;',
+  '    var a: specialize TAnt<AliasU>;',
   '        Size: AliasU;',
   '  end;',
   '  generic TAnt<T> = class',
   '    private type AliasT = T;',
-  '    var f: TFish<AliasT>;',
+  '    var f: specialize TFish<AliasT>;',
   '        Speed: AliasT;',
   '  end;',
   'var',
@@ -991,7 +991,7 @@ begin
   '  TObject = class end;',
   '  generic TBird<T> = class',
   '    e: T;',
-  '    v: TBird<boolean>;',
+  '    v: specialize TBird<boolean>;',
   '  end;',
   'var',
   '  b: specialize TBird<word>;',
@@ -1606,8 +1606,8 @@ begin
   '  except',
   '    on Exception do ;',
   '    on E: Exception do ;',
-  '    on E: EMsg<boolean> do E.Msg:=true;',
-  '    on E: EMsg<T> do E.Msg:=1;',
+  '    on E: specialize EMsg<boolean> do E.Msg:=true;',
+  '    on E: specialize EMsg<T> do E.Msg:=1;',
   '  end;',
   'end;',
   'var',

packages/pastojs/tests/tcgenerics.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testregistry,
-  TCModules;
+  TCModules, FPPas2Js;
 
 type
 
@@ -22,6 +22,7 @@ type
     Procedure TestGen_Class_EmptyMethod;
     Procedure TestGen_Class_TList;
     Procedure TestGen_ClassAncestor;
+    Procedure TestGen_TypeInfo;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
@@ -242,6 +243,51 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_TypeInfo;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  published',
+  '    m: T;',
+  '  end;',
+  '  TEagle = specialize TBird<word>;',
+  'var',
+  '  b: specialize TBird<word>;',
+  '  p: pointer;',
+  'begin',
+  '  p:=typeinfo(TEagle);',
+  '  p:=typeinfo(b);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_TypeInfo',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.m = 0;',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("m", rtl.word);',
+    '});',
+    'this.b = null;',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TBird$G1"];',
+    '$mod.p = $mod.b.$rtti;',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);
@@ -314,7 +360,7 @@ begin
   '  generic TBird<T> = class',
   '  end;',
   'constructor TObject.Create; begin end;',
-  'var b: TBird<word>;',
+  'var b: specialize TBird<word>;',
   'begin',
   '  b:=specialize TBird<word>.Create;',
   '']);