mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-31 08:42:33 +02:00
+ variants can be used as case expression
git-svn-id: trunk@3530 -
This commit is contained in:
parent
d9dfcfa402
commit
48802b0866
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -6791,6 +6791,7 @@ tests/webtbs/tw4675.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4678.pp -text
|
||||
tests/webtbs/tw4700.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4704.pp -text
|
||||
tests/webtbs/tw4705.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4722.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4763.pp svneol=native#text/plain
|
||||
tests/webtbs/tw4768.pp -text
|
||||
|
@ -125,6 +125,12 @@ implementation
|
||||
caseexpr:=comp_expr(true);
|
||||
{ determines result type }
|
||||
do_resulttypepass(caseexpr);
|
||||
{ variants must be accepted, but first they must be converted to integer }
|
||||
if caseexpr.resulttype.def.deftype=variantdef then
|
||||
begin
|
||||
caseexpr:=ctypeconvnode.create_internal(caseexpr,sinttype);
|
||||
do_resulttypepass(caseexpr);
|
||||
end;
|
||||
set_varstate(caseexpr,vs_read,[vsf_must_be_valid]);
|
||||
casedeferror:=false;
|
||||
casedef:=caseexpr.resulttype.def;
|
||||
|
21
tests/webtbs/tw4705.pp
Normal file
21
tests/webtbs/tw4705.pp
Normal file
@ -0,0 +1,21 @@
|
||||
{ Source provided for Free Pascal Bug Report 4705 }
|
||||
{ Submitted by "Phil H." on 2006-01-17 }
|
||||
{ e-mail: pjhess@purdue.edu }
|
||||
program TestVarCase;
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
Variants;
|
||||
|
||||
var
|
||||
AVar : Variant;
|
||||
e : (e1,e2);
|
||||
|
||||
begin
|
||||
AVar := 1;
|
||||
case AVar of
|
||||
1 : halt(0);
|
||||
end;
|
||||
halt(1);
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user