Add testcases to exercize gnatdbg.generics more

Change-Id: I1db4186640f6e32f369b639e0d119bb3320c24e6
TN: RC14-025

Author: pmderodat

testsuite/tests/matchers/array/foo.adb

@@ -0,0 +1,12 @@
+procedure Foo is
+
+   procedure Process (S : out String) is
+   begin
+      S := (S'Range => 'A');
+   end Process;
+
+   S : String (1 .. 2) := "AB";
+
+begin
+   Process (S); --  BREAK
+end Foo;

testsuite/tests/matchers/array/script.py

@@ -0,0 +1,23 @@
+import re
+
+from gnatdbg.generics import Match
+
+
+s = gdb.parse_and_eval('s')
+char_type = s.type.target()
+
+# Only arrays can match
+assert not Match.Array().match(s.type.target())
+assert Match.Array().match(s.type)
+
+# The element type must match
+assert not Match.Array(element=Match.Array()).match(s.type)
+assert Match.Array(element=Match.Char()).match(s.type)
+
+# The first bound must match
+assert not Match.Array(first=2).match(s.type)
+assert Match.Array(first=1).match(s.type)
+
+# The last bound must match
+assert not Match.Array(last=1).match(s.type)
+assert Match.Array(last=2).match(s.type)

testsuite/tests/matchers/array/test.py

@@ -0,0 +1,8 @@
+from support.build import gnatmake
+from support.gdb import GDBSession
+
+
+gnatmake('foo')
+gdb = GDBSession('foo')
+gdb.run_to(gdb.find_loc('foo.adb', 'BREAK'))
+gdb.test('source script.py', '')

testsuite/tests/matchers/array/test.yaml

@@ -0,0 +1 @@
+driver: python

testsuite/tests/matchers/debug/foo.adb

@@ -0,0 +1,10 @@
+procedure Foo is
+   type My_Record is record
+      I : Integer;
+      N : Positive;
+   end record;
+
+   R : My_Record := (1, 2);
+begin
+   R.N := R.N + R.I; -- BREAK
+end Foo;

testsuite/tests/matchers/debug/script.py

@@ -0,0 +1,11 @@
+import re
+
+from gnatdbg.generics import Match
+
+
+value = gdb.parse_and_eval('r')
+type_matcher = Match.Struct(
+    Match.Field('i'),
+    Match.Field('n', Match.TypeName(name='natural')),
+)
+assert not type_matcher.match(value.type, debug=True)

testsuite/tests/matchers/debug/test.py

@@ -0,0 +1,14 @@
+from support.build import gnatmake
+from support.gdb import GDBSession
+
+
+gnatmake('foo')
+gdb = GDBSession('foo')
+gdb.run_to(gdb.find_loc('foo.adb', 'BREAK'))
+
+gdb.test('source script.py', """\
+Debug: mismatch:
+  Struct(2 fields) <-> TYPE_CODE_STRUCT (name=foo__my_record, 2 fields)
+  Field(name=n) <-> n
+  TypeName(name=natural) <-> TYPE_CODE_RANGE\
+ (name=positive___XDLU_1__@/.*/)""")

testsuite/tests/matchers/debug/test.yaml

@@ -0,0 +1 @@
+driver: python

testsuite/tests/matchers/struct/foo.adb

@@ -0,0 +1,26 @@
+procedure Foo is
+
+   type Null_Rec is null record;
+   type Rec is record
+      I : Integer;
+   end record;
+
+   procedure Process (R : out Null_Rec) is
+   begin
+      R := (null record);
+   end Process;
+
+   procedure Process (R : out Rec) is
+   begin
+      R := (I => 1);
+   end Process;
+
+   NR : Null_Rec;
+   R  : Rec;
+   I : Integer;
+
+begin
+   Process (NR); --  BREAK
+   Process (R); --  BREAK
+   I := I + 1;
+end Foo;

testsuite/tests/matchers/struct/script.py

@@ -0,0 +1,24 @@
+import re
+
+from gnatdbg.generics import Match
+
+
+nr = gdb.parse_and_eval('nr')
+r = gdb.parse_and_eval('r')
+i = gdb.parse_and_eval('i')
+
+# Only structs can match
+assert not Match.Struct().match(i.type)
+assert Match.Struct().match(nr.type)
+
+# The number of fields must match
+assert not Match.Struct(Match.Field('i')).match(nr.type)
+assert Match.Struct(Match.Field('i')).match(r.type)
+
+# The field names must match
+assert not Match.Struct(Match.Field('o')).match(r.type)
+assert Match.Struct(Match.Field('i')).match(r.type)
+
+# The field types must match
+assert not Match.Struct(Match.Field('i', Match.Char())).match(r.type)
+assert Match.Struct(Match.Field('i', Match.Integer())).match(r.type)