1# Copyright 1994, 1995, 1997, 1998 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 2 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, write to the Free Software 15# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 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 23if $tracelevel then { 24 strace $tracelevel 25} 26 27set prms_id 0 28set bug_id 0 29 30# Set the current language to fortran. This counts as a test. If it 31# fails, then we skip the other tests. 32 33proc set_lang_fortran {} { 34 global gdb_prompt 35 36 if [gdb_test "set language fortran" ""] { 37 return 0; 38 } 39 40 if ![gdb_test "show language" ".* source language is \"fortran\".*"] { 41 return 1; 42 } else { 43 return 0; 44 } 45} 46 47proc test_integer_literal_types_accepted {} { 48 global gdb_prompt 49 50 # Test various decimal values. 51 # Should be integer*4 probably. 52 gdb_test "pt 123" "type = int" 53} 54 55proc test_character_literal_types_accepted {} { 56 global gdb_prompt 57 58 # Test various character values. 59 60 gdb_test "pt 'a'" "type = character\\*1" 61} 62 63proc test_integer_literal_types_rejected {} { 64 global gdb_prompt 65 66 test_print_reject "pt _" 67} 68 69proc 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 = logical\\*2" 75 gdb_test "pt .FALSE." "type = logical\\*2" 76} 77 78proc 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 = real\\*\[0-9\]+" 88 gdb_test "pt 44.0" "type = real\\*\[0-9\]+" 89 gdb_test "pt 10D20" "type = real\\*\[0-9\]+" 90 gdb_test "pt 10D20" "type = real\\*\[0-9\]+" 91 gdb_test "pt 10d20" "type = real\\*\[0-9\]+" 92 gdb_test "pt 10d20" "type = real\\*\[0-9\]+" 93 gdb_test "pt 10E20" "type = real\\*\[0-9\]+" 94 gdb_test "pt 10E20" "type = real\\*\[0-9\]+" 95 gdb_test "pt 10e20" "type = real\\*\[0-9\]+" 96 gdb_test "pt 10e20" "type = real\\*\[0-9\]+" 97} 98 99# Start with a fresh gdb. 100 101gdb_exit 102gdb_start 103gdb_reinitialize_dir $srcdir/$subdir 104 105gdb_test "set print sevenbit-strings" "" 106 107if [set_lang_fortran] then { 108 test_integer_literal_types_accepted 109 test_integer_literal_types_rejected 110 test_logical_literal_types_accepted 111 test_character_literal_types_accepted 112 test_float_literal_types_accepted 113} else { 114 warning "$test_name tests suppressed." 0 115} 116