From d49b4043ab5391c2026a3ddeb3bf5d2e3044c6b1 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Wed, 30 Jan 2013 16:10:15 +0000 Subject: [PATCH] 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 - --- .gitattributes | 3 ++ compiler/scanner.pas | 47 ++++++++++++++-- tests/test/tgeneric93.pp | 109 ++++++++++++++++++++++++++++++++++++++ tests/test/ugeneric93a.pp | 27 ++++++++++ tests/test/ugeneric93b.pp | 15 ++++++ 5 files changed, 197 insertions(+), 4 deletions(-) create mode 100644 tests/test/tgeneric93.pp create mode 100644 tests/test/ugeneric93a.pp create mode 100644 tests/test/ugeneric93b.pp diff --git a/.gitattributes b/.gitattributes index df7276c0fd..918b6ce76a 100644 --- a/.gitattributes +++ b/.gitattributes @@ -11018,6 +11018,7 @@ tests/test/tgeneric9.pp svneol=native#text/plain tests/test/tgeneric90.pp svneol=native#text/pascal tests/test/tgeneric91.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/theap.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/ugeneric91a.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/uhlp3.pp svneol=native#text/pascal tests/test/uhlp31.pp svneol=native#text/pascal diff --git a/compiler/scanner.pas b/compiler/scanner.pas index e2aa8e8da1..210ac36fea 100644 --- a/compiler/scanner.pas +++ b/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; var - hs : string; + hs,countstr : string; mac: tmacro; srsym : tsym; srsymtable : TSymtable; @@ -1166,13 +1166,52 @@ In case not, the value returned can be arbitrary. if current_scanner.preproc_token =_ID then begin 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 - 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 hs := '0'; read_factor := hs; - preproc_consume(_ID); - current_scanner.skipspace; end else Message(scan_e_error_in_preproc_expr); diff --git a/tests/test/tgeneric93.pp b/tests/test/tgeneric93.pp new file mode 100644 index 0000000000..cfb94ffd09 --- /dev/null +++ b/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. diff --git a/tests/test/ugeneric93a.pp b/tests/test/ugeneric93a.pp new file mode 100644 index 0000000000..a6abd40fc6 --- /dev/null +++ b/tests/test/ugeneric93a.pp @@ -0,0 +1,27 @@ +unit ugeneric93a; + +{$mode delphi} + +interface + +type + TTestDelphi = class + + end; + + TTestDelphi = class + + end; + + TTest2Delphi = class + + end; + + TTest2Delphi = class + + end; + +implementation + +end. + diff --git a/tests/test/ugeneric93b.pp b/tests/test/ugeneric93b.pp new file mode 100644 index 0000000000..8df7a34a1f --- /dev/null +++ b/tests/test/ugeneric93b.pp @@ -0,0 +1,15 @@ +unit ugeneric93b; + +{$mode objfpc}{$H+} + +interface + +type + generic TTestFPC = class + + end; + +implementation + +end. +