Browse Source

Implement DECLARED() for generic symbols. This fixes Mantis #21829 . The syntax is SomeGenericType<> for a generic with only one type parameter and SomeGeneric<,[,]*> for a generic with more than one type parameter. Spaces between the commas or brackets are allowed.

scanner.pas, parse_compiler_expr.read_factor:
  + allow "<>" after "declared" (handle "<>" operator specially)
  + count "," to get correct amount of type parameters
  + check together with the count string for symbols 
  + correctly handle dummy symbols

+ added tests

git-svn-id: trunk@23544 -
svenbarth 12 years ago
parent
commit
d49b4043ab
5 changed files with 197 additions and 4 deletions
  1. 3 0
      .gitattributes
  2. 43 4
      compiler/scanner.pas
  3. 109 0
      tests/test/tgeneric93.pp
  4. 27 0
      tests/test/ugeneric93a.pp
  5. 15 0
      tests/test/ugeneric93b.pp

+ 3 - 0
.gitattributes

@@ -11018,6 +11018,7 @@ tests/test/tgeneric9.pp svneol=native#text/plain
 tests/test/tgeneric90.pp svneol=native#text/pascal
 tests/test/tgeneric90.pp svneol=native#text/pascal
 tests/test/tgeneric91.pp svneol=native#text/pascal
 tests/test/tgeneric91.pp svneol=native#text/pascal
 tests/test/tgeneric92.pp svneol=native#text/pascal
 tests/test/tgeneric92.pp svneol=native#text/pascal
+tests/test/tgeneric93.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
@@ -11614,6 +11615,8 @@ tests/test/ugeneric74b.pp svneol=native#text/pascal
 tests/test/ugeneric75.pp svneol=native#text/pascal
 tests/test/ugeneric75.pp svneol=native#text/pascal
 tests/test/ugeneric91a.pp svneol=native#text/pascal
 tests/test/ugeneric91a.pp svneol=native#text/pascal
 tests/test/ugeneric91b.pp svneol=native#text/pascal
 tests/test/ugeneric91b.pp svneol=native#text/pascal
+tests/test/ugeneric93a.pp svneol=native#text/pascal
+tests/test/ugeneric93b.pp svneol=native#text/pascal
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhintdir.pp svneol=native#text/plain
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp3.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal
 tests/test/uhlp31.pp svneol=native#text/pascal

+ 43 - 4
compiler/scanner.pas

@@ -922,7 +922,7 @@ In case not, the value returned can be arbitrary.
 
 
         function read_factor(var factorType: TCTETypeSet; eval : Boolean) : string;
         function read_factor(var factorType: TCTETypeSet; eval : Boolean) : string;
         var
         var
-           hs : string;
+           hs,countstr : string;
            mac: tmacro;
            mac: tmacro;
            srsym : tsym;
            srsym : tsym;
            srsymtable : TSymtable;
            srsymtable : TSymtable;
@@ -1166,13 +1166,52 @@ In case not, the value returned can be arbitrary.
                     if current_scanner.preproc_token =_ID then
                     if current_scanner.preproc_token =_ID then
                       begin
                       begin
                         hs := upper(current_scanner.preproc_pattern);
                         hs := upper(current_scanner.preproc_pattern);
+                        preproc_consume(_ID);
+                        current_scanner.skipspace;
+                        if current_scanner.preproc_token in [_LT,_LSHARPBRACKET] then
+                          begin
+                            l:=1;
+                            preproc_consume(current_scanner.preproc_token);
+                            current_scanner.skipspace;
+                            while current_scanner.preproc_token=_COMMA do
+                              begin
+                                inc(l);
+                                preproc_consume(_COMMA);
+                                current_scanner.skipspace;
+                              end;
+                            if not (current_scanner.preproc_token in [_GT,_RSHARPBRACKET]) then
+                              Message(scan_e_error_in_preproc_expr)
+                            else
+                              preproc_consume(current_scanner.preproc_token);
+                            str(l,countstr);
+                            hs:=hs+'$'+countstr;
+                          end
+                        else
+                          { special case: <> }
+                          if current_scanner.preproc_token=_NE then
+                            begin
+                              hs:=hs+'$1';
+                              preproc_consume(_NE);
+                            end;
+                        current_scanner.skipspace;
                         if searchsym(hs,srsym,srsymtable) then
                         if searchsym(hs,srsym,srsymtable) then
-                          hs := '1'
+                          begin
+                            { TSomeGeneric<...> also adds a TSomeGeneric symbol }
+                            if (sp_generic_dummy in srsym.symoptions) and
+                                (srsym.typ=typesym) and
+                                (
+                                  { mode delphi}
+                                  (ttypesym(srsym).typedef.typ in [undefineddef,errordef]) or
+                                  { non-delphi modes }
+                                  (df_generic in ttypesym(srsym).typedef.defoptions)
+                                ) then
+                              hs:='0'
+                            else
+                              hs:='1';
+                          end
                         else
                         else
                           hs := '0';
                           hs := '0';
                         read_factor := hs;
                         read_factor := hs;
-                        preproc_consume(_ID);
-                        current_scanner.skipspace;
                       end
                       end
                     else
                     else
                       Message(scan_e_error_in_preproc_expr);
                       Message(scan_e_error_in_preproc_expr);

+ 109 - 0
tests/test/tgeneric93.pp

@@ -0,0 +1,109 @@
+program tgeneric93;
+
+uses
+  ugeneric93a,
+  ugeneric93b;
+
+const
+  // should be False
+{$if declared(NotDeclared<>)}
+  TestNotDeclared = True;
+{$else}
+  TestNotDeclared = False;
+{$endif}
+
+  // should be False
+{$if declared(TTestDelphi)}
+  TestTTestDelphi = True;
+{$else}
+  TestTTestDelphi = False;
+{$endif}
+
+  // should be True
+{$if declared(TTestDelphi<>)}
+  TestTTestDelphi1 = True;
+{$else}
+  TestTTestDelphi1 = False;
+{$endif}
+
+  // should be False
+{$if declared(TTestDelphi<,>)}
+  TestTTestDelphi2 = True;
+{$else}
+  TestTTestDelphi2 = False;
+{$endif}
+
+  // should be True
+{$if declared(TTestDelphi<,,>)}
+  TestTTestDelphi3 = True;
+{$else}
+  TestTTestDelphi3 = False;
+{$endif}
+
+// should be True
+{$if declared(TTest2Delphi)}
+  TestTTest2Delphi = True;
+{$else}
+  TestTTest2Delphi = False;
+{$endif}
+
+// should be False
+{$if declared(TTest2Delphi<>)}
+  TestTTest2Delphi1 = True;
+{$else}
+  TestTTest2Delphi1 = False;
+{$endif}
+
+// should be True
+{$if declared(TTest2Delphi<,>)}
+  TestTTest2Delphi2 = True;
+{$else}
+  TestTTest2Delphi2 = False;
+{$endif}
+
+  // should be False
+{$if declared(TTestFPC)}
+  TestTTestFPC = True;
+{$else}
+  TestTTestFPC = False;
+{$endif}
+
+  // should be False
+{$if declared(TTestFPC<>)}
+  TestTTestFPC1 = True;
+{$else}
+  TestTTestFPC1 = False;
+{$endif}
+
+  // should be True
+{$if declared(TTestFPC<,>)}
+  TestTTestFPC2 = True;
+{$else}
+  TestTTestFPC2 = False;
+{$endif}
+
+begin
+  if TestNotDeclared then
+    Halt(1);
+  if TestTTestDelphi then
+    Halt(2);
+  if not TestTTestDelphi1 then
+    Halt(3);
+  if TestTTestDelphi2 then
+    Halt(4);
+  if not TestTTestDelphi3 then
+    Halt(5);
+  if not TestTTest2Delphi then
+    Halt(6);
+  if TestTTest2Delphi1 then
+    Halt(7);
+  if not TestTTest2Delphi2 then
+    Halt(8);
+  if TestTTestFPC then
+    Halt(9);
+  if TestTTestFPC1 then
+    Halt(10);
+  if not TestTTestFPC2 then
+    Halt(11);
+  Writeln('OK');
+end.

+ 27 - 0
tests/test/ugeneric93a.pp

@@ -0,0 +1,27 @@
+unit ugeneric93a;
+
+{$mode delphi}
+
+interface
+
+type
+  TTestDelphi<T> = class
+
+  end;
+
+  TTestDelphi<T, S, R> = class
+
+  end;
+
+  TTest2Delphi = class
+
+  end;
+
+  TTest2Delphi<T, S> = class
+
+  end;
+
+implementation
+
+end.
+

+ 15 - 0
tests/test/ugeneric93b.pp

@@ -0,0 +1,15 @@
+unit ugeneric93b;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  generic TTestFPC<T, S> = class
+
+  end;
+
+implementation
+
+end.
+