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