mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-27 06:30:01 +02:00
* fix for Mantis #38642: for enumerations with jumps Delphi behaves as follows:
- GetTypeKind returns tkEnumeration (FPC previously generated a compile error here) - GetTypeInfo on a generic parameters returns Nil for such types (FPC previously generated a compile error here) - GetTypeInfo otherwise generates a compile error (as before) git-svn-id: trunk@49064 -
This commit is contained in:
parent
57e040cb82
commit
ca7c775e36
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -15848,6 +15848,9 @@ tests/test/trtti18b.pp svneol=native#text/pascal
|
||||
tests/test/trtti19.pp svneol=native#text/pascal
|
||||
tests/test/trtti2.pp svneol=native#text/plain
|
||||
tests/test/trtti20.pp svneol=native#text/pascal
|
||||
tests/test/trtti21.pp svneol=native#text/pascal
|
||||
tests/test/trtti22.pp svneol=native#text/pascal
|
||||
tests/test/trtti23.pp svneol=native#text/pascal
|
||||
tests/test/trtti3.pp svneol=native#text/plain
|
||||
tests/test/trtti4.pp svneol=native#text/plain
|
||||
tests/test/trtti5.pp svneol=native#text/plain
|
||||
@ -18757,6 +18760,7 @@ tests/webtbs/tw38549c.pp svneol=native#text/plain
|
||||
tests/webtbs/tw38549d.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3863.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3864.pp svneol=native#text/plain
|
||||
tests/webtbs/tw38642.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3865.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3870.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3893.pp svneol=native#text/plain
|
||||
|
@ -3209,7 +3209,11 @@ implementation
|
||||
if target_info.system in systems_managed_vm then
|
||||
message(parser_e_feature_unsupported_for_vm);
|
||||
if (left.resultdef.typ=enumdef) and
|
||||
(tenumdef(left.resultdef).has_jumps) then
|
||||
(tenumdef(left.resultdef).has_jumps) and
|
||||
(
|
||||
(left.nodetype<>typen) or
|
||||
not (sp_generic_para in ttypenode(left).typesym.symoptions)
|
||||
) then
|
||||
CGMessage(type_e_no_type_info);
|
||||
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
||||
resultdef:=voidpointertype;
|
||||
@ -3219,9 +3223,6 @@ implementation
|
||||
begin
|
||||
if target_info.system in systems_managed_vm then
|
||||
message(parser_e_feature_unsupported_for_vm);
|
||||
if (left.resultdef.typ=enumdef) and
|
||||
(tenumdef(left.resultdef).has_jumps) then
|
||||
CGMessage(type_e_no_type_info);
|
||||
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
||||
resultdef:=typekindtype;
|
||||
end;
|
||||
@ -3935,9 +3936,18 @@ implementation
|
||||
|
||||
in_typeinfo_x:
|
||||
begin
|
||||
result:=caddrnode.create_internal(
|
||||
crttinode.create(tstoreddef(left.resultdef),fullrtti,rdt_normal)
|
||||
);
|
||||
if (left.resultdef.typ=enumdef) and
|
||||
(tenumdef(left.resultdef).has_jumps) then
|
||||
begin
|
||||
if (left.nodetype=typen) and (sp_generic_para in ttypenode(left).typesym.symoptions) then
|
||||
result:=cnilnode.create
|
||||
else
|
||||
internalerror(2021032601);
|
||||
end
|
||||
else
|
||||
result:=caddrnode.create_internal(
|
||||
crttinode.create(tstoreddef(left.resultdef),fullrtti,rdt_normal)
|
||||
);
|
||||
end;
|
||||
|
||||
in_gettypekind_x:
|
||||
|
26
tests/test/trtti21.pp
Normal file
26
tests/test/trtti21.pp
Normal file
@ -0,0 +1,26 @@
|
||||
{ GetTypeKind() of an enumeration with holes returns tkEnumeration and
|
||||
TypeInfo() returns Nil, but *only* inside a generic/specialization when used
|
||||
with a generic parameter }
|
||||
|
||||
program trtti21;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
type
|
||||
TEnum = (teOne = 1, teTwo);
|
||||
|
||||
generic TTest<T> = class
|
||||
class function Test: Pointer;
|
||||
end;
|
||||
|
||||
class function TTest.Test: Pointer;
|
||||
begin
|
||||
Result := TypeInfo(T);
|
||||
end;
|
||||
|
||||
begin
|
||||
if GetTypeKind(TEnum) <> tkEnumeration then
|
||||
Halt(1);
|
||||
if specialize TTest<TEnum>.Test <> Nil then
|
||||
Halt(2);
|
||||
end.
|
17
tests/test/trtti22.pp
Normal file
17
tests/test/trtti22.pp
Normal file
@ -0,0 +1,17 @@
|
||||
{ %FAIl }
|
||||
|
||||
{ outside of generics TypeInfo() of types without type information (e.g. enums
|
||||
with holes) throws a compile error }
|
||||
|
||||
program trtti22;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
type
|
||||
TEnum = (teOne = 1, teTwo);
|
||||
|
||||
var
|
||||
p: Pointer;
|
||||
begin
|
||||
p := TypeInfo(TEnum);
|
||||
end.
|
27
tests/test/trtti23.pp
Normal file
27
tests/test/trtti23.pp
Normal file
@ -0,0 +1,27 @@
|
||||
{ %FAIl }
|
||||
|
||||
{ inside of generics TypeInfo() of types without type information (e.g. enums
|
||||
with holes) that are not generic parameters throws a compile error }
|
||||
|
||||
program trtti23;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
type
|
||||
TEnum = (teOne = 1, teTwo);
|
||||
|
||||
generic TTest<T> = class
|
||||
procedure Test;
|
||||
end;
|
||||
|
||||
{ TTest }
|
||||
|
||||
procedure TTest.Test;
|
||||
var
|
||||
ti: Pointer;
|
||||
begin
|
||||
ti := TypeInfo(TEnum);
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
14
tests/webtbs/tw38642.pp
Normal file
14
tests/webtbs/tw38642.pp
Normal file
@ -0,0 +1,14 @@
|
||||
{ %NORUN }
|
||||
|
||||
program tw38642;
|
||||
{$mode delphi}{$H+}
|
||||
uses
|
||||
classes,
|
||||
generics.collections;
|
||||
type
|
||||
TMonthType = (January, February, May=10, June, July);
|
||||
TMonthList = TList<TMonthType>;
|
||||
var
|
||||
myList : TMonthList;
|
||||
begin
|
||||
end.
|
Loading…
Reference in New Issue
Block a user