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