operator_call.exp 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
  1. # Copyright 2021-2022 Free Software Foundation, Inc.
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 3 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. load_lib "ada.exp"
  16. if { [skip_ada_tests] } { return -1 }
  17. standard_ada_testfile opcall
  18. if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
  19. return -1
  20. }
  21. clean_restart ${testfile}
  22. set bp_location [gdb_get_line_number "STOP" ${testdir}/opcall.adb]
  23. runto "opcall.adb:$bp_location"
  24. gdb_test "print p" " = \\(x => 4, y => 5\\)"
  25. proc test_with_menu {command result} {
  26. global expect_out
  27. set rxcmd [string_to_regexp $command]
  28. set num {}
  29. send_gdb "$command\n"
  30. gdb_expect 30 {
  31. -re "^$rxcmd\r\n" {
  32. exp_continue
  33. }
  34. -re "Multiple matches for \[^\r\n\]*\r\n" {
  35. exp_continue
  36. }
  37. -re "^\\\[(\[0-9\]+)\\\] twovecs\\.*\[^\r\n\]*\r\n" {
  38. set num $expect_out(1,string)
  39. exp_continue
  40. }
  41. -re "^\\\[\[0-9\]+\\\] \[^\r\n\]*\r\n" {
  42. # Any other match, we don't want.
  43. exp_continue
  44. }
  45. -re "^> " {
  46. if {$num == ""} {
  47. fail $command
  48. set num 0
  49. }
  50. send_gdb "$num\n"
  51. exp_continue
  52. }
  53. -re "^\[0-9\]+\r\n" {
  54. # The number we just sent, ignore.
  55. exp_continue
  56. }
  57. -re "\\\$\[0-9\]+ = (\[^\r\n\]+)\r\n" {
  58. if {[regexp $result $expect_out(1,string)]} {
  59. pass $command
  60. } else {
  61. fail $command
  62. }
  63. }
  64. timeout {
  65. fail "$command (timeout)"
  66. }
  67. }
  68. }
  69. test_with_menu "print p + p" "\\(x => 8, y => 10\\)"
  70. test_with_menu "print p - p" "\\(x => 0, y => 0\\)"
  71. test_with_menu "print p * p" "\\(x => 16, y => 25\\)"
  72. test_with_menu "print p / p" "\\(x => 1, y => 1\\)"
  73. # See the code to understand the weird numbers here.
  74. test_with_menu "print p mod p" "\\(x => 17, y => 18\\)"
  75. test_with_menu "print p rem p" "\\(x => 38, y => 39\\)"
  76. test_with_menu "print p ** p" "\\(x => 84, y => 105\\)"
  77. test_with_menu "print p < p" "false"
  78. test_with_menu "print p < p2" "true"
  79. test_with_menu "print p <= p" "true"
  80. test_with_menu "print p <= p2" "true"
  81. test_with_menu "print p > p" "false"
  82. test_with_menu "print p2 > p" "true"
  83. test_with_menu "print p >= p" "true"
  84. test_with_menu "print p2 >= p" "true"
  85. test_with_menu "print p = p" "true"
  86. test_with_menu "print p = p2" "false"
  87. test_with_menu "print p /= p" "false"
  88. test_with_menu "print p /= p2" "true"
  89. test_with_menu "print p and p2" "\\(x => 4, y => 4\\)"
  90. test_with_menu "print p or p2" "\\(x => 12, y => 13\\)"
  91. test_with_menu "print p xor p2" "\\(x => 8, y => 9\\)"
  92. # See the code to understand the weird numbers here.
  93. test_with_menu "print p & p" "\\(x => 44, y => 55\\)"
  94. test_with_menu "print -p" "\\(x => 65532, y => 65531\\)"
  95. test_with_menu "print abs(-p)" "\\(x => 65532, y => 65531\\)"
  96. test_with_menu "print not(p)" "\\(x => 65531, y => 65530\\)"
  97. # See the code to understand the weird numbers here.
  98. test_with_menu "print +(p)" "\\(x => 5, y => 4\\)"