gdb/testsuite/gdb.testsuite/foreach_with_prefix.exp

   1 # Copyright 2019-2022 Free Software Foundation, Inc.
   2 # This program is free software; you can redistribute it and/or modify
   3 # it under the terms of the GNU General Public License as published by
   4 # the Free Software Foundation; either version 3 of the License, or
   5 # (at your option) any later version.
   6 #
   7 # This program is distributed in the hope that it will be useful,
   8 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   9 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10 # GNU General Public License for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License
  13 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14
  15 # Testsuite self-tests for foreach_with_prefix.
  16
  17 # Check that SEQVAR and EXPECTED_SEQ hold the same sequence.
  18 proc check_sequence {seqvar expected_seq} {
  19     verbose -log "\"$seqvar\" eq \"$expected_seq\"?"
  20
  21     set test "sequence matches"
  22     if {$seqvar eq $expected_seq} {
  23         pass $test
  24     } else {
  25         fail $test
  26     }
  27 }
  28
  29 # Test TCL_OK (0).
  30 with_test_prefix "ok" {
  31     set seq ""
  32     foreach_with_prefix var1 {0 1} {
  33         foreach_with_prefix var2 {0 1} {
  34             lappend seq $var1 $var2
  35         }
  36     }
  37
  38     check_sequence $seq "0 0 0 1 1 0 1 1"
  39 }
  40
  41 # Test TCL_ERROR (1).
  42 with_test_prefix "error" {
  43     catch {
  44         set seq ""
  45         foreach_with_prefix var1 {0 1} {
  46             foreach_with_prefix var2 {0 1} {
  47                 lappend seq $var1 $var2
  48                 error $seq
  49             }
  50         }
  51         return "unreachable"
  52     } seq
  53
  54     check_sequence $seq "0 0"
  55 }
  56
  57 # Test TCL_RETURN (2).
  58 with_test_prefix "return" {
  59     proc test_return {} {
  60         set seq ""
  61         foreach_with_prefix var1 {0 1} {
  62             foreach_with_prefix var2 {0 1} {
  63                 lappend seq $var1 $var2
  64                 return $seq
  65             }
  66         }
  67         return $seq
  68     }
  69
  70     set seq [test_return]
  71     check_sequence $seq "0 0"
  72 }
  73
  74 # Test TCL_BREAK (3).
  75 with_test_prefix "break" {
  76     set seq ""
  77     foreach_with_prefix var1 {0 1} {
  78         foreach_with_prefix var2 {0 1} {
  79             lappend seq $var1 $var2
  80             break
  81         }
  82     }
  83
  84     check_sequence $seq "0 0 1 0"
  85 }
  86
  87 # Test TCL_CONTINUE (4).
  88 with_test_prefix "continue" {
  89     set seq ""
  90     foreach_with_prefix var1 {0 1} {
  91         foreach_with_prefix var2 {0 1} {
  92             lappend seq $var1 $var2
  93             continue
  94         }
  95     }
  96
  97     check_sequence $seq "0 0 0 1 1 0 1 1"
  98 }