DBG: Tests for environment

git-svn-id: trunk@36910 -

.gitattributes

@@ -3071,6 +3071,7 @@ debugger/registersdlg.pp svneol=native#text/pascal
 debugger/sshgdbmidebugger.pas svneol=native#text/pascal
 debugger/test/Gdbmi/RunGdbmi.lpi svneol=native#text/xml
 debugger/test/Gdbmi/RunGdbmi.lpr svneol=native#text/pascal
+debugger/test/Gdbmi/TestApps/EnvPrg.pas svneol=native#text/pascal
 debugger/test/Gdbmi/TestApps/ExceptPrg.pas svneol=native#text/pascal
 debugger/test/Gdbmi/TestApps/WatchesPrg.pas svneol=native#text/pascal
 debugger/test/Gdbmi/TestApps/WatchesPrgArray.inc svneol=native#text/pascal
@@ -3091,6 +3092,7 @@ debugger/test/Gdbmi/rungdbmiform.pas svneol=native#text/pascal
 debugger/test/Gdbmi/testbase.pas svneol=native#text/pascal
 debugger/test/Gdbmi/testbreakpoint.pas svneol=native#text/pascal
 debugger/test/Gdbmi/testdisass.pas svneol=native#text/pascal
+debugger/test/Gdbmi/testenvironment.pas svneol=native#text/pascal
 debugger/test/Gdbmi/testexception.pas svneol=native#text/pascal
 debugger/test/Gdbmi/testgdbmicontrol.lfm svneol=native#text/plain
 debugger/test/Gdbmi/testgdbmicontrol.pas svneol=native#text/pascal

debugger/test/Gdbmi/TestApps/EnvPrg.pas

@@ -0,0 +1,13 @@
+program EnvPrg;
+
+uses sysutils;
+
+var
+  s: String;
+begin
+  s := GetEnvironmentVariable('ETEST1');
+  if s = 'ab123c' then
+    writeln(1)
+  else
+    writeln(2);
+end.

debugger/test/Gdbmi/TestGdbmi.lpi

@@ -31,7 +31,7 @@
     <RequiredPackages Count="5">
       <Item1>
         <PackageName Value="LCLBase"/>
-        <MinVersion Major="1" Valid="True" Release="1"/>
+        <MinVersion Major="1" Release="1" Valid="True"/>
       </Item1>
       <Item2>
         <PackageName Value="ide"/>
@@ -46,7 +46,7 @@
         <PackageName Value="FCL"/>
       </Item5>
     </RequiredPackages>
-    <Units Count="10">
+    <Units Count="11">
       <Unit0>
         <Filename Value="TestGdbmi.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -97,10 +97,15 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TestDisAss"/>
       </Unit9>
+      <Unit10>
+        <Filename Value="testenvironment.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestEnvironment"/>
+      </Unit10>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <PathDelim Value="\"/>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
@@ -116,8 +121,7 @@
     </CodeGeneration>
     <Linking>
       <Debugging>
-        <GenerateDebugInfo Value="True"/>
-        <DebugInfoType Value="dsDwarf2"/>
+        <DebugInfoType Value="dsDwarf2Set"/>
         <UseHeaptrc Value="True"/>
       </Debugging>
     </Linking>

debugger/test/Gdbmi/TestGdbmi.lpr

@@ -6,7 +6,7 @@ uses
   Interfaces, Forms, GuiTestRunner, CompileHelpers,
   TestGdbType, TestDisAss,
   TestGDBMIControl,
-  TestBase, TestException, Testwatches, TestBreakPoint;
+  TestBase, TestException, Testwatches, TestBreakPoint, TestEnvironment;
 
 {$R *.res}
 

debugger/test/Gdbmi/testenvironment.pas

@@ -0,0 +1,113 @@
+unit TestEnvironment;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  SysUtils, fpcunit, testutils, testregistry, TestGDBMIControl,
+  TestBase, Debugger, GDBMIDebugger, LCLProc, TestWatches;
+
+const
+  BREAK_LINE_ENV1 = 10;
+  BREAK_LINE_ENV2 = 12;
+
+type
+
+  { TTestEnvironment }
+
+  TTestEnvironment = class(TGDBTestCase)
+  private
+    FCurLine: Integer;
+  protected
+    procedure DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
+  published
+    procedure TestEnv;
+  end;
+
+implementation
+
+{ TTestEnvironment }
+
+procedure TTestEnvironment.DoCurrent(Sender: TObject; const ALocation: TDBGLocationRec);
+begin
+  FCurLine := ALocation.SrcLine;
+end;
+
+procedure TTestEnvironment.TestEnv;
+var
+  dbg: TGDBMIDebugger;
+  TestExeName, s: string;
+  IgnoreRes: String;
+begin
+  if SkipTest then exit;
+  if not TestControlForm.CheckListBox1.Checked[TestControlForm.CheckListBox1.Items.IndexOf('TTestEnvironment')] then exit;
+
+  ClearTestErrors;
+  TestCompile(AppDir + 'EnvPrg.pas', TestExeName);
+
+  IgnoreRes := '';
+  {$IFDEF Windows}
+  if (DebuggerInfo.Version > 060600) and
+     (DebuggerInfo.Version < 070400)
+  then
+    IgnoreRes := 'broken gdb';
+  {$ENDIF}
+
+  s := 'env value 1';
+  try
+    dbg := StartGDB(AppDir, TestExeName);
+    dbg.OnCurrent  := @DoCurrent;
+    dbg.Environment.Add('ETEST1=ab123c');
+    with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV1) do begin
+      InitialEnabled := True;
+      Enabled := True;
+    end;
+    with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV2) do begin
+      InitialEnabled := True;
+      Enabled := True;
+    end;
+
+    dbg.Run;
+
+    TestTrue(s+' not in error state', dbg.State <> dsError, 0);
+	TestTrue(s+' at break', FCurLine = BREAK_LINE_ENV1, 0, IgnoreRes);
+  finally
+    dbg.Done;
+    CleanGdb;
+    dbg.Free;
+  end;
+
+  s := 'env value 2';
+  try
+    dbg := StartGDB(AppDir, TestExeName);
+    dbg.OnCurrent  := @DoCurrent;
+    dbg.Environment.Add('ETEST1=xxx');
+    with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV1) do begin
+      InitialEnabled := True;
+      Enabled := True;
+    end;
+    with dbg.BreakPoints.Add('EnvPrg.pas', BREAK_LINE_ENV2) do begin
+      InitialEnabled := True;
+      Enabled := True;
+    end;
+
+    dbg.Run;
+
+    TestTrue(s+' not in error state', dbg.State <> dsError, 0);
+	TestTrue(s+' at break', FCurLine = BREAK_LINE_ENV2, 0);
+  finally
+    dbg.Done;
+    CleanGdb;
+    dbg.Free;
+  end;
+
+
+  AssertTestErrors;
+end;
+
+initialization
+  RegisterDbgTest(TTestEnvironment);
+
+end.
+

debugger/test/Gdbmi/testgdbmicontrol.pas

@@ -86,6 +86,8 @@ begin
   CheckListBox1.Checked[j] := True;
   j := CheckListBox1.Items.Add('    TTestBreakPoint.BadInterrupt.All');
   CheckListBox1.Checked[j] := False;
+  j := CheckListBox1.Items.Add('TTestEnvironment');
+  CheckListBox1.Checked[j] := True;
 
   d := GetDebuggers;
   for i := 0 to d.Count - 1 do begin