Home | History | Annotate | Line # | Download | only in gdb.ada 
      1 # Copyright 2021-2024 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 
     16 load_lib "ada.exp"
     17 
     18 require allow_ada_tests
     19 
     20 standard_ada_testfile opcall
     21 
     22 if {[gdb_compile_ada "${srcfile}" "${binfile}" executable {debug}] != ""} {
     23     return -1
     24 }
     25 
     26 clean_restart ${testfile}
     27 
     28 set bp_location [gdb_get_line_number "STOP" ${testdir}/opcall.adb]
     29 runto "opcall.adb:$bp_location"
     30 
     31 gdb_test "print p" " = \\(x => 4, y => 5\\)"
     32 
     33 proc test_with_menu {command result} {
     34     global expect_out
     35 
     36     set rxcmd [string_to_regexp $command]
     37 
     38     set num {}
     39     send_gdb "$command\n"
     40     gdb_expect 30 {
     41 	-re "^$rxcmd\r\n" {
     42 	    exp_continue
     43 	}
     44 	-re "Multiple matches for \[^\r\n\]*\r\n" {
     45 	    exp_continue
     46 	}
     47 	-re "^\\\[(\[0-9\]+)\\\] twovecs\\.*\[^\r\n\]*\r\n" {
     48 	    set num $expect_out(1,string)
     49 	    exp_continue
     50 	}
     51 	-re "^\\\[\[0-9\]+\\\] \[^\r\n\]*\r\n" {
     52 	    # Any other match, we don't want.
     53 	    exp_continue
     54 	}
     55 	-re "^> " {
     56 	    if {$num == ""} {
     57 		fail $command
     58 		set num 0
     59 	    }
     60 	    send_gdb "$num\n"
     61 	    exp_continue
     62 	}
     63 	-re "^\[0-9\]+\r\n" {
     64 	    # The number we just sent, ignore.
     65 	    exp_continue
     66 	}
     67 	-re "\\\$\[0-9\]+ = (\[^\r\n\]+)\r\n" {
     68 	    if {[regexp $result $expect_out(1,string)]} {
     69 		pass $command
     70 	    } else {
     71 		fail $command
     72 	    }
     73 	}
     74 	timeout {
     75 	    fail "$command (timeout)"
     76 	}
     77     }
     78 }
     79 
     80 test_with_menu "print p + p" "\\(x => 8, y => 10\\)"
     81 test_with_menu "print p - p" "\\(x => 0, y => 0\\)"
     82 test_with_menu "print p * p" "\\(x => 16, y => 25\\)"
     83 test_with_menu "print p / p" "\\(x => 1, y => 1\\)"
     84 
     85 # See the code to understand the weird numbers here.
     86 test_with_menu "print p mod p" "\\(x => 17, y => 18\\)"
     87 test_with_menu "print p rem p" "\\(x => 38, y => 39\\)"
     88 test_with_menu "print p ** p" "\\(x => 84, y => 105\\)"
     89 
     90 test_with_menu "print p < p" "false"
     91 test_with_menu "print p < p2" "true"
     92 test_with_menu "print p <= p" "true"
     93 test_with_menu "print p <= p2" "true"
     94 test_with_menu "print p > p" "false"
     95 test_with_menu "print p2 > p" "true"
     96 test_with_menu "print p >= p" "true"
     97 test_with_menu "print p2 >= p" "true"
     98 test_with_menu "print p = p" "true"
     99 test_with_menu "print p = p2" "false"
    100 test_with_menu "print p /= p" "false"
    101 test_with_menu "print p /= p2" "true"
    102 
    103 test_with_menu "print p and p2" "\\(x => 4, y => 4\\)"
    104 test_with_menu "print p or p2" "\\(x => 12, y => 13\\)"
    105 test_with_menu "print p xor p2" "\\(x => 8, y => 9\\)"
    106 
    107 # See the code to understand the weird numbers here.
    108 test_with_menu "print p & p" "\\(x => 44, y => 55\\)"
    109 
    110 test_with_menu "print -p" "\\(x => 65532, y => 65531\\)"
    111 test_with_menu "print abs(-p)" "\\(x => 65532, y => 65531\\)"
    112 test_with_menu "print not(p)" "\\(x => 65531, y => 65530\\)"
    113 
    114 # See the code to understand the weird numbers here.
    115 test_with_menu "print +(p)" "\\(x => 5, y => 4\\)"
    116