Kaynağa Gözat

Merged revisions 2614,2616,2619-2620,2647,2651-2652,2659 via svnmerge from
svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r2614 | jonas | 2006-02-16 21:27:31 +0100 (Thu, 16 Feb 2006) | 2 lines

* fixed handling of wrong invocations of slice + improved error reporting

........
r2616 | jonas | 2006-02-17 10:05:03 +0100 (Fri, 17 Feb 2006) | 2 lines

* committed wrong file in r2614 (ncal.pas instead of pexpr.pas)

........
r2619 | jonas | 2006-02-18 19:02:18 +0100 (Sat, 18 Feb 2006) | 2 lines

* fixed test

........
r2620 | jonas | 2006-02-18 19:02:50 +0100 (Sat, 18 Feb 2006) | 2 lines

* moved to webtbs

........
r2647 | jonas | 2006-02-20 11:20:58 +0100 (Mon, 20 Feb 2006) | 2 lines

* fixed range error

........
r2651 | jonas | 2006-02-20 11:59:42 +0100 (Mon, 20 Feb 2006) | 2 lines

+ slice constant

........
r2652 | jonas | 2006-02-20 12:00:40 +0100 (Mon, 20 Feb 2006) | 3 lines

+ telldir returns a TOff, change searchpos for findfirst/next in Dos from
longint into TOff

........
r2659 | jonas | 2006-02-21 11:00:20 +0100 (Tue, 21 Feb 2006) | 2 lines

* hopefully final range check fix

........

git-svn-id: branches/fixes_2_0@2671 -

Jonas Maebe 19 yıl önce
ebeveyn
işleme
559e4e652a

+ 3 - 1
.gitattributes

@@ -5497,6 +5497,8 @@ tests/test/units/system/tround.pp svneol=native#text/plain
 tests/test/units/system/tseg.pp svneol=native#text/plain
 tests/test/units/system/tsetstr.pp svneol=native#text/plain
 tests/test/units/system/tsetstr2.pp svneol=native#text/plain
+tests/test/units/system/tslice1.pp svneol=native#text/plain
+tests/test/units/system/tslice2.pp svneol=native#text/plain
 tests/test/units/system/tstring.pp svneol=native#text/plain
 tests/test/units/system/ttrig.pas svneol=native#text/plain
 tests/test/units/system/ttrunc.pp svneol=native#text/plain
@@ -5706,7 +5708,6 @@ tests/webtbf/tw4777.pp svneol=native#text/plain
 tests/webtbf/tw4778a.pp svneol=native#text/plain
 tests/webtbf/tw4781a.pp svneol=native#text/plain
 tests/webtbf/tw4781b.pp svneol=native#text/plain
-tests/webtbf/tw4809.pp svneol=native#text/plain
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
 tests/webtbf/uw0840b.pp svneol=native#text/plain
@@ -6442,6 +6443,7 @@ tests/webtbs/tw4778.pp svneol=native#text/plain
 tests/webtbs/tw4781a.pp svneol=native#text/plain
 tests/webtbs/tw4781b.pp svneol=native#text/plain
 tests/webtbs/tw4789.pp svneol=native#text/plain
+tests/webtbs/tw4809.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 - 0
compiler/cgobj.pas

@@ -1663,6 +1663,10 @@ implementation
         getrange(todef,lto,hto);
         from_signed := is_signed(fromdef);
         to_signed := is_signed(todef);
+        { check the rangetype of the array, not the array itself }
+        { (only change now, since getrange needs the arraydef)   }
+        if (todef.deftype = arraydef) then
+          todef := tarraydef(todef).rangetype.def;
         { no range check if from and to are equal and are both longint/dword }
         { (if we have a 32bit processor) or int64/qword, since such          }
         { operations can at most cause overflows (JM)                        }

+ 7 - 3
compiler/ninl.pas

@@ -1748,9 +1748,13 @@ implementation
               in_slice_x:
                 begin
                   result:=nil;
-                  resulttype:=tcallparanode(tcallparanode(left).left).resulttype;
-                  if not(resulttype.def.deftype=arraydef) then
-                    CGMessage(type_e_mismatch);
+                  resulttype:=tcallparanode(left).left.resulttype;
+                  if (resulttype.def.deftype <> arraydef) then
+                    CGMessagePos(left.fileinfo,type_e_mismatch);
+                  if not(is_integer(tcallparanode(tcallparanode(left).right).left.resulttype.def)) then
+                    CGMessagePos1(tcallparanode(left).right.fileinfo,
+                      type_e_integer_expr_expected,
+                      tcallparanode(tcallparanode(left).right).left.resulttype.def.typename);
                 end;
 
               in_low_x,

+ 3 - 2
compiler/pexpr.pas

@@ -675,10 +675,11 @@ implementation
                   consume(_LKLAMMER);
                   in_args:=true;
                   p1:=comp_expr(true);
-                  if try_to_consume(_COMMA) then
+                  Consume(_COMMA);
+                  if not(codegenerror) then
                     p2:=ccallparanode.create(comp_expr(true),nil)
                   else
-                    p2:=nil;
+                    p2:=cerrornode.create;
                   p2:=ccallparanode.create(p1,p2);
                   statement_syssym:=geninlinenode(l,false,p2);
                   consume(_RKLAMMER);

+ 1 - 1
rtl/darwin/termiosproc.inc

@@ -25,7 +25,7 @@ end;
 
 Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
 var
-  nr:cint;
+  nr:culong;
 begin
   case OptAct of
    TCSANOW   : nr:=TIOCSETA;

+ 1 - 0
rtl/inc/innr.inc

@@ -61,6 +61,7 @@ const
    fpc_in_initialize_x      = 50;
    fpc_in_leave             = 51; {macpas}
    fpc_in_cycle             = 52; {macpas}
+   fpc_in_slice             = 53;
 
 { Internal constant functions }
    fpc_in_const_sqr        = 100;

+ 5 - 3
rtl/unix/dos.pp

@@ -14,6 +14,8 @@
 Unit Dos;
 Interface
 
+uses baseunix;
+
 Const
   FileNameLen = 255;
 
@@ -24,12 +26,12 @@ Type
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
     Record
   {Fill : array[1..21] of byte;  Fill replaced with below}
+    SearchPos  : TOff;        {directory position}
     SearchNum  : LongInt;     {to track which search this is}
-    SearchPos  : LongInt;     {directory position}
     DirPtr     : Pointer;     {directory pointer for reading directory}
     SearchType : Byte;        {0=normal, 1=open will close, 2=only 1 file}
     SearchAttr : Byte;        {attribute we are searching for}
-    Fill       : Array[1..07] of Byte; {future use}
+    Fill       : Array[1..03] of Byte; {future use}
   {End of fill}
     Attr       : Byte;        {attribute of found file}
     Time       : LongInt;     {last modify date of found file}
@@ -57,7 +59,7 @@ Uses
   UnixUtil, // tzSeconds
   Strings,
   Unix,
-  BaseUnix,{$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF};
+  {$ifdef FPC_USE_LIBC}initc{$ELSE}Syscall{$ENDIF};
 
 {$DEFINE HAS_GETMSCOUNT}
 

+ 2 - 2
rtl/unix/unix.pp

@@ -121,7 +121,7 @@ Function  SelectText (var T:Text;TimeOut :cint):cint;
 ***************************}
 
 procedure SeekDir(p:pdir;loc:clong);
-function  TellDir(p:pdir):clong;
+function  TellDir(p:pdir):TOff;
 
 {**************************
     Pipe/Fifo/Stream
@@ -605,7 +605,7 @@ begin
   p^.dd_loc:=0;
 end;
 
-function TellDir(p:pdir):clong;
+function TellDir(p:pdir):TOff;
 begin
   if p=nil then
    begin

+ 9 - 0
tests/test/units/system/tslice1.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+procedure t(arr: array of integer);
+begin
+  t(slice(arr));
+end;
+
+begin
+end.

+ 9 - 0
tests/test/units/system/tslice2.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+procedure t(arr: array of integer);
+begin
+  t(slice(arr,'k'));
+end;
+
+begin
+end.

+ 1 - 1
tests/webtbf/tw4809.pp → tests/webtbs/tw4809.pp

@@ -1,4 +1,4 @@
-{ %fail }
+{ %result=201 }
 
 {$r+}
 Type