Переглянути джерело

compiler: allow generic inline specialization for delphi mode (like TFoo<Integer>.Create)

git-svn-id: trunk@16709 -
paul 14 роки тому
батько
коміт
0d6b62d293
4 змінених файлів з 32 додано та 3 видалено
  1. 1 0
      .gitattributes
  2. 5 0
      compiler/pexpr.pas
  3. 6 3
      compiler/ptype.pas
  4. 20 0
      tests/test/tgeneric32.pp

+ 1 - 0
.gitattributes

@@ -9422,6 +9422,7 @@ tests/test/tgeneric29.pp svneol=native#text/pascal
 tests/test/tgeneric3.pp svneol=native#text/plain
 tests/test/tgeneric3.pp svneol=native#text/plain
 tests/test/tgeneric30.pp svneol=native#text/pascal
 tests/test/tgeneric30.pp svneol=native#text/pascal
 tests/test/tgeneric31.pp svneol=native#text/pascal
 tests/test/tgeneric31.pp svneol=native#text/pascal
+tests/test/tgeneric32.pp svneol=native#text/pascal
 tests/test/tgeneric4.pp svneol=native#text/plain
 tests/test/tgeneric4.pp svneol=native#text/plain
 tests/test/tgeneric5.pp svneol=native#text/plain
 tests/test/tgeneric5.pp svneol=native#text/plain
 tests/test/tgeneric6.pp svneol=native#text/plain
 tests/test/tgeneric6.pp svneol=native#text/plain

+ 5 - 0
compiler/pexpr.pas

@@ -1522,6 +1522,11 @@ implementation
                        if (hdef=cvarianttype) and
                        if (hdef=cvarianttype) and
                           not(cs_compilesystem in current_settings.moduleswitches) then
                           not(cs_compilesystem in current_settings.moduleswitches) then
                          current_module.flags:=current_module.flags or uf_uses_variants;
                          current_module.flags:=current_module.flags or uf_uses_variants;
+                       { if we get a generic then check that it is not an inline specialization }
+                       if (df_generic in hdef.defoptions) and
+                          (token=_LT) and
+                          (m_delphi in current_settings.modeswitches) then
+                          generate_specialization(hdef,false);
                        if try_to_consume(_LKLAMMER) then
                        if try_to_consume(_LKLAMMER) then
                         begin
                         begin
                           p1:=comp_expr(true,false);
                           p1:=comp_expr(true,false);

+ 6 - 3
compiler/ptype.pas

@@ -50,6 +50,7 @@ interface
     { generate persistent type information like VMT, RTTI and inittables }
     { generate persistent type information like VMT, RTTI and inittables }
     procedure write_persistent_type_info(st:tsymtable);
     procedure write_persistent_type_info(st:tsymtable);
 
 
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
 
 
 implementation
 implementation
 
 
@@ -199,7 +200,8 @@ implementation
             exit;
             exit;
           end;
           end;
 
 
-        consume(_LSHARPBRACKET);
+        if not try_to_consume(_LT) then
+          consume(_LSHARPBRACKET);
         { Parse generic parameters, for each undefineddef in the symtable of
         { Parse generic parameters, for each undefineddef in the symtable of
           the genericdef we need to have a new def }
           the genericdef we need to have a new def }
         err:=false;
         err:=false;
@@ -252,7 +254,7 @@ implementation
           end;
           end;
         uspecializename:=upper(specializename);
         uspecializename:=upper(specializename);
         { force correct error location if too much type parameters are passed }
         { force correct error location if too much type parameters are passed }
-        if token<>_RSHARPBRACKET then
+        if not (token in [_RSHARPBRACKET,_GT]) then
           consume(_RSHARPBRACKET);
           consume(_RSHARPBRACKET);
 
 
         { Special case if we are referencing the current defined object }
         { Special case if we are referencing the current defined object }
@@ -361,7 +363,8 @@ implementation
           end;
           end;
 
 
         generictypelist.free;
         generictypelist.free;
-        consume(_RSHARPBRACKET);
+        if not try_to_consume(_GT) then
+          consume(_RSHARPBRACKET);
       end;
       end;
 
 
 
 

+ 20 - 0
tests/test/tgeneric32.pp

@@ -0,0 +1,20 @@
+program tgeneric32;
+{$MODE DELPHI}
+{$APPTYPE CONSOLE}
+type
+  TFoo<T> = class
+    constructor Create;
+  end;
+
+constructor TFoo<T>.Create;
+begin
+  inherited Create;
+end;
+
+var
+  FooInt: TFoo<Integer>;
+begin
+  // check inline specialization
+  FooInt := TFoo<Integer>.Create;
+  FooInt.Free;
+end.