summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2021-04-03 09:12:47 +0000
committermarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2021-04-03 09:12:47 +0000
commit59f91f2ce1e76093520aede7172ac413a20dab3d (patch)
tree1b2654200b766252d3e0d6015d14c059153df9fa
parent43175cc9bcd71d2a1352d01a2db695dd69ba9bbb (diff)
downloadfpc-59f91f2ce1e76093520aede7172ac413a20dab3d.tar.gz
--- Merging r49040 into '.':
U packages/rtl-objpas/src/inc/variants.pp --- Recording mergeinfo for merge of r49040 into '.': U . --- Merging r49044 into '.': U packages/rtl-objpas/src/inc/strutils.pp --- Recording mergeinfo for merge of r49044 into '.': G . --- Merging r49047 into '.': U packages/regexpr/src/regexpr.pas --- Recording mergeinfo for merge of r49047 into '.': G . --- Merging r49101 into '.': U rtl/win/wininc/struct.inc --- Recording mergeinfo for merge of r49101 into '.': G . --- Merging r49104 into '.': C compiler/aarch64/cgcpu.pas A tests/webtbs/tw38695.pp --- Recording mergeinfo for merge of r49104 into '.': G . Summary of conflicts: Text conflicts: 1 # revisions: 49040,49044,49047,49101,49104 r49040 | florian | 2021-03-23 21:57:18 +0100 (Tue, 23 Mar 2021) | 1 line Changed paths: M /trunk/packages/rtl-objpas/src/inc/variants.pp * patch by Arnaud Bouchez: initialize dummy_data properly, resolves #38653 r49044 | michael | 2021-03-24 11:40:03 +0100 (Wed, 24 Mar 2021) | 1 line Changed paths: M /trunk/packages/rtl-objpas/src/inc/strutils.pp Fix casing, bug ID 38660 r49047 | michael | 2021-03-24 18:05:26 +0100 (Wed, 24 Mar 2021) | 1 line Changed paths: M /trunk/packages/regexpr/src/regexpr.pas * Fix issue 38442 r49101 | marco | 2021-04-02 16:54:40 +0200 (Fri, 02 Apr 2021) | 1 line Changed paths: M /trunk/rtl/win/wininc/struct.inc * split propsheetheader in -A and -W variants. r49104 | florian | 2021-04-02 18:44:43 +0200 (Fri, 02 Apr 2021) | 2 lines Changed paths: M /trunk/compiler/aarch64/cgcpu.pas A /trunk/tests/webtbs/tw38695.pp * Aarch64: patch by J. Gareth Moreton: fix constant writing, resolves #38695 + test git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@49110 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--compiler/aarch64/cgcpu.pas22
-rw-r--r--packages/regexpr/src/regexpr.pas43
-rw-r--r--packages/rtl-objpas/src/inc/strutils.pp12
-rw-r--r--packages/rtl-objpas/src/inc/variants.pp4
-rw-r--r--rtl/win/wininc/struct.inc73
-rw-r--r--tests/webtbs/tw38695.pp10
6 files changed, 127 insertions, 37 deletions
diff --git a/compiler/aarch64/cgcpu.pas b/compiler/aarch64/cgcpu.pas
index 42e6fdab89..765a28f5f1 100644
--- a/compiler/aarch64/cgcpu.pas
+++ b/compiler/aarch64/cgcpu.pas
@@ -585,6 +585,9 @@ implementation
manipulated_a: tcgint;
leftover_a: word;
begin
+{$ifdef extdebug}
+ list.concat(tai_comment.Create(strpnew('Generating constant ' + tostr(a) + ' / $' + hexstr(a, 16))));
+{$endif extdebug}
case a of
{ Small positive number }
$0..$FFFF:
@@ -618,7 +621,7 @@ implementation
Exit;
end;
- { This determines whether this write can be peformed with an ORR followed by MOVK
+ { This determines whether this write can be performed with an ORR followed by MOVK
by copying the 2nd word to the 4th word for the ORR constant, then overwriting
the 4th word (unless the word is. The alternative would require 3 instructions }
leftover_a := word(a shr 48);
@@ -639,14 +642,15 @@ implementation
called for a and it returned False. Reduces processing time. [Kit] }
if (manipulated_a <> a) and is_shifter_const(manipulated_a, size) then
begin
+ { Encode value as:
+ orr reg,xzr,manipulated_a
+ movk reg,#(leftover_a),lsl #48
+ }
list.concat(taicpu.op_reg_reg_const(A_ORR, reg, makeregsize(NR_XZR, size), manipulated_a));
- if (leftover_a <> 0) then
- begin
- shifterop_reset(so);
- so.shiftmode := SM_LSL;
- so.shiftimm := 48;
- list.concat(taicpu.op_reg_const_shifterop(A_MOVK, reg, leftover_a, so));
- end;
+ shifterop_reset(so);
+ so.shiftmode := SM_LSL;
+ so.shiftimm := 48;
+ list.concat(taicpu.op_reg_const_shifterop(A_MOVK, reg, leftover_a, so));
Exit;
end;
@@ -659,7 +663,7 @@ implementation
stored as the first 16 bits followed by a shifter constant }
case a of
TCgInt($FFFF0000FFFF0000)..TCgInt($FFFF0000FFFFFFFF):
- doinverted := False
+ doinverted := False;
else
begin
doinverted := True;
diff --git a/packages/regexpr/src/regexpr.pas b/packages/regexpr/src/regexpr.pas
index 2e433aadb5..8f447f9003 100644
--- a/packages/regexpr/src/regexpr.pas
+++ b/packages/regexpr/src/regexpr.pas
@@ -1614,40 +1614,65 @@ end; { of function TRegExpr.GetModifierStr
procedure TRegExpr.SetModifierG(AValue: boolean);
begin
- fModifiers.G := AValue;
+ if fModifiers.G <> AValue then
+ begin
+ fModifiers.G := AValue;
+ InvalidateProgramm;
+ end;
end;
procedure TRegExpr.SetModifierI(AValue: boolean);
begin
- fModifiers.I := AValue;
+ if fModifiers.I <> AValue then
+ begin
+ fModifiers.I := AValue;
+ InvalidateProgramm;
+ end;
end;
procedure TRegExpr.SetModifierM(AValue: boolean);
begin
- fModifiers.M := AValue;
+ if fModifiers.M <> AValue then
+ begin
+ fModifiers.M := AValue;
+ InvalidateProgramm;
+ end;
end;
procedure TRegExpr.SetModifierR(AValue: boolean);
begin
- fModifiers.R := AValue;
+ if fModifiers.R <> AValue then
+ begin
+ fModifiers.R := AValue;
+ InvalidateProgramm;
+ end;
end;
procedure TRegExpr.SetModifierS(AValue: boolean);
begin
- fModifiers.S := AValue;
+ if fModifiers.S <> AValue then
+ begin
+ fModifiers.S := AValue;
+ InvalidateProgramm;
+ end;
end;
procedure TRegExpr.SetModifierX(AValue: boolean);
begin
- fModifiers.X := AValue;
+ if fModifiers.X <> AValue then
+ begin
+ fModifiers.X := AValue;
+ InvalidateProgramm;
+ end;
end;
procedure TRegExpr.SetModifierStr(const AStr: RegExprString);
begin
- if not ParseModifiers(PRegExprChar(AStr), Length(AStr), fModifiers) then
+ if ParseModifiers(PRegExprChar(AStr), Length(AStr), fModifiers) then
+ InvalidateProgramm
+ else
Error(reeModifierUnsupported);
-end; { of procedure TRegExpr.SetModifierStr
- -------------------------------------------------------------- }
+end;
{ ============================================================= }
{ ==================== Compiler section ======================= }
diff --git a/packages/rtl-objpas/src/inc/strutils.pp b/packages/rtl-objpas/src/inc/strutils.pp
index 7b8de4c69b..4e4a08a71f 100644
--- a/packages/rtl-objpas/src/inc/strutils.pp
+++ b/packages/rtl-objpas/src/inc/strutils.pp
@@ -177,14 +177,14 @@ function DelSpace1(const S: string): string;
function Tab2Space(const S: string; Numb: Byte): string;
function NPos(const C: string; S: string; N: Integer): SizeInt;
-Function RPosEX(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload;
-Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : SizeInt; overload;
+Function RPosEx(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload;
+Function RPosEx(C:Unicodechar;const S : UnicodeString;offs:cardinal):SizeInt; overload;
+Function RPosEx(Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : SizeInt; overload;
+Function RPosEx(Const Substr : UnicodeString; Const Source : UnicodeString;offs:cardinal) : SizeInt; overload;
Function RPos(c:char;const S : AnsiString):SizeInt; overload;
-Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; overload;
-Function RPosEX(C:Unicodechar;const S : UnicodeString;offs:cardinal):SizeInt; overload;
-Function RPosex (Const Substr : UnicodeString; Const Source : UnicodeString;offs:cardinal) : SizeInt; overload;
Function RPos(c:Unicodechar;const S : UnicodeString):SizeInt; overload;
-Function RPos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt; overload;
+Function RPos(Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; overload;
+Function RPos(Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt; overload;
function AddChar(C: Char; const S: string; N: Integer): string;
function AddCharR(C: Char; const S: string; N: Integer): string;
diff --git a/packages/rtl-objpas/src/inc/variants.pp b/packages/rtl-objpas/src/inc/variants.pp
index 7e306f6aca..84091cee27 100644
--- a/packages/rtl-objpas/src/inc/variants.pp
+++ b/packages/rtl-objpas/src/inc/variants.pp
@@ -4129,7 +4129,7 @@ begin
if not DoProcedure(Source,method_name,args) then
// may be function?
try
- variant(dummy_data) := Unassigned;
+ dummy_data.VType := varEmpty;
if not DoFunction(dummy_data,Source,method_name,args) then
RaiseDispError;
finally
@@ -4482,7 +4482,7 @@ Var
begin
case (PropInfo^.PropProcs shr 2) and 3 of
ptfield:
- PVariant(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
+ PVariant(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
ptVirtual,ptStatic:
begin
if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
diff --git a/rtl/win/wininc/struct.inc b/rtl/win/wininc/struct.inc
index 0c5c0cb363..7b459b7a6f 100644
--- a/rtl/win/wininc/struct.inc
+++ b/rtl/win/wininc/struct.inc
@@ -6304,41 +6304,92 @@ Const
lpemptyrecord = ^emptyrecord;
HPROPSHEETPAGE = ^emptyrecord;
- PROPSHEETHEADER = record
+ PROPSHEETHEADERA = record
dwSize : DWORD;
dwFlags : DWORD;
hwndParent : HWND;
hInstance : HINST;
case longint of
0 : (hIcon : HICON);
- 1 : (pszIcon : LPCTSTR;
- pszCaption : LPCTSTR;
+ 1 : (pszIcon : LPCSTR;
+ pszCaption : LPCSTR;
nPages : UINT;
case longint of
0 : (nStartPage : UINT);
- 1 : (pStartPage : LPCTSTR;
+ 1 : (pStartPage : LPCSTR;
case longint of
0 : (ppsp : LPCPROPSHEETPAGE);
1 : (phpage : ^HPROPSHEETPAGE;
pfnCallback : PFNPROPSHEETCALLBACK;
case longint of
0 : (hbmWatermark : HBITMAP);
- 1 : (pszbmWatermark : LPCTSTR;
+ 1 : (pszbmWatermark : LPCSTR;
hplWatermark : HPALETTE;
case longint of
0 : (hbmHeader : HBITMAP);
- 1 : (pszbmHeader: PAnsiChar);
+ 1 : (pszbmHeader: LPCStr);
);
);
);
);
end;
- LPPROPSHEETHEADER = ^PROPSHEETHEADER;
- LPCPROPSHEETHEADER = ^PROPSHEETHEADER;
- _PROPSHEETHEADER = PROPSHEETHEADER;
- TPROPSHEETHEADER = PROPSHEETHEADER;
- PPROPSHEETHEADER = ^PROPSHEETHEADER;
+ LPPROPSHEETHEADERA = ^PROPSHEETHEADERA;
+ LPCPROPSHEETHEADERA = ^PROPSHEETHEADERA;
+ _PROPSHEETHEADERA = PROPSHEETHEADERA;
+ TPROPSHEETHEADERA = PROPSHEETHEADERA;
+ PPROPSHEETHEADERA = ^PROPSHEETHEADERA;
+ PROPSHEETHEADERW = record
+ dwSize : DWORD;
+ dwFlags : DWORD;
+ hwndParent : HWND;
+ hInstance : HINST;
+ case longint of
+ 0 : (hIcon : HICON);
+ 1 : (pszIcon : LPCWSTR;
+ pszCaption : LPCWSTR;
+ nPages : UINT;
+ case longint of
+ 0 : (nStartPage : UINT);
+ 1 : (pStartPage : LPCWSTR;
+ case longint of
+ 0 : (ppsp : LPCPROPSHEETPAGE);
+ 1 : (phpage : ^HPROPSHEETPAGE;
+ pfnCallback : PFNPROPSHEETCALLBACK;
+ case longint of
+ 0 : (hbmWatermark : HBITMAP);
+ 1 : (pszbmWatermark : LPCWSTR;
+ hplWatermark : HPALETTE;
+ case longint of
+ 0 : (hbmHeader : HBITMAP);
+ 1 : (pszbmHeader: LPCWStr);
+ );
+ );
+ );
+ );
+ end;
+ LPPROPSHEETHEADERW = ^PROPSHEETHEADERW;
+ LPCPROPSHEETHEADERW = ^PROPSHEETHEADERW;
+ _PROPSHEETHEADERW = PROPSHEETHEADERW;
+ TPROPSHEETHEADERW = PROPSHEETHEADERW;
+ PPROPSHEETHEADERW = ^PROPSHEETHEADERW;
+
+ {$ifdef Unicode}
+ PROPSHEETHEADER = PROPSHEETHEADERW;
+ LPPROPSHEETHEADER = LPPROPSHEETHEADERW;
+ LPCPROPSHEETHEADER = LPCPROPSHEETHEADERW;
+ _PROPSHEETHEADER = _PROPSHEETHEADERW;
+ TPROPSHEETHEADER = TPROPSHEETHEADERW;
+ PPROPSHEETHEADER = PPROPSHEETHEADERW;
+ {$else}
+ PROPSHEETHEADER = PROPSHEETHEADERA;
+ LPPROPSHEETHEADER = LPPROPSHEETHEADERA;
+ LPCPROPSHEETHEADER = LPCPROPSHEETHEADERA;
+ _PROPSHEETHEADER = _PROPSHEETHEADERA;
+ TPROPSHEETHEADER = TPROPSHEETHEADERA;
+ PPROPSHEETHEADER = PPROPSHEETHEADERA;
+ {$endif}
+
{ PropertySheet callbacks }
LPFNADDPROPSHEETPAGE = function (_para1:HPROPSHEETPAGE; _para2:LPARAM):WINBOOL;stdcall;
TFNADDPROPSHEETPAGE = LPFNADDPROPSHEETPAGE;
diff --git a/tests/webtbs/tw38695.pp b/tests/webtbs/tw38695.pp
new file mode 100644
index 0000000000..7a34003356
--- /dev/null
+++ b/tests/webtbs/tw38695.pp
@@ -0,0 +1,10 @@
+{ %opt=-O- }
+var
+ q1,q2,q3 : qword;
+begin
+ q1:=$0000FFFFFFFEFFFF;
+ q2:=$FFFEFFFF;
+ q3:=$FFFF00000000;
+ if q1<>q2 or q3 then
+ halt(1);
+end.