浏览代码

Merged revisions 7302 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r7302 | peter | 2007-05-10 08:01:42 +0200 (Thu, 10 May 2007) | 2 lines

* fix shortstring:=char

........

git-svn-id: branches/fixes_2_2@7303 -

peter 18 年之前
父节点
当前提交
1a3bb79211
共有 3 个文件被更改,包括 20 次插入2 次删除
  1. 1 0
      .gitattributes
  2. 4 2
      compiler/ncgld.pas
  3. 15 0
      tests/webtbs/tw8838.pp

+ 1 - 0
.gitattributes

@@ -8087,6 +8087,7 @@ tests/webtbs/tw8615.pp svneol=native#text/plain
 tests/webtbs/tw8660.pp svneol=native#text/plain
 tests/webtbs/tw8664.pp svneol=native#text/plain
 tests/webtbs/tw8757.pp svneol=native#text/plain
+tests/webtbs/tw8838.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 4 - 2
compiler/ncgld.pas

@@ -480,8 +480,10 @@ implementation
                - char
             }
 
-            { The addn is replaced by a blockn or calln }
-            if right.nodetype in [blockn,calln] then
+            { The addn is replaced by a blockn or calln that already returns
+              a shortstring }
+            if is_shortstring(right.resultdef) and
+               (right.nodetype in [blockn,calln]) then
               begin
                 { nothing to do }
               end

+ 15 - 0
tests/webtbs/tw8838.pp

@@ -0,0 +1,15 @@
+var
+  c,u: char;
+  s,t: string[6];
+begin
+  c := 'x';
+  u := UpCase(c);
+  s := UpCase(c);
+  t := u;
+  writeln('c = "',c,'"');
+  writeln('u = "',u,'"');
+  writeln('s = "',s,'"');
+  writeln('t = "',t,'"');
+  if (s='') or (t='') then
+    halt(1);
+end.