From 40767d2bab74d90981dabc4d099a494179ebcc81 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 21 Feb 2021 13:54:25 +0000 Subject: * fix by avk for issue #38513 + test git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48752 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/test/units/strutils/tboyer.pp | 79 +++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 tests/test/units/strutils/tboyer.pp (limited to 'tests') diff --git a/tests/test/units/strutils/tboyer.pp b/tests/test/units/strutils/tboyer.pp new file mode 100644 index 0000000000..7eb6fda835 --- /dev/null +++ b/tests/test/units/strutils/tboyer.pp @@ -0,0 +1,79 @@ +{$mode objfpc} + +uses + StrUtils; +const + result1 : array of SizeInt = (1, 4, 7, 10, 13, 16); +var + a : array of SizeInt; + i : LongInt; +begin + if FindMatchesBoyerMooreCaseSensitive('abcabcabcabcabcabcab','abcab',a,false) then + begin + if Length(a)<>1 then + halt(2); + if a[0]<>result1[0] then + halt(3); + end + else + halt(1); + + if FindMatchesBoyerMooreCaseSensitive('abcabcabcabcabcabcab','abcab',a,true) then + begin + if Length(a)<>Length(result1) then + halt(12); + for i:=Low(a) to High(a) do + if a[i]<>result1[i] then + halt(13); + end + else + halt(11); + + if FindMatchesBoyerMooreCaseInSensitive('abcabcabcabcabcabcab','abcab',a,false) then + begin + if Length(a)<>1 then + halt(22); + if a[0]<>result1[0] then + halt(23); + end + else + halt(21); + +{ + apparently not working yet: + + if FindMatchesBoyerMooreCaseInSensitive('abcabcabcabcabcabcab','abcab',a,true) then + begin + if Length(a)<>Length(result1) then + halt(32); + for i:=Low(a) to High(a) do + if a[i]<>result1[i] then + halt(33); + end + else + halt(31); + + if FindMatchesBoyerMooreCaseInSensitive('abcabcabcAbcabcAbcab','abcaB',a,false) then + begin + if Length(a)<>1 then + halt(42); + if a[0]<>result1[0] then + halt(43); + end + else + halt(41); + + if FindMatchesBoyerMooreCaseInSensitive('abcabCabcAbcabcABcab','abcaB',a,true) then + begin + if Length(a)<>Length(result1) then + halt(52); + for i:=Low(a) to High(a) do + if a[i]<>result1[i] then + halt(53); + end + else + halt(51); +} + + writeln('ok'); +end. -- cgit v1.2.1 From f9208b96d5b17a3d64795bf7ced0981b60c2c4d8 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 21 Feb 2021 18:46:00 +0000 Subject: * string constants have a size of 0, resolves #38504 git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48759 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/webtbf/tw38504.pp | 11 +++++++++++ tests/webtbf/tw38504b.pp | 11 +++++++++++ 2 files changed, 22 insertions(+) create mode 100644 tests/webtbf/tw38504.pp create mode 100644 tests/webtbf/tw38504b.pp (limited to 'tests') diff --git a/tests/webtbf/tw38504.pp b/tests/webtbf/tw38504.pp new file mode 100644 index 0000000000..6eb43cac70 --- /dev/null +++ b/tests/webtbf/tw38504.pp @@ -0,0 +1,11 @@ +{ %fail } +Var + MyVar : char; + +Procedure MyProc; +Begin + MyVar := ''; (* <-- two single-quotes *) +End; + +Begin +End. diff --git a/tests/webtbf/tw38504b.pp b/tests/webtbf/tw38504b.pp new file mode 100644 index 0000000000..211f763d03 --- /dev/null +++ b/tests/webtbf/tw38504b.pp @@ -0,0 +1,11 @@ +{ %fail } +Var + MyVar : char; + +Procedure MyProc; +Begin + MyVar := char(''); +End; + +Begin +End. -- cgit v1.2.1 From 4a7f7f244a628f4d46074bbe7aa696912dd58e19 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 21 Feb 2021 21:29:40 +0000 Subject: * allow in-operator to be used on type parameters, resolves #38497 git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48763 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/webtbs/tw38497.pp | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 tests/webtbs/tw38497.pp (limited to 'tests') diff --git a/tests/webtbs/tw38497.pp b/tests/webtbs/tw38497.pp new file mode 100644 index 0000000000..4c8c5ebcb9 --- /dev/null +++ b/tests/webtbs/tw38497.pp @@ -0,0 +1,24 @@ +program project1; + +{$mode delphi} + +type + TAlphabet = (A, B, C); + TAlphabets = set of TAlphabet; + + procedure Test(E: TEnum; S: TSet); + var + I: TEnum; + B: Boolean; + begin + B := [E] <= S; + if E in S then + WriteLn(E); + for I := Low(TEnum) to High(TEnum) do + if I in S then + WriteLn(I); + end; + +begin + Test(A, [A, B]); +end. -- cgit v1.2.1 From a1592830172239469a68ff6116f65cb3b8f4b331 Mon Sep 17 00:00:00 2001 From: pierre Date: Mon, 22 Feb 2021 23:15:31 +0000 Subject: Apply patch proposed by J. Gareth Moreton in bug report #0038527 The patch reworks the LeaLea2Lea optimisation and hopefully fixes the bug (admittedly by adding a brand new optimisation!). git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48792 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/webtbs/tw38527.pp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 tests/webtbs/tw38527.pp (limited to 'tests') diff --git a/tests/webtbs/tw38527.pp b/tests/webtbs/tw38527.pp new file mode 100644 index 0000000000..4f50d92bc8 --- /dev/null +++ b/tests/webtbs/tw38527.pp @@ -0,0 +1,15 @@ +{%OPT=-O2} + +{$mode objfpc} + +function F(n: SizeUint): SizeUint; +begin + result := 4 * n + 4 * n; +end; + +begin + writeln('Reference F(5): ', 4 * 5 + 4 * 5); + writeln(' Actual F(5): ', F(5)); + if (F(5) <> 40) then + halt(1); +end. -- cgit v1.2.1 From 27490adccae215b269386e16e0c8639ebc21c10e Mon Sep 17 00:00:00 2001 From: pierre Date: Tue, 23 Feb 2021 22:04:18 +0000 Subject: Fix tw28713 for big endian CPUs git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48795 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/webtbs/tw28713.pp | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'tests') diff --git a/tests/webtbs/tw28713.pp b/tests/webtbs/tw28713.pp index e0879f1cc3..d27b8bb138 100644 --- a/tests/webtbs/tw28713.pp +++ b/tests/webtbs/tw28713.pp @@ -6,7 +6,14 @@ type TWordArray = array [0..1023]of Word; WordRec = packed record +{$ifdef FPC} +{$ifdef FPC_LITTLE_ENDIAN} LoByte,HiByte:Byte +{$endif} +{$ifdef FPC_BIG_ENDIAN} + HiByte,LoByte:Byte +{$endif} +{$endif} end; var -- cgit v1.2.1 From 095ac3b607585d7bd979ba2d851e1f28dd59ecec Mon Sep 17 00:00:00 2001 From: pierre Date: Wed, 24 Feb 2021 10:36:45 +0000 Subject: Add wposuffix to keep different logs for each pass when passes is > 1 git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48800 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/utils/dotest.pp | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/utils/dotest.pp b/tests/utils/dotest.pp index 9aa88073f0..fd248b97d0 100644 --- a/tests/utils/dotest.pp +++ b/tests/utils/dotest.pp @@ -839,7 +839,7 @@ end; function RunCompiler(const ExtraPara: string):boolean; var args,LocalExtraArgs, - wpoargs : string; + wpoargs,wposuffix : string; passnr, passes : longint; execres : boolean; @@ -880,6 +880,7 @@ begin if Config.NeedOptions<>'' then AppendOptions(Config.NeedOptions,args); wpoargs:=''; + wposuffix:=''; if (Config.WpoPasses=0) or (Config.WpoParas='') then passes:=1 @@ -891,6 +892,7 @@ begin begin if (passes>1) then begin + wposuffix:='_'+tostr(passnr); wpoargs:=' -OW'+config.wpoparas+' -FW'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr)); if (passnr>1) then wpoargs:=wpoargs+' -Ow'+config.wpoparas+' -Fw'+TestOutputFileName('',PPFile[current],'wp'+tostr(passnr-1)); @@ -899,12 +901,12 @@ begin { also get the output from as and ld that writes to stderr sometimes } StartTicks:=GetMicroSTicks; {$ifndef macos} - execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile,'stdout'); + execres:=ExecuteRedir(CompilerBin,args+wpoargs,'',CompilerLogFile+wposuffix,'stdout'); {$else macos} {Due to that Toolserver is not reentrant, we have to asm and link via script.} - execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile,'stdout'); + execres:=ExecuteRedir(CompilerBin,'-s '+args+wpoargs,'',CompilerLogFile+wposuffix,'stdout'); if execres then - execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile,'stdout'); + execres:=ExecuteRedir(TestOutputDir + ':ppas','','',CompilerLogFile+wpo_suffix,'stdout'); {$endif macos} EndTicks:=GetMicroSTicks; Verbose(V_Debug,'Exitcode '+ToStr(ExecuteResult)); @@ -913,6 +915,8 @@ begin Verbose(V_Normal,'Compilation took '+ToStr(EndTicks-StartTicks)+' us'); end; + if passes > 1 then + CopyFile(CompilerLogFile+wposuffix,CompilerLogFile,true); { Error during execution? } if (not execres) and (ExecuteResult=0) then begin -- cgit v1.2.1 From 696deeab2428bbb1d80a6cb7e5753300bb660d77 Mon Sep 17 00:00:00 2001 From: pierre Date: Fri, 26 Feb 2021 23:39:14 +0000 Subject: Extend list of CPUs defining slowcpu conditional in tmt1 and tw8177 sources git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48816 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/test/tmt1.pp | 4 ++-- tests/webtbs/tw8177.pp | 5 +---- 2 files changed, 3 insertions(+), 6 deletions(-) (limited to 'tests') diff --git a/tests/test/tmt1.pp b/tests/test/tmt1.pp index b2992963ed..c4a50d5217 100644 --- a/tests/test/tmt1.pp +++ b/tests/test/tmt1.pp @@ -11,9 +11,9 @@ uses ; const -{$ifdef cpuarm} +{$if defined(cpuarm) or defined(cpuavr) or defined(cpui8086) or defined(cpum68k) or defined(cpumips) or defined(cpuz80)} {$define slowcpu} -{$endif cpuarm} +{$endif} {$ifdef slowcpu} threadcount = 40; diff --git a/tests/webtbs/tw8177.pp b/tests/webtbs/tw8177.pp index 4b410fabf4..c2e7e05eec 100644 --- a/tests/webtbs/tw8177.pp +++ b/tests/webtbs/tw8177.pp @@ -6,10 +6,7 @@ program ValidateStrToInt; {$mode delphi} {$ENDIF} -{$ifdef cpuarm} - {$define slowcpu} -{$endif} -{$ifdef cpumips} +{$if defined(cpuarm) or defined(cpuavr) or defined(cpui8086) or defined(cpum68k) or defined(cpumips) or defined(cpuz80)} {$define slowcpu} {$endif} {$ifdef android} -- cgit v1.2.1 From 6c0e177ef9c8cdb857cf67131fd80eb9b6d95a81 Mon Sep 17 00:00:00 2001 From: jonas Date: Sat, 27 Feb 2021 21:44:53 +0000 Subject: * support Objective-C classes and protocols with -gw3 (mantis #36250) git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48834 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/webtbs/tw36250.pp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 tests/webtbs/tw36250.pp (limited to 'tests') diff --git a/tests/webtbs/tw36250.pp b/tests/webtbs/tw36250.pp new file mode 100644 index 0000000000..569294da6f --- /dev/null +++ b/tests/webtbs/tw36250.pp @@ -0,0 +1,15 @@ +{ %norun } +{ %target=darwin,ios,iphonesim} +{ %opt=-gw3 } + +{$mode objfpc}{$h+} +{$ModeSwitch objectivec2} + +function NSStringToString(ns: NSString): String; +begin + Result := ''; +end; + +begin + WriteLn(NSStringToString(nil)); +end. -- cgit v1.2.1 From f0b47db49155a8e72b538f487db437ef000e15f4 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 28 Feb 2021 18:20:46 +0000 Subject: + optimize (a and b) or (c and not(b)) into c xor ((c xor a) and b) + test git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@48841 3ad0048d-3df7-0310-abae-a5850022a9f2 --- tests/test/tandorandnot1.pp | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 tests/test/tandorandnot1.pp (limited to 'tests') diff --git a/tests/test/tandorandnot1.pp b/tests/test/tandorandnot1.pp new file mode 100644 index 0000000000..aff04507ea --- /dev/null +++ b/tests/test/tandorandnot1.pp @@ -0,0 +1,34 @@ +{ test (a and b) or (c and not(b)) into c xor ((c xor a) and b) optimization with random values } +var + i,a,b,c,_a,_b,_c : word; +begin + for i:=1 to 1000 do + begin + a:=random(65536); + _a:=a; + b:=random(65536); + _b:=b; + c:=random(65536); + _c:=c; + if (a and b) or (c and not(b))<>_c xor ((_c xor _a) and _b) then + begin + writeln('Error: ','a=',a,'b=',b,'c=',c); + halt(1); + end; + if (a and b) or (not(b) and c)<>_c xor ((_c xor _a) and _b) then + begin + writeln('Error: ','a=',a,'b=',b,'c=',c); + halt(1); + end; + if (not(b) and c) or (a and b)<>_c xor ((_c xor _a) and _b) then + begin + writeln('Error: ','a=',a,'b=',b,'c=',c); + halt(1); + end; + if (not(b) and c) or (b and a)<>_c xor ((_c xor _a) and _b) then + begin + writeln('Error: ','a=',a,'b=',b,'c=',c); + halt(1); + end; + end; +end. -- cgit v1.2.1