mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-31 03:31:19 +02:00
FpDebug, tests: function-ref variables
git-svn-id: trunk@61522 -
This commit is contained in:
martin
parent
afb6089d74
commit
2c26dfcbd5
@ -882,14 +882,23 @@ end;
|
||||
|
||||
|
||||
|
||||
t.Add(AName, p+'Enum'+e, weEnum('EnVal3', 'TEnum'));
|
||||
t.Add(AName, p+'Enum1'+e, weEnum('EnVal2', 'TEnumSub'));
|
||||
t.Add(AName, p+'Enum2'+e, weEnum('EnVal21', 'TEnum2'));
|
||||
t.Add(AName, p+'Enum3'+e, weEnum('EnVal25', 'TEnum2'));
|
||||
t.Add(AName, p+'Enum'+e, weEnum('EnVal3', 'TEnum'));
|
||||
t.Add(AName, p+'Enum1'+e, weEnum('EnVal2', 'TEnumSub'));
|
||||
t.Add(AName, p+'Enum2'+e, weEnum('EnVal21', 'TEnum2'));
|
||||
t.Add(AName, p+'Enum3'+e, weEnum('EnVal25', 'TEnum2'));
|
||||
|
||||
t.Add(AName, p+'Set'+e, weSet(['EnVal2', 'EnVal4'], 'TSet')).Skip([stDwarf]);
|
||||
t.Add(AName, p+'Set'+e, weSet(['EnVal2', 'EnVal4'], 'TSet')).Skip([stDwarf]);
|
||||
|
||||
t.Add(AName, p+'IntfUnknown'+e, weMatch('.?', skInterface)).Skip(); // only run eval / do not crash
|
||||
t.Add(AName, p+'IntfUnknown'+e, weMatch('.?', skInterface)).Skip(); // only run eval / do not crash
|
||||
|
||||
|
||||
if not(ALoc in [tlConst]) then begin
|
||||
t.Add(AName, p+'SomeFunc1Ref'+e, weMatch('\$[0-9A-F]+ = SomeFunc1: *function *\(SOMEVALUE, Foo: LONGINT; Bar: Word; x: Byte\): *BOOLEAN', skFunctionRef) );
|
||||
t.Add(AName, '@'+p+'SomeFunc1Ref'+e, wePointer('^TFunc1') ).AddFlag(ehIgnPointerDerefData);
|
||||
t.Add(AName, p+'SomeProc1Ref'+e, weMatch('\$[0-9A-F]+ = SomeProc1: *procedure *\(\) *$', skProcedureRef) );
|
||||
t.Add(AName, p+'SomeMeth1Ref'+e, weMatch('TMeth1.*Proc *= *\$[0-9A-F]+ *= *TMyBaseClass\.SomeMeth1.*:.*Self.*=.*', skRecord) ); // TODO: correct type / NOT Boolean
|
||||
t.Add(AName, p+'SomeMeth1Ref'+e+'.Proc', weMatch('\$[0-9A-F]+ = TMyBaseClass\.SomeMeth1: *function *\(.*AVal.*\): *BOOLEAN', skFunctionRef) );
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
@ -942,6 +951,8 @@ begin
|
||||
//t.CheckResults;
|
||||
//exit;
|
||||
|
||||
t.Add('SomeFunc1', weMatch('^function *\(SOMEVALUE, Foo: LONGINT; Bar: Word; x: Byte\): *BOOLEAN', skFunction) );
|
||||
t.Add('@SomeFunc1', weMatch('.', skPointer) ); // TODO: the text is based on the function return type
|
||||
AddWatches(t, 'glob const', 'gc', 000, 'A', tlConst);
|
||||
AddWatches(t, 'glob var', 'gv', 001, 'B');
|
||||
AddWatches(t, 'glob MyClass1', 'MyClass1.mc', 002, 'C');
|
||||
@ -1582,10 +1593,10 @@ begin
|
||||
AddWatchesCast(t, 'glob const', 'gc', 000, 'A', tlConst);
|
||||
AddWatchesCast(t, 'glob var', 'gv', 001, 'B');
|
||||
AddWatchesCast(t, 'glob MyClass1', 'MyClass1.mc', 002, 'C');
|
||||
//AddWatchesCast(t, 'glob MyBaseClass1', 'MyClass1.mbc', 003, 'D');
|
||||
//AddWatchesCast(t, 'glob MyClass1', 'TMyClass(MyClass2).mc', 004, 'E');
|
||||
//AddWatchesCast(t, 'glob MyBaseClass1', 'TMyClass(MyClass2).mbc', 005, 'F');
|
||||
//AddWatchesCast(t, 'glob var dyn array of [0]', 'gva', 005, 'K', tlArrayWrap, '[0]' );
|
||||
AddWatchesCast(t, 'glob MyBaseClass1', 'MyClass1.mbc', 003, 'D');
|
||||
AddWatchesCast(t, 'glob MyClass1', 'TMyClass(MyClass2).mc', 004, 'E');
|
||||
AddWatchesCast(t, 'glob MyBaseClass1', 'TMyClass(MyClass2).mbc', 005, 'F');
|
||||
AddWatchesCast(t, 'glob var dyn array of [0]', 'gva', 005, 'K', tlArrayWrap, '[0]' );
|
||||
AddWatchesCast(t, 'glob var dyn array of [1]', 'gva', 006, 'L', tlArrayWrap, '[1]');
|
||||
AddWatchesCast(t, 'glob var pointer', 'gvp_', 001, 'B', tlPointer, '^'); // pointer
|
||||
t.EvaluateWatches;
|
||||
|
||||
@ -11,6 +11,11 @@ program WatchesValuePrg;
|
||||
|
||||
uses sysutils, Classes;
|
||||
|
||||
function SomeFunc1(SomeValue, Foo: Integer; Bar: Word; X: Byte): Boolean;
|
||||
begin result := SomeValue = 0; end;
|
||||
procedure SomeProc1();
|
||||
begin SomeFunc1(2,2,2,2); end;
|
||||
|
||||
type
|
||||
{$ifdef CPU64}
|
||||
PtrUInt = type QWord;
|
||||
@ -104,6 +109,10 @@ type
|
||||
TArrayEnumElem = array [EnVal1..EnVal4] of word;
|
||||
TArrayEnumSubElem = array [EnVal1..EnVal2] of word;
|
||||
|
||||
TFunc1 = function(SomeValue, Foo: Integer; Bar: Word; X: Byte): Boolean;
|
||||
TProc1 = procedure();
|
||||
TMeth1 = function(AVal: Integer): Boolean of object;
|
||||
|
||||
type
|
||||
(* LOCATION: TYPE *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=Tx, "_OP_== type ", (=;//, "_O2_= = type", _EQ_=, _BLOCK_=TestVar )
|
||||
@ -111,6 +120,8 @@ type
|
||||
|
||||
(* LOCATION: field in baseclass *)
|
||||
TMyBaseClass = class
|
||||
public
|
||||
function SomeMeth1(SomeValue: Integer): Boolean;
|
||||
public
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=mbc, _OP_=:, (=;//, _O2_=:, _EQ_=, _BLOCK_=TestVar )
|
||||
end;
|
||||
@ -139,6 +150,9 @@ var
|
||||
(* LOCATION: global var pointer <each type> *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc, pre__=gvp_, "_OP_=: ^", (=;//, "_O2_=: ^", _EQ_=, _BLOCK_=TestVar, _BLOCK2_=TestPointer )
|
||||
|
||||
function TMyBaseClass.SomeMeth1(SomeValue: Integer): Boolean;
|
||||
begin result := SomeValue = 0; end;
|
||||
|
||||
|
||||
procedure Foo(
|
||||
(* LOCATION: param *)
|
||||
@ -209,6 +223,8 @@ begin
|
||||
BreakDummy := ord(gcCharStatArray[1]);
|
||||
BreakDummy := ord(gcWCharStatArray[1]);
|
||||
p := nil;
|
||||
SomeFunc1(1,1,1,1);
|
||||
SomeProc1();
|
||||
|
||||
(* use global const / value in "gv" will be overriden... *)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=gv, {e}={, "//@@=} :=", _pre3_=gc, _BLOCK_=TestAssignGC)
|
||||
@ -218,6 +234,7 @@ begin
|
||||
|
||||
(* INIT: field in class / baseclass *)
|
||||
MyClass1 := TMyClass.Create;
|
||||
MyClass1.SomeMeth1(1);
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=MyClass1.mbc, ADD=3, CHR1='D', _OP_=:=, _O2_={, _EQ_=}:=, _pre2_=gc, _BLOCK_=TestAssign)
|
||||
TEST_PREPOCESS(WatchesValuePrgIdent.inc,pre__=MyClass1.mc, ADD=2, CHR1='C', _OP_=:=, _O2_={, _EQ_=}:=, _pre2_=gc, _BLOCK_=TestAssign)
|
||||
|
||||
|
||||
@ -371,8 +371,18 @@
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
pre__SomeFunc1Ref{e} _O2_ TFunc1 _EQ_ (nil); //@@ _pre3_SomeFunc1Ref;
|
||||
pre__SomeProc1Ref{e} _O2_ TProc1 _EQ_ (nil); //@@ _pre3_SomeProc1Ref;
|
||||
pre__SomeMeth1Ref{e} _O2_ TMeth1 _EQ_ (nil); //@@ _pre3_SomeMeth1Ref;
|
||||
{$IFDEF TestAssign}
|
||||
pre__SomeFunc1Ref{e} := @SomeFunc1; //@@
|
||||
pre__SomeProc1Ref{e} := @SomeProc1; //@@
|
||||
pre__SomeMeth1Ref{e} := @MyClass2.SomeMeth1; //@@
|
||||
//pre__SomeMeth1Ref{e} := @TMyBaseClass(nil).SomeMeth1; //@@
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
// interface
|
||||
// array dyn/stat / nested of record/class/char/num ... bitpacked
|
||||
// record
|
||||
// object
|
||||
|
||||
@ -24,6 +24,7 @@ type
|
||||
ehTestSkip, // Do not run test
|
||||
|
||||
ehIgnData, // Ignore the data part
|
||||
ehIgnPointerDerefData, // Ignore if a pointer has deref data or not
|
||||
ehIgnKind, // Ignore skSimple, ....
|
||||
ehIgnKindPtr, // Ignore skSimple, ONLY if got kind=skPointer
|
||||
ehIgnTypeName, // Ignore the typename
|
||||
@ -275,6 +276,7 @@ function weShortStr(AExpVal: string; ATypeName: String=#1): TWatchExpectationRes
|
||||
function weWideStr(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
|
||||
function weUniStr(AExpVal: string; ATypeName: String=#1): TWatchExpectationResult;
|
||||
|
||||
function wePointer(ATypeName: String=''): TWatchExpectationResult;
|
||||
function wePointer(AExpVal: TWatchExpectationResult; ATypeName: String=''): TWatchExpectationResult;
|
||||
function wePointerAddr(AExpVal: Pointer; ATypeName: String=''): TWatchExpectationResult;
|
||||
|
||||
@ -460,6 +462,14 @@ begin
|
||||
Result.ExpTextData := AExpVal;
|
||||
end;
|
||||
|
||||
function wePointer(ATypeName: String): TWatchExpectationResult;
|
||||
begin
|
||||
Result := Default(TWatchExpectationResult);
|
||||
Result.ExpResultKind := rkPointer;
|
||||
Result.ExpSymKind := skPointer;
|
||||
Result.ExpTypeName := ATypeName;
|
||||
end;
|
||||
|
||||
function wePointer(AExpVal: TWatchExpectationResult; ATypeName: String
|
||||
): TWatchExpectationResult;
|
||||
begin
|
||||
@ -1376,15 +1386,17 @@ begin
|
||||
with AContext.WatchExp do begin
|
||||
Result := True;
|
||||
Expect := AContext.Expectation;
|
||||
DebugLn(['test pointer got: ', AContext.WatchVal.Value, ' // want: ',Expect.ExpSubResults[0].ExpTextData]);
|
||||
|
||||
e := '(\$[0-9a-fA-F]*|nil)';
|
||||
if Expect.ExpTypeName <> '' then
|
||||
e := Expect.ExpTypeName+'\('+e+'\)';
|
||||
e := QuoteRegExprMetaChars(Expect.ExpTypeName)+'\('+e+'\)';
|
||||
e := '^'+e;
|
||||
|
||||
Result := TestMatches('Data', e, AContext.WatchVal.Value, AContext, AnIgnoreRsn);
|
||||
|
||||
if ehIgnPointerDerefData in Expect.ExpErrorHandlingFlags[Compiler.SymbolType] then
|
||||
exit;
|
||||
|
||||
g := AContext.WatchVal.Value;
|
||||
i := pos(' ', g);
|
||||
if i > 1 then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user