mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 09:19:23 +02:00
Fix for Mantis #22220
ptype.pas: * read_named_type: allow specializations for pointers in Delphi modes * single_type: correctly handle forwarddefs; as we can only specialize generics if they are completely defined (srsym<>nil) we don't need to return a forward def, but instead return the specialized def itself + added tests to "test" instead of "webtbs" as no explicit tests were given in the report git-svn-id: trunk@21689 -
This commit is contained in:
parent
2d8796fa1a
commit
cc65ac20c5
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -10727,7 +10727,11 @@ tests/test/tgeneric83.pp svneol=native#text/pascal
|
|||||||
tests/test/tgeneric84.pp svneol=native#text/pascal
|
tests/test/tgeneric84.pp svneol=native#text/pascal
|
||||||
tests/test/tgeneric85.pp svneol=native#text/pascal
|
tests/test/tgeneric85.pp svneol=native#text/pascal
|
||||||
tests/test/tgeneric86.pp svneol=native#text/pascal
|
tests/test/tgeneric86.pp svneol=native#text/pascal
|
||||||
|
tests/test/tgeneric87.pp svneol=native#text/pascal
|
||||||
|
tests/test/tgeneric88.pp svneol=native#text/pascal
|
||||||
|
tests/test/tgeneric89.pp svneol=native#text/pascal
|
||||||
tests/test/tgeneric9.pp svneol=native#text/plain
|
tests/test/tgeneric9.pp svneol=native#text/plain
|
||||||
|
tests/test/tgeneric90.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
|
||||||
|
@ -439,8 +439,22 @@ implementation
|
|||||||
if ([stoAllowSpecialization,stoAllowTypeDef] * options <> []) and
|
if ([stoAllowSpecialization,stoAllowTypeDef] * options <> []) and
|
||||||
(m_delphi in current_settings.modeswitches) then
|
(m_delphi in current_settings.modeswitches) then
|
||||||
dospecialize:=token in [_LSHARPBRACKET,_LT];
|
dospecialize:=token in [_LSHARPBRACKET,_LT];
|
||||||
|
if dospecialize and
|
||||||
|
(def.typ=forwarddef) then
|
||||||
|
begin
|
||||||
|
if not assigned(srsym) or not (srsym.typ=typesym) then
|
||||||
|
begin
|
||||||
|
Message(type_e_type_is_not_completly_defined);
|
||||||
|
def:=generrordef;
|
||||||
|
dospecialize:=false;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
if dospecialize then
|
if dospecialize then
|
||||||
generate_specialization(def,stoParseClassParent in options,'',nil,'')
|
begin
|
||||||
|
if def.typ=forwarddef then
|
||||||
|
def:=ttypesym(srsym).typedef;
|
||||||
|
generate_specialization(def,stoParseClassParent in options,'',nil,'');
|
||||||
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
|
if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
|
||||||
@ -1330,6 +1344,7 @@ implementation
|
|||||||
|
|
||||||
const
|
const
|
||||||
SingleTypeOptionsInTypeBlock:array[Boolean] of TSingleTypeOptions = ([],[stoIsForwardDef]);
|
SingleTypeOptionsInTypeBlock:array[Boolean] of TSingleTypeOptions = ([],[stoIsForwardDef]);
|
||||||
|
SingleTypeOptionsIsDelphi:array[Boolean] of TSingleTypeOptions = ([],[stoAllowSpecialization]);
|
||||||
var
|
var
|
||||||
p : tnode;
|
p : tnode;
|
||||||
hdef : tdef;
|
hdef : tdef;
|
||||||
@ -1459,7 +1474,10 @@ implementation
|
|||||||
_CARET:
|
_CARET:
|
||||||
begin
|
begin
|
||||||
consume(_CARET);
|
consume(_CARET);
|
||||||
single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
|
single_type(tt2,
|
||||||
|
SingleTypeOptionsInTypeBlock[block_type=bt_type]+
|
||||||
|
SingleTypeOptionsIsDelphi[m_delphi in current_settings.modeswitches]
|
||||||
|
);
|
||||||
{ in case of e.g. var or const sections we need to especially
|
{ in case of e.g. var or const sections we need to especially
|
||||||
check that we don't use a generic dummy symbol }
|
check that we don't use a generic dummy symbol }
|
||||||
if (block_type<>bt_type) and
|
if (block_type<>bt_type) and
|
||||||
|
18
tests/test/tgeneric87.pp
Normal file
18
tests/test/tgeneric87.pp
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
|
||||||
|
program tgeneric87;
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
type
|
||||||
|
generic TTest<T> = record
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
TestLongIntNil: ^specialize TTest<LongInt> = Nil;
|
||||||
|
TestBooleanNil: ^specialize TTest<Boolean> = Nil;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
end.
|
17
tests/test/tgeneric88.pp
Normal file
17
tests/test/tgeneric88.pp
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
{ %FAIL }
|
||||||
|
|
||||||
|
program tgeneric88;
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
type
|
||||||
|
generic TTest<T> = record
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
PTestLongInt = ^specialize TTest<LongInt>;
|
||||||
|
PTestBoolean = ^specialize TTest<Boolean>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
end.
|
17
tests/test/tgeneric89.pp
Normal file
17
tests/test/tgeneric89.pp
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
{ %NORUN }
|
||||||
|
|
||||||
|
program tgeneric89;
|
||||||
|
|
||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
type
|
||||||
|
TTest<T> = record
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
PTestLongInt = ^TTest<LongInt>;
|
||||||
|
PTestBoolean = ^TTest<Boolean>;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
end.
|
26
tests/test/tgeneric90.pp
Normal file
26
tests/test/tgeneric90.pp
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
{ %NORUN }
|
||||||
|
|
||||||
|
program tgeneric90;
|
||||||
|
|
||||||
|
{$mode delphi}
|
||||||
|
|
||||||
|
type
|
||||||
|
TTest = record
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
TTest<T> = record
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
TTest<T, S> = record
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
PTestLongInt = ^TTest<LongInt>;
|
||||||
|
PTestLongIntLongInt = ^TTest<LongInt, LongInt>;
|
||||||
|
PTest = ^TTest;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user