gdb/testsuite/gdb.pascal/types.exp

   1 # Copyright 1994, 1995, 1997, 1998, 2007, 2008 Free Software Foundation, Inc.
   2 # Copyright 2007 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 this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 # This file was adapted from old Chill tests by Stan Shebs
  18 # (shebs@cygnus.com).
  19 # Adapted to pascal by Pierre Muller
  20
  21 if $tracelevel then {
  22         strace $tracelevel
  23 }
  24
  25 set prms_id 0
  26 set bug_id 0
  27
  28 # Set the current language to pascal.  This counts as a test.  If it
  29 # fails, then we skip the other tests.
  30
  31 proc set_lang_pascal {} {
  32     global gdb_prompt
  33
  34     if [gdb_test "set language pascal" ""] {
  35         return 0;
  36     }
  37
  38     if ![gdb_test "show language" ".* source language is \"pascal\".*"] {
  39         return 1;
  40     } else {
  41         return 0;
  42     }
  43 }
  44
  45 proc test_integer_literal_types_accepted {} {
  46     global gdb_prompt
  47
  48     # Test various decimal values.
  49     # Should be integer*4 probably.
  50     gdb_test "pt 123" "type = int"
  51 }
  52 proc test_character_literal_types_accepted {} {
  53     global gdb_prompt
  54
  55     # Test various character values.
  56
  57     gdb_test "pt 'a'" "type = char"
  58 }
  59
  60 proc test_string_literal_types_accepted {} {
  61     global gdb_prompt
  62
  63     # Test various character values.
  64
  65     setup_kfail *-*-* gdb/2326
  66     gdb_test "pt 'a simple string'" "type = string"
  67 }
  68
  69 proc test_logical_literal_types_accepted {} {
  70     global gdb_prompt
  71
  72     # Test the only possible values for a logical, TRUE and FALSE.
  73
  74     gdb_test "pt TRUE" "type = bool"
  75     gdb_test "pt FALSE" "type = bool"
  76 }
  77
  78 proc test_float_literal_types_accepted {} {
  79     global gdb_prompt
  80
  81     # Test various floating point formats
  82
  83     # this used to guess whether to look for "real*4" or
  84     # "real*8" based on a target config variable, but noone
  85     # maintained it properly.
  86
  87     gdb_test "pt .44" "type = double"
  88     gdb_test "pt 44.0" "type = double"
  89     gdb_test "pt 10e20" "type = double"
  90     gdb_test "pt 10E20" "type = double"
  91 }
  92
  93 # Start with a fresh gdb.
  94
  95 gdb_exit
  96 gdb_start
  97 gdb_reinitialize_dir $srcdir/$subdir
  98
  99 if [set_lang_pascal] then {
 100     test_integer_literal_types_accepted
 101     test_logical_literal_types_accepted
 102     test_character_literal_types_accepted
 103     test_string_literal_types_accepted
 104     test_float_literal_types_accepted
 105 } else {
 106     warning "$test_name tests suppressed." 0
 107 }