浏览代码

* read/write new cstringpattern correctly from/to ppu files
+ test

git-svn-id: trunk@14791 -

florian 15 年之前
父节点
当前提交
fc148f4aec
共有 4 个文件被更改,包括 72 次插入2 次删除
  1. 2 0
      .gitattributes
  2. 2 2
      compiler/scanner.pas
  3. 25 0
      tests/tbs/tb0569.pp
  4. 43 0
      tests/tbs/ub0569.pp

+ 2 - 0
.gitattributes

@@ -8275,6 +8275,7 @@ tests/tbs/tb0565.pp svneol=native#text/plain
 tests/tbs/tb0566.pp svneol=native#text/plain
 tests/tbs/tb0566.pp svneol=native#text/plain
 tests/tbs/tb0567.pp svneol=native#text/plain
 tests/tbs/tb0567.pp svneol=native#text/plain
 tests/tbs/tb0568.pp svneol=native#text/plain
 tests/tbs/tb0568.pp svneol=native#text/plain
+tests/tbs/tb0569.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
@@ -8311,6 +8312,7 @@ tests/tbs/ub0461.pp svneol=native#text/plain
 tests/tbs/ub0489.pp svneol=native#text/plain
 tests/tbs/ub0489.pp svneol=native#text/plain
 tests/tbs/ub0489b.pp svneol=native#text/plain
 tests/tbs/ub0489b.pp svneol=native#text/plain
 tests/tbs/ub0506.pp svneol=native#text/plain
 tests/tbs/ub0506.pp svneol=native#text/plain
+tests/tbs/ub0569.pp svneol=native#text/pascal
 tests/test/README.txt svneol=native#text/plain
 tests/test/README.txt svneol=native#text/plain
 tests/test/alglib/t_testconvunit.pp svneol=native#text/plain
 tests/test/alglib/t_testconvunit.pp svneol=native#text/plain
 tests/test/alglib/t_testcorrunit.pp svneol=native#text/plain
 tests/test/alglib/t_testcorrunit.pp svneol=native#text/plain

+ 2 - 2
compiler/scanner.pas

@@ -2094,7 +2094,7 @@ In case not, the value returned can be arbitrary.
             begin
             begin
               len:=length(cstringpattern);
               len:=length(cstringpattern);
               recordtokenbuf.write(len,sizeof(sizeint));
               recordtokenbuf.write(len,sizeof(sizeint));
-              recordtokenbuf.write(pattern[1],length(pattern));
+              recordtokenbuf.write(cstringpattern[1],length(cstringpattern));
             end;
             end;
           _CCHAR,
           _CCHAR,
           _INTCONST,
           _INTCONST,
@@ -2181,7 +2181,7 @@ In case not, the value returned can be arbitrary.
               begin
               begin
                 replaytokenbuf.read(wlen,sizeof(sizeint));
                 replaytokenbuf.read(wlen,sizeof(sizeint));
                 setlength(cstringpattern,wlen);
                 setlength(cstringpattern,wlen);
-                replaytokenbuf.read(pattern[1],length(pattern));
+                replaytokenbuf.read(cstringpattern[1],wlen);
                 orgpattern:='';
                 orgpattern:='';
                 pattern:='';
                 pattern:='';
               end;
               end;

+ 25 - 0
tests/tbs/tb0569.pp

@@ -0,0 +1,25 @@
+{$mode objfpc}
+
+uses
+  ub0569;
+
+type
+  TMyGen = specialize TGen<longint>;
+
+var
+  MyGen : TMyGen;
+
+begin
+  MyGen:=TMyGen.Create;
+  if MyGen.getstring<>'Free Pascal' then
+    halt(1);
+  if MyGen.getwidestring<>'Free Pascal'#1234 then
+    halt(2);
+  if MyGen.getint<>1234123412341234 then
+    halt(3);
+  if MyGen.getreal<>333.0 then
+    halt(4);
+  MyGen.Free;
+  writeln('ok');
+end.
+

+ 43 - 0
tests/tbs/ub0569.pp

@@ -0,0 +1,43 @@
+{ %norun }
+{$mode objfpc}
+unit ub0569;
+
+  interface
+
+    type
+      generic TGen<T> = class
+        function getstring : string;
+        function getwidestring : widestring;
+        function getint : int64;
+        function getreal : real;
+      end;
+
+  implementation
+
+    function TGen.getstring : string;
+      begin
+        result:='Free Pascal';
+      end;
+
+
+    function TGen.getwidestring : widestring;
+      begin
+        { force widestring }
+        result:='Free Pascal'#1234;
+      end;
+
+
+    function TGen.getint : int64;
+      begin
+        result:=1234123412341234;
+      end;
+
+
+    function TGen.getreal : real;
+      begin
+        result:=333.0;
+      end;
+
+
+end.
+