diff --git a/.gitattributes b/.gitattributes index 6f212c9186..8af203a076 100644 --- a/.gitattributes +++ b/.gitattributes @@ -18357,6 +18357,10 @@ tests/webtbs/tw3669.pp svneol=native#text/plain tests/webtbs/tw36698.pp -text svneol=native#text/pascal tests/webtbs/tw36738.pp svneol=native#text/pascal tests/webtbs/tw3676.pp svneol=native#text/plain +tests/webtbs/tw36775.pp svneol=native#text/pascal +tests/webtbs/tw36775a.pp svneol=native#text/pascal +tests/webtbs/tw36775b.pp -text svneol=native#text/pascal +tests/webtbs/tw36775c.pp -text svneol=native#text/pascal tests/webtbs/tw3681.pp svneol=native#text/plain tests/webtbs/tw3683.pp svneol=native#text/plain tests/webtbs/tw36863.pp svneol=native#text/pascal diff --git a/compiler/nadd.pas b/compiler/nadd.pas index b6acb47a21..1380d3e0ff 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -1443,7 +1443,7 @@ implementation { full boolean evaluation is only useful if the nodes are not too complex and if no flags/jumps must be converted, further, we need to know the expectloc } if (node_complexity(right)<=2) and - not(left.expectloc in [LOC_JUMP,LOC_INVALID]) and not(right.expectloc in [LOC_JUMP,LOC_INVALID]) then + not(left.expectloc in [LOC_FLAGS,LOC_JUMP,LOC_INVALID]) and not(right.expectloc in [LOC_FLAGS,LOC_JUMP,LOC_INVALID]) then begin { we need to copy the whole tree to force another pass_1 } include(localswitches,cs_full_boolean_eval); diff --git a/tests/webtbs/tw36775.pp b/tests/webtbs/tw36775.pp new file mode 100644 index 0000000000..3f0261dbe0 --- /dev/null +++ b/tests/webtbs/tw36775.pp @@ -0,0 +1,152 @@ +program tw36775; + +{$mode objfpc} + +{ NOTE: The important part of this test is on line 65, the FindByName method } + +uses + SysUtils; + +type + TTestItem = class; + + TTestCollection = class + private + FItemArray: array of TTestItem; + function GetItem(const Index: Integer): TTestItem; + function GetCount: Integer; + public + destructor Destroy; override; + function Add(const Item: TTestItem): Integer; + function FindByName(const Val: ansistring; Ignore: TTestItem = nil): TTestItem; + property Items[Index: Integer]: TTestItem read GetItem; + property Count: Integer read GetCount; + end; + + TTestItem = class + private + FName: ansistring; + public + constructor Create(Owner: TTestCollection; AName: ansistring); + property Name: ansistring read FName; + end; + +{ TTestCollection } + +destructor TTestCollection.Destroy; + var + i: Integer; + begin + for i := 0 to Count - 1 do + FItemArray[i].Free; + + inherited Destroy; + end; + +function TTestCollection.GetItem(const Index: Integer): TTestItem; + begin + Result := FItemArray[Index]; + end; + +function TTestCollection.GetCount: Integer; + begin + Result := Length(FItemArray); + end; + +function TTestCollection.Add(const Item: TTestItem): Integer; + begin + Result := Length(FItemArray); + SetLength(FItemArray, Result + 1); + FItemArray[Result] := Item; + end; + +{ NOTE - The construction of the internal loop in the method below, specifically + the setting of Result, is paramount for triggering Internal Error 200405231 } +function TTestCollection.FindByName(const Val: ansistring; Ignore: TTestItem): TTestItem; + var + i: Integer; + begin + i := Count - 1; + while i >= 0 do + begin + Result := Items[i]; + { If either one of the conditions is removed, the internal error does not trigger } + if (AnsiCompareText(Result.Name, Val) = 0) and (Ignore <> Result) then + Exit; + Dec(i); + end; + Result := nil; + end; + +{ TTestItem } + +constructor TTestItem.Create(Owner: TTestCollection; AName: ansistring); + begin + FName := AName; + Owner.Add(Self); + end; + +const + TestName1 = 'Low'; + TestName2 = 'Defrost'; + TestName3 = 'Medium'; + TestName4 = 'Medium High'; + TestName5 = 'Cook'; + TestNameX = 'High'; + +var + Collection: TTestCollection; + ReturnedItem, IgnoreMe: TTestItem; +begin + Collection := TTestCollection.Create; + try + TTestItem.Create(Collection, TestName1); + TTestItem.Create(Collection, TestName2); + TTestItem.Create(Collection, TestName3); + TTestItem.Create(Collection, TestName4); + TTestItem.Create(Collection, TestName5); + IgnoreMe := TTestItem.Create(Collection, TestName3); { A second item named "Medium" } + + ReturnedItem := Collection.FindByName(TestName2); + if not Assigned(ReturnedItem) then + begin + WriteLn('ERROR: Collection.FindByName(', TestName2, ') returned nil.'); + Halt(1); + end + else if ReturnedItem.Name <> TestName2 then + begin + WriteLn('ERROR: Collection.FindByName(', TestName2, ') returned the wrong item (', ReturnedItem.Name, ').'); + Halt(1); + end; + + ReturnedItem := Collection.FindByName(TestNameX); + if Assigned(ReturnedItem) then + begin + WriteLn('ERROR: Collection.FindByName(', TestNameX, ') did not return nil (', ReturnedItem.Name, ').'); + Halt(1); + end; + + ReturnedItem := Collection.FindByName(TestName3, IgnoreMe); + if not Assigned(ReturnedItem) then + begin + WriteLn('ERROR: Collection.FindByName(', TestName3, ') returned nil.'); + Halt(1); + end + else if ReturnedItem.Name <> TestName3 then + begin + WriteLn('ERROR: Collection.FindByName(', TestName3, ') returned the wrong item (', ReturnedItem.Name, ').'); + Halt(1); + end + else if ReturnedItem = IgnoreMe then + begin + WriteLn('ERROR: Collection.FindByName(', TestName3, ') returned the ignored item.'); + Halt(1); + end; + + finally + Collection.Free; + end; + + WriteLn('ok'); +end. + diff --git a/tests/webtbs/tw36775a.pp b/tests/webtbs/tw36775a.pp new file mode 100644 index 0000000000..7ba921fba6 --- /dev/null +++ b/tests/webtbs/tw36775a.pp @@ -0,0 +1,2 @@ +{ %OPT=-O2 } +{$i tw36775.pp} diff --git a/tests/webtbs/tw36775b.pp b/tests/webtbs/tw36775b.pp new file mode 100644 index 0000000000..7e76ab84a7 --- /dev/null +++ b/tests/webtbs/tw36775b.pp @@ -0,0 +1,2 @@ +{ %OPT=-O3 } +{$i tw36775.pp} \ No newline at end of file diff --git a/tests/webtbs/tw36775c.pp b/tests/webtbs/tw36775c.pp new file mode 100644 index 0000000000..4e442b4094 --- /dev/null +++ b/tests/webtbs/tw36775c.pp @@ -0,0 +1,2 @@ +{ %OPT=-O4 } +{$i tw36775.pp} \ No newline at end of file