Merged revisions 7784,7788,7792,7798,7830,7836-7839,7846,7849,7862,7864-7865,7869,7872,7877,7882,7906,7927-7930,7933,7953,7961,7967,7971,7986-7987,7990-7994,7998-8000,8004-8012,8016-8017,8027,8034,8036-8037,8039,8041,8044,8046,8048,8051,8057,8060,8071-8073,8075-8076,8082-8083,8087-8089,8095-8097,8099-8100,8125,8136,8142,8145,8162,8181,8187,8190,8192,8194-8196,8198,8203,8206-8207,8212-8213,8215,8225,8227,8233-8239,8262,8279,8296,8302,8307,8309,8314,8316,8318-8319,8322,8336,8338-8340,8350,8352,8381,8388,8392,8404,8410-8411,8416,8430,8438-8442,8445-8446,8448,8450-8454,8456-8457,8459,8462,8469-8470,8472-8483,8486-8488,8490,8493,8496,8506,8514,8517 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r7784 | jonas | 2007-06-23 15:44:06 +0200 (Sat, 23 Jun 2007) | 2 lines
  
    + new test (already works)
........
  r7792 | florian | 2007-06-24 16:33:28 +0200 (Sun, 24 Jun 2007) | 2 lines
  
  + new test
........
  r7798 | daniel | 2007-06-24 21:31:32 +0200 (Sun, 24 Jun 2007) | 2 lines
  
    * Prevent multiply between qword and longint.
........
  r7906 | florian | 2007-07-01 17:06:19 +0200 (Sun, 01 Jul 2007) | 2 lines
  
  * fixed warning
........
  r7930 | daniel | 2007-07-03 12:15:14 +0200 (Tue, 03 Jul 2007) | 3 lines
  
    * Compiler now catches the error already at compiler time. Use a variable
      to force checking at runtime.
........
  r7933 | jonas | 2007-07-03 15:49:58 +0200 (Tue, 03 Jul 2007) | 2 lines
  
    * don't run test, it contains bogus code (at least for most platforms)
........
  r8007 | vincents | 2007-07-10 13:58:01 +0200 (Tue, 10 Jul 2007) | 1 line
  
  * fixed compilation on win64
........
  r8017 | vincents | 2007-07-11 00:19:27 +0200 (Wed, 11 Jul 2007) | 1 line
  
  * fixed typo
........
  r8041 | vincents | 2007-07-13 23:21:39 +0200 (Fri, 13 Jul 2007) | 1 line
  
  + added test for bug #9141
........
  r8057 | daniel | 2007-07-14 23:21:07 +0200 (Sat, 14 Jul 2007) | 2 lines
  
    + Test program for bug #9261.
........
  r8072 | vincents | 2007-07-16 09:00:24 +0200 (Mon, 16 Jul 2007) | 1 line
  
  * fixed test for win64
........
  r8073 | vincents | 2007-07-16 09:04:09 +0200 (Mon, 16 Jul 2007) | 1 line
  
  * fixed readability of previous commit
........
  r8097 | vincents | 2007-07-18 22:48:27 +0200 (Wed, 18 Jul 2007) | 1 line
  
  * skip test on win64, because it tests proper initc handling and initc is not available on win64 (no cygwin for win64)
........
  r8125 | daniel | 2007-07-22 11:13:15 +0200 (Sun, 22 Jul 2007) | 2 lines
  
    * set svn:eol-style to native
........
  r8142 | florian | 2007-07-23 00:53:44 +0200 (Mon, 23 Jul 2007) | 2 lines
  
  + new test for #9059
........
  r8145 | peter | 2007-07-23 09:26:44 +0200 (Mon, 23 Jul 2007) | 2 lines
  
    * goto on
........
  r8162 | peter | 2007-07-24 00:25:35 +0200 (Tue, 24 Jul 2007) | 2 lines
  
    * add goto on
........
  r8181 | jonas | 2007-07-28 16:51:11 +0200 (Sat, 28 Jul 2007) | 3 lines
  
    + test for optimization of invisible function result parameters
      in assignment statements
........
  r8192 | jonas | 2007-07-29 17:59:17 +0200 (Sun, 29 Jul 2007) | 2 lines
  
    * extended test
........
  r8194 | jonas | 2007-07-29 19:35:34 +0200 (Sun, 29 Jul 2007) | 2 lines
  
    * extended more
........
  r8195 | jonas | 2007-07-29 19:48:46 +0200 (Sun, 29 Jul 2007) | 2 lines
  
    * extended even more (and now also fails)
........
  r8196 | jonas | 2007-07-29 19:50:31 +0200 (Sun, 29 Jul 2007) | 2 lines
  
    * forgot to call testrec3inl
........
  r8198 | jonas | 2007-07-29 21:35:52 +0200 (Sun, 29 Jul 2007) | 3 lines
  
    * fixed some test/opt tests
    + include test/opt directory in Makefile
........
  r8279 | jonas | 2007-08-13 17:20:23 +0200 (Mon, 13 Aug 2007) | 2 lines
  
    + added (works now)
........
  r8296 | jonas | 2007-08-22 08:56:41 +0200 (Wed, 22 Aug 2007) | 2 lines
  
    + forgot to commit earlier
........
  r8314 | jonas | 2007-08-26 21:24:36 +0200 (Sun, 26 Aug 2007) | 2 lines
  
    * removed svn:executable properties
........
  r8322 | jonas | 2007-08-28 21:30:56 +0200 (Tue, 28 Aug 2007) | 2 lines
  
    * fixed inttohex overload choosing
........
  r8350 | jonas | 2007-09-01 22:36:04 +0200 (Sat, 01 Sep 2007) | 3 lines
  
    * set HaltOnNotReleased to true in all testss using heaptrc so
      they'll exit with an error code in case of a memory leak
........
  r8352 | jonas | 2007-09-02 09:50:17 +0200 (Sun, 02 Sep 2007) | 2 lines
  
    + { %opt=-ghl }
........
  r8381 | jonas | 2007-09-04 19:33:59 +0200 (Tue, 04 Sep 2007) | 2 lines
  
    * improved test
........
  r8388 | jonas | 2007-09-06 13:08:22 +0200 (Thu, 06 Sep 2007) | 2 lines
  
    * removed explicit refcounting checks and replaced with memory leak check
........
  r8392 | jonas | 2007-09-07 12:48:32 +0200 (Fri, 07 Sep 2007) | 2 lines
  
    * enabled assembler test for ppc64
........
  r8416 | peter | 2007-09-09 15:12:26 +0200 (Sun, 09 Sep 2007) | 2 lines
  
    * generic inheritance tests
........
  r8514 | jonas | 2007-09-16 21:22:15 +0200 (Sun, 16 Sep 2007) | 2 lines
  
    * added run time testing
........
  r8517 | florian | 2007-09-16 22:37:54 +0200 (Sun, 16 Sep 2007) | 2 lines
  
  * test for one of the oldest open bugs, fixed by rev. 8515
........

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

.gitattributes

@@ -6377,6 +6377,7 @@ tests/tbs/tb0534.pp svneol=native#text/plain
 tests/tbs/tb0535.pp svneol=native#text/plain
 tests/tbs/tb0536.pp svneol=native#text/plain
 tests/tbs/tb0537.pp svneol=native#text/plain
+tests/tbs/tb0538.pp svneol=native#text/plain
 tests/tbs/tb0539.pp svneol=native#text/plain
 tests/tbs/tb0540.pp svneol=native#text/x-pascal
 tests/tbs/tb0541.pp svneol=native#text/plain
@@ -6428,7 +6429,6 @@ tests/test/cg/obj/beos/i386/ctest.o -text
 tests/test/cg/obj/beos/i386/tcext3.o -text
 tests/test/cg/obj/beos/i386/tcext4.o -text
 tests/test/cg/obj/beos/i386/tcext5.o -text
-tests/test/cg/obj/ctest.c -text
 tests/test/cg/obj/darwin/i386/ctest.o -text
 tests/test/cg/obj/darwin/i386/tcext3.o -text
 tests/test/cg/obj/darwin/i386/tcext4.o -text
@@ -6807,10 +6807,10 @@ tests/test/opt/tcse2.pp svneol=native#text/plain
 tests/test/opt/tcse3.pp svneol=native#text/plain
 tests/test/opt/tgotoreg.pp svneol=native#text/plain
 tests/test/opt/treg1.pp svneol=native#text/plain
-tests/test/opt/treg2.dat -text
 tests/test/opt/treg2.pp svneol=native#text/plain
 tests/test/opt/treg3.pp svneol=native#text/plain
 tests/test/opt/treg4.pp svneol=native#text/plain
+tests/test/opt/tretopt.pp svneol=native#text/plain
 tests/test/t4cc1.pp svneol=native#text/plain
 tests/test/t4cc2.pp svneol=native#text/plain
 tests/test/tabstrcl.pp svneol=native#text/plain
@@ -6887,6 +6887,8 @@ tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
 tests/test/tgeneric14.pp svneol=native#text/plain
+tests/test/tgeneric15.pp svneol=native#text/plain
+tests/test/tgeneric16.pp svneol=native#text/plain
 tests/test/tgeneric2.pp svneol=native#text/plain
 tests/test/tgeneric3.pp svneol=native#text/plain
 tests/test/tgeneric4.pp svneol=native#text/plain
@@ -8149,6 +8151,7 @@ tests/webtbs/tw4557.pp svneol=native#text/plain
 tests/webtbs/tw4566.pp -text svneol=unset#text/plain
 tests/webtbs/tw4574.pp svneol=native#text/plain
 tests/webtbs/tw4599.pp svneol=native#text/plain
+tests/webtbs/tw4606.pp svneol=native#text/plain
 tests/webtbs/tw4613.pp -text svneol=unset#text/plain
 tests/webtbs/tw4616.pp svneol=native#text/plain
 tests/webtbs/tw4624.pp -text svneol=unset#text/plain
@@ -8197,6 +8200,9 @@ tests/webtbs/tw6129.pp svneol=native#text/plain
 tests/webtbs/tw6184.pp svneol=native#text/plain
 tests/webtbs/tw6203.pp svneol=native#text/plain
 tests/webtbs/tw6435.pp svneol=native#text/plain
+tests/webtbs/tw6451.pp svneol=native#text/plain
+tests/webtbs/tw6451a.pp svneol=native#text/plain
+tests/webtbs/tw6451b.pp svneol=native#text/plain
 tests/webtbs/tw6491.pp svneol=native#text/plain
 tests/webtbs/tw6493.pp svneol=native#text/plain
 tests/webtbs/tw6525.pp -text
@@ -8253,6 +8259,7 @@ tests/webtbs/tw7637.pp svneol=native#text/plain
 tests/webtbs/tw7643.pp svneol=native#text/plain
 tests/webtbs/tw7679.pp svneol=native#text/plain
 tests/webtbs/tw7719.pp svneol=native#text/plain
+tests/webtbs/tw7733.pp svneol=native#text/plain
 tests/webtbs/tw7756.pp svneol=native#text/plain
 tests/webtbs/tw7803.pp svneol=native#text/plain
 tests/webtbs/tw7806.pp svneol=native#text/plain
@@ -8338,6 +8345,7 @@ tests/webtbs/tw8977.pp svneol=native#text/plain
 tests/webtbs/tw9025.pp svneol=native#text/plain
 tests/webtbs/tw9026.pp svneol=native#text/plain
 tests/webtbs/tw9054.pp svneol=native#text/plain
+tests/webtbs/tw9059.pp svneol=native#text/plain
 tests/webtbs/tw9072.pp svneol=native#text/plain
 tests/webtbs/tw9073.pp svneol=native#text/plain
 tests/webtbs/tw9076.pp svneol=native#text/plain
@@ -8346,10 +8354,12 @@ tests/webtbs/tw9085.pp svneol=native#text/plain
 tests/webtbs/tw9096.pp svneol=native#text/plain
 tests/webtbs/tw9098.pp svneol=native#text/plain
 tests/webtbs/tw9107.pp svneol=native#text/plain
+tests/webtbs/tw9108.pp svneol=native#text/plain
 tests/webtbs/tw9113.pp svneol=native#text/plain
 tests/webtbs/tw9128.pp svneol=native#text/plain
 tests/webtbs/tw9139.pp svneol=native#text/plain
 tests/webtbs/tw9139a.pp svneol=native#text/plain
+tests/webtbs/tw9141.pp svneol=native#text/plain
 tests/webtbs/tw9145.pp svneol=native#text/plain
 tests/webtbs/tw9161.pp svneol=native#text/plain
 tests/webtbs/tw9162.pp svneol=native#text/plain
@@ -8361,6 +8371,7 @@ tests/webtbs/tw9187.pp svneol=native#text/plain
 tests/webtbs/tw9190.pp svneol=native#text/plain
 tests/webtbs/tw9209.pp svneol=native#text/plain
 tests/webtbs/tw9221.pp svneol=native#text/plain
+tests/webtbs/tw9261.pp svneol=native#text/x-pascal
 tests/webtbs/tw9299.pp -text
 tests/webtbs/tw9306a.pp -text
 tests/webtbs/tw9306b.pp -text

tests/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/08/29]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/09/20]
 #
 default: allexectests
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-embedded
@@ -1392,7 +1392,7 @@ endif
 ifndef LOG
 export LOG:=$(TEST_OUTPUTDIR)/log
 endif
-TESTSUBDIRS=cg cg/variants cg/cdecl units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
+TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
 TESTDIRS:=test $(addprefix test/,$(TESTSUBDIRS))
 .PHONY: utils units copyfiles testprep
 utils:

tests/Makefile.fpc

@@ -109,7 +109,7 @@ endif
 
 
 # Subdirs available in the test subdir
-TESTSUBDIRS=cg cg/variants cg/cdecl units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
+TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
 
 # All full dirnames in the test/ dir including the subdir self
 TESTDIRS:=test $(addprefix test/,$(TESTSUBDIRS))

tests/tbs/tb0412.pp

@@ -6,6 +6,7 @@ uses
 
 var
    a : array of longint;
+   b : longint;
 
 begin
    try
@@ -19,7 +20,8 @@ begin
        a[3]:=1;
      except
        try
-         a[-1]:=1;
+         b:=-1;
+         a[b]:=1;
        except
          halt(0);
        end;

tests/tbs/tb0538.pp

@@ -0,0 +1,19 @@
+{$mode delphi}
+type
+  to1 = class
+    procedure p1;
+    procedure p2;
+  end;
+
+procedure to1.p1;
+  begin
+  end;
+
+procedure to1.p2;
+  const
+    p1 : pointer = nil;
+  begin
+  end;
+
+begin
+end.

tests/test/cg/obj/ctest.c

@@ -1,384 +1,384 @@
-/*
-  Program to test linking between C and pascal units.
-  Copyright (c) 2002, Carl Eric Codere
-*/
-
-/*
-   Note : Arrays seem to always be passed by reference
-   in the C language. Therefore, no testing is required
-   to use them.
-*/
-
-unsigned char global_u8bit;
-unsigned short global_u16bit;
-unsigned int global_u32bit;
-short global_s16bit;
-int global_s32bit;
-long long global_s64bit;
-unsigned long long global_u64bit;
-float global_float;
-double global_double;
-long double global_long_double;
-
-#define   RESULT_U8BIT    0x55
-#define   RESULT_U16BIT   0x500F
-#define   RESULT_U32BIT   0x500F0000
-#define   RESULT_S16BIT   -12
-#define   RESULT_S32BIT   -120
-#define   RESULT_S64BIT   -12000
-#define   RESULT_U64BIT   0x1BCDABCD
-#define   RESULT_PCHAR    "Hello world"
-#define   RESULT_FLOAT       14.54
-#define   RESULT_DOUBLE      15.54
-#define	  RESULT_LONGDOUBLE  16.54
-
-
-struct _1BYTE_
-{
-	unsigned char  u8;
-};
-
-struct _3BYTE_
-{
-	unsigned char  u8;
-	unsigned short u16;
-};
-
-struct _3BYTE_S
-{
-	unsigned short u16;
-	unsigned char w8;
-};
-
-struct _5BYTE_
-{
-	unsigned char  u8;
-	unsigned int u32;
-};
-
-struct _7BYTE_
-{
-	unsigned char u8;
-	long long s64;
-	unsigned short u16;
-};
-
-
-struct _7BYTE_ test_struct;
-
-
-/* simple parameter testing */
-void test_param_u8(unsigned char v)
-{
-  global_u8bit = v;
-}
-
-
-void test_param_u16(unsigned short v)
-{
-  global_u16bit = v;
-}
-
-void test_param_u32(unsigned int v)
-{
-  global_u32bit = v;
-}
-
-
-void test_param_s16(short v)
-{
-  global_s16bit = v;
-}
-
-void test_param_s32(int v)
-{
-  global_s32bit = v;
-}
-
-
-void test_param_s64(long long v)
-{
-  global_s64bit = v;
-}
-
-void test_param_u64(unsigned long long v)
-{
-  global_u64bit = v;
-}
-
-void test_param_float(float v)
-{
-  global_float = v;
-}
-
-void test_param_double(double v)
-{
-  global_double = v;
-}
-
-
-void test_param_longdouble(long double v)
-{
-  global_long_double = v;
-}
-
-/* simple array parameter testing */
-void test_array_param_u8(unsigned char v[2])
-{
-  global_u8bit = v[1];
-}
-
-
-void test_array_param_u16(unsigned short v[2])
-{
-  global_u16bit = v[1];
-}
-
-void test_array_param_u32(unsigned int v[2])
-{
-  global_u32bit = v[1];
-}
-
-
-void test_array_param_s16(short v[2])
-{
-  global_s16bit = v[1];
-}
-
-void test_array_param_s32(int v[2])
-{
-  global_s32bit = v[1];
-}
-
-
-void test_array_param_s64(long long v[2])
-{
-  global_s64bit = v[1];
-}
-
-void test_array_param_u64(unsigned long long v[2])
-{
-  global_u64bit = v[1];
-}
-
-void test_array_param_float(float v[2])
-{
-  global_float = v[1];
-}
-
-void test_array_param_double(double v[2])
-{
-  global_double = v[1];
-}
-
-
-void test_array_param_longdouble(long double v[2])
-{
-  global_long_double = v[1];
-}
-
-/* if this one works, others should also automatically */
-void test_param_var_u8(unsigned char *x)
-{
-	*x = RESULT_U8BIT;
-}
-
-/* mixed parameter testing */
-void test_param_mixed_u16(unsigned char z, unsigned short x, unsigned char y)
-{
-	global_u16bit = x;
-	global_u8bit = y;
-}
-
-void test_param_mixed_u32(unsigned char z, unsigned int x, unsigned char y)
-{
-	global_u32bit = x;
-	global_u8bit = y;
-}
-
-void test_param_mixed_s64(unsigned char z, long long x, unsigned char y)
-{
-	global_s64bit = x;
-	global_u8bit = y;
-}
-
-void test_param_mixed_var_u8(unsigned char *x, unsigned char y)
-{
-	global_u8bit = y;
-	*x = RESULT_U8BIT;
-}
-
-/* mixed parameter testing with floating point args */
-void test_param_mixed_float(float x, unsigned char y)
-{
-	global_float = x;
-	global_u8bit = y;
-}
-
-void test_param_mixed_double(double x, unsigned char y)
-{
-	global_double = x;
-	global_u8bit = y;
-}
-
-void test_param_mixed_long_double(long double x, unsigned char y)
-{
-	global_long_double = x;
-	global_u8bit = y;
-}
-
-/* simple record testing */
-void test_param_struct_tiny(struct _1BYTE_ buffer)
-{
-	global_u8bit = buffer.u8;
-}
-
-void test_param_struct_small(struct _3BYTE_ buffer)
-{
-	global_u8bit = buffer.u8;
-	global_u16bit = buffer.u16;
-}
-void test_param_struct_small_s(struct _3BYTE_S buffer)
-{
-	global_u8bit = buffer.w8;
-	global_u16bit = buffer.u16;
-}
-
-void test_param_struct_medium(struct _5BYTE_ buffer)
-{
-	global_u8bit = buffer.u8;
-	global_u32bit = buffer.u32;
-}
-
-void test_param_struct_large(struct _7BYTE_ buffer)
-{
-	global_u8bit = buffer.u8;
-	global_u16bit = buffer.u16;
-	global_s64bit = buffer.s64;
-}
-
-
-/* record+char testing */
-void test_param_mixed_struct_tiny(struct _1BYTE_ buffer, unsigned char y)
-{
-	global_u8bit = y;
-}
-
-void test_param_mixed_struct_small(struct _3BYTE_ buffer, unsigned char y)
-{
-	global_u8bit = y;
-	global_u16bit = buffer.u16;
-}
-void test_param_mixed_struct_small_s(struct _3BYTE_S buffer, unsigned char y)
-{
-	global_u8bit = y;
-	global_u16bit = buffer.u16;
-}
-
-void test_param_mixed_struct_medium(struct _5BYTE_ buffer, unsigned char y)
-{
-        global_u8bit = y;
-	global_u32bit = buffer.u32;
-}
-
-void test_param_mixed_struct_large(struct _7BYTE_ buffer, unsigned char y)
-{
-        global_u8bit = y;
-	global_u16bit = buffer.u16;
-	global_s64bit = buffer.s64;
-}
-
-
-/* function result testing */
-unsigned char test_function_u8()
-{
-	return RESULT_U8BIT;
-}
-
-unsigned short test_function_u16()
-{
-	return RESULT_U16BIT;
-}
-
-unsigned int test_function_u32()
-{
-	return RESULT_U32BIT;
-}
-
-unsigned long long test_function_u64()
-{
-	return RESULT_U64BIT;
-}
-
-unsigned short test_function_s16()
-{
-	return RESULT_S16BIT;
-}
-
-unsigned int test_function_s32()
-{
-	return RESULT_S32BIT;
-}
-
-unsigned long long test_function_s64()
-{
-	return RESULT_S64BIT;
-}
-
-char* test_function_pchar()
-{
-	return RESULT_PCHAR;
-}
-
-float test_function_float()
-{
-	return RESULT_FLOAT;
-}
-
-double test_function_double()
-{
-	return RESULT_DOUBLE;
-}
-
-long double test_function_longdouble()
-{
-	return RESULT_LONGDOUBLE;
-}
-
-struct _1BYTE_ test_function_tiny_struct()
-{
-        struct _1BYTE_ test_struct;
-	test_struct.u8 = RESULT_U8BIT;
-	return test_struct;
-}
-
-struct _3BYTE_ test_function_small_struct()
-{
-        struct _3BYTE_ test_struct;
-	test_struct.u8 = RESULT_U8BIT;
-	test_struct.u16 = RESULT_U16BIT;
-	return test_struct;
-}
-struct _3BYTE_S test_function_small_struct_s()
-{
-        struct _3BYTE_S test_struct;
-	test_struct.u16 = RESULT_U16BIT;
-	test_struct.w8 = RESULT_U8BIT;
-	return test_struct;
-}
-
-struct _5BYTE_ test_function_medium_struct()
-{
-        struct _5BYTE_ test_struct;
-	test_struct.u8 = RESULT_U8BIT;
-	test_struct.u32 = RESULT_U32BIT;
-	return test_struct;
-}
-
-struct _7BYTE_ test_function_struct()
-{
-	test_struct.u8 = RESULT_U8BIT;
-	test_struct.s64 = RESULT_S64BIT;
-	test_struct.u16 = RESULT_U16BIT;
-	return test_struct;
-}
+/*
+  Program to test linking between C and pascal units.
+  Copyright (c) 2002, Carl Eric Codere
+*/
+
+/*
+   Note : Arrays seem to always be passed by reference
+   in the C language. Therefore, no testing is required
+   to use them.
+*/
+
+unsigned char global_u8bit;
+unsigned short global_u16bit;
+unsigned int global_u32bit;
+short global_s16bit;
+int global_s32bit;
+long long global_s64bit;
+unsigned long long global_u64bit;
+float global_float;
+double global_double;
+long double global_long_double;
+
+#define   RESULT_U8BIT    0x55
+#define   RESULT_U16BIT   0x500F
+#define   RESULT_U32BIT   0x500F0000
+#define   RESULT_S16BIT   -12
+#define   RESULT_S32BIT   -120
+#define   RESULT_S64BIT   -12000
+#define   RESULT_U64BIT   0x1BCDABCD
+#define   RESULT_PCHAR    "Hello world"
+#define   RESULT_FLOAT       14.54
+#define   RESULT_DOUBLE      15.54
+#define	  RESULT_LONGDOUBLE  16.54
+
+
+struct _1BYTE_
+{
+	unsigned char  u8;
+};
+
+struct _3BYTE_
+{
+	unsigned char  u8;
+	unsigned short u16;
+};
+
+struct _3BYTE_S
+{
+	unsigned short u16;
+	unsigned char w8;
+};
+
+struct _5BYTE_
+{
+	unsigned char  u8;
+	unsigned int u32;
+};
+
+struct _7BYTE_
+{
+	unsigned char u8;
+	long long s64;
+	unsigned short u16;
+};
+
+
+struct _7BYTE_ test_struct;
+
+
+/* simple parameter testing */
+void test_param_u8(unsigned char v)
+{
+  global_u8bit = v;
+}
+
+
+void test_param_u16(unsigned short v)
+{
+  global_u16bit = v;
+}
+
+void test_param_u32(unsigned int v)
+{
+  global_u32bit = v;
+}
+
+
+void test_param_s16(short v)
+{
+  global_s16bit = v;
+}
+
+void test_param_s32(int v)
+{
+  global_s32bit = v;
+}
+
+
+void test_param_s64(long long v)
+{
+  global_s64bit = v;
+}
+
+void test_param_u64(unsigned long long v)
+{
+  global_u64bit = v;
+}
+
+void test_param_float(float v)
+{
+  global_float = v;
+}
+
+void test_param_double(double v)
+{
+  global_double = v;
+}
+
+
+void test_param_longdouble(long double v)
+{
+  global_long_double = v;
+}
+
+/* simple array parameter testing */
+void test_array_param_u8(unsigned char v[2])
+{
+  global_u8bit = v[1];
+}
+
+
+void test_array_param_u16(unsigned short v[2])
+{
+  global_u16bit = v[1];
+}
+
+void test_array_param_u32(unsigned int v[2])
+{
+  global_u32bit = v[1];
+}
+
+
+void test_array_param_s16(short v[2])
+{
+  global_s16bit = v[1];
+}
+
+void test_array_param_s32(int v[2])
+{
+  global_s32bit = v[1];
+}
+
+
+void test_array_param_s64(long long v[2])
+{
+  global_s64bit = v[1];
+}
+
+void test_array_param_u64(unsigned long long v[2])
+{
+  global_u64bit = v[1];
+}
+
+void test_array_param_float(float v[2])
+{
+  global_float = v[1];
+}
+
+void test_array_param_double(double v[2])
+{
+  global_double = v[1];
+}
+
+
+void test_array_param_longdouble(long double v[2])
+{
+  global_long_double = v[1];
+}
+
+/* if this one works, others should also automatically */
+void test_param_var_u8(unsigned char *x)
+{
+	*x = RESULT_U8BIT;
+}
+
+/* mixed parameter testing */
+void test_param_mixed_u16(unsigned char z, unsigned short x, unsigned char y)
+{
+	global_u16bit = x;
+	global_u8bit = y;
+}
+
+void test_param_mixed_u32(unsigned char z, unsigned int x, unsigned char y)
+{
+	global_u32bit = x;
+	global_u8bit = y;
+}
+
+void test_param_mixed_s64(unsigned char z, long long x, unsigned char y)
+{
+	global_s64bit = x;
+	global_u8bit = y;
+}
+
+void test_param_mixed_var_u8(unsigned char *x, unsigned char y)
+{
+	global_u8bit = y;
+	*x = RESULT_U8BIT;
+}
+
+/* mixed parameter testing with floating point args */
+void test_param_mixed_float(float x, unsigned char y)
+{
+	global_float = x;
+	global_u8bit = y;
+}
+
+void test_param_mixed_double(double x, unsigned char y)
+{
+	global_double = x;
+	global_u8bit = y;
+}
+
+void test_param_mixed_long_double(long double x, unsigned char y)
+{
+	global_long_double = x;
+	global_u8bit = y;
+}
+
+/* simple record testing */
+void test_param_struct_tiny(struct _1BYTE_ buffer)
+{
+	global_u8bit = buffer.u8;
+}
+
+void test_param_struct_small(struct _3BYTE_ buffer)
+{
+	global_u8bit = buffer.u8;
+	global_u16bit = buffer.u16;
+}
+void test_param_struct_small_s(struct _3BYTE_S buffer)
+{
+	global_u8bit = buffer.w8;
+	global_u16bit = buffer.u16;
+}
+
+void test_param_struct_medium(struct _5BYTE_ buffer)
+{
+	global_u8bit = buffer.u8;
+	global_u32bit = buffer.u32;
+}
+
+void test_param_struct_large(struct _7BYTE_ buffer)
+{
+	global_u8bit = buffer.u8;
+	global_u16bit = buffer.u16;
+	global_s64bit = buffer.s64;
+}
+
+
+/* record+char testing */
+void test_param_mixed_struct_tiny(struct _1BYTE_ buffer, unsigned char y)
+{
+	global_u8bit = y;
+}
+
+void test_param_mixed_struct_small(struct _3BYTE_ buffer, unsigned char y)
+{
+	global_u8bit = y;
+	global_u16bit = buffer.u16;
+}
+void test_param_mixed_struct_small_s(struct _3BYTE_S buffer, unsigned char y)
+{
+	global_u8bit = y;
+	global_u16bit = buffer.u16;
+}
+
+void test_param_mixed_struct_medium(struct _5BYTE_ buffer, unsigned char y)
+{
+        global_u8bit = y;
+	global_u32bit = buffer.u32;
+}
+
+void test_param_mixed_struct_large(struct _7BYTE_ buffer, unsigned char y)
+{
+        global_u8bit = y;
+	global_u16bit = buffer.u16;
+	global_s64bit = buffer.s64;
+}
+
+
+/* function result testing */
+unsigned char test_function_u8()
+{
+	return RESULT_U8BIT;
+}
+
+unsigned short test_function_u16()
+{
+	return RESULT_U16BIT;
+}
+
+unsigned int test_function_u32()
+{
+	return RESULT_U32BIT;
+}
+
+unsigned long long test_function_u64()
+{
+	return RESULT_U64BIT;
+}
+
+unsigned short test_function_s16()
+{
+	return RESULT_S16BIT;
+}
+
+unsigned int test_function_s32()
+{
+	return RESULT_S32BIT;
+}
+
+unsigned long long test_function_s64()
+{
+	return RESULT_S64BIT;
+}
+
+char* test_function_pchar()
+{
+	return RESULT_PCHAR;
+}
+
+float test_function_float()
+{
+	return RESULT_FLOAT;
+}
+
+double test_function_double()
+{
+	return RESULT_DOUBLE;
+}
+
+long double test_function_longdouble()
+{
+	return RESULT_LONGDOUBLE;
+}
+
+struct _1BYTE_ test_function_tiny_struct()
+{
+        struct _1BYTE_ test_struct;
+	test_struct.u8 = RESULT_U8BIT;
+	return test_struct;
+}
+
+struct _3BYTE_ test_function_small_struct()
+{
+        struct _3BYTE_ test_struct;
+	test_struct.u8 = RESULT_U8BIT;
+	test_struct.u16 = RESULT_U16BIT;
+	return test_struct;
+}
+struct _3BYTE_S test_function_small_struct_s()
+{
+        struct _3BYTE_S test_struct;
+	test_struct.u16 = RESULT_U16BIT;
+	test_struct.w8 = RESULT_U8BIT;
+	return test_struct;
+}
+
+struct _5BYTE_ test_function_medium_struct()
+{
+        struct _5BYTE_ test_struct;
+	test_struct.u8 = RESULT_U8BIT;
+	test_struct.u32 = RESULT_U32BIT;
+	return test_struct;
+}
+
+struct _7BYTE_ test_function_struct()
+{
+	test_struct.u8 = RESULT_U8BIT;
+	test_struct.s64 = RESULT_S64BIT;
+	test_struct.u16 = RESULT_U16BIT;
+	return test_struct;
+}

tests/test/opt/tgotoreg.pp

@@ -1,4 +1,4 @@
-{% OPT=-Or}
+{ %OPT=-Ooregvar }
 
 {$goto on}
 

tests/test/opt/treg2.dat

@@ -1,7 +0,0 @@
-1.0
-2.0
-3.0
-4.0
-5.0
-6.0
-

tests/test/opt/treg2.pp

@@ -36,7 +36,17 @@ procedure p;
 
 begin
    assign(t,'treg2.dat');
+   rewrite(t);
+   writeln(t,'1.0');
+   writeln(t,'2.0');
+   writeln(t,'3.0');
+   writeln(t,'4.0');
+   writeln(t,'5.0');
+   writeln(t,'6.0');
+   close(t);
    reset(t);
    p;
    close(t);
+   erase(t);
 end.
+

tests/test/opt/tretopt.pp

@@ -0,0 +1,440 @@
+{$mode objfpc}
+{$inline on}
+
+type
+  pshortstring=^shortstring;
+
+  tr = record
+    a,b,c,d,e: shortstring;
+  end;
+
+  ta = array[0..5] of shortstring;
+
+  tc = record
+    p: pointer;
+  end;
+
+var
+  p,p2,p3: pointer;
+  inlined, failed: boolean;
+
+procedure error(err: longint);
+begin
+  writeln('error near ',err, ' (inlined: ',inlined,')');
+  failed:=true;
+end;
+
+function f1(p: pchar): tr;
+begin
+  fillchar(result,sizeof(tr),0);
+  if (p^<>'x') then
+    error(1);
+  f1.a:=p^;
+end;
+
+
+function f2(var s: shortstring): tr;
+begin
+  fillchar(result,sizeof(tr),0);
+  if (s<>'x') then
+    error(2);
+  f2.a:=s;
+end;
+
+
+function f3(const s: shortstring): tr;
+begin
+  fillchar(result,sizeof(tr),0);
+  if (s<>'x') then
+    error(3);
+  f3.a:=s;
+end;
+
+
+function f4(const t: tr): tr;
+begin
+  fillchar(result,sizeof(tr),0);
+  if (t.a<>'x') then
+    error(4);
+  f4:=t;
+end;
+
+
+
+function f5(p: pchar): ta;
+begin
+  fillchar(result,sizeof(result),0);
+  if (p^<>'x') then
+    error(5);
+  result[3]:=p^;
+end;
+
+
+function f6(var s: shortstring): ta;
+begin
+  fillchar(result,sizeof(result),0);
+  if (s<>'x') then
+    error(6);
+  result[3]:=s;
+end;
+
+
+function f7(const s: shortstring): ta;
+begin
+  fillchar(result,sizeof(result),0);
+  if (s<>'x') then
+    error(7);
+  result[3]:=s;
+end;
+
+
+function f8(const t: ta): ta;
+begin
+  fillchar(result,sizeof(result),0);
+  if (t[3]<>'x') then
+    error(8);
+  result:=t;
+end;
+
+
+procedure temp;
+begin
+  if (pshortstring(p)^<>'x') then
+    error(9);
+end;
+
+function f9: tr;
+begin
+  fillchar(result,sizeof(result),0);
+  temp;
+  result.a:='x';
+end;
+
+procedure temp2(var a);
+begin
+  p2:=@a;
+end;
+
+function f10: tr;
+begin
+  fillchar(result,sizeof(result),0);
+  if (pshortstring(p2)^<>'x') then
+    error(10);
+  result.a:='x';
+end;
+
+procedure testrec1;
+var
+  t: tr;
+begin
+  t.a:='x';
+  t:=f1(@t.a[1]);
+end;
+
+
+procedure testrec2;
+var
+  t: tr;
+begin
+  t.a:='x';
+  t:=f2(t.a);
+end;
+
+
+procedure testrec3;
+var
+  t: tr;
+begin
+  t.a:='x';
+  t:=f3(t.a);
+end;
+
+
+procedure testrec4;
+var
+  t: tr;
+begin
+  t.a:='x';
+  t:=f4(t);
+end;
+
+
+procedure testrec5;
+var
+  t: tr;
+begin
+  t.a:='x';
+  p:[email protected];
+  t:=f9;
+end;
+
+
+procedure testrecinl1; inline;
+var
+  t: tr;
+begin
+  inlined:=true;
+  t.a:='x';
+  t:=f1(@t.a[1]);
+end;
+
+
+procedure testrecinl2; inline;
+var
+  t: tr;
+begin
+  inlined:=true;
+  t.a:='x';
+  t:=f2(t.a);
+end;
+
+
+procedure testrecinl3; inline;
+var
+  t: tr;
+begin
+  inlined:=true;
+  t.a:='x';
+  t:=f3(t.a);
+end;
+
+
+procedure testrecinl4; inline;
+var
+  t: tr;
+begin
+  inlined:=true;
+  t.a:='x';
+  t:=f4(t);
+end;
+
+
+procedure testrecinl5; inline;
+var
+  t: tr;
+begin
+  inlined:=true;
+  t.a:='x';
+  p:[email protected];
+  t:=f9;
+  inlined:=false;
+end;
+
+
+procedure testrec2a;
+var
+  t: tr;
+begin
+  t.a:='x';
+  temp2(t.a);
+  t:=f10;
+end;
+
+
+procedure testrec2ainl; inline;
+var
+  t: tr;
+begin
+  inlined:=true;
+  t.a:='x';
+  temp2(t.a);
+  t:=f10;
+  inlined:=false;
+end;
+
+
+{$if defined(cpupowerpc) or defined(cpupowerpc64) or defined(cpui386)}
+function f11: tr;
+begin
+  fillchar(result,sizeof(result),0);
+  if (pshortstring(p3)^<>'x') then
+    error(11);
+  result.a:='x';
+end;
+
+procedure testrec3a;
+var
+  t: tr;
+begin
+  asm
+{$ifdef cpupowerpc}
+    la  r3,t
+  {$ifndef macos}
+    lis  r4,p3@ha
+    addi r4,r4,p3@l
+  {$else}
+    lwz  r4,p3(r2)
+  {$endif}
+    stw  r3,0(r4)
+{$endif}
+{$ifdef cpupowerpc64}
+    la  r3,t
+{$ifndef darwin}
+    lis  r4, p3@highesta
+    ori  r4, r4, p3@highera
+    sldi r4, r4, 32
+    oris r4, r4, p3@ha
+{$else darwin}
+    lis  r4, p3@ha
+{$endif darwin}
+    std  r3,p3@l(r4)
+{$endif}
+{$ifdef cpui386}
+    leal t,%eax
+    movl %eax,p3
+{$endif}
+  end;
+
+  t.a:='x';
+  t:=f11;
+end;
+
+
+procedure testrec3ainl; inline;
+var
+  t: tr;
+begin
+  inlined:=true;
+  asm
+{$ifdef cpupowerpc}
+    la  r3,t
+  {$ifndef macos}
+    lis  r4,p3@ha
+    addi r4,r4,p3@l
+  {$else}
+    lwz  r4,p3(r2)
+  {$endif}
+    stw  r3,0(r4)
+{$endif}
+{$ifdef cpupowerpc64}
+    la  r3,t
+{$ifndef darwin}
+    lis  r4, p3@highesta
+    ori  r4, r4, p3@highera
+    sldi r4, r4, 32
+    oris r4, r4, p3@ha
+{$else darwin}
+    lis  r4, p3@ha
+{$endif darwin}
+    std  r3,p3@l(r4)
+{$endif}
+{$ifdef cpui386}
+    leal t,%eax
+    movl %eax,p3
+{$endif}
+  end;
+
+  t.a:='x';
+  t:=f11;
+  inlined:=false;
+end;
+
+{$endif}
+
+
+
+procedure testarr1;
+var
+  t: ta;
+begin
+  t[3]:='x';
+  t:=f5(@t[3][1]);
+end;
+
+
+procedure testarr2;
+var
+  t: ta;
+begin
+  t[3]:='x';
+  t:=f6(t[3]);
+end;
+
+
+procedure testarr3;
+var
+  t: ta;
+begin
+  t[3]:='x';
+  t:=f7(t[3]);
+end;
+
+
+procedure testarr4;
+var
+  t: ta;
+begin
+  t[3]:='x';
+  t:=f8(t);
+end;
+
+
+procedure testarrinl1; inline;
+var
+  t: ta;
+begin
+  inlined:=true;
+  t[3]:='x';
+  t:=f5(@t[3][1]);
+end;
+
+
+procedure testarrinl2; inline;
+var
+  t: ta;
+begin
+  inlined:=true;
+  t[3]:='x';
+  t:=f6(t[3]);
+end;
+
+
+procedure testarrinl3; inline;
+var
+  t: ta;
+begin
+  inlined:=true;
+  t[3]:='x';
+  t:=f7(t[3]);
+end;
+
+
+procedure testarrinl4; inline;
+var
+  t: ta;
+begin
+  inlined:=true;
+  t[3]:='x';
+  t:=f8(t);
+  inlined:=false;
+end;
+
+
+begin
+  testrec1;
+  testrec2;
+  testrec3;
+  testrec4;
+  testrec5;
+  testrecinl1;
+  testrecinl2;
+  testrecinl3;
+  testrecinl4;
+  testrecinl5;
+  testrec2a;
+  testrec2ainl;
+{$if defined(cpupowerpc) or defined(cpui386) or defined(cpupowerpc64)}
+  testrec3a;
+  testrec3ainl;
+{$endif}
+  testarr1;
+  testarr2;
+  testarr3;
+  testarr4;
+  testarrinl1;
+  testarrinl2;
+  testarrinl3;
+  testarrinl4;
+  if failed then
+    halt(1);
+end.

tests/test/tgeneric15.pp

@@ -0,0 +1,78 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+type
+
+  { TStack }
+
+  generic TStack<T> = class(TObject)
+   public
+    procedure Clear; virtual;
+    destructor Destroy; override;
+  end;
+
+  { TIntegerStack }
+
+  TIntegerStack = class(specialize TStack<Integer>)
+   public
+    procedure Clear; override;
+  end;
+
+  { TIntegerStack2 }
+
+  TIntegerStack2 = class(specialize TStack<Integer>)
+   public
+    procedure Clear; override;
+  end;
+
+var
+  Idx : Longint;
+
+{ TIntegerStack }
+
+procedure TIntegerStack.Clear;
+begin
+  Writeln('new clear');
+  Idx:=Idx or 1;
+end;
+
+{ TIntegerStack2 }
+
+procedure TIntegerStack2.Clear;
+begin
+  Writeln('new clear2');
+  Idx:=Idx or 2;
+end;
+
+{ TStack }
+
+procedure TStack.Clear;
+begin
+  Writeln('old clear');
+end;
+
+destructor TStack.Destroy;
+begin
+  Writeln('old destroy');
+  Clear;
+end;
+
+
+var
+  s: TIntegerStack;
+  s2: TIntegerStack2;
+begin
+  Idx:=0;
+
+  s := TIntegerStack.Create;
+  Writeln(s.ClassName);
+  s.Free;
+
+  s2 := TIntegerStack2.Create;
+  Writeln(s2.ClassName);
+  s2.Free;
+
+  if Idx<>3 then
+    halt(1);
+end.

tests/test/tgeneric16.pp

@@ -0,0 +1,82 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+type
+
+  { TStack }
+
+  generic TStack<T> = class(TObject)
+   public
+    procedure Clear; virtual;
+    destructor Destroy; override;
+  end;
+
+  { TIntegerStack }
+
+  TAdvStack = class(specialize TStack<T>)
+  public
+    procedure Clear; override;
+  end;
+
+  { TIntegerStack }
+
+  TIntegerStack = specialize TAdvStack<Integer>;
+
+  { TIntegerStack2 }
+
+  TIntegerStack2 = class(specialize TAdvStack<Integer>);
+  public
+    procedure Clear; override;
+  end;
+
+var
+  Idx : Longint;
+
+{ TAdvStack }
+
+procedure TAdvStack.Clear;
+begin
+  Writeln('new clear');
+  Idx:=Idx or 1;
+end;
+
+{ TIntegerStack2 }
+
+procedure TIntegerStack2.Clear;
+begin
+  Writeln('new clear2');
+  Idx:=Idx or 2;
+end;
+
+{ TStack }
+
+procedure TStack.Clear;
+begin
+  Writeln('old clear');
+end;
+
+destructor TStack.Destroy;
+begin
+  Writeln('old destroy');
+  Clear;
+end;
+
+
+var
+  s : TIntegerStack;
+  s2 : TIntegerStack2;
+begin
+  Idx:=0;
+
+  s := TIntegerStack.Create;
+  Writeln(s.ClassName);
+  s.Free;
+
+  s2 := TIntegerStack2.Create;
+  Writeln(s2.ClassName);
+  s2.Free;
+
+  if Idx<>3 then
+    halt(1);
+end.

tests/test/tint642.pp

@@ -732,7 +732,7 @@ procedure teststringqword;
   var
      q1,q2 : qword;
      s : string;
-     l : longint;
+     l : cardinal;
      a : ansistring;
      code : integer;
 

tests/test/tlibrary3.pp

@@ -1,5 +1,5 @@
 { %NORUN }
-{ %SKIPTARGET=macos }
+{ %SKIPTARGET=macos, win64 }
 
 {$ifdef CPUX86_64}
 {$ifndef WINDOWS}

tests/test/toperator6.pp

@@ -12,6 +12,8 @@ type  Tconstexprint=record
 
 operator := (const u:qword):Tconstexprint;
 begin
+  if (u<>high(int64)+100) then
+    halt(1);
   result.overflow:=false;
   result.signed:=false;
   result.uvalue:=u;
@@ -19,6 +21,8 @@ end;
 
 operator := (const s:int64):Tconstexprint;
 begin
+  if (s<>-128) then
+    halt(2);
   result.overflow:=false;
   result.signed:=true;
   result.svalue:=s;

tests/webtbf/tw7752.pp

@@ -1,6 +1,7 @@
 { %OPT=-gh }
 { The only problem is that we don't really get a
   non zero exitcode if some memory is not freed PM }
+{ now we do, thanks to a patch of yours several years later :) }
 { Source provided for Free Pascal Bug Report 1433 }
 { Submitted by "Aleksey V. Vaneev" on  2001-03-10 }
 { e-mail: [email protected] }
@@ -29,6 +30,7 @@ begin
 end;
 
 begin
+        HaltOnNotReleased := true;
         ExitTest1;
         ExitTest2;
 end.

tests/webtbs/tw2911.pp

@@ -1,4 +1,5 @@
 { %version=1.1 }
+{ %opt=-gh }
 
 { Source provided for Free Pascal Bug Report 2911 }
 { Submitted by "Chris Hilder" on  2004-01-19 }
@@ -20,53 +21,21 @@ var
         twostring : string;
         ARecordWithStrings : RecordWithStrings;
 
-procedure RefCount(const s : string;expect:longint);
-type
-        PLongint = ^Longint;
-var
-        P : psizeint;
-        rc : longint;
-begin
-        P := psizeint(s);
-        rc:=0;
-        if (p = nil)
-        then writeln('Nil string.')
-        else
-{$ifdef  fpc}
-  {$if defined(ver1_0) or defined(ver1_9_4)}
-         rc:=(p-1)^;
-  {$else}
-         rc:=psizeint(pchar(p)-sizeof(sizeint)*2)^;
-  {$endif}
-{$else}
-         rc:=psizeint(pchar(p)-sizeof(sizeint)*2)^;
-{$endif}
-  writeln('Ref count is ',rc,' expected ',expect);
-  if rc<>expect then
-    halt(1);
-end;
-
 function FunctionResultIsRecord(a : RecordWithStrings) : RecordWithStrings;
 begin
         result := a;
 end;
 
 begin
+        HaltOnNotReleased := true;
         onestring := 'one';
         twostring := 'two';
         ARecordWithStrings.one := onestring + twostring;
         twostring := onestring + twostring;
-        RefCount(ARecordWithStrings.one,1);
-        { Here we allocate a temp so refcount will be 2 }
         ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
         twostring := onestring + twostring;
-        RefCount(ARecordWithStrings.one,2);
-        { Temp is reused, refcount should stay 2 }
         ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
         twostring := onestring + twostring;
-        RefCount(ARecordWithStrings.one,2);
-        { Temp is reused, refcount should stay 2 }
         ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
         twostring := onestring + twostring;
-        RefCount(ARecordWithStrings.one,2);
 end.

tests/webtbs/tw3348.pp

@@ -19,6 +19,7 @@ end;
 var
  ar1: integerarty;
 begin
+ HaltOnNotReleased := true;
  ar1:= nil;
  proc(ar1); // checkpointer error (nil!)
 end.

tests/webtbs/tw3411.pp

@@ -1,3 +1,5 @@
+{ %opt=-ghl }
+
 { Source provided for Free Pascal Bug Report 3411 }
 { Submitted by "Dean Zobec" on  2004-11-28 }
 { e-mail: [email protected] }
@@ -51,5 +53,6 @@ begin
 end;
 
 begin
+   HaltOnNotReleased := true;
   TestLeak;
 end.

tests/webtbs/tw3661.pp

@@ -9,5 +9,6 @@ uses
   Classes;
 
 begin
+ HaltOnNotReleased := true;
  writeln('abc');
 end.

tests/webtbs/tw3721.pp

@@ -5,6 +5,7 @@ uses sysutils;
 var ps : pstring;
 
 begin
+  HaltOnNotReleased := true;  
   ps:=newstr('TEST');
   writeln(ps^);
   disposestr(ps);

tests/webtbs/tw3742.pp

@@ -37,6 +37,7 @@ begin
 end;
 
 begin
+ HaltOnNotReleased := true;
  testproc;
  writeln('refcount b 0: ',pinteger(pchar(pointer(ar2[0].stack)-8))^);
  writeln('refcount b 1: ',pinteger(pchar(pointer(ar2[1].stack)-8))^);

tests/webtbs/tw3973.pp

@@ -128,7 +128,7 @@ var
     Writeln(Format('high of int64 is: %d', [Longlong]), ' ', IntToHex(Longlong, 16));
     {$IFDEF FPC}
     Quad := High(Quad);
-    Writeln(Format('high of quadword is: %u', [Quad]), ' ', IntToHex(Quad, 16));
+    Writeln(Format('high of quadword is: %u', [Quad]), ' ', IntToHex(int64(Quad), 16));
     {$ENDIF}
   end;
 

tests/webtbs/tw4038.pp

@@ -11,11 +11,11 @@ begin
 {$ifdef unix}
   s:='/bin/echo';
 {$else}
-{$ifdef win32}
+{$ifdef windows}
   s:='gecho';
-{$else win32}
+{$else windows}
   s:='echo';
-{$endif win32}
+{$endif windows}
 {$endif}
   writeln(executeprocess(s,'works1 works2 works3'));
   writeln(executeprocess(s,'works1 works2 works3'));

tests/webtbs/tw4247.pp

@@ -7,6 +7,7 @@ program project1;
 var
  po1,po2: pointer;
 begin
+ HaltOnNotReleased := true;
  getmem(po1,500);
  getmem(po2,500);
  reallocmem(po1,400);
@@ -16,4 +17,4 @@ begin
  reallocmem(po1,600);
  freemem(po1,600);
  freemem(po2,500);
-end.
+end.

tests/webtbs/tw4606.pp

@@ -0,0 +1,11 @@
+{$packset 1}
+type
+  tlettersset=set of 'a'..'z';
+
+begin
+  if sizeof(tlettersset)<>4 then
+    begin
+      writeln(sizeof(tlettersset));
+      halt(1);
+    end;
+end.

tests/webtbs/tw5800.pp

@@ -0,0 +1,9 @@
+{ %fail }
+
+{$codepage utf8}
+
+{ can't convert widechar to char, because don't know what }
+{ encoding to use at compile-time                         }
+const abc : array [1..4] of char = ('a','é','b','c');
+begin
+end.

tests/webtbs/tw6451a.pp

@@ -0,0 +1,11 @@
+{ %fail }
+{$codepage utf8}
+
+var
+  a: char;
+begin
+  a:='a';
+  { can't convert widechar to char, because don't know what }
+  { encoding to use at compile-time                         }
+  if a in ['é', 'a'] then ;
+end.

tests/webtbs/tw6451b.pp

@@ -0,0 +1,11 @@
+{ %fail }
+{$codepage utf8}
+
+var
+  a: char;
+begin
+  a:='a';
+  { can't convert widechar to char, because don't know what }
+  { encoding to use at compile-time                         }
+  if a in ['a', 'é'] then;
+end.

tests/webtbs/tw6525.pp

@@ -1,5 +1,7 @@
 { %cpu=i386,x86_64 }
 
+{$goto on}
+
 label l1;
 var
   err : boolean;

tests/webtbs/tw6767.pp

@@ -11,6 +11,7 @@ uses
 var
  CheckThread : TCheckConnThread;
 begin
+  HaltOnNotReleased := true;
   CheckThread := TCheckConnThread.Create(false);
   CheckThread.Terminate;
   CheckThread.Waitfor;

tests/webtbs/tw7733.pp

@@ -0,0 +1,13 @@
+{ %cpu=i386 }
+
+function A: pointer; assembler; nostackframe;
+asm
+  pushl $A
+  popl %eax
+end;
+
+begin
+  if A <> pointer(@A) then
+    halt(1);
+end.
+

tests/webtbs/tw8018.pp

@@ -17,6 +17,6 @@ var
 begin
   e := b;
   p := Pointer(e);
-  if Integer(p)<>1 then
+  if PtrUInt(p)<>1 then
     halt(1); // produces "1" in Delphi
 end.

tests/webtbs/tw8664.pp

@@ -9,5 +9,6 @@ end;
 
 
 begin
+  HaltOnNotReleased := true;
   TLResourceListAdd(['Value1']);
 end.

tests/webtbs/tw8757.pp

@@ -9,6 +9,7 @@ constructor o.init; begin end;
 var o1 : ^o;
 
 begin
+  HaltOnNotReleased := true;;
   New(o1,init);
   // New(o1); o1^.init; <- no error
   dispose(o1);

tests/webtbs/tw9059.pp

@@ -0,0 +1,14 @@
+{ %opt=-Oodfa -vw -Sew}
+program DoesNotSeemToBeInited;
+
+{$goto on}
+
+label 10, 20, 30;
+var i: integer;
+begin
+        goto 20;
+        10: begin i:= i + 1; goto 30 end;
+        20: i:= 1;
+        goto 10;
+        30: writeln( 'i = ', i)
+end.

tests/webtbs/tw9108.pp

@@ -0,0 +1,11 @@
+program bug;
+
+function Func(a:longint): longint;
+begin
+  if (a >= 0) then Func:=Trunc(1.0*a) else Func:=-Trunc(1.0*a);
+end;
+
+begin
+  if Func(100) <> 100 then
+    halt(1);
+end.

tests/webtbs/tw9141.pp

@@ -0,0 +1,60 @@
+{$mode objfpc}{$H+}
+
+uses classes,typinfo;
+type
+  TA = class(TPersistent)
+  private
+    FOnTest: TNotifyEvent;
+    procedure SetOnTest(value: TNotifyEvent);
+  public
+    procedure CallTest;
+  published
+    property OnTest: TNotifyEvent read FOnTest Write SetOnTest;
+  end;  
+
+  TB = class
+  public
+    procedure Test(Sender: TObject);
+  end;
+
+procedure TA.SetOnTest(value: TNotifyEvent);
+begin
+  FOnTest := Value
+end;
+
+procedure TA.CallTest;
+begin
+  if Assigned(FOnTest) then 
+    OnTest(self)
+  else
+    WriteLn('OnTest no set');
+end;
+
+procedure TB.Test(Sender: TObject);
+begin
+  WriteLn('Test Called');
+end;
+
+var
+  A: TA;
+  B: TB;
+  PropInfo: PPropInfo;
+  Method: TMethod;
+begin
+  A := TA.Create;
+  B := TB.Create;
+
+  Method:=TMethod(@B.Test);
+
+  PropInfo:=GetPropInfo(A.ClassInfo, 'OnTest');
+  if Assigned(PropInfo) then begin
+    SetMethodProp(A, PropInfo, Method);
+    WriteLn('Testing SetMethodProp method');
+    A.CallTest;
+  end 
+  else begin
+    WriteLn('PropInfo for ''OnTest'' not found');
+    Halt(1);
+  end;
+end.
+

tests/webtbs/tw9145.pp

@@ -1,3 +1,5 @@
+{ %norun }
+
 program main;
 {$mode objfpc}
 uses

tests/webtbs/tw9261.pp

@@ -0,0 +1,26 @@
+program tw9261;
+
+{$mode objfpc}
+
+type methodprocvar = function(): Boolean of object;
+
+procedure test_procedure(a1, a2, a3, a4, a5, a6: integer; mv: methodprocvar);
+begin
+  with Tmethod(mv) do
+    if (code<>pointer($11111111)) or (data<>pointer($22222222)) then
+       begin
+         writeln('test failed');
+         halt(1);
+       end;
+end;
+
+var a:methodprocvar;
+
+begin
+  with Tmethod(a) do
+    begin
+      code:=pointer($11111111);
+      data:=pointer($22222222);
+    end;
+  test_procedure(1, 2, 3, 4, 5, 6, a);
+end.