mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 20:36:09 +02:00
DBG: improved display of watches
git-svn-id: trunk@28725 -
This commit is contained in:
martin
parent
4eb25d537b
commit
e4121d2b0b
@ -460,6 +460,10 @@ type
|
||||
|
||||
type
|
||||
TDBGSymbolKind = (skClass, skRecord, skEnum, skSet, skProcedure, skFunction, skSimple, skPointer, skVariant);
|
||||
TDBGSymbolAttribute = (saRefParam, // var, const, constref passed by reference
|
||||
saInternalPointer // PointerToObject
|
||||
);
|
||||
TDBGSymbolAttributes = set of TDBGSymbolAttribute;
|
||||
TDBGFieldLocation = (flPrivate, flProtected, flPublic, flPublished);
|
||||
TDBGFieldFlag = (ffVirtual,ffConstructor,ffDestructor);
|
||||
TDBGFieldFlags = set of TDBGFieldFlag;
|
||||
@ -528,12 +532,12 @@ type
|
||||
{ TDBGType }
|
||||
|
||||
TDBGType = class(TObject)
|
||||
private
|
||||
protected
|
||||
FAncestor: String;
|
||||
FResult: TDBGType;
|
||||
FResultString: String;
|
||||
FArguments: TDBGTypes;
|
||||
FAttributes: TDBGSymbolAttributes;
|
||||
FFields: TDBGFields;
|
||||
FKind: TDBGSymbolKind;
|
||||
FMembers: TStrings;
|
||||
@ -548,6 +552,7 @@ type
|
||||
property Arguments: TDBGTypes read FArguments;
|
||||
property Fields: TDBGFields read FFields;
|
||||
property Kind: TDBGSymbolKind read FKind;
|
||||
property Attributes: TDBGSymbolAttributes read FAttributes;
|
||||
property TypeName: String read FTypeName;
|
||||
property Members: TStrings read FMembers;
|
||||
property Result: TDBGType read FResult;
|
||||
|
||||
@ -1189,12 +1189,11 @@ type
|
||||
{ TGDBMIType }
|
||||
|
||||
TGDBMIType = class(TGDBType)
|
||||
private
|
||||
FIsAmpersandAddr: Boolean;
|
||||
protected
|
||||
public
|
||||
constructor CreateFromResult(const AResult: TGDBMIExecResult);
|
||||
property IsAmpersandAddr: Boolean read FIsAmpersandAddr; // for dwarf only "&TypeName" indicates a param by ref (var, const, constref)
|
||||
constructor CreateFromResult(const AResult: TGDBMIExecResult;
|
||||
const AWhatIsValue: String = '';
|
||||
const AWhatIsType: String = '';
|
||||
AClassIsPointer: Boolean = False);
|
||||
end;
|
||||
|
||||
{ TGDBStringIterator }
|
||||
@ -7707,29 +7706,11 @@ end;
|
||||
|
||||
{ TGDBMIType }
|
||||
|
||||
constructor TGDBMIType.CreateFromResult(const AResult: TGDBMIExecResult);
|
||||
var
|
||||
s: String;
|
||||
i: Integer;
|
||||
constructor TGDBMIType.CreateFromResult(const AResult: TGDBMIExecResult;
|
||||
const AWhatIsValue: String = ''; const AWhatIsType: String = ''; AClassIsPointer: Boolean = False);
|
||||
begin
|
||||
// TODO: add check ?
|
||||
|
||||
// tfClassIsPointer can be ignored, because the "&" only occurs with dwarf, which always has tfClassIsPointer
|
||||
FIsAmpersandAddr := False;
|
||||
s := AResult.Values;
|
||||
i := pos('type = &', s);
|
||||
if i > 0 then begin
|
||||
FIsAmpersandAddr := True;
|
||||
if (copy(s, i+8, 15) = '__vtbl_ptr_type') or
|
||||
//( (tfClassIsPointer in TargetInfo^.TargetFlags) and
|
||||
(copy(s, i+8, 5) = 'class') //)
|
||||
then
|
||||
s[i+7] := '^'
|
||||
else
|
||||
Delete(s, i + 7, 1);
|
||||
end;
|
||||
|
||||
CreateFromValues(s);
|
||||
CreateFromValues(AResult.Values, AWhatIsValue, AWhatIsType, AClassIsPointer);
|
||||
end;
|
||||
|
||||
{ TGDBStringIterator }
|
||||
@ -8322,15 +8303,57 @@ end;
|
||||
|
||||
function TGDBMIDebuggerCommand.GetGDBTypeInfo(const AExpression: String): TGDBType;
|
||||
var
|
||||
R: TGDBMIExecResult;
|
||||
WIExprRes, PTypeRes, WITypeRes: TGDBMIExecResult;
|
||||
WIExprVal, WIExprValCln, WITypeValS2: String;
|
||||
begin
|
||||
if not ExecuteCommand('ptype %s', [AExpression], R)
|
||||
or (R.State = dsError)
|
||||
Result := nil;
|
||||
WIExprValCln := '';
|
||||
if ExecuteCommand('whatis %s', [AExpression], WIExprRes)
|
||||
and (WIExprRes.State <> dsError)
|
||||
then begin
|
||||
WIExprVal := ParseTypeFromGdb(WIExprRes.Values);
|
||||
WIExprValCln := WIExprVal;
|
||||
while (WIExprValCln<>'') and (WIExprValCln[1] in ['^', '&']) do delete(WIExprValCln, 1, 1);
|
||||
|
||||
if (pos(' ', WIExprValCln) > 0) or (WIExprValCln = '') then begin
|
||||
if ExecuteCommand('ptype %s', [AExpression], PTypeRes) // can not ptype with spaces
|
||||
and (PTypeRes.State <> dsError)
|
||||
then begin
|
||||
Result := TGdbMIType.CreateFromResult(PTypeRes, WIExprRes.Values, '', tfClassIsPointer in TargetInfo^.TargetFlags);
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
if ExecuteCommand('ptype %s', [WIExprValCln], PTypeRes)
|
||||
and (PTypeRes.State <> dsError)
|
||||
then begin
|
||||
|
||||
WITypeValS2 := '';
|
||||
if (Pos(' = class ', PTypeRes.Values) > 0)
|
||||
and (tfClassIsPointer in TargetInfo^.TargetFlags) // ptype will give ^ for pointer-to-class or just class
|
||||
and (pos('type = ^^', PTypeRes.Values) <= 0) // not known to be a pointer (not sure it ever happens)
|
||||
and (WIExprVal[1] <> '^') // not known to be a pointer (not sure it ever happens)
|
||||
and ExecuteCommand('whatis %s', [WIExprValCln], WITypeRes)
|
||||
and (PTypeRes.State <> dsError)
|
||||
then WITypeValS2 := WITypeRes.Values;
|
||||
|
||||
Result := TGdbMIType.CreateFromResult(PTypeRes, WIExprRes.Values, WITypeValS2, tfClassIsPointer in TargetInfo^.TargetFlags);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (PTypeRes.State = dsError) and (pos('msg="No symbol ', PTypeRes.Values) > 0)
|
||||
then exit;
|
||||
|
||||
// try ptype on the value
|
||||
if not ExecuteCommand('ptype %s', [AExpression], PTypeRes)
|
||||
or (PTypeRes.State = dsError)
|
||||
then begin
|
||||
Result := nil;
|
||||
end
|
||||
else begin
|
||||
Result := TGdbMIType.CreateFromResult(R);
|
||||
Result := TGdbMIType.CreateFromResult(PTypeRes, '', '', tfClassIsPointer in TargetInfo^.TargetFlags);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -9209,15 +9232,14 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
||||
if ResultInfo = nil then
|
||||
ResultInfo := GetGDBTypeInfo(AnExpression);
|
||||
if (ResultInfo = nil) then Exit;
|
||||
FTypeInfo := ResultInfo;
|
||||
|
||||
case ResultInfo.Kind of
|
||||
skPointer: begin
|
||||
AnExpression := GetPart([], [' '], FTextValue, False, False);
|
||||
Val(AnExpression, addr, e);
|
||||
if e <> 0 then begin
|
||||
FreeAndNil(ResultInfo);
|
||||
if e <> 0 then
|
||||
Exit;
|
||||
end;
|
||||
|
||||
AnExpression := Lowercase(ResultInfo.TypeName);
|
||||
case StringCase(AnExpression, ['char', 'character', 'ansistring', '__vtbl_ptr_type',
|
||||
@ -9262,7 +9284,7 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
||||
AnExpression[1] := 'T';
|
||||
if Length(AnExpression) > 1 then AnExpression[2] := UpperCase(AnExpression[2])[1];
|
||||
end;
|
||||
FTextValue := PascalizePointer(FTextValue, '^' + AnExpression);
|
||||
FTextValue := PascalizePointer(FTextValue, AnExpression);
|
||||
end;
|
||||
|
||||
end;
|
||||
@ -9276,14 +9298,19 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
||||
|
||||
skClass: begin
|
||||
Val(FTextValue, addr, e); //Get the class mem address
|
||||
if e = 0 then begin //No error ?
|
||||
if Addr = 0
|
||||
then FTextValue := 'nil'
|
||||
else begin
|
||||
AnExpression := GetInstanceClassName(Addr);
|
||||
if AnExpression = '' then AnExpression := '???'; //No instanced class found
|
||||
FTextValue := 'class ' + AnExpression + ' ' + FTextValue;
|
||||
end;
|
||||
if (e = 0) and (addr = 0)
|
||||
then FTextValue := 'nil';
|
||||
|
||||
if (FTextValue <> '') and (FTypeInfo <> nil)
|
||||
then begin
|
||||
FTextValue := '<' + FTypeInfo.TypeName + '> = ' + FTextValue;
|
||||
end
|
||||
else
|
||||
if (e = 0) and (addr <> 0)
|
||||
then begin //No error ?
|
||||
AnExpression := GetInstanceClassName(Addr);
|
||||
if AnExpression = '' then AnExpression := '???'; //No instanced class found
|
||||
FTextValue := 'instance of ' + AnExpression + ' ' + FTextValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -9305,7 +9332,6 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
||||
end;
|
||||
end;
|
||||
|
||||
FTypeInfo := ResultInfo;
|
||||
PutValuesInTree;
|
||||
FTextValue := FormatResult(FTextValue);
|
||||
end;
|
||||
@ -9488,17 +9514,30 @@ function TGDBMIDebuggerCommandEvaluate.DoExecute: Boolean;
|
||||
Result := False;
|
||||
FTypeInfo := GetGDBTypeInfo(AnExpression);
|
||||
if FTypeInfo = nil
|
||||
then exit;
|
||||
|
||||
if TGdbMIType(FTypeInfo).IsAmpersandAddr and (FTypeInfo.TypeName <> '')
|
||||
then begin
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s(%s)', [FTypeInfo.TypeName, AnExpression], R);
|
||||
ResultList := TGDBMINameValueList.Create(LastExecResult.Values);
|
||||
FTextValue := ResultList.Values['msg'];
|
||||
FreeAndNil(ResultList);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (saInternalPointer in FTypeInfo.Attributes)
|
||||
then begin
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s%s', [AnExpression, '^'], R);
|
||||
Result := Result and (R.State <> dsError);
|
||||
end;
|
||||
|
||||
if not Result then
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s', [AnExpression], R);
|
||||
if (not Result)
|
||||
and (saRefParam in FTypeInfo.Attributes) and (FTypeInfo.InternalTypeName <> '')
|
||||
then begin
|
||||
Result := ExecuteCommand('-data-evaluate-expression %s(%s)', [FTypeInfo.InternalTypeName, AnExpression], R);
|
||||
Result := Result and (R.State <> dsError);
|
||||
end;
|
||||
|
||||
if (not Result)
|
||||
then Result := ExecuteCommand('-data-evaluate-expression %s', [AnExpression], R);
|
||||
Result := Result and (R.State <> dsError);
|
||||
|
||||
if (not Result) and (not StoreError)
|
||||
then exit;
|
||||
|
||||
|
||||
@ -61,12 +61,20 @@ type
|
||||
{ TGDBType }
|
||||
|
||||
TGDBType = class(TDBGType)
|
||||
private
|
||||
FInternalTypeName: string;
|
||||
public
|
||||
constructor CreateFromValues(const AValues: String);
|
||||
constructor CreateFromValues(const AValues: String;
|
||||
AWhatIsValue: String = '';
|
||||
const AWhatIsType: String = '';
|
||||
AClassIsPointer: Boolean = False);
|
||||
// InternalTypeName: include ^ for TObject, if needed
|
||||
property InternalTypeName: string read FInternalTypeName;
|
||||
end;
|
||||
|
||||
|
||||
function CreatePTypeValueList(AResultValues: String): TStringList;
|
||||
function ParseTypeFromGdb(const ATypeText: string): string;
|
||||
|
||||
implementation
|
||||
|
||||
@ -248,9 +256,38 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ParseTypeFromGdb(const ATypeText: string): string;
|
||||
var
|
||||
StartIdx, EndIdx, BracketCnt, ln: Integer;
|
||||
EndPtr: PChar;
|
||||
begin
|
||||
Result := '';
|
||||
StartIdx := pos('type = ', ATypeText);
|
||||
if StartIdx <= 0 then exit;
|
||||
inc(StartIdx, 7);
|
||||
EndIdx := StartIdx;
|
||||
EndPtr := @ATypeText[EndIdx];
|
||||
ln := length(ATypeText);
|
||||
BracketCnt := 0;
|
||||
while (EndIdx <= ln) do begin
|
||||
case EndPtr^ of
|
||||
' ' : if BracketCnt = 0 then break;
|
||||
'[', '{' : inc(BracketCnt);
|
||||
']', '}' : dec(BracketCnt);
|
||||
'\' : if (EndIdx < ln) and ((EndPtr+1)^ = 'n') then break;
|
||||
#0..#31: break;
|
||||
end;
|
||||
inc(EndPtr);
|
||||
inc(EndIdx);
|
||||
end;
|
||||
Result := copy(ATypeText, StartIdx, EndIdx-StartIdx);
|
||||
end;
|
||||
|
||||
{ TGDBPType }
|
||||
|
||||
constructor TGDBType.CreateFromValues(const AValues: String);
|
||||
constructor TGDBType.CreateFromValues(const AValues: String;
|
||||
AWhatIsValue: String = ''; const AWhatIsType: String = '';
|
||||
AClassIsPointer: Boolean = False);
|
||||
var
|
||||
S, Line: String;
|
||||
Lines: TStringList;
|
||||
@ -440,44 +477,104 @@ var
|
||||
end;
|
||||
|
||||
var
|
||||
HasClass: Boolean;
|
||||
ParsedWhatIsValue, ParsedWhatIsType: string;
|
||||
begin
|
||||
Create(skSimple, '');
|
||||
|
||||
if AValues = '' then Exit;
|
||||
ParsedWhatIsValue := ParseTypeFromGdb(AWhatIsValue);
|
||||
ParsedWhatIsType := ParseTypeFromGdb(AWhatIsType);
|
||||
|
||||
Lines := TStringList.Create;
|
||||
try
|
||||
Lines.Text := AValues;
|
||||
if Lines.Count = 0 then Exit;
|
||||
|
||||
Line := Lines[0];
|
||||
Lines.Delete(0);
|
||||
if Lines.Count > 0 then begin
|
||||
Line := Lines[0];
|
||||
Lines.Delete(0);
|
||||
end
|
||||
else Line := '';
|
||||
S := ParseTypeFromGdb(Line);
|
||||
|
||||
S := GetPart(['type = '], [' '], Line);
|
||||
if S = '' then Exit;
|
||||
HasClass := Pos(' = class ', Line) > 0;
|
||||
if HasClass
|
||||
and (S[2] <> '^') // pointer to class is handled next
|
||||
then begin
|
||||
FKind:=skClass;
|
||||
if S[1] = '^' then begin
|
||||
FKind:=skPointer;
|
||||
FTypeName := GetPart(['^'], [' '], S);
|
||||
end else begin
|
||||
FTypeName := GetPart([], ['{'], S);
|
||||
DoClass;
|
||||
FAttributes := [];
|
||||
if (ParsedWhatIsValue <> '') and (ParsedWhatIsValue[1] = '&') then begin
|
||||
Delete(ParsedWhatIsValue, 1, 1);
|
||||
include(FAttributes, saRefParam);
|
||||
end;
|
||||
|
||||
Create(skSimple, ParsedWhatIsValue);
|
||||
FInternalTypeName := ParsedWhatIsValue;
|
||||
|
||||
if Pos(' = class ', Line) > 0 then begin
|
||||
// Class or pointer to class
|
||||
if AClassIsPointer and (S[1] = '^') then begin
|
||||
// class: dwarf type, always pefixed with ^
|
||||
|
||||
if (length(s) >= 2) and (s[2] = '^')
|
||||
then begin
|
||||
FKind:=skPointer;
|
||||
if FTypeName = ''
|
||||
then FTypeName := copy(s, 3, length(s));
|
||||
end
|
||||
else if (ParsedWhatIsValue <> '') and (ParsedWhatIsValue[1] = '^')
|
||||
and (pos(' = class', AWhatIsValue) <= 0)
|
||||
then begin
|
||||
FKind:=skPointer; // pointer to another named type
|
||||
if FTypeName = ''
|
||||
then FTypeName := copy(ParsedWhatIsValue, 2, length(ParsedWhatIsValue));
|
||||
end
|
||||
else if (ParsedWhatIsType <> '') and (ParsedWhatIsType[1] = '^')
|
||||
and (pos(' = class', AWhatIsType) <= 0)
|
||||
then begin
|
||||
FKind:=skPointer; // pointer to another named type
|
||||
if FTypeName = ''
|
||||
then FTypeName := copy(ParsedWhatIsType, 2, length(ParsedWhatIsType));
|
||||
end
|
||||
else begin
|
||||
include(FAttributes, saInternalPointer);
|
||||
if FTypeName = ''
|
||||
then FTypeName := GetPart([], ['{'], S);
|
||||
DoClass;
|
||||
end;
|
||||
|
||||
if FInternalTypeName = ''
|
||||
then FInternalTypeName := FTypeName;
|
||||
|
||||
if (FInternalTypeName <> '') and (FInternalTypeName[1] <> '^')
|
||||
and (saInternalPointer in FAttributes)
|
||||
then FInternalTypeName := '^' + FInternalTypeName;
|
||||
|
||||
end
|
||||
else begin
|
||||
// class: stabs type, not normaly prefixed
|
||||
|
||||
if (length(s) >= 1) and (s[1] = '^')
|
||||
then begin
|
||||
FKind:=skPointer;
|
||||
if FTypeName = ''
|
||||
then FTypeName := copy(s, 2, length(s));
|
||||
end
|
||||
else begin
|
||||
include(FAttributes, saInternalPointer);
|
||||
if FTypeName = ''
|
||||
then FTypeName := GetPart([], ['{'], S);
|
||||
DoClass;
|
||||
end;
|
||||
|
||||
if FInternalTypeName = ''
|
||||
then FInternalTypeName := FTypeName;
|
||||
end;
|
||||
end
|
||||
else if S[1] = '^'
|
||||
|
||||
else
|
||||
if (S[1] = '^')
|
||||
or ((ParsedWhatIsValue <> '') and (ParsedWhatIsValue[1] = '^'))
|
||||
or ((ParsedWhatIsType <> '') and (ParsedWhatIsType[1] = '^'))
|
||||
then begin
|
||||
FKind := skPointer;
|
||||
if HasClass
|
||||
then FTypeName := GetPart(['^^'], [' ='], S)
|
||||
else FTypeName := GetPart(['^'], [' ='], S);
|
||||
if FTypeName = ''
|
||||
then FTypeName := GetPart(['^'], [' ='], S);
|
||||
// strip brackets
|
||||
FTypeName := GetPart(['(', ''], [')'], FTypeName);
|
||||
end
|
||||
|
||||
else if S = 'set'
|
||||
then DoSet
|
||||
else if S = 'procedure'
|
||||
@ -488,7 +585,8 @@ begin
|
||||
then DoEnum
|
||||
else if Pos(' = record', Line) > 0
|
||||
then begin
|
||||
FTypeName := S;
|
||||
if FTypeName = ''
|
||||
then FTypeName := S;
|
||||
DoRecord
|
||||
end
|
||||
else if S = 'record'
|
||||
@ -498,7 +596,8 @@ begin
|
||||
end
|
||||
else begin
|
||||
FKind := skSimple;
|
||||
FTypeName := S;
|
||||
if FTypeName = ''
|
||||
then FTypeName := S;
|
||||
end;
|
||||
|
||||
finally
|
||||
|
||||
@ -176,7 +176,7 @@ begin
|
||||
PropertiesPage.TabVisible:=false;
|
||||
MethodsPage.TabVisible:=false;
|
||||
if not Assigned(FDBGInfo) then exit;
|
||||
EditInspected.Text:=FExpression+' : ^'+FDBGInfo.TypeName + ' = ' + FDBGInfo.Value.AsString;
|
||||
EditInspected.Text:=FExpression+' : '+FDBGInfo.TypeName + ' = ' + FDBGInfo.Value.AsString;
|
||||
GridDataSetup;
|
||||
FGridData.Cells[0,1]:=FExpression;
|
||||
FGridData.Cells[1,1]:='Pointer to '+FDBGInfo.TypeName;
|
||||
|
||||
@ -3,38 +3,884 @@ program WatchesPrg;
|
||||
|
||||
uses sysutils;
|
||||
|
||||
procedure Foo(
|
||||
ArgAnsiString1: AnsiString; var ArgAnsiString2: AnsiString; const ArgAnsiString3: AnsiString;
|
||||
ArgChar1: Char; var ArgChar2: Char; const ArgChar3: Char
|
||||
type
|
||||
TFoo = class;
|
||||
|
||||
{ records }
|
||||
TRec = record
|
||||
ValInt: Integer;
|
||||
ValFoo: TFoo;
|
||||
end;
|
||||
|
||||
PRec = ^TRec;
|
||||
PPRec = ^PRec;
|
||||
|
||||
TNewRec = type TRec;
|
||||
|
||||
{ Classes }
|
||||
|
||||
TFoo = class
|
||||
public
|
||||
ValueInt: Integer;
|
||||
ValueFoo: TFoo;
|
||||
ValueRec: TRec;
|
||||
property PropInt: Integer read ValueInt write ValueInt;
|
||||
end;
|
||||
|
||||
TFooChild = class(TFoo) end;
|
||||
TFooKid = class(TFoo) end;
|
||||
|
||||
PFoo = ^TFoo;
|
||||
PPFoo = ^PFoo;
|
||||
TSamePFoo = PFoo;
|
||||
TNewPFoo = {type} PFoo; // fpc crash
|
||||
|
||||
TSameFoo = TFoo;
|
||||
TNewFoo = type TFoo;
|
||||
PNewFoo = ^TNewFoo;
|
||||
|
||||
{ ClassesTyps }
|
||||
TFooClass = Class of TFoo;
|
||||
PFooClass = ^TFooClass;
|
||||
PPFooClass = ^PFooClass;
|
||||
|
||||
TNewFooClass = class of TNewFoo;
|
||||
PNewFooClass = ^TNewFooClass;
|
||||
|
||||
{ strings }
|
||||
TMyAnsiString = AnsiString;
|
||||
PMyAnsiString = ^TMyAnsiString;
|
||||
PPMyAnsiString = ^PMyAnsiString;
|
||||
|
||||
TNewAnsiString = type AnsiString;
|
||||
PNewAnsiString = ^TNewAnsiString;
|
||||
|
||||
|
||||
TMyShortString = ShortString;
|
||||
PMyShortString = ^TMyShortString;
|
||||
PPMyShortString = ^PMyShortString;
|
||||
|
||||
TNewhortString = type ShortString;
|
||||
PNewhortString = ^TNewhortString;
|
||||
|
||||
TMyWideString = WideString;
|
||||
PMyWideString = ^TMyWideString;
|
||||
PPMyWideString = ^PMyWideString;
|
||||
|
||||
TNewWideString = type WideString;
|
||||
PNewWideString = ^TNewWideString;
|
||||
|
||||
TMyString10 = String[10];
|
||||
PMyString10 = ^TMyString10;
|
||||
PPMyString10 = ^PMyString10;
|
||||
|
||||
|
||||
{ simple }
|
||||
{ variants }
|
||||
{ Array }
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
procedure FooFunc(
|
||||
(*** parameter and var-param ***)
|
||||
{ records }
|
||||
ArgTRec: TRec; var VArgTRec: TRec;
|
||||
ArgPRec: PRec; var VArgPRec: PRec;
|
||||
ArgPPRec: PPRec; var VArgPPRec: PPRec;
|
||||
ArgTNewRec: TNewRec; var VArgTNewRec: TNewRec;
|
||||
|
||||
{ Classes }
|
||||
ArgTFoo: TFoo; var VArgTFoo: TFoo;
|
||||
ArgPFoo: PFoo; var VArgPFoo: PFoo;
|
||||
ArgPPFoo: PPFoo; var VArgPPFoo: PPFoo;
|
||||
ArgTSamePFoo: TSamePFoo; var VArgTSamePFoo: TSamePFoo;
|
||||
ArgTNewPFoo: TNewPFoo; var VArgTNewPFoo: TNewPFoo;
|
||||
|
||||
ArgTSameFoo: TSameFoo; var VArgTSameFoo: TSameFoo;
|
||||
ArgTNewFoo: TNewFoo; var VArgTNewFoo: TNewFoo;
|
||||
ArgPNewFoo: PNewFoo; var VArgPNewFoo: PNewFoo;
|
||||
|
||||
{ ClassesTyps }
|
||||
ArgTFooClass: TFooClass; var VArgTFooClass: TFooClass;
|
||||
ArgPFooClass: PFooClass; var VArgPFooClass: PFooClass;
|
||||
ArgPPFooClass: PPFooClass; var VArgPPFooClass: PPFooClass;
|
||||
ArgTNewFooClass: TNewFooClass; var VArgTNewFooClass: TNewFooClass;
|
||||
ArgPNewFooClass: PNewFooClass; var VArgPNewFooClass: PNewFooClass;
|
||||
|
||||
{ strings }
|
||||
ArgTMyAnsiString: TMyAnsiString; var VArgTMyAnsiString: TMyAnsiString;
|
||||
ArgPMyAnsiString: PMyAnsiString; var VArgPMyAnsiString: PMyAnsiString;
|
||||
ArgPPMyAnsiString: PPMyAnsiString; var VArgPPMyAnsiString: PPMyAnsiString;
|
||||
|
||||
ArgTNewAnsiString: TNewAnsiString; var VArgTNewAnsiString: TNewAnsiString;
|
||||
ArgPNewAnsiString: PNewAnsiString; var VArgPNewAnsiString: PNewAnsiString;
|
||||
|
||||
|
||||
ArgTMyShortString: TMyShortString; var VArgTMyShortString: TMyShortString;
|
||||
ArgPMyShortString: PMyShortString; var VArgPMyShortString: PMyShortString;
|
||||
ArgPPMyShortString: PPMyShortString; var VArgPPMyShortString: PPMyShortString;
|
||||
|
||||
ArgTNewhortString: TNewhortString; var VArgTNewhortString: TNewhortString;
|
||||
ArgPNewhortString: PNewhortString; var VArgPNewhortString: PNewhortString;
|
||||
|
||||
ArgTMyWideString: TMyWideString; var VArgTMyWideString: TMyWideString;
|
||||
ArgPMyWideString: PMyWideString; var VArgPMyWideString: PMyWideString;
|
||||
ArgPPMyWideString: PPMyWideString; var VArgPPMyWideString: PPMyWideString;
|
||||
|
||||
ArgTNewWideString: TNewWideString; var VArgTNewWideString: TNewWideString;
|
||||
ArgPNewWideString: PNewWideString; var VArgPNewWideString: PNewWideString;
|
||||
|
||||
ArgTMyString10: TMyString10; var VArgTMyString10: TMyString10;
|
||||
ArgPMyString10: PMyString10; var VArgPMyString10: PMyString10;
|
||||
ArgPPMyString10: PPMyString10; var VArgPPMyString10: PPMyString10;
|
||||
|
||||
{ simple }
|
||||
|
||||
ArgByte: Byte; var VArgByte: Byte;
|
||||
ArgWord: Word; var VArgWord: Word;
|
||||
ArgLongWord: LongWord; var VArgLongWord: LongWord;
|
||||
ArgQWord: QWord; var VArgQWord: QWord;
|
||||
|
||||
ArgShortInt: ShortInt; var VArgShortInt: ShortInt;
|
||||
ArgSmallInt: SmallInt; var VArgSmallInt: SmallInt;
|
||||
ArgInt: Integer; var VArgInt: Integer;
|
||||
ArgInt64: Int64; var VArgInt64: Int64;
|
||||
|
||||
ArgPByte: PByte; var VArgPByte: PByte;
|
||||
ArgPWord: PWord; var VArgPWord: PWord;
|
||||
ArgPLongWord: PLongWord; var VArgPLongWord: PLongWord;
|
||||
ArgPQWord: PQWord; var VArgPQWord: PQWord;
|
||||
|
||||
ArgPShortInt: PShortInt; var VArgPShortInt: PShortInt;
|
||||
ArgPSmallInt: PSmallInt; var VArgPSmallInt: PSmallInt;
|
||||
ArgPInt: PInteger; var VArgPInt: PInteger;
|
||||
ArgPInt64: PInt64; var VArgPInt64: PInt64;
|
||||
|
||||
ArgPointer: Pointer; var VArgPointer: Pointer;
|
||||
ArgPPointer: PPointer; var VArgPPointer: PPointer;
|
||||
|
||||
ArgDouble: Double; var VArgDouble: Double;
|
||||
ArgExtended: Extended; var VArgExtended: Extended;
|
||||
|
||||
Dummy: Integer
|
||||
);
|
||||
var
|
||||
TestInt: Integer;
|
||||
TesTShortString: String[10];
|
||||
TestAnsiString: AnsiString;
|
||||
TestPChar: PChar;
|
||||
(*** local var ***)
|
||||
{ records }
|
||||
VarTRec: TRec;
|
||||
VarPRec: PRec;
|
||||
VarPPRec: PPRec;
|
||||
VarTNewRec: TNewRec;
|
||||
|
||||
PVarTRec: ^TRec;
|
||||
PVarTNewRec: ^TNewRec;
|
||||
|
||||
{ Classes }
|
||||
VarTFoo: TFoo;
|
||||
VarPFoo: PFoo;
|
||||
VarPPFoo: PPFoo;
|
||||
VarTSamePFoo: TSamePFoo;
|
||||
VarTNewPFoo: TNewPFoo;
|
||||
|
||||
VarTSameFoo: TSameFoo;
|
||||
VarTNewFoo: TNewFoo;
|
||||
VarPNewFoo: PNewFoo;
|
||||
|
||||
PVarTFoo: ^TFoo;
|
||||
PVarPFoo: ^PFoo;
|
||||
PVarTSamePFoo: ^TSamePFoo;
|
||||
PVarTSameFoo: ^TSameFoo;
|
||||
|
||||
{ ClassesTyps }
|
||||
VarTFooClass: TFooClass;
|
||||
VarPFooClass: PFooClass;
|
||||
VarPPFooClass: PPFooClass;
|
||||
VarTNewFooClass: TNewFooClass;
|
||||
VarPNewFooClass: PNewFooClass;
|
||||
|
||||
PVarTFooClass: ^TFooClass;
|
||||
|
||||
{ strings }
|
||||
VarTMyAnsiString: TMyAnsiString;
|
||||
VarPMyAnsiString: PMyAnsiString;
|
||||
VarPPMyAnsiString: PPMyAnsiString;
|
||||
|
||||
VarTNewAnsiString: TNewAnsiString;
|
||||
VarPNewAnsiString: PNewAnsiString;
|
||||
|
||||
VarTMyShortString: TMyShortString;
|
||||
VarPMyShortString: PMyShortString;
|
||||
VarPPMyShortString: PPMyShortString;
|
||||
|
||||
VarTNewhortString: TNewhortString;
|
||||
VarPNewhortString: PNewhortString;
|
||||
|
||||
VarTMyWideString: TMyWideString;
|
||||
VarPMyWideString: PMyWideString;
|
||||
VarPPMyWideString: PPMyWideString;
|
||||
|
||||
VarTNewWideString: TNewWideString;
|
||||
VarPNewWideString: PNewWideString;
|
||||
|
||||
VarTMyString10: TMyString10;
|
||||
VarPMyString10: PMyString10;
|
||||
VarPPMyString10: PPMyString10;
|
||||
|
||||
PVarAnsiString: ^AnsiString;
|
||||
PVarShortString: ^ShortString;
|
||||
PVarWideString: ^WideString;
|
||||
|
||||
VarString15: string[15];
|
||||
|
||||
{ simple }
|
||||
|
||||
VarByte: Byte;
|
||||
VarWord: Word;
|
||||
VarLongWord: LongWord;
|
||||
VarQWord: QWord;
|
||||
|
||||
VarShortInt: ShortInt;
|
||||
varSmallInt: SmallInt;
|
||||
VarInt: Integer;
|
||||
VarInt64: Int64;
|
||||
|
||||
VarPByte: PByte;
|
||||
VarPWord: PWord;
|
||||
VarPLongWord: PLongWord;
|
||||
VarPQWord: PQWord;
|
||||
|
||||
VarPShortInt: PShortInt;
|
||||
varPSmallInt: PSmallInt;
|
||||
VarPInt: PInteger;
|
||||
VarPInt64: PInt64;
|
||||
|
||||
PVarByte: ^Byte;
|
||||
PVarWord: ^Word;
|
||||
PVarLongWord: ^LongWord;
|
||||
PVarQWord: ^QWord;
|
||||
|
||||
PVarShortInt: ^ShortInt;
|
||||
PvarSmallInt: ^SmallInt;
|
||||
PVarInt: ^Integer;
|
||||
PVarInt64: ^Int64;
|
||||
|
||||
VarPointer: Pointer;
|
||||
VarPPointer: PPointer;
|
||||
PVarPointer: ^Pointer;
|
||||
|
||||
VarDouble: Double;
|
||||
VarExtended: Extended;
|
||||
PVarDouble: ^Double;
|
||||
PVarExtended: ^Extended;
|
||||
|
||||
|
||||
function SubFoo(var AVal1: Integer; AVal2: Integer) : Integer;
|
||||
begin
|
||||
AVal1 := 2 * AVal2;
|
||||
Result := AVal2;
|
||||
inc(AVal2); // First BreakBoint
|
||||
writeln(1);
|
||||
end;
|
||||
|
||||
begin
|
||||
TestInt := 3;
|
||||
TesTShortString := IntToStr(TestInt) + ':';
|
||||
TestAnsiString := TesTShortString + ' Foo';
|
||||
TestPChar := @TestAnsiString[2];
|
||||
SubFoo(TestInt, 5);
|
||||
writeln(TestPChar);
|
||||
writeln(ArgAnsiString1, ArgAnsiString2, ArgAnsiString3, ArgChar1, ArgChar2, ArgChar3); // breakpoint 2
|
||||
{ records }
|
||||
VarTRec := ArgTRec;
|
||||
VarPRec := ArgPRec;
|
||||
VarPPRec := ArgPPRec;
|
||||
VarTNewRec := ArgTNewRec;
|
||||
|
||||
PVarTRec := @ArgTRec;
|
||||
PVarTNewRec := @ArgTNewRec;
|
||||
|
||||
{ Classes }
|
||||
VarTFoo := ArgTFoo;
|
||||
VarPFoo := ArgPFoo;
|
||||
VarPPFoo := ArgPPFoo;
|
||||
VarTSamePFoo := ArgTSamePFoo;
|
||||
VarTNewPFoo := ArgTNewPFoo;
|
||||
|
||||
VarTSameFoo := ArgTSameFoo;
|
||||
VarTNewFoo := ArgTNewFoo;
|
||||
VarPNewFoo := ArgPNewFoo;
|
||||
|
||||
PVarTFoo := @ArgTFoo;
|
||||
PVarPFoo := @ArgPFoo;
|
||||
PVarTSamePFoo := @ArgTSamePFoo;
|
||||
PVarTSameFoo := @ArgTSameFoo;
|
||||
|
||||
{ ClassesTyps }
|
||||
VarTFooClass := ArgTFooClass;
|
||||
VarPFooClass := ArgPFooClass;
|
||||
VarPPFooClass := ArgPPFooClass;
|
||||
VarTNewFooClass := ArgTNewFooClass;
|
||||
VarPNewFooClass := ArgPNewFooClass;
|
||||
|
||||
PVarTFooClass := @ArgTFooClass;
|
||||
|
||||
{ strings }
|
||||
VarTMyAnsiString := ArgTMyAnsiString + '-var';
|
||||
VarPMyAnsiString := ArgPMyAnsiString;
|
||||
VarPPMyAnsiString := ArgPPMyAnsiString;
|
||||
|
||||
VarTNewAnsiString := ArgTNewAnsiString + '-var';
|
||||
VarPNewAnsiString := ArgPNewAnsiString;
|
||||
|
||||
VarTMyShortString := ArgTMyShortString + '-var';
|
||||
VarPMyShortString := ArgPMyShortString;
|
||||
VarPPMyShortString := ArgPPMyShortString;
|
||||
|
||||
VarTNewhortString := ArgTNewhortString + '-var';
|
||||
VarPNewhortString := ArgPNewhortString;
|
||||
|
||||
VarTMyWideString := ArgTMyWideString + '-var';
|
||||
VarPMyWideString := ArgPMyWideString;
|
||||
VarPPMyWideString := ArgPPMyWideString;
|
||||
|
||||
VarTNewWideString := ArgTNewWideString + '-var';
|
||||
VarPNewWideString := ArgPNewWideString;
|
||||
|
||||
VarTMyString10 := ArgTMyString10 + '-var';
|
||||
VarPMyString10 := ArgPMyString10;
|
||||
VarPPMyString10 := ArgPPMyString10;
|
||||
|
||||
PVarAnsiString := @ArgTMyAnsiString;
|
||||
PVarShortString := @ArgTMyShortString;
|
||||
PVarWideString := @ArgTMyWideString;
|
||||
|
||||
VarString15 := 'T15' +#10#13 + 'L2' + #13 + 'L3' +#10 +'L4';
|
||||
|
||||
{ simple }
|
||||
|
||||
VarByte := ArgByte + 100;
|
||||
VarWord := ArgWord + 100;
|
||||
VarLongWord := ArgLongWord + 100;
|
||||
VarQWord := ArgQWord + 100;
|
||||
|
||||
VarShortInt := ArgShortInt + 100;
|
||||
VarSmallInt := ArgSmallInt + 100;
|
||||
VarInt := ArgInt + 100;
|
||||
VarInt64 := ArgInt64 + 100;
|
||||
|
||||
VarPByte := ArgPByte;
|
||||
VarPWord := ArgPWord;
|
||||
VarPLongWord := ArgPLongWord;
|
||||
VarPQWord := ArgPQWord;
|
||||
|
||||
VarPShortInt := ArgPShortInt;
|
||||
VarPSmallInt := ArgPSmallInt;
|
||||
VarPInt := ArgPInt;
|
||||
VarPInt64 := ArgPInt64;
|
||||
|
||||
PVarByte := @ArgByte;
|
||||
PVarWord := @ArgWord;
|
||||
PVarLongWord := @ArgLongWord;
|
||||
PVarQWord := @ArgQWord;
|
||||
|
||||
PVarShortInt := @ArgShortInt;
|
||||
PVarSmallInt := @ArgSmallInt;
|
||||
PVarInt := @ArgInt;
|
||||
PVarInt64 := @ArgInt64;
|
||||
|
||||
VarPointer := ArgPointer;
|
||||
VarPPointer := ArgPPointer;
|
||||
PVarPointer := ArgPointer;
|
||||
|
||||
VarDouble := ArgDouble;
|
||||
VarExtended := ArgExtended;
|
||||
PVarDouble := @ArgDouble;
|
||||
PVarExtended := @ArgExtended;
|
||||
|
||||
|
||||
SubFoo(VarInt, VarPInt^);
|
||||
// break on next line
|
||||
writeln(1);
|
||||
end;
|
||||
|
||||
|
||||
(*** global var (to feed var-param)-***)
|
||||
var
|
||||
a2: ansistring;
|
||||
c2: Char;
|
||||
{ records }
|
||||
GlobTRec, GlobTRec1, GlobTRec2: TRec;
|
||||
GlobPRec: PRec;
|
||||
GlobPPRec: PPRec;
|
||||
GlobTNewRec: TNewRec;
|
||||
|
||||
PGlobTRec: ^TRec;
|
||||
PGlobTNewRec: ^TNewRec;
|
||||
|
||||
{ Classes }
|
||||
GlobTFoo, GlobTFoo1, GlobTFoo2, GlobTFooNil: TFoo;
|
||||
GlobPFoo: PFoo;
|
||||
GlobPPFoo: PPFoo;
|
||||
GlobTSamePFoo: TSamePFoo;
|
||||
GlobTNewPFoo: TNewPFoo;
|
||||
|
||||
GlobTSameFoo: TSameFoo;
|
||||
GlobTNewFoo: TNewFoo;
|
||||
GlobPNewFoo: PNewFoo;
|
||||
|
||||
PGlobTFoo: ^TFoo;
|
||||
PGlobPFoo: ^PFoo;
|
||||
PGlobTSamePFoo: ^TSamePFoo;
|
||||
PGlobTSameFoo: ^TSameFoo;
|
||||
|
||||
{ ClassesTyps }
|
||||
GlobTFooClass: TFooClass;
|
||||
GlobPFooClass: PFooClass;
|
||||
GlobPPFooClass: PPFooClass;
|
||||
GlobTNewFooClass: TNewFooClass;
|
||||
GlobPNewFooClass: PNewFooClass;
|
||||
|
||||
PGlobTFooClass: ^TFooClass;
|
||||
|
||||
{ strings }
|
||||
GlobTMyAnsiString: TMyAnsiString;
|
||||
GlobPMyAnsiString: PMyAnsiString;
|
||||
GlobPPMyAnsiString: PPMyAnsiString;
|
||||
|
||||
GlobTNewAnsiString: TNewAnsiString;
|
||||
GlobPNewAnsiString: PNewAnsiString;
|
||||
|
||||
GlobTMyShortString: TMyShortString;
|
||||
GlobPMyShortString: PMyShortString;
|
||||
GlobPPMyShortString: PPMyShortString;
|
||||
|
||||
GlobTNewhortString: TNewhortString;
|
||||
GlobPNewhortString: PNewhortString;
|
||||
|
||||
GlobTMyWideString: TMyWideString;
|
||||
GlobPMyWideString: PMyWideString;
|
||||
GlobPPMyWideString: PPMyWideString;
|
||||
|
||||
GlobTNewWideString: TNewWideString;
|
||||
GlobPNewWideString: PNewWideString;
|
||||
|
||||
GlobTMyString10: TMyString10;
|
||||
GlobPMyString10: PMyString10;
|
||||
GlobPPMyString10: PPMyString10;
|
||||
|
||||
PGlobAnsiString: ^AnsiString;
|
||||
PGlobShortString: ^ShortString;
|
||||
PGlobWideString: ^WideString;
|
||||
|
||||
GlobString15: string[15];
|
||||
|
||||
{ simple }
|
||||
|
||||
GlobByte: Byte;
|
||||
GlobWord: Word;
|
||||
GlobLongWord: LongWord;
|
||||
GlobQWord: QWord;
|
||||
|
||||
GlobShortInt: ShortInt;
|
||||
GlobSmallInt: SmallInt;
|
||||
GlobInt: Integer;
|
||||
GlobInt64: Int64;
|
||||
|
||||
GlobPByte: PByte;
|
||||
GlobPWord: PWord;
|
||||
GlobPLongWord: PLongWord;
|
||||
GlobPQWord: PQWord;
|
||||
|
||||
GlobPShortInt: PShortInt;
|
||||
GlobPSmallInt: PSmallInt;
|
||||
GlobPInt: PInteger;
|
||||
GlobPInt64: PInt64;
|
||||
|
||||
PGlobByte: ^Byte;
|
||||
PGlobWord: ^Word;
|
||||
PGlobLongWord: ^LongWord;
|
||||
PGlobQWord: ^QWord;
|
||||
|
||||
PGlobShortInt: ^ShortInt;
|
||||
PGlobSmallInt: ^SmallInt;
|
||||
PGlobInt: ^Integer;
|
||||
PGlobInt64: ^Int64;
|
||||
|
||||
GlobPointer: Pointer;
|
||||
GlobPPointer: PPointer;
|
||||
PGlobPointer: ^Pointer;
|
||||
|
||||
GlobDouble: Double;
|
||||
GlobExtended: Extended;
|
||||
PGlobDouble: ^Double;
|
||||
PGlobExtended: ^Extended;
|
||||
|
||||
begin
|
||||
a2 := 'def';
|
||||
c2 := 'Y';
|
||||
Foo('abc', a2, 'ghi', 'X', c2, 'Z');
|
||||
{ records }
|
||||
GlobTRec.ValInt := -1;
|
||||
GlobTRec.ValFoo := nil;
|
||||
GlobTRec1.ValInt := 1;
|
||||
GlobTRec1.ValFoo := TFoo.Create;
|
||||
GlobTRec1.ValFoo.ValueInt := 11;
|
||||
GlobTRec2.ValInt := 2;
|
||||
GlobTRec2.ValFoo := TFoo.Create;
|
||||
GlobTRec2.ValFoo.ValueInt := 22;
|
||||
|
||||
GlobPRec := @GlobTRec1;
|
||||
GlobPPRec := @GlobPRec;
|
||||
GlobTNewRec.ValInt := 3;
|
||||
GlobTNewRec.ValFoo := nil;
|
||||
|
||||
PGlobTRec := @GlobTNewRec;
|
||||
PGlobTNewRec := @GlobTNewRec;
|
||||
|
||||
{ Classes }
|
||||
GlobTFoo := TFoo.Create;
|
||||
GlobTFoo.ValueInt := -11;
|
||||
GlobTFoo1 := TFoo.Create;
|
||||
GlobTFoo1.ValueInt := 31;
|
||||
GlobTFoo2 := TFoo.Create;
|
||||
GlobTFoo2.ValueInt := 32;
|
||||
GlobTFooNil := nil;
|
||||
GlobPFoo := @GlobTFoo1;
|
||||
GlobPPFoo := @GlobPFoo;
|
||||
GlobTSamePFoo := @GlobTFoo2;
|
||||
GlobTNewPFoo := @GlobTFoo;
|
||||
|
||||
GlobTSameFoo := TFoo.Create;
|
||||
GlobTSameFoo.ValueInt := 41;
|
||||
GlobTNewFoo := TNewFoo.Create;
|
||||
GlobTNewFoo.ValueInt := 42;
|
||||
GlobPNewFoo := @GlobTSameFoo;
|
||||
|
||||
PGlobTFoo := @GlobTFoo;
|
||||
PGlobPFoo := @PGlobTFoo;
|
||||
PGlobTSamePFoo := @GlobTFoo;
|
||||
PGlobTSameFoo := @GlobTFoo;
|
||||
|
||||
{ ClassesTyps }
|
||||
GlobTFooClass := TFooKid;
|
||||
GlobPFooClass := @GlobTFooClass;
|
||||
GlobPPFooClass := @GlobPFooClass;
|
||||
GlobTNewFooClass := TNewFoo;
|
||||
GlobPNewFooClass := @GlobTNewFooClass;
|
||||
|
||||
PGlobTFooClass := @GlobTNewFooClass;
|
||||
|
||||
{ strings }
|
||||
GlobTMyAnsiString := 'ansi';
|
||||
GlobPMyAnsiString := @GlobTMyAnsiString;
|
||||
GlobPPMyAnsiString := @GlobPMyAnsiString;
|
||||
|
||||
GlobTNewAnsiString := 'newansi';
|
||||
GlobPNewAnsiString := @GlobTNewAnsiString;
|
||||
|
||||
GlobTMyShortString := 'short';
|
||||
GlobPMyShortString := @GlobTMyShortString;
|
||||
GlobPPMyShortString := @GlobPMyShortString;
|
||||
|
||||
GlobTNewhortString := 'newshort';
|
||||
GlobPNewhortString := @GlobTNewhortString;
|
||||
|
||||
GlobTMyWideString := 'wide';
|
||||
GlobPMyWideString := @GlobTMyWideString;
|
||||
GlobPPMyWideString := @GlobPMyWideString;
|
||||
|
||||
GlobTNewWideString := 'newwide';
|
||||
GlobPNewWideString := @GlobTNewWideString;
|
||||
|
||||
GlobTMyString10 := 's10';
|
||||
GlobPMyString10 := @GlobTMyString10;
|
||||
GlobPPMyString10 := @GlobPMyString10;
|
||||
|
||||
PGlobAnsiString := @GlobTMyAnsiString;
|
||||
PGlobShortString := @PGlobAnsiString;
|
||||
PGlobWideString := @PGlobShortString;
|
||||
|
||||
GlobString15 := 'g15';
|
||||
|
||||
{ simple }
|
||||
|
||||
GlobByte := 25;
|
||||
GlobWord := 26;
|
||||
GlobLongWord := 27;
|
||||
GlobQWord := 28;
|
||||
|
||||
GlobShortInt := 35;
|
||||
GlobSmallInt := 36;
|
||||
GlobInt := 37;
|
||||
GlobInt64 := 38;
|
||||
|
||||
GlobPByte := @GlobByte;
|
||||
GlobPWord := @GlobWord;
|
||||
GlobPLongWord := @GlobLongWord;
|
||||
GlobPQWord := @GlobQWord;
|
||||
|
||||
GlobPShortInt := @GlobShortInt;
|
||||
GlobPSmallInt := @GlobSmallInt;
|
||||
GlobPInt := @GlobInt;
|
||||
GlobPInt64 := @GlobInt64;
|
||||
|
||||
PGlobByte := @GlobByte;
|
||||
PGlobWord := @GlobWord;
|
||||
PGlobLongWord := @GlobLongWord;
|
||||
PGlobQWord := @GlobQWord;
|
||||
|
||||
PGlobShortInt := @GlobShortInt;
|
||||
PGlobSmallInt := @GlobSmallInt;
|
||||
PGlobInt := @GlobInt;
|
||||
PGlobInt64 := @GlobInt64;
|
||||
|
||||
GlobPointer := @GlobByte;
|
||||
GlobPPointer := @GlobPointer;
|
||||
PGlobPointer := @GlobPointer;
|
||||
|
||||
GlobDouble := 1.123;
|
||||
GlobExtended := 2.345;
|
||||
PGlobDouble := @GlobDouble;
|
||||
PGlobExtended := @GlobExtended;
|
||||
|
||||
|
||||
|
||||
|
||||
FooFunc(
|
||||
{ records }
|
||||
GlobTRec, GlobTRec,
|
||||
GlobPRec, GlobPRec,
|
||||
GlobPPRec, GlobPPRec,
|
||||
GlobTNewRec, GlobTNewRec,
|
||||
|
||||
{ Classes }
|
||||
GlobTFoo, GlobTFoo,
|
||||
GlobPFoo, GlobPFoo,
|
||||
GlobPPFoo, GlobPPFoo,
|
||||
GlobTSamePFoo, GlobTSamePFoo,
|
||||
GlobTNewPFoo, GlobTNewPFoo,
|
||||
|
||||
GlobTSameFoo, GlobTSameFoo,
|
||||
GlobTNewFoo, GlobTNewFoo,
|
||||
GlobPNewFoo, GlobPNewFoo,
|
||||
|
||||
{ ClassesTyps }
|
||||
GlobTFooClass, GlobTFooClass,
|
||||
GlobPFooClass, GlobPFooClass,
|
||||
GlobPPFooClass, GlobPPFooClass,
|
||||
GlobTNewFooClass, GlobTNewFooClass,
|
||||
GlobPNewFooClass, GlobPNewFooClass,
|
||||
|
||||
{ strings }
|
||||
GlobTMyAnsiString, GlobTMyAnsiString,
|
||||
GlobPMyAnsiString, GlobPMyAnsiString,
|
||||
GlobPPMyAnsiString, GlobPPMyAnsiString,
|
||||
|
||||
GlobTNewAnsiString, GlobTNewAnsiString,
|
||||
GlobPNewAnsiString, GlobPNewAnsiString,
|
||||
|
||||
|
||||
GlobTMyShortString, GlobTMyShortString,
|
||||
GlobPMyShortString, GlobPMyShortString,
|
||||
GlobPPMyShortString, GlobPPMyShortString,
|
||||
|
||||
GlobTNewhortString, GlobTNewhortString,
|
||||
GlobPNewhortString, GlobPNewhortString,
|
||||
|
||||
GlobTMyWideString, GlobTMyWideString,
|
||||
GlobPMyWideString, GlobPMyWideString,
|
||||
GlobPPMyWideString, GlobPPMyWideString,
|
||||
|
||||
GlobTNewWideString, GlobTNewWideString,
|
||||
GlobPNewWideString, GlobPNewWideString,
|
||||
|
||||
GlobTMyString10, GlobTMyString10,
|
||||
GlobPMyString10, GlobPMyString10,
|
||||
GlobPPMyString10, GlobPPMyString10,
|
||||
|
||||
{ simple }
|
||||
|
||||
GlobByte, GlobByte,
|
||||
GlobWord, GlobWord,
|
||||
GlobLongWord, GlobLongWord,
|
||||
GlobQWord, GlobQWord,
|
||||
|
||||
GlobShortInt, GlobShortInt,
|
||||
GlobSmallInt, GlobSmallInt,
|
||||
GlobInt, GlobInt,
|
||||
GlobInt64, GlobInt64,
|
||||
|
||||
GlobPByte, GlobPByte,
|
||||
GlobPWord, GlobPWord,
|
||||
GlobPLongWord, GlobPLongWord,
|
||||
GlobPQWord, GlobPQWord,
|
||||
|
||||
GlobPShortInt, GlobPShortInt,
|
||||
GlobPSmallInt, GlobPSmallInt,
|
||||
GlobPInt, GlobPInt,
|
||||
GlobPInt64, GlobPInt64,
|
||||
|
||||
GlobPointer, GlobPointer,
|
||||
GlobPPointer, GlobPPointer,
|
||||
|
||||
GlobDouble, GlobDouble,
|
||||
GlobExtended, GlobExtended,
|
||||
|
||||
0
|
||||
);
|
||||
|
||||
// same with nil
|
||||
{ records }
|
||||
//GlobTRec := nil;
|
||||
GlobPRec := nil;
|
||||
GlobPPRec := nil;
|
||||
//GlobTNewRec := nil;
|
||||
|
||||
{ Classes }
|
||||
GlobTFoo := nil;
|
||||
GlobPFoo := nil;
|
||||
GlobPPFoo := nil;
|
||||
GlobTSamePFoo := nil;
|
||||
GlobTNewPFoo := nil;
|
||||
|
||||
GlobTSameFoo := nil;
|
||||
GlobTNewFoo := nil;
|
||||
GlobPNewFoo := nil;
|
||||
|
||||
{ ClassesTyps }
|
||||
GlobTFooClass := nil;
|
||||
GlobPFooClass := nil;
|
||||
GlobPPFooClass := nil;
|
||||
GlobTNewFooClass := nil;
|
||||
GlobPNewFooClass := nil;
|
||||
|
||||
{ strings }
|
||||
GlobTMyAnsiString := '';
|
||||
GlobPMyAnsiString := nil;
|
||||
GlobPPMyAnsiString := nil;
|
||||
|
||||
GlobTNewAnsiString := '';
|
||||
GlobPNewAnsiString := nil;
|
||||
|
||||
|
||||
GlobTMyShortString := '';
|
||||
GlobPMyShortString := nil;
|
||||
GlobPPMyShortString := nil;
|
||||
|
||||
GlobTNewhortString := '';
|
||||
GlobPNewhortString := nil;
|
||||
|
||||
GlobTMyWideString := '';
|
||||
GlobPMyWideString := nil;
|
||||
GlobPPMyWideString := nil;
|
||||
|
||||
GlobTNewWideString := '';
|
||||
GlobPNewWideString := nil;
|
||||
|
||||
GlobTMyString10 := '';
|
||||
GlobPMyString10 := nil;
|
||||
GlobPPMyString10 := nil;
|
||||
|
||||
{ simple }
|
||||
|
||||
GlobByte := 0;
|
||||
GlobWord := 0;
|
||||
GlobLongWord := 0;
|
||||
GlobQWord := 0;
|
||||
|
||||
GlobShortInt := 0;
|
||||
GlobSmallInt := 0;
|
||||
GlobInt := 0;
|
||||
GlobInt64 := 0;
|
||||
|
||||
GlobPByte := nil;
|
||||
GlobPWord := nil;
|
||||
GlobPLongWord := nil;
|
||||
GlobPQWord := nil;
|
||||
|
||||
GlobPShortInt := nil;
|
||||
GlobPSmallInt := nil;
|
||||
GlobPInt := nil;
|
||||
GlobPInt64 := nil;
|
||||
|
||||
GlobPointer := nil;
|
||||
GlobPPointer := nil;
|
||||
|
||||
GlobDouble := 0;
|
||||
GlobExtended := 0;
|
||||
|
||||
|
||||
FooFunc(
|
||||
{ records }
|
||||
GlobTRec, GlobTRec,
|
||||
GlobPRec, GlobPRec,
|
||||
GlobPPRec, GlobPPRec,
|
||||
GlobTNewRec, GlobTNewRec,
|
||||
|
||||
{ Classes }
|
||||
GlobTFoo, GlobTFoo,
|
||||
GlobPFoo, GlobPFoo,
|
||||
GlobPPFoo, GlobPPFoo,
|
||||
GlobTSamePFoo, GlobTSamePFoo,
|
||||
GlobTNewPFoo, GlobTNewPFoo,
|
||||
|
||||
GlobTSameFoo, GlobTSameFoo,
|
||||
GlobTNewFoo, GlobTNewFoo,
|
||||
GlobPNewFoo, GlobPNewFoo,
|
||||
|
||||
{ ClassesTyps }
|
||||
GlobTFooClass, GlobTFooClass,
|
||||
GlobPFooClass, GlobPFooClass,
|
||||
GlobPPFooClass, GlobPPFooClass,
|
||||
GlobTNewFooClass, GlobTNewFooClass,
|
||||
GlobPNewFooClass, GlobPNewFooClass,
|
||||
|
||||
{ strings }
|
||||
GlobTMyAnsiString, GlobTMyAnsiString,
|
||||
GlobPMyAnsiString, GlobPMyAnsiString,
|
||||
GlobPPMyAnsiString, GlobPPMyAnsiString,
|
||||
|
||||
GlobTNewAnsiString, GlobTNewAnsiString,
|
||||
GlobPNewAnsiString, GlobPNewAnsiString,
|
||||
|
||||
|
||||
GlobTMyShortString, GlobTMyShortString,
|
||||
GlobPMyShortString, GlobPMyShortString,
|
||||
GlobPPMyShortString, GlobPPMyShortString,
|
||||
|
||||
GlobTNewhortString, GlobTNewhortString,
|
||||
GlobPNewhortString, GlobPNewhortString,
|
||||
|
||||
GlobTMyWideString, GlobTMyWideString,
|
||||
GlobPMyWideString, GlobPMyWideString,
|
||||
GlobPPMyWideString, GlobPPMyWideString,
|
||||
|
||||
GlobTNewWideString, GlobTNewWideString,
|
||||
GlobPNewWideString, GlobPNewWideString,
|
||||
|
||||
GlobTMyString10, GlobTMyString10,
|
||||
GlobPMyString10, GlobPMyString10,
|
||||
GlobPPMyString10, GlobPPMyString10,
|
||||
|
||||
{ simple }
|
||||
|
||||
GlobByte, GlobByte,
|
||||
GlobWord, GlobWord,
|
||||
GlobLongWord, GlobLongWord,
|
||||
GlobQWord, GlobQWord,
|
||||
|
||||
GlobShortInt, GlobShortInt,
|
||||
GlobSmallInt, GlobSmallInt,
|
||||
GlobInt, GlobInt,
|
||||
GlobInt64, GlobInt64,
|
||||
|
||||
GlobPByte, GlobPByte,
|
||||
GlobPWord, GlobPWord,
|
||||
GlobPLongWord, GlobPLongWord,
|
||||
GlobPQWord, GlobPQWord,
|
||||
|
||||
GlobPShortInt, GlobPShortInt,
|
||||
GlobPSmallInt, GlobPSmallInt,
|
||||
GlobPInt, GlobPInt,
|
||||
GlobPInt64, GlobPInt64,
|
||||
|
||||
GlobPointer, GlobPointer,
|
||||
GlobPPointer, GlobPPointer,
|
||||
|
||||
GlobDouble, GlobDouble,
|
||||
GlobExtended, GlobExtended,
|
||||
|
||||
0
|
||||
);
|
||||
|
||||
|
||||
|
||||
// no bother freeing mem
|
||||
end.
|
||||
|
||||
@ -102,38 +102,24 @@ type
|
||||
TCompilerSuite = class(TTestSuite)
|
||||
private
|
||||
FCompilerInfo: TCompilerInfo;
|
||||
public
|
||||
constructor Create(ACompilerInfo: TCompilerInfo; ADebuggerList: TDebuggerList);
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
public
|
||||
property CompilerInfo: TCompilerInfo read FCompilerInfo;
|
||||
end;
|
||||
|
||||
{ TCompilerOptionsSuite }
|
||||
|
||||
TCompilerOptionsSuite = class(TTestSuite)
|
||||
private
|
||||
FParent: TCompilerSuite;
|
||||
FSymbolSwitch: String;
|
||||
FSymbolType: TSymbolType;
|
||||
FFileNameExt: String;
|
||||
FCompiledList: TStringList;
|
||||
FInRun: Boolean;
|
||||
function GetCompilerInfo: TCompilerInfo;
|
||||
protected
|
||||
procedure Clear;
|
||||
public
|
||||
constructor Create(AParent: TCompilerSuite; ASymbolType: TSymbolType; ADebuggerList: TDebuggerList);
|
||||
constructor Create(ACompilerInfo: TCompilerInfo; ASymbolType: TSymbolType; ADebuggerList: TDebuggerList);
|
||||
destructor Destroy; override;
|
||||
procedure Run(AResult: TTestResult); override;
|
||||
procedure RunTest(ATest: TTest; AResult: TTestResult); override;
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
Procedure TestCompile(const PrgName: string; out ExeName: string);
|
||||
public
|
||||
property Parent: TCompilerSuite read FParent;
|
||||
property SymbolType: TSymbolType read FSymbolType;
|
||||
property SymbolSwitch: String read FSymbolSwitch;
|
||||
property CompilerInfo: TCompilerInfo read GetCompilerInfo;
|
||||
property CompilerInfo: TCompilerInfo read FCompilerInfo;
|
||||
end;
|
||||
|
||||
{ TDebuggerSuite }
|
||||
@ -141,15 +127,15 @@ type
|
||||
TDebuggerSuite = class(TTestSuite)
|
||||
private
|
||||
FDebuggerInfo: TDebuggerInfo;
|
||||
FParent: TCompilerOptionsSuite;
|
||||
FParent: TCompilerSuite;
|
||||
function GetCompilerInfo: TCompilerInfo;
|
||||
function GetSymbolType: TSymbolType;
|
||||
public
|
||||
constructor Create(AParent: TCompilerOptionsSuite; ADebuggerInfo: TDebuggerInfo);
|
||||
constructor Create(AParent: TCompilerSuite; ADebuggerInfo: TDebuggerInfo);
|
||||
procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
Procedure TestCompile(const PrgName: string; out ExeName: string);
|
||||
public
|
||||
property Parent: TCompilerOptionsSuite read FParent;
|
||||
property Parent: TCompilerSuite read FParent;
|
||||
property DebuggerInfo: TDebuggerInfo read FDebuggerInfo;
|
||||
property SymbolType: TSymbolType read GetSymbolType;
|
||||
property CompilerInfo: TCompilerInfo read GetCompilerInfo;
|
||||
@ -199,6 +185,7 @@ procedure RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
|
||||
var
|
||||
AppDir: String;
|
||||
ConfDir: String;
|
||||
|
||||
implementation
|
||||
|
||||
@ -226,30 +213,24 @@ end;
|
||||
|
||||
|
||||
function GetCompilers: TCompilerList;
|
||||
var
|
||||
AppDir: String;
|
||||
begin
|
||||
if Compilers <> nil then exit(Compilers);
|
||||
|
||||
AppDir := ExtractFilePath(Paramstr(0));
|
||||
Result := TCompilerList.Create;
|
||||
if FileExists(AppDir + 'fpclist.txt') then
|
||||
Result.LoadFromFile(AppDir + 'fpclist.txt');
|
||||
if FileExists(ConfDir + 'fpclist.txt') then
|
||||
Result.LoadFromFile(ConfDir + 'fpclist.txt');
|
||||
if (Result.Count = 0) and (EnvironmentOptions.CompilerFilename <> '') then
|
||||
Result.Add('fpc from conf', EnvironmentOptions.CompilerFilename);
|
||||
Compilers := Result;
|
||||
end;
|
||||
|
||||
function GetDebuggers: TDebuggerList;
|
||||
var
|
||||
AppDir: String;
|
||||
begin
|
||||
if Debuggers <> nil then exit(Debuggers);
|
||||
|
||||
AppDir := ExtractFilePath(Paramstr(0));
|
||||
Result := TDebuggerList.Create;
|
||||
if FileExists(AppDir + 'gdblist.txt') then
|
||||
Result.LoadFromFile(AppDir + 'gdblist.txt');
|
||||
if FileExists(ConfDir + 'gdblist.txt') then
|
||||
Result.LoadFromFile(ConfDir + 'gdblist.txt');
|
||||
if (Result.Count = 0) and (EnvironmentOptions.DebuggerFilename <> '') then
|
||||
Result.Add('gdb from conf', EnvironmentOptions.DebuggerFilename);
|
||||
Debuggers := Result;
|
||||
@ -415,40 +396,7 @@ end;
|
||||
|
||||
{ TCompilerSuite }
|
||||
|
||||
constructor TCompilerSuite.Create(ACompilerInfo: TCompilerInfo; ADebuggerList: TDebuggerList);
|
||||
var
|
||||
st: TSymbolType;
|
||||
SubSuite: TCompilerOptionsSuite;
|
||||
begin
|
||||
inherited Create(ACompilerInfo.Name);
|
||||
FCompilerInfo := ACompilerInfo;
|
||||
|
||||
for st := low(TSymbolType) to high(TSymbolType) do begin
|
||||
if not (st in FCompilerInfo.SymbolTypes) then
|
||||
continue;
|
||||
|
||||
SubSuite := TCompilerOptionsSuite.Create(Self, st, ADebuggerList);
|
||||
Self.AddTest(SubSuite);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerSuite.RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Tests.Count - 1 do
|
||||
if Test[i] is TCompilerOptionsSuite then
|
||||
TCompilerOptionsSuite(Test[i]).RegisterDbgTest(ATestClass);
|
||||
end;
|
||||
|
||||
{ TCompilerOptionsSuite }
|
||||
|
||||
function TCompilerOptionsSuite.GetCompilerInfo: TCompilerInfo;
|
||||
begin
|
||||
Result := Parent.CompilerInfo;
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.Clear;
|
||||
procedure TCompilerSuite.Clear;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
@ -457,14 +405,14 @@ begin
|
||||
FCompiledList.Clear;
|
||||
end;
|
||||
|
||||
constructor TCompilerOptionsSuite.Create(AParent: TCompilerSuite; ASymbolType: TSymbolType;
|
||||
constructor TCompilerSuite.Create(ACompilerInfo: TCompilerInfo; ASymbolType: TSymbolType;
|
||||
ADebuggerList: TDebuggerList);
|
||||
var
|
||||
i: Integer;
|
||||
SubSuite: TDebuggerSuite;
|
||||
begin
|
||||
inherited Create(SymbolTypeNames[ASymbolType]);
|
||||
FParent := AParent;
|
||||
inherited Create(ACompilerInfo.Name + ' / ' + SymbolTypeNames[ASymbolType]);
|
||||
FCompilerInfo := ACompilerInfo;
|
||||
FSymbolType := ASymbolType;
|
||||
|
||||
FCompiledList := TStringList.Create;
|
||||
@ -489,14 +437,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TCompilerOptionsSuite.Destroy;
|
||||
destructor TCompilerSuite.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
Clear;
|
||||
FreeAndNil(FCompiledList);
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.Run(AResult: TTestResult);
|
||||
procedure TCompilerSuite.Run(AResult: TTestResult);
|
||||
begin
|
||||
FInRun := True;
|
||||
try
|
||||
@ -507,7 +455,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.RunTest(ATest: TTest; AResult: TTestResult);
|
||||
procedure TCompilerSuite.RunTest(ATest: TTest; AResult: TTestResult);
|
||||
begin
|
||||
try
|
||||
inherited RunTest(ATest, AResult);
|
||||
@ -516,7 +464,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
procedure TCompilerSuite.RegisterDbgTest(ATestClass: TTestCaseClass);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
@ -525,7 +473,7 @@ begin
|
||||
TDebuggerSuite(Test[i]).RegisterDbgTest(ATestClass);
|
||||
end;
|
||||
|
||||
procedure TCompilerOptionsSuite.TestCompile(const PrgName: string; out ExeName: string);
|
||||
procedure TCompilerSuite.TestCompile(const PrgName: string; out ExeName: string);
|
||||
var
|
||||
ExePath, ErrMsg: String;
|
||||
begin
|
||||
@ -561,10 +509,10 @@ begin
|
||||
Result := Parent.SymbolType;
|
||||
end;
|
||||
|
||||
constructor TDebuggerSuite.Create(AParent: TCompilerOptionsSuite;
|
||||
constructor TDebuggerSuite.Create(AParent: TCompilerSuite;
|
||||
ADebuggerInfo: TDebuggerInfo);
|
||||
begin
|
||||
inherited Create(ADebuggerInfo.Name);
|
||||
inherited Create(ADebuggerInfo.Name + ' ('+AParent.TestName+')');
|
||||
FParent := AParent;
|
||||
FDebuggerInfo := ADebuggerInfo;
|
||||
end;
|
||||
@ -637,21 +585,28 @@ var
|
||||
GdbList: TDebuggerList;
|
||||
CompilerSuite: TCompilerSuite;
|
||||
i: Integer;
|
||||
st: TSymbolType;
|
||||
begin
|
||||
FpcList := GetCompilers;
|
||||
GdbList := GetDebuggers;
|
||||
|
||||
for i := 0 to FpcList.Count - 1 do begin
|
||||
CompilerSuite := TCompilerSuite.Create(FpcList.CompilerInfo[i], GdbList);
|
||||
GetTestRegistry.AddTest(CompilerSuite);
|
||||
for st := low(TSymbolType) to high(TSymbolType) do begin
|
||||
if not (st in FpcList.CompilerInfo[i].SymbolTypes) then
|
||||
continue;
|
||||
|
||||
CompilerSuite := TCompilerSuite.Create(FpcList.CompilerInfo[i], st, GdbList);
|
||||
if CompilerSuite.Tests.Count >0 then
|
||||
GetTestRegistry.AddTest(CompilerSuite)
|
||||
else
|
||||
CompilerSuite.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CheckAppDir(var AppDir: string): Boolean;
|
||||
begin
|
||||
Result := DirectoryExistsUTF8(AppDir + 'TestApps');
|
||||
if Result then
|
||||
AppDir := AppendPathDelim(AppDir + 'TestApps');
|
||||
end;
|
||||
|
||||
function CheckAppDirLib(var AppDir: string): Boolean;
|
||||
@ -664,7 +619,7 @@ begin
|
||||
s := copy(AppDir, 1, length(AppDir) - length('lib' + DirectorySeparator));
|
||||
Result := DirectoryExistsUTF8(s + 'TestApps');
|
||||
if Result then
|
||||
AppDir := AppendPathDelim(s + 'TestApps');
|
||||
AppDir := s;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -694,7 +649,8 @@ initialization
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
ConfDir := AppDir;
|
||||
AppDir := AppendPathDelim(AppDir + 'TestApps');
|
||||
|
||||
EnvironmentOptions := TEnvironmentOptions.Create;
|
||||
with EnvironmentOptions do
|
||||
@ -702,6 +658,7 @@ initialization
|
||||
SetLazarusDefaultFilename;
|
||||
Load(false);
|
||||
end;
|
||||
|
||||
BuildTestSuites;
|
||||
|
||||
finalization
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry,
|
||||
TestBase, Debugger, GDBMIDebugger, LCLProc;
|
||||
TestBase, Debugger, GDBMIDebugger, LCLProc, SynRegExpr;
|
||||
|
||||
type
|
||||
|
||||
@ -18,8 +18,10 @@ type
|
||||
FHasValue: Boolean;
|
||||
FMaster: TDBGWatch;
|
||||
FValue: String;
|
||||
FTypeInfo: TDBGType;
|
||||
protected
|
||||
procedure DoChanged; override;
|
||||
function GetTypeInfo: TDBGType; override;
|
||||
public
|
||||
constructor Create(AOwner: TBaseWatches; AMaster: TDBGWatch);
|
||||
property Master: TDBGWatch read FMaster;
|
||||
@ -33,21 +35,6 @@ type
|
||||
TTestWatches = class(TGDBTestCase)
|
||||
private
|
||||
FWatches: TBaseWatches;
|
||||
|
||||
FAVal1Watch: TTestWatch;
|
||||
FAVal2Watch: TTestWatch;
|
||||
|
||||
FTestIntWatch: TTestWatch;
|
||||
FTestShortStringWatch: TTestWatch;
|
||||
FTestAnsiStringWatch: TTestWatch;
|
||||
FTestPCharWatch: TTestWatch;
|
||||
|
||||
FArgAnsisString1: TTestWatch;
|
||||
FArgAnsisString2: TTestWatch;
|
||||
FArgAnsisString3: TTestWatch;
|
||||
FArgChar1: TTestWatch;
|
||||
FArgChar2: TTestWatch;
|
||||
FArgChar3: TTestWatch;
|
||||
public
|
||||
procedure DebugInteract(dbg: TGDBMIDebugger);
|
||||
|
||||
@ -58,21 +45,238 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
RNoPreQuote = '(^|[^''])'; // No open qoute (Either at start, or other char)
|
||||
RNoPostQuote = '($|[^''])'; // No close qoute (Either at end, or other char)
|
||||
|
||||
type
|
||||
TWatchExpectationFlag = (fnoDwrf, fnoStabs, fTpMtch);
|
||||
TWatchExpectationFlags = set of TWatchExpectationFlag;
|
||||
TWatchExpectation = record
|
||||
Exp: string;
|
||||
Mtch: string;
|
||||
Kind: TDBGSymbolKind;
|
||||
TpNm: string;
|
||||
Flgs: TWatchExpectationFlags;
|
||||
end;
|
||||
|
||||
const
|
||||
Match_Pointer = '(0x|\$)[0-9A-F]+';
|
||||
Match_PasPointer = '\$[0-9A-F]+';
|
||||
Match_ArgTRec = 'record TREC .+ valint = -1.+valfoo'; // record TREC { VALINT = -1, VALFOO = $0}
|
||||
Match_ArgTRec1 = 'record TREC .+ valint = 1.+valfoo'; // record TREC { VALINT = 1, VALFOO = $xxx}
|
||||
Match_ArgTRec2 = 'record TREC .+ valint = 2.+valfoo'; // record TREC { VALINT = 2, VALFOO = $xxx}
|
||||
Match_ArgTNewRec = 'record TNEWREC .+ valint = 3.+valfoo'; // record TREC { VALINT = 3, VALFOO = $0}
|
||||
|
||||
Match_ArgTFoo = '<TFoo> = \{.+ValueInt = -1';
|
||||
Match_ArgTFoo1 = '<TFoo> = \{.+ValueInt = 31';
|
||||
// Todo: Dwarf fails with dereferenced var pointer types
|
||||
|
||||
ExpectBrk1NoneNil: Array [1..49] of TWatchExpectation = (
|
||||
{ records }
|
||||
|
||||
(Exp: 'ArgTRec'; Mtch: Match_ArgTRec; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'VArgTRec'; Mtch: Match_ArgTRec; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'ArgPRec'; Mtch: '^PRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PRec'; Flgs: []),
|
||||
(Exp: 'VArgPRec'; Mtch: '^PRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PRec'; Flgs: []),
|
||||
(Exp: 'ArgPRec^'; Mtch: Match_ArgTRec1; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'VArgPRec^'; Mtch: Match_ArgTRec1; Kind: skRecord; TpNm: 'TRec'; Flgs: [fnoDwrf]),
|
||||
(Exp: 'ArgPPRec'; Mtch: '^PPRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PPRec'; Flgs: []),
|
||||
(Exp: 'VArgPPRec'; Mtch: '^PPRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PPRec'; Flgs: []),
|
||||
(Exp: 'ArgPPRec^'; Mtch: '^PRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PRec'; Flgs: []),
|
||||
(Exp: 'VArgPPRec^'; Mtch: '^PRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PRec'; Flgs: [fnoDwrf]),
|
||||
(Exp: 'ArgPPRec^^'; Mtch: Match_ArgTRec1; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'VArgPPRec^^'; Mtch: Match_ArgTRec1; Kind: skRecord; TpNm: 'TRec'; Flgs: [fnoDwrf]),
|
||||
(Exp: 'ArgTNewRec'; Mtch: Match_ArgTNewRec; Kind: skRecord; TpNm: 'TNewRec'; Flgs: []),
|
||||
(Exp: 'VArgTNewRec'; Mtch: Match_ArgTNewRec; Kind: skRecord; TpNm: 'TNewRec'; Flgs: []),
|
||||
|
||||
(Exp: 'VarTRec'; Mtch: Match_ArgTRec; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'VarPRec'; Mtch: '^PRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PRec'; Flgs: []),
|
||||
(Exp: 'VarPRec^'; Mtch: Match_ArgTRec1; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'VarPPRec'; Mtch: '^PPRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PPRec'; Flgs: []),
|
||||
(Exp: 'VarPPRec^'; Mtch: '^PRec\('+Match_PasPointer; Kind: skPointer; TpNm: 'PRec'; Flgs: []),
|
||||
(Exp: 'VarPPRec^^'; Mtch: Match_ArgTRec1; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'VarTNewRec'; Mtch: Match_ArgTNewRec; Kind: skRecord; TpNm: 'TNewRec'; Flgs: []),
|
||||
|
||||
(Exp: 'PVarTRec'; Mtch: '^(\^T|P)Rec\('+Match_PasPointer; Kind: skPointer; TpNm: '^(\^T|P)Rec$'; Flgs: [fTpMtch]), // TODO: stabs returns PRec
|
||||
(Exp: 'PVarTRec^'; Mtch: Match_ArgTRec; Kind: skRecord; TpNm: 'TRec'; Flgs: []),
|
||||
(Exp: 'PVarTNewRec'; Mtch: '^\^TNewRec\('+Match_PasPointer; Kind: skPointer; TpNm: '^TNewRec'; Flgs: []),
|
||||
(Exp: 'PVarTNewRec^'; Mtch: Match_ArgTNewRec; Kind: skRecord; TpNm: 'TNewRec'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgTFoo'; Mtch: Match_ArgTFoo; Kind: skClass; TpNm: 'TFoo'; Flgs: []),
|
||||
(Exp: 'VArgTFoo'; Mtch: Match_ArgTFoo; Kind: skClass; TpNm: 'TFoo'; Flgs: []),
|
||||
(Exp: 'ArgPFoo'; Mtch: 'PFoo\('+Match_PasPointer; Kind: skPointer; TpNm: 'PFoo'; Flgs: []),
|
||||
(Exp: 'VArgPFoo'; Mtch: 'PFoo\('+Match_PasPointer; Kind: skPointer; TpNm: 'PFoo'; Flgs: []),
|
||||
(Exp: 'ArgPFoo^'; Mtch: Match_ArgTFoo1; Kind: skClass; TpNm: 'TFoo'; Flgs: []),
|
||||
(Exp: 'VArgPFoo^'; Mtch: Match_ArgTFoo1; Kind: skClass; TpNm: 'TFoo'; Flgs: [fnoDwrf]),
|
||||
|
||||
(*
|
||||
|
||||
{ Classes }
|
||||
(Exp: 'ArgPPFoo'; Mtch: ''; Kind: sk; TpNm: 'PPFoo'; Flgs: []),
|
||||
(Exp: 'VArgPPFoo'; Mtch: ''; Kind: sk; TpNm: 'PPFoo'; Flgs: []),
|
||||
(Exp: 'ArgTSamePFoo'; Mtch: ''; Kind: sk; TpNm: 'TSamePFoo'; Flgs: []),
|
||||
(Exp: 'VArgTSamePFoo'; Mtch: ''; Kind: sk; TpNm: 'TSamePFoo'; Flgs: []),
|
||||
(Exp: 'ArgTNewPFoo'; Mtch: ''; Kind: sk; TpNm: 'TNewPFoo'; Flgs: []),
|
||||
(Exp: 'VArgTNewPFoo'; Mtch: ''; Kind: sk; TpNm: 'TNewPFoo'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgTSameFoo'; Mtch: ''; Kind: sk; TpNm: 'TSameFoo'; Flgs: []),
|
||||
(Exp: 'VArgTSameFoo'; Mtch: ''; Kind: sk; TpNm: 'TSameFoo'; Flgs: []),
|
||||
(Exp: 'ArgTNewFoo'; Mtch: ''; Kind: sk; TpNm: 'TNewFoo'; Flgs: []),
|
||||
(Exp: 'VArgTNewFoo'; Mtch: ''; Kind: sk; TpNm: 'TNewFoo'; Flgs: []),
|
||||
(Exp: 'ArgPNewFoo'; Mtch: ''; Kind: sk; TpNm: 'PNewFoo'; Flgs: []),
|
||||
(Exp: 'VArgPNewFoo'; Mtch: ''; Kind: sk; TpNm: 'PNewFoo'; Flgs: []),
|
||||
|
||||
{ ClassesTyps }
|
||||
(Exp: 'ArgTFooClass'; Mtch: ''; Kind: sk; TpNm: 'TFooClass'; Flgs: []),
|
||||
(Exp: 'VArgTFooClass'; Mtch: ''; Kind: sk; TpNm: 'TFooClass'; Flgs: []),
|
||||
(Exp: 'ArgPFooClass'; Mtch: ''; Kind: sk; TpNm: 'PFooClass'; Flgs: []),
|
||||
(Exp: 'VArgPFooClass'; Mtch: ''; Kind: sk; TpNm: 'PFooClass'; Flgs: []),
|
||||
(Exp: 'ArgPPFooClass'; Mtch: ''; Kind: sk; TpNm: 'PPFooClass'; Flgs: []),
|
||||
(Exp: 'VArgPPFooClass'; Mtch: ''; Kind: sk; TpNm: 'PPFooClass'; Flgs: []),
|
||||
(Exp: 'ArgTNewFooClass'; Mtch: ''; Kind: sk; TpNm: 'TNewFooClass'; Flgs: []),
|
||||
(Exp: 'VArgTNewFooClass'; Mtch: ''; Kind: sk; TpNm: 'TNewFooClass'; Flgs: []),
|
||||
(Exp: 'ArgPNewFooClass'; Mtch: ''; Kind: sk; TpNm: 'PNewFooClass'; Flgs: []),
|
||||
(Exp: 'VArgPNewFooClass'; Mtch: ''; Kind: sk; TpNm: 'PNewFooClass'; Flgs: []),
|
||||
*)
|
||||
|
||||
{ strings }
|
||||
(Exp: 'ArgTMyAnsiString'; Mtch: '''ansi'''; Kind: skPointer; TpNm: '^(TMy)?AnsiString$'; Flgs: [fTpMtch]),
|
||||
(Exp: 'VArgTMyAnsiString'; Mtch: '''ansi'''; Kind: skPointer; TpNm: '^(TMy)?AnsiString$'; Flgs: [fTpMtch]),
|
||||
(Exp: 'ArgPMyAnsiString'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'PMyAnsiString'; Flgs: []),
|
||||
(Exp: 'VArgPMyAnsiString'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'PMyAnsiString'; Flgs: []),
|
||||
(Exp: 'ArgPMyAnsiString^'; Mtch: '''ansi'''; Kind: skPointer; TpNm: '^(TMy)?AnsiString$'; Flgs: [fTpMtch]),
|
||||
(Exp: 'VArgPMyAnsiString^'; Mtch: '''ansi'''; Kind: skPointer; TpNm: '^(TMy)?AnsiString$'; Flgs: [fTpMtch, fnoDwrf]),
|
||||
(Exp: 'ArgPPMyAnsiString'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'PPMyAnsiString'; Flgs: []),
|
||||
(Exp: 'VArgPPMyAnsiString'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'PPMyAnsiString'; Flgs: []),
|
||||
(Exp: 'ArgPPMyAnsiString^'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'PMyAnsiString'; Flgs: []),
|
||||
(Exp: 'VArgPPMyAnsiString^'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'PMyAnsiString'; Flgs: [fnoDwrf]),
|
||||
(Exp: 'ArgPPMyAnsiString^^'; Mtch: '''ansi'''; Kind: skPointer; TpNm: '^(TMy)?AnsiString$'; Flgs: [fTpMtch]),
|
||||
(Exp: 'VArgPPMyAnsiString^^'; Mtch: '''ansi'''; Kind: skPointer; TpNm: '^(TMy)?AnsiString$'; Flgs: [fTpMtch, fnoDwrf]),
|
||||
|
||||
(*
|
||||
(Exp: 'ArgTNewAnsiString'; Mtch: ''; Kind: sk; TpNm: 'TNewAnsiString'; Flgs: []),
|
||||
(Exp: 'VArgTNewAnsiString'; Mtch: ''; Kind: sk; TpNm: 'TNewAnsiString'; Flgs: []),
|
||||
(Exp: 'ArgPNewAnsiString'; Mtch: ''; Kind: sk; TpNm: 'PNewAnsiString'; Flgs: []),
|
||||
(Exp: 'VArgPNewAnsiString'; Mtch: ''; Kind: sk; TpNm: 'PNewAnsiString'; Flgs: []),
|
||||
*)
|
||||
|
||||
(Exp: 'ArgTMyShortString'; Mtch: '''short'''; Kind: skSimple; TpNm: '^(TMy)?ShortString$'; Flgs: [fTpMtch]),
|
||||
(Exp: 'VArgTMyShortString'; Mtch: '''short'''; Kind: skSimple; TpNm: '^(TMy)?ShortString$'; Flgs: [fTpMtch]),
|
||||
(Exp: 'ArgPMyShortString'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'P(My)?ShortString'; Flgs: [fTpMtch]),
|
||||
(Exp: 'VArgPMyShortString'; Mtch: Match_Pointer; Kind: skPointer; TpNm: 'P(My)?ShortString'; Flgs: [fTpMtch]),
|
||||
(Exp: 'ArgPMyShortString^'; Mtch: '''short'''; Kind: skSimple; TpNm: '^(TMy)?ShortString$'; Flgs: [fTpMtch]),
|
||||
(Exp: 'VArgPMyShortString^'; Mtch: '''short'''; Kind: skSimple; TpNm: '^(TMy)?ShortString$'; Flgs: [fTpMtch, fnoDwrf])//,
|
||||
|
||||
(*
|
||||
(Exp: 'ArgPPMyShortString'; Mtch: ''; Kind: sk; TpNm: 'PPMyShortString'; Flgs: []),
|
||||
(Exp: 'VArgPPMyShortString'; Mtch: ''; Kind: sk; TpNm: 'PPMyShortString'; Flgs: []),
|
||||
(Exp: 'ArgTNewhortString'; Mtch: ''; Kind: sk; TpNm: 'TNewhortString'; Flgs: []),
|
||||
(Exp: 'VArgTNewhortString'; Mtch: ''; Kind: sk; TpNm: 'TNewhortString'; Flgs: []),
|
||||
(Exp: 'ArgPNewhortString'; Mtch: ''; Kind: sk; TpNm: 'PNewhortString'; Flgs: []),
|
||||
(Exp: 'VArgPNewhortString'; Mtch: ''; Kind: sk; TpNm: 'PNewhortString'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgTMyWideString'; Mtch: ''; Kind: sk; TpNm: 'TMyWideString'; Flgs: []),
|
||||
(Exp: 'VArgTMyWideString'; Mtch: ''; Kind: sk; TpNm: 'TMyWideString'; Flgs: []),
|
||||
(Exp: 'ArgPMyWideString'; Mtch: ''; Kind: sk; TpNm: 'PMyWideString'; Flgs: []),
|
||||
(Exp: 'VArgPMyWideString'; Mtch: ''; Kind: sk; TpNm: 'PMyWideString'; Flgs: []),
|
||||
(Exp: 'ArgPPMyWideString'; Mtch: ''; Kind: sk; TpNm: 'PPMyWideString'; Flgs: []),
|
||||
(Exp: 'VArgPPMyWideString'; Mtch: ''; Kind: sk; TpNm: 'PPMyWideString'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgTNewWideString'; Mtch: ''; Kind: sk; TpNm: 'TNewWideString'; Flgs: []),
|
||||
(Exp: 'VArgTNewWideString'; Mtch: ''; Kind: sk; TpNm: 'TNewWideString'; Flgs: []),
|
||||
(Exp: 'ArgPNewWideString'; Mtch: ''; Kind: sk; TpNm: 'PNewWideString'; Flgs: []),
|
||||
(Exp: 'VArgPNewWideString'; Mtch: ''; Kind: sk; TpNm: 'PNewWideString'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgTMyString10'; Mtch: ''; Kind: sk; TpNm: 'TMyString10'; Flgs: []),
|
||||
(Exp: 'VArgTMyString10'; Mtch: ''; Kind: sk; TpNm: 'TMyString10'; Flgs: []),
|
||||
(Exp: 'ArgPMyString10'; Mtch: ''; Kind: sk; TpNm: 'PMyString10'; Flgs: []),
|
||||
(Exp: 'VArgPMyString10'; Mtch: ''; Kind: sk; TpNm: 'PMyString10'; Flgs: []),
|
||||
(Exp: 'ArgPPMyString10'; Mtch: ''; Kind: sk; TpNm: 'PPMyString10'; Flgs: []),
|
||||
(Exp: 'VArgPPMyString10'; Mtch: ''; Kind: sk; TpNm: 'PPMyString10'; Flgs: []),
|
||||
|
||||
{ simple }
|
||||
|
||||
(Exp: 'ArgByte'; Mtch: ''; Kind: sk; TpNm: 'Byte'; Flgs: []),
|
||||
(Exp: 'VArgByte'; Mtch: ''; Kind: sk; TpNm: 'Byte'; Flgs: []),
|
||||
(Exp: 'ArgWord'; Mtch: ''; Kind: sk; TpNm: 'Word'; Flgs: []),
|
||||
(Exp: 'VArgWord'; Mtch: ''; Kind: sk; TpNm: 'Word'; Flgs: []),
|
||||
(Exp: 'ArgLongWord'; Mtch: ''; Kind: sk; TpNm: 'LongWord'; Flgs: []),
|
||||
(Exp: 'VArgLongWord'; Mtch: ''; Kind: sk; TpNm: 'LongWord'; Flgs: []),
|
||||
(Exp: 'ArgQWord'; Mtch: ''; Kind: sk; TpNm: 'QWord'; Flgs: []),
|
||||
(Exp: 'VArgQWord'; Mtch: ''; Kind: sk; TpNm: 'QWord'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgShortInt'; Mtch: ''; Kind: sk; TpNm: 'ShortInt'; Flgs: []),
|
||||
(Exp: 'VArgShortInt'; Mtch: ''; Kind: sk; TpNm: 'ShortInt'; Flgs: []),
|
||||
(Exp: 'ArgSmallInt'; Mtch: ''; Kind: sk; TpNm: 'SmallInt'; Flgs: []),
|
||||
(Exp: 'VArgSmallInt'; Mtch: ''; Kind: sk; TpNm: 'SmallInt'; Flgs: []),
|
||||
(Exp: 'ArgInt'; Mtch: ''; Kind: sk; TpNm: 'Integer'; Flgs: []),
|
||||
(Exp: 'VArgInt'; Mtch: ''; Kind: sk; TpNm: 'Integer'; Flgs: []),
|
||||
(Exp: 'ArgInt64'; Mtch: ''; Kind: sk; TpNm: 'Int64'; Flgs: []),
|
||||
(Exp: 'VArgInt64'; Mtch: ''; Kind: sk; TpNm: 'Int64'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgPByte'; Mtch: ''; Kind: sk; TpNm: 'PByte'; Flgs: []),
|
||||
(Exp: 'VArgPByte'; Mtch: ''; Kind: sk; TpNm: 'PByte'; Flgs: []),
|
||||
(Exp: 'ArgPWord'; Mtch: ''; Kind: sk; TpNm: 'PWord'; Flgs: []),
|
||||
(Exp: 'VArgPWord'; Mtch: ''; Kind: sk; TpNm: 'PWord'; Flgs: []),
|
||||
(Exp: 'ArgPLongWord'; Mtch: ''; Kind: sk; TpNm: 'PLongWord'; Flgs: []),
|
||||
(Exp: 'VArgPLongWord'; Mtch: ''; Kind: sk; TpNm: 'PLongWord'; Flgs: []),
|
||||
(Exp: 'ArgPQWord'; Mtch: ''; Kind: sk; TpNm: 'PQWord'; Flgs: []),
|
||||
(Exp: 'VArgPQWord'; Mtch: ''; Kind: sk; TpNm: 'PQWord'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgPShortInt'; Mtch: ''; Kind: sk; TpNm: 'PShortInt'; Flgs: []),
|
||||
(Exp: 'VArgPShortInt'; Mtch: ''; Kind: sk; TpNm: 'PShortInt'; Flgs: []),
|
||||
(Exp: 'ArgPSmallInt'; Mtch: ''; Kind: sk; TpNm: 'PSmallInt'; Flgs: []),
|
||||
(Exp: 'VArgPSmallInt'; Mtch: ''; Kind: sk; TpNm: 'PSmallInt'; Flgs: []),
|
||||
(Exp: 'ArgPInt'; Mtch: ''; Kind: sk; TpNm: 'PInteger'; Flgs: []),
|
||||
(Exp: 'VArgPInt'; Mtch: ''; Kind: sk; TpNm: 'PInteger'; Flgs: []),
|
||||
(Exp: 'ArgPInt64'; Mtch: ''; Kind: sk; TpNm: 'PInt64'; Flgs: []),
|
||||
(Exp: 'VArgPInt64'; Mtch: ''; Kind: sk; TpNm: 'PInt64'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgPointer'; Mtch: ''; Kind: sk; TpNm: 'Pointer'; Flgs: []),
|
||||
(Exp: 'VArgPointer'; Mtch: ''; Kind: sk; TpNm: 'Pointer'; Flgs: []),
|
||||
(Exp: 'ArgPPointer'; Mtch: ''; Kind: sk; TpNm: 'PPointer'; Flgs: []),
|
||||
(Exp: 'VArgPPointer'; Mtch: ''; Kind: sk; TpNm: 'PPointer'; Flgs: []),
|
||||
|
||||
(Exp: 'ArgDouble'; Mtch: ''; Kind: sk; TpNm: 'Double'; Flgs: []),
|
||||
(Exp: 'VArgDouble'; Mtch: ''; Kind: sk; TpNm: 'Double'; Flgs: []),
|
||||
(Exp: 'ArgExtended'; Mtch: ''; Kind: sk; TpNm: 'Extended'; Flgs: []),
|
||||
(Exp: 'VArgExtended'; Mtch: ''; Kind: sk; TpNm: 'Extended'; Flgs: []),
|
||||
*)
|
||||
|
||||
);
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
{ TTestWatch }
|
||||
|
||||
procedure TTestWatch.DoChanged;
|
||||
begin
|
||||
if FMaster = nil then exit;;
|
||||
if FMaster.Valid = vsValid then begin
|
||||
if FHasValue and (FValue <> FMaster.Value) then
|
||||
if FHasValue and (FValue <> FMaster.Value) then begin
|
||||
FHasMultiValue := True;
|
||||
FValue := FValue + LineEnding + FMaster.Value;
|
||||
end
|
||||
else
|
||||
FValue := FMaster.Value;
|
||||
FHasValue := True;
|
||||
FValue := FMaster.Value;
|
||||
|
||||
FTypeInfo := Master.TypeInfo;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestWatch.GetTypeInfo: TDBGType;
|
||||
begin
|
||||
Result := FTypeInfo;
|
||||
end;
|
||||
|
||||
constructor TTestWatch.Create(AOwner: TBaseWatches; AMaster: TDBGWatch);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Expression := AMaster.Expression;
|
||||
FMaster := AMaster;
|
||||
FMaster.Slave := Self;
|
||||
FMaster.Enabled := True;
|
||||
@ -92,61 +296,85 @@ end;
|
||||
|
||||
procedure TTestWatches.TestWatches;
|
||||
var FailText: String;
|
||||
procedure TestWatch(Name: String; AWatch: TTestWatch; Exp: String; StripQuotes: Boolean = False);
|
||||
|
||||
procedure TestWatch(Name: String; Data: TWatchExpectation);
|
||||
const KindName: array [TDBGSymbolKind] of string =
|
||||
('skClass', 'skRecord', 'skEnum', 'skSet', 'skProcedure', 'skFunction', 'skSimple', 'skPointer', 'skVariant');
|
||||
var
|
||||
AWatch: TTestWatch;
|
||||
rx: TRegExpr;
|
||||
s: String;
|
||||
begin
|
||||
rx := nil;
|
||||
if (fnoDwrf in Data.Flgs) and (SymbolType = stDwarf) then exit;
|
||||
if (fnoStabs in Data.Flgs) and (SymbolType = stStabs) then exit;
|
||||
|
||||
Name := Name + Data.Exp;
|
||||
AWatch := TTestWatch(FWatches.Find(Data.Exp));
|
||||
try
|
||||
AWatch.Master.Value; // trigger read
|
||||
AssertTrue (Name+ ' (HasValue)', AWatch.HasValue);
|
||||
AssertFalse (Name+ ' (One Value)', AWatch.HasMultiValue);
|
||||
|
||||
s := AWatch.Value;
|
||||
if StripQuotes and (length(s) > 1) and
|
||||
(s[1] = '''') and (s[length(s)] = '''')
|
||||
then
|
||||
s := copy(s, 2, length(s)-2);
|
||||
AssertEquals(Name+ ' (Value)', Exp, s);
|
||||
rx := TRegExpr.Create;
|
||||
rx.ModifierI := true;
|
||||
rx.Expression := Data.Mtch;
|
||||
if Data.Mtch <> ''
|
||||
then AssertTrue(Name + ' Matches "'+Data.Mtch + '", but was "' + s + '"', rx.Exec(s));
|
||||
except
|
||||
on e: Exception do
|
||||
FailText := FailText + e.Message + LineEnding;
|
||||
FailText := FailText + LineEnding + e.Message;
|
||||
end;
|
||||
try
|
||||
if Data.TpNm <> '' then begin;
|
||||
AssertTrue(Name + ' has typeinfo', AWatch.TypeInfo <> nil);
|
||||
AssertEquals(Name + ' kind', KindName[Data.Kind], KindName[AWatch.TypeInfo.Kind]);
|
||||
if fTpMtch in Data.Flgs
|
||||
then begin
|
||||
FreeAndNil(rx);
|
||||
s := AWatch.TypeInfo.TypeName;
|
||||
rx := TRegExpr.Create;
|
||||
rx.ModifierI := true;
|
||||
rx.Expression := Data.TpNm;
|
||||
AssertTrue(Name + ' TypeName matches '+Data.TpNm+' but was '+AWatch.TypeInfo.TypeName, rx.Exec(s))
|
||||
end
|
||||
else AssertEquals(Name + ' TypeName', LowerCase(Data.TpNm), LowerCase(AWatch.TypeInfo.TypeName));
|
||||
end;
|
||||
except
|
||||
on e: Exception do
|
||||
FailText := FailText + LineEnding + e.Message;
|
||||
end;
|
||||
FreeAndNil(rx);
|
||||
end;
|
||||
|
||||
var
|
||||
TestExeName: string;
|
||||
dbg: TGDBMIDebugger;
|
||||
i: Integer;
|
||||
begin
|
||||
TestCompile(AppDir + 'WatchesPrg.pas', TestExeName);
|
||||
FTestIntWatch := nil;
|
||||
|
||||
try
|
||||
FWatches := TBaseWatches.Create(TBaseWatch);
|
||||
dbg := TGDBMIDebugger.Create(DebuggerInfo.ExeName);
|
||||
//dbg.OnBreakPointHit := @DebuggerBreakPointHit;
|
||||
with dbg.BreakPoints.Add('WatchesPrg.pas', 20) do begin
|
||||
InitialEnabled := True;
|
||||
Enabled := True;
|
||||
end;
|
||||
with dbg.BreakPoints.Add('WatchesPrg.pas', 30) do begin
|
||||
|
||||
(* Add breakpoints *)
|
||||
//with dbg.BreakPoints.Add('WatchesPrg.pas', 44) do begin
|
||||
// InitialEnabled := True;
|
||||
// Enabled := True;
|
||||
//end;
|
||||
with dbg.BreakPoints.Add('WatchesPrg.pas', 395) do begin
|
||||
InitialEnabled := True;
|
||||
Enabled := True;
|
||||
end;
|
||||
|
||||
FAVal1Watch := TTestWatch.Create(FWatches, dbg.Watches.Add('AVal1'));
|
||||
FAVal2Watch := TTestWatch.Create(FWatches, dbg.Watches.Add('AVal2'));
|
||||
(* Create all watches *)
|
||||
for i := low(ExpectBrk1NoneNil) to high(ExpectBrk1NoneNil) do
|
||||
TTestWatch.Create(FWatches, dbg.Watches.Add(ExpectBrk1NoneNil[i].Exp));
|
||||
|
||||
FTestIntWatch := TTestWatch.Create(FWatches, dbg.Watches.Add('TestInt'));
|
||||
FTestShortStringWatch := TTestWatch.Create(FWatches, dbg.Watches.Add('TestShortString'));
|
||||
FTestAnsiStringWatch := TTestWatch.Create(FWatches, dbg.Watches.Add('TestAnsiString'));
|
||||
FTestPCharWatch := TTestWatch.Create(FWatches, dbg.Watches.Add('TestPChar'));
|
||||
|
||||
FArgAnsisString1 := TTestWatch.Create(FWatches, dbg.Watches.Add('ArgAnsiString1'));
|
||||
FArgAnsisString2 := TTestWatch.Create(FWatches, dbg.Watches.Add('ArgAnsiString2'));
|
||||
FArgAnsisString3 := TTestWatch.Create(FWatches, dbg.Watches.Add('ArgAnsiString3'));
|
||||
FArgChar1 := TTestWatch.Create(FWatches, dbg.Watches.Add('ArgChar1'));
|
||||
FArgChar2 := TTestWatch.Create(FWatches, dbg.Watches.Add('ArgChar2'));
|
||||
FArgChar3 := TTestWatch.Create(FWatches, dbg.Watches.Add('ArgChar3'));
|
||||
|
||||
(* Start debugging *)
|
||||
dbg.Init;
|
||||
if dbg.State = dsError then
|
||||
Fail(' Failed Init');
|
||||
@ -157,28 +385,15 @@ begin
|
||||
dbg.ShowConsole := True;
|
||||
|
||||
dbg.Run;
|
||||
// hit breakpoint
|
||||
//TestWatch('AVal1', FAVal1Watch, '10');
|
||||
TestWatch('AVal2', FAVal2Watch, '5');
|
||||
|
||||
TestWatch('TestInt', FTestIntWatch, '10');
|
||||
//TestWatch('TestShortString', FTestShortStringWatch, '3:', True);
|
||||
TestWatch('TestAnsiString', FTestAnsiStringWatch, '3: Foo', True);
|
||||
TestWatch('TestPChar', FTestPCharWatch, ': Foo', True);
|
||||
(* Hit first breakpoint: Test *)
|
||||
for i := low(ExpectBrk1NoneNil) to high(ExpectBrk1NoneNil) do
|
||||
TestWatch('Brk1 ', ExpectBrk1NoneNil[i]);
|
||||
|
||||
dbg.Run;
|
||||
// 2nd breakpoint
|
||||
TestWatch('ArgAnsiString1', FArgAnsisString1, 'abc', True);
|
||||
//TestWatch('ArgAnsiString2', FArgAnsisString2, 'def', True);
|
||||
TestWatch('ArgAnsiString3', FArgAnsisString3, 'ghi', True);
|
||||
|
||||
TestWatch('ArgChar1', FArgChar1, '88 ''X''');
|
||||
//TestWatch('ArgChar2', FArgChar2, '89 ''Y''');
|
||||
TestWatch('ArgChar3', FArgChar3, '90 ''Z''');
|
||||
|
||||
//DebugInteract(dbg);
|
||||
|
||||
|
||||
dbg.Stop;
|
||||
finally
|
||||
dbg.Free;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user