paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 17:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

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.

Browse Source 
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 -
This commit is contained in:
svenbarth 2013-01-30 16:10:15 +00:00
parent cca897cfd3
commit d49b4043ab
5 changed files with 197 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -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

47
compiler/scanner.pas
View File

@ -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);

109
tests/test/tgeneric93.pp Normal file
View File

@ -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
tests/test/ugeneric93a.pp Normal file
View File

@ -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
tests/test/ugeneric93b.pp Normal file
View File

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