URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
Compare Revisions
- This comparison shows the changes necessary to convert path
/openrisc/trunk/gnu-old/gdb-6.8/gdb/testsuite/gdb.pascal
- from Rev 157 to Rev 816
- ↔ Reverse comparison
Rev 157 → Rev 816
/Makefile.in
0,0 → 1,24
VPATH = @srcdir@ |
srcdir = @srcdir@ |
|
EXECUTABLES = hello/hello |
|
MISCELLANEOUS = |
|
all info install-info dvi install uninstall installcheck check: |
@echo "Nothing to be done for $@..." |
|
clean mostlyclean: |
-find . -name '*.o' -print | xargs rm -f |
-find . -name '*.ali' -print | xargs rm -f |
-find . -name 'b~*.ad[sb]' -print | xargs rm -f |
-rm -f *~ a.out xgdb *.x *.ci *.tmp |
-rm -f *~ *.o a.out xgdb *.x *.ci *.tmp |
-rm -f core core.coremaker coremaker.core corefile $(EXECUTABLES) |
-rm -f $(MISCELLANEOUS) twice-tmp.c |
|
distclean maintainer-clean realclean: clean |
-rm -f *~ core |
-rm -f Makefile config.status config.log |
-rm -f *-init.exp |
-rm -fr *.log summary detail *.plog *.sum *.psum site.* |
/types.exp
0,0 → 1,110
# Copyright 1994, 1995, 1997, 1998, 2007, 2008 Free Software Foundation, Inc. |
# Copyright 2007 Free Software Foundation, Inc. |
# |
# This program is free software; you can redistribute it and/or modify |
# it under the terms of the GNU General Public License as published by |
# the Free Software Foundation; either version 3 of the License, or |
# (at your option) any later version. |
# |
# This program is distributed in the hope that it will be useful, |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# GNU General Public License for more details. |
# |
# You should have received a copy of the GNU General Public License |
# along with this program. If not, see <http://www.gnu.org/licenses/>. |
|
# Please email any bugs, comments, and/or additions to this file to: |
# bug-gdb@prep.ai.mit.edu |
|
# This file was adapted from old Chill tests by Stan Shebs |
# (shebs@cygnus.com). |
# Adapted to pascal by Pierre Muller |
|
if $tracelevel then { |
strace $tracelevel |
} |
|
set prms_id 0 |
set bug_id 0 |
|
# Set the current language to pascal. This counts as a test. If it |
# fails, then we skip the other tests. |
|
proc set_lang_pascal {} { |
global gdb_prompt |
|
if [gdb_test "set language pascal" ""] { |
return 0; |
} |
|
if ![gdb_test "show language" ".* source language is \"pascal\".*"] { |
return 1; |
} else { |
return 0; |
} |
} |
|
proc test_integer_literal_types_accepted {} { |
global gdb_prompt |
|
# Test various decimal values. |
# Should be integer*4 probably. |
gdb_test "pt 123" "type = int" |
} |
proc test_character_literal_types_accepted {} { |
global gdb_prompt |
|
# Test various character values. |
|
gdb_test "pt 'a'" "type = char" |
} |
|
proc test_string_literal_types_accepted {} { |
global gdb_prompt |
|
# Test various character values. |
|
setup_kfail *-*-* gdb/2326 |
gdb_test "pt 'a simple string'" "type = string" |
} |
|
proc test_logical_literal_types_accepted {} { |
global gdb_prompt |
|
# Test the only possible values for a logical, TRUE and FALSE. |
|
gdb_test "pt TRUE" "type = bool" |
gdb_test "pt FALSE" "type = bool" |
} |
|
proc test_float_literal_types_accepted {} { |
global gdb_prompt |
|
# Test various floating point formats |
|
# this used to guess whether to look for "real*4" or |
# "real*8" based on a target config variable, but noone |
# maintained it properly. |
|
gdb_test "pt .44" "type = double" |
gdb_test "pt 44.0" "type = double" |
gdb_test "pt 10e20" "type = double" |
gdb_test "pt 10E20" "type = double" |
} |
|
# Start with a fresh gdb. |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
|
if [set_lang_pascal] then { |
test_integer_literal_types_accepted |
test_logical_literal_types_accepted |
test_character_literal_types_accepted |
test_string_literal_types_accepted |
test_float_literal_types_accepted |
} else { |
warning "$test_name tests suppressed." 0 |
} |
/integers.pas
0,0 → 1,51
{ |
Copyright 2008 Free Software Foundation, Inc. |
|
This program is free software; you can redistribute it and/or modify |
it under the terms of the GNU General Public License as published by |
the Free Software Foundation; either version 3 of the License, or |
(at your option) any later version. |
|
This program is distributed in the hope that it will be useful, |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
GNU General Public License for more details. |
|
You should have received a copy of the GNU General Public License |
along with this program. If not, see <http://www.gnu.org/licenses/>. |
} |
|
program integers; |
|
|
function add(a,b : integer) : integer; |
begin |
add:=a+b; |
end; |
|
function sub(a,b : integer) : integer; |
begin |
sub:=a-b; |
end; |
|
var |
i, j, k, l : integer; |
|
begin |
i := 0; |
j := 0; |
k := 0; |
l := 0; { set breakpoint 1 here } |
i := 1; |
j := 2; |
k := 3; |
l := k; |
|
i := j + k; |
|
j := 0; { set breakpoint 2 here } |
k := 0; |
l := add(i,j); |
l := sub(i,j); |
|
end. |
/floats.exp
0,0 → 1,159
# Copyright 2007, 2008 Free Software Foundation, Inc. |
# |
# This program is free software; you can redistribute it and/or modify |
# it under the terms of the GNU General Public License as published by |
# the Free Software Foundation; either version 3 of the License, or |
# (at your option) any later version. |
# |
# This program is distributed in the hope that it will be useful, |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# GNU General Public License for more details. |
# |
# You should have received a copy of the GNU General Public License |
# along with this program. If not, see <http://www.gnu.org/licenses/>. |
|
if $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "pascal.exp" |
|
set testfile "floats" |
set srcfile ${testfile}.pas |
set binfile ${objdir}/${subdir}/${testfile}$EXEEXT |
|
if {[gdb_compile_pascal "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
set bp_location1 [gdb_get_line_number "set breakpoint 1 here"] |
set bp_location2 [gdb_get_line_number "set breakpoint 2 here"] |
|
if { [gdb_breakpoint ${srcfile}:${bp_location1}] } { |
pass "setting breakpoint 1" |
} |
if { [gdb_breakpoint ${srcfile}:${bp_location2}] } { |
pass "setting breakpoint 2" |
} |
|
# Verify that "start" lands inside the right procedure. |
if { [gdb_start_cmd] < 0 } { |
untested start |
return -1 |
} |
|
gdb_test "" ".* at .*${srcfile}.*" "start" |
|
gdb_test "cont" "Breakpoint .*:${bp_location1}.*" "Going to first breakpoint" |
gdb_test "print r" ".* = 0" "Print r before assigned to 1.25" |
|
gdb_test "next" "r := 1\\.25;" "Next to 'r := 1.25' line" |
gdb_test "next" "s := 2\\.2;" "Next to 's := 2.2' line" |
gdb_test "next" "t := -3\\.2;" "Next to 't := -3.2' line" |
gdb_test "next" "u := 78\\.3;" "Next to 'u := 78.3' line" |
gdb_test "next" "l := 1;" "Next to 'l := 1' line" |
gdb_test "next" "i := 1;" "Next to 'i := 1' line" |
|
# At that point, |
# r should be equal to 1.25 |
gdb_test "print r" " = 1\\.25" |
# s should be equal to 2.2 |
gdb_test "print s" " = 2\\.(199.*|2|200.*)" |
# t should be equal to -3.2 |
gdb_test "print t" " = -3\\.(199.*|2|200.*)" |
# u should be equal to 78.3 |
gdb_test "print u" " = 78\\.(3|300.*|299.*)" |
|
# Test addition |
gdb_test "print r + s" " = 3\\.4(499.*|5|500.*)" |
gdb_test "print r + t" " = -1\\.9(499.*|5|500.*)" |
|
#Test addition with float constants |
gdb_test "print r + 1.5" " = 2\\.7(499.*|5|500.*)" |
gdb_test "print r + 0.03" " = 1\\.2(799.*|8|800.*)" |
gdb_test "print r + (-0.2)" " = 1\\.0(499|5|500.*)" |
gdb_test "print r + 1.5E+3" " = 1501\\.2(499.*|5|500.*)" |
gdb_test "print r + 1.5E+2" " = 151\\.2(499.*|5|500.*)" |
gdb_test "print r + 1.5E+1" " = 16\\.2(499|5|500.*)" |
gdb_test "print r + 1.5E+0" " = 2\\.7(499.*|5|500.*)" |
gdb_test "print r + 1.5E-1" " = 1\\.(399.*|4|400.*)" |
gdb_test "print r + 1.5E-2" " = 1\\.26(499.*|5|500.*)" |
gdb_test "print r + 1.5E-3" " = 1\\.251(499.*|5|500.*)" |
|
# Test addition with integer variables |
gdb_test "print r + l" " = 2\\.2(499.*|5|500.*)" |
gdb_test "print l + t" " = -2\\.(199.*|2|200.*)" |
|
# Test addition with integer constants |
gdb_test "print r + 10" " = 11\\.2(499.*|5|500.*)" |
gdb_test "print r + 5" " = 6\\.2(499.*|5|500.*)" |
gdb_test "print r + 1" " = 2\\.2(499.*|5|500.*)" |
gdb_test "print r + 0" " = 1\\.2(499|5|500.*)" |
gdb_test "print r + (-1)" " = 0\\.2(499.*|5|500.*)" |
gdb_test "print r + (-5)" " = -3\\.7(499.*|5|500.*)" |
gdb_test "print r + (-10)" " = -8\\.7(499.*|5|500.*)" |
|
# Test substraction |
gdb_test "print r - s" " = -0\\.9(499.*|5|500.*)" |
gdb_test "print r - t" " = 4\\.4(499.*|5|500.*)" |
|
# Test unany minus |
gdb_test "print -r" " = -1\\.2(499.*|5|500.*)" |
gdb_test "print (-r)" " = -1\\.2(499.*|5|500.*)" |
gdb_test "print -(r)" " = -1.2(499.*|5|500.*)" |
gdb_test "print -(r + s)" " = -3\\.4(499.*|5|500.*)" |
|
# Test multiplication |
gdb_test "print 2 * r" " = 2\\.(499.*|5|500.*)" |
gdb_test "print 2.0 * r" " = 2\\.(499.*|5|500.*)" |
gdb_test "print 1000*r" " = 12(49\\.99.*|50|50\\.00.*)" |
|
#Test division |
gdb_test "print r / 2" " = 0\\.62(499.*|5|500.*)" |
gdb_test "print 35 / 2" " = 17\\.(499.*|5|500.*)" |
|
# 'set r' does not work, as there are set sub-commands starting with 'r' |
# Thus we need to use 'set var r' |
gdb_test "set var r := 2.56" " := 2\\.56" |
gdb_test "print r" " = 2\\.56.*" "Testing new r value" |
|
gdb_test "cont" \ |
"Breakpoint .*:${bp_location2}.*" \ |
"Going to second breakpoint" |
gdb_test "next" "r := cos\\(u\\);" "Advance to 'r := cos(u)' line" |
gdb_test "print u" " = 3\\.14159.*" "Test pi value" |
gdb_test "next" "s := sin\\(u\\);" "Advance to 's := sin(u)' line" |
gdb_test "print r" " = -1" "Test cos(pi) is equal to -1" |
gdb_test "next" "" "Go past 's := sin(u)' line" |
|
set msg "Test sin(pi) is equal to 0" |
|
gdb_test_multiple "print s" $msg { |
-re ".* = (0|-?\[0-9\]\\.\[0-9\]*\[eE\](-?\[0-9\]*))\[\r\n\]+$gdb_prompt $" { |
set value "$expect_out(1,string)" |
verbose "value is $value" 1 |
if [info exists expect_out(2,string)] { |
set expo $expect_out(2,string) |
verbose "expo found: $expo" 1 |
} else { |
set expo "0" |
regsub ".*\[eE\]" "$value" "" expo; |
} |
regsub "^-" "$expo" "" mexpo; |
verbose "expo is $expo" 1 |
verbose "mexpo is $mexpo" 1 |
if { $value == 0 } { |
pass $msg |
} elseif {$mexpo > 8} { |
pass "$msg '$value' is close to zero" |
} else { |
fail "$msg '$value' too large" |
} |
verbose "Still here" 1 |
} |
} |
/hello.pas
0,0 → 1,15
program hello; |
|
var |
st : string; |
|
procedure print_hello; |
begin |
Writeln('Before assignment'); { set breakpoint 1 here } |
st:='Hello, world!'; |
writeln(st); {set breakpoint 2 here } |
end; |
|
begin |
print_hello; |
end. |
/floats.pas
0,0 → 1,47
{ |
Copyright 2008 Free Software Foundation, Inc. |
|
This program is free software; you can redistribute it and/or modify |
it under the terms of the GNU General Public License as published by |
the Free Software Foundation; either version 3 of the License, or |
(at your option) any later version. |
|
This program is distributed in the hope that it will be useful, |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
GNU General Public License for more details. |
|
You should have received a copy of the GNU General Public License |
along with this program. If not, see <http://www.gnu.org/licenses/>. |
} |
|
|
program floats; |
|
var |
i, j, k, l : integer; |
r, s, t, u : real; |
|
begin |
i := 0; |
j := 0; |
k := 0; |
r := 0.0; |
s := 0.0; |
t := 0.0; |
u := 0.0; |
l := 0; |
i := 1; { set breakpoint 1 here } |
r := 1.25; |
s := 2.2; |
t := -3.2; |
u := 78.3; |
l := 1; |
i := 1; |
u := pi; { set breakpoint 2 here } |
r := cos(u); |
s := sin(u); |
u := pi / 2; |
r := cos(u); |
s := sin(u); |
end. |
/integers.exp
0,0 → 1,129
# Copyright 2008 Free Software Foundation, Inc. |
# |
# This program is free software; you can redistribute it and/or modify |
# it under the terms of the GNU General Public License as published by |
# the Free Software Foundation; either version 3 of the License, or |
# (at your option) any later version. |
# |
# This program is distributed in the hope that it will be useful, |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# GNU General Public License for more details. |
# |
# You should have received a copy of the GNU General Public License |
# along with this program. If not, see <http://www.gnu.org/licenses/>. |
|
if $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "pascal.exp" |
|
set testfile "integers" |
set srcfile ${testfile}.pas |
set binfile ${objdir}/${subdir}/${testfile}$EXEEXT |
|
if {[gdb_compile_pascal "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
set bp_location1 [gdb_get_line_number "set breakpoint 1 here"] |
set bp_location2 [gdb_get_line_number "set breakpoint 2 here"] |
|
if { [gdb_breakpoint ${srcfile}:${bp_location1}] } { |
pass "setting breakpoint 1" |
} |
if { [gdb_breakpoint ${srcfile}:${bp_location2}] } { |
pass "setting breakpoint 2" |
} |
|
# Verify that "start" lands inside the right procedure. |
if { [gdb_start_cmd] < 0 } { |
untested start |
return -1 |
} |
|
gdb_test "" ".* at .*${srcfile}.*" "start" |
|
gdb_test "cont" "Breakpoint .*:${bp_location1}.*" "Going to first breakpoint" |
|
gdb_test "print i" ".* = 0" "Print i before assigned to 1" |
|
gdb_test "next" "i := 1;" "Next to 'i := 1' line" |
gdb_test "next" "j := 2;" "Next to 'j := 2' line" |
# At that point, |
# i should be equal to 1 |
gdb_test "print i" " = 1" |
# but j should still be equal to zero |
if { $pascal_compiler_is_gpc } { |
setup_xfail *-*-* |
} |
gdb_test "print j" " = 0" "Test j value before assignment" |
|
gdb_test "next" "k := 3;" "Next to 'k := 3' line" |
gdb_test "next" "l := k;" "Next to 'l := k' line" |
|
#j should be equal to 2 |
gdb_test "print j" " = 2" |
# k should be equal to 3 |
gdb_test "print k" " = 3" |
# But l shoud still be zero |
if { $pascal_compiler_is_gpc } { |
setup_xfail *-*-* |
} |
gdb_test "print l" " = 0" |
|
# Test addition |
gdb_test "print i + j" " = 3" |
gdb_test "print i + k" " = 4" |
gdb_test "print j + k" " = 5" |
gdb_test "print i + j + k" " = 6" |
|
# Test substraction |
gdb_test "print j - i" " = 1" |
gdb_test "print i - j" "= -1" |
gdb_test "print k -i -j" " = 0" |
gdb_test "print k -(i + j)" " = 0" |
|
# Test unany minus |
gdb_test "print -i" " = -1" |
gdb_test "print (-i)" " = -1" |
gdb_test "print -(i)" " = -1" |
gdb_test "print -(i+j)" " = -3" |
|
# Test boolean operators =, <>, <, <=, > and >= |
gdb_test "print i + 1 = j" " = true" |
gdb_test "print i + 1 <> j" " = false" |
gdb_test "print i + 1 < j" " = false" |
gdb_test "print i + 1 <= j" " = true" |
gdb_test "print i + 1 > j" " = false" |
gdb_test "print i + 1 >= j" " = true" |
|
# Test multiplication |
gdb_test "print 2 * i" " = 2" |
gdb_test "print j * k" " = 6" |
gdb_test "print 3000*i" " = 3000" |
|
#Test div and mod operators |
gdb_test "print 35 div 2" " = 17" |
gdb_test "print 35 mod 2" " = 1" |
|
# Test several operators together |
gdb_test "print i+10*j+100*k" " = 321" |
gdb_test " print (i + 5) * (j + 7)" " = 54" |
|
# 'set i' does not work, as there are set sub-commands starting with 'i' |
# Thus we need to use 'set var i' |
gdb_test "set var i := 2" " := 2" |
gdb_test "print i" " = 2" "Testing new i value" |
|
gdb_test "cont" \ |
"Breakpoint .*:${bp_location2}.*" \ |
"Going to second breakpoint" |
gdb_test "print i" \ |
".* = 5.*" \ |
"Value of i after assignment" |
/hello.exp
0,0 → 1,75
# Copyright 2007, 2008 Free Software Foundation, Inc. |
# |
# This program is free software; you can redistribute it and/or modify |
# it under the terms of the GNU General Public License as published by |
# the Free Software Foundation; either version 3 of the License, or |
# (at your option) any later version. |
# |
# This program is distributed in the hope that it will be useful, |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# GNU General Public License for more details. |
# |
# You should have received a copy of the GNU General Public License |
# along with this program. If not, see <http://www.gnu.org/licenses/>. |
|
if $tracelevel then { |
strace $tracelevel |
} |
|
load_lib "pascal.exp" |
|
set testfile "hello" |
set srcfile ${testfile}.pas |
set binfile ${objdir}/${subdir}/${testfile}${EXEEXT} |
|
if {[gdb_compile_pascal "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } { |
return -1 |
} |
|
gdb_exit |
gdb_start |
gdb_reinitialize_dir $srcdir/$subdir |
gdb_load ${binfile} |
set bp_location1 [gdb_get_line_number "set breakpoint 1 here"] |
set bp_location2 [gdb_get_line_number "set breakpoint 2 here"] |
|
if { [gdb_breakpoint ${srcfile}:${bp_location1}] } { |
pass "setting breakpoint 1" |
} |
if { [gdb_breakpoint ${srcfile}:${bp_location2}] } { |
pass "setting breakpoint 2" |
} |
|
# Verify that "start" lands inside the right procedure. |
if { [gdb_start_cmd] < 0 } { |
untested start |
return -1 |
} |
|
# This test fails for gpc |
# because debug information for 'main' |
# is in some <implicit code> |
gdb_test "" \ |
".* at .*hello.pas.*" \ |
"start" |
|
gdb_test "cont" \ |
"Breakpoint .*:${bp_location1}.*" \ |
"Going to first breakpoint" |
gdb_test "print st" \ |
".* = ''.*" \ |
"Empty string check" |
|
# This test also fails for gpc because the program |
# stops after the string has been written |
# while it should stop before writing it |
if { $pascal_compiler_is_gpc } { |
setup_xfail *-*-* |
} |
gdb_test "cont" \ |
"Breakpoint .*:${bp_location2}.*" \ |
"Going to second breakpoint" |
gdb_test "print st" \ |
".* = 'Hello, world!'.*" \ |
"String after assignment check" |