OpenCores
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 827 to Rev 840
    ↔ Reverse comparison
  •

Rev 827 → Rev 840

/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"

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.