Kaynağa Gözat

+ variants can be used as case expression

git-svn-id: trunk@3530 -
florian 19 yıl önce
ebeveyn
işleme
48802b0866
3 değiştirilmiş dosya ile 28 ekleme ve 0 silme
  1. 1 0
      .gitattributes
  2. 6 0
      compiler/pstatmnt.pas
  3. 21 0
      tests/webtbs/tw4705.pp

+ 1 - 0
.gitattributes

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

+ 6 - 0
compiler/pstatmnt.pas

@@ -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 - 0
tests/webtbs/tw4705.pp

@@ -0,0 +1,21 @@
+{ Source provided for Free Pascal Bug Report 4705 }
+{ Submitted by "Phil H." on  2006-01-17 }
+{ e-mail: [email protected] }
+program TestVarCase;
+
+uses
+  SysUtils,
+  Variants;
+
+var
+  AVar  : Variant;
+  e : (e1,e2);
+
+begin
+  AVar := 1;
+  case AVar of
+    1 : halt(0);
+  end;
+  halt(1);
+end.
+