gcc/testsuite/lib/scantree.exp

   1 #   Copyright (C) 2000, 2002, 2003, 2005, 2006, 2007
   2 #   Free Software Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 3 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with GCC; see the file COPYING3.  If not see
  16 # <http://www.gnu.org/licenses/>.
  17
  18 # Various utilities for scanning tree dump output, used by gcc-dg.exp and
  19 # g++-dg.exp.
  20
  21 load_lib scandump.exp
  22
  23 # Utility for scanning compiler result, invoked via dg-final.
  24 # Call pass if pattern is present, otherwise fail.
  25 #
  26 # Argument 0 is the regexp to match
  27 # Argument 1 is the name of the dumped tree pass
  28 # Argument 2 handles expected failures and the like
  29 proc scan-tree-dump { args } {
  30
  31     if { [llength $args] < 2 } {
  32         error "scan-tree-dump: too few arguments"
  33         return
  34     }
  35     if { [llength $args] > 3 } {
  36         error "scan-tree-dump: too many arguments"
  37         return
  38     }
  39     if { [llength $args] >= 3 } {
  40         scan-dump "tree" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" [lindex $args 2]
  41     } else {
  42         scan-dump "tree" [lindex $args 0] "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]"
  43     }
  44 }
  45
  46 # Call pass if pattern is present given number of times, otherwise fail.
  47 # Argument 0 is the regexp to match
  48 # Argument 1 is number of times the regexp must be found
  49 # Argument 2 is the name of the dumped tree pass
  50 # Argument 3 handles expected failures and the like
  51 proc scan-tree-dump-times { args } {
  52
  53     if { [llength $args] < 3 } {
  54         error "scan-tree-dump: too few arguments"
  55         return
  56     }
  57     if { [llength $args] > 4 } {
  58         error "scan-tree-dump: too many arguments"
  59         return
  60     }
  61     if { [llength $args] >= 4 } {
  62         scan-dump-times "tree" [lindex $args 0] [lindex $args 1] \
  63                         "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 2]" [lindex $args 3]
  64     } else {
  65         scan-dump-times "tree" [lindex $args 0] [lindex $args 1] \
  66                         "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 2]"
  67     }
  68 }
  69
  70 # Call pass if pattern is not present, otherwise fail.
  71 #
  72 # Argument 0 is the regexp to match
  73 # Argument 1 is the name of the dumped tree pass
  74 # Argument 2 handles expected failures and the like
  75 proc scan-tree-dump-not { args } {
  76
  77     if { [llength $args] < 2 } {
  78         error "scan-tree-dump-not: too few arguments"
  79         return
  80     }
  81     if { [llength $args] > 3 } {
  82         error "scan-tree-dump-not: too many arguments"
  83         return
  84     }
  85     if { [llength $args] >= 3 } {
  86         scan-dump-not "tree" [lindex $args 0] \
  87                       "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" [lindex $args 2]
  88     } else {
  89         scan-dump-not "tree" [lindex $args 0] \
  90                       "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]"
  91     }
  92 }
  93
  94 # Utility for scanning demangled compiler result, invoked via dg-final.
  95 # Call pass if pattern is present, otherwise fail.
  96 #
  97 # Argument 0 is the regexp to match
  98 # Argument 1 is the name of the dumped tree pass
  99 # Argument 2 handles expected failures and the like
 100 proc scan-tree-dump-dem { args } {
 101
 102     if { [llength $args] < 2 } {
 103         error "scan-tree-dump-dem: too few arguments"
 104         return
 105     }
 106     if { [llength $args] > 3 } {
 107         error "scan-tree-dump-dem: too many arguments"
 108         return
 109     }
 110     if { [llength $args] >= 3 } {
 111         scan-dump-dem "tree" [lindex $args 0] \
 112                       "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" [lindex $args 2]
 113     } else {
 114         scan-dump-dem "tree" [lindex $args 0] \
 115                       "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]"
 116     }
 117 }
 118
 119 # Call pass if demangled pattern is not present, otherwise fail.
 120 #
 121 # Argument 0 is the regexp to match
 122 # Argument 1 is the name of the dumped tree pass
 123 # Argument 2 handles expected failures and the like
 124 proc scan-tree-dump-dem-not { args } {
 125
 126     if { [llength $args] < 2 } {
 127         error "scan-tree-dump-dem-not: too few arguments"
 128         return
 129     }
 130     if { [llength $args] > 3 } {
 131         error "scan-tree-dump-dem-not: too many arguments"
 132         return
 133     }
 134     if { [llength $args] >= 3 } {
 135         scan-dump-dem-not "tree" [lindex $args 0] \
 136                           "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" \
 137                           [lindex $args 2]
 138     } else {
 139         scan-dump-dem-not "tree" [lindex $args 0] \
 140                           "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]"
 141     }
 142 }