OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (gfc_match_function_decl): Correctly error out in case of omitted function argument list. 

fortran/
* decl.c (gfc_match_function_decl): Correctly error out in case of
omitted function argument list.
testsuite/
* gfortran.dg/func_decl_1.f90: New.
* gfortran.dg/array_alloc_1.f90: Fix wrong function declaration.
* gfortran.dg/array_alloc_2.f90: Likewise.
* gfortran.dg/char_result_8.f90: Likewise.
* gfortran.dg/dup_save_1.f90: Likewise.
* gfortran.dg/dup_save_2.f90: Likewise.
* gfortran.dg/f2c_6.f90: Likewise.
* gfortran.dg/f2c_7.f90: Likewise.
* gfortran.dg/func_result_2.f90: Likewise.
* gfortran.fortran-torture/execute/pr23373-2.f90: Likewise.

From-SVN: r109451
This commit is contained in:
Tobias Schlüter 2006-01-07 17:30:53 +01:00 committed by Tobias Schlüter
parent 5487b6e597
commit 2b9a33aeea
13 changed files with 72 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2005-01-07 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
* decl.c (gfc_match_function_decl): Correctly error out in case of
omitted function argument list.
2006-01-07 Paul Thomas <pault@gcc.gnu.org> 2006-01-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/22146 PR fortran/22146

7
gcc/fortran/decl.c
View File

@ -2548,7 +2548,12 @@ gfc_match_function_decl (void)
m = gfc_match_formal_arglist (sym, 0, 0); m = gfc_match_formal_arglist (sym, 0, 0);
if (m == MATCH_NO) if (m == MATCH_NO)
gfc_error ("Expected formal argument list in function definition at %C"); {
gfc_error ("Expected formal argument list in function "
"definition at %C");
m = MATCH_ERROR;
goto cleanup;
}
else if (m == MATCH_ERROR) else if (m == MATCH_ERROR)
goto cleanup; goto cleanup;

13
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,16 @@
2005-01-07 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.dg/func_decl_1.f90: New.
* gfortran.dg/array_alloc_1.f90: Fix wrong function declaration.
* gfortran.dg/array_alloc_2.f90: Likewise.
* gfortran.dg/char_result_8.f90: Likewise.
* gfortran.dg/dup_save_1.f90: Likewise.
* gfortran.dg/dup_save_2.f90: Likewise.
* gfortran.dg/f2c_6.f90: Likewise.
* gfortran.dg/f2c_7.f90: Likewise.
* gfortran.dg/func_result_2.f90: Likewise.
* gfortran.fortran-torture/execute/pr23373-2.f90: Likewise.
2006-01-07 Paul Thomas <pault@gcc.gnu.org> 2006-01-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/22146 PR fortran/22146

2
gcc/testsuite/gfortran.dg/array_alloc_1.f90
View File

@ -13,7 +13,7 @@ contains
end do end do
end subroutine test end subroutine test
function f function f ()
integer, dimension (10) :: f integer, dimension (10) :: f
integer :: i integer :: i
forall (i = 1:10) f (i) = i * 100 forall (i = 1:10) f (i) = i * 100

2
gcc/testsuite/gfortran.dg/array_alloc_2.f90
View File

@ -17,7 +17,7 @@ contains
end do end do
end subroutine test end subroutine test
function f1 function f1 ()
integer, dimension (n) :: f1 integer, dimension (n) :: f1
integer :: i integer :: i
forall (i = 1:n) f1 (i) = i * 100 forall (i = 1:n) f1 (i) = i * 100

4
gcc/testsuite/gfortran.dg/char_result_8.f90
View File

@ -13,7 +13,7 @@ program main
call indirect (100) call indirect (100)
contains contains
function f1 function f1 ()
character (len = 30) :: f1 character (len = 30) :: f1
f1 = '' f1 = ''
end function f1 end function f1
@ -24,7 +24,7 @@ contains
f2 = '' f2 = ''
end function f2 end function f2
function f3 function f3 ()
character (len = 30), pointer :: f3 character (len = 30), pointer :: f3
f3 => string f3 => string
end function f3 end function f3

8
gcc/testsuite/gfortran.dg/dup_save_1.f90
View File

@ -19,7 +19,7 @@ program save_1
end do end do
end program save_1 end program save_1
integer function foo1 integer function foo1 ()
integer j integer j
save save
save ! { dg-warning "Blanket SAVE" } save ! { dg-warning "Blanket SAVE" }
@ -28,7 +28,7 @@ integer function foo1
foo1 = j foo1 = j
end function foo1 end function foo1
integer function foo2 integer function foo2 ()
integer j integer j
save j save j
save j ! { dg-warning "Duplicate SAVE" } save j ! { dg-warning "Duplicate SAVE" }
@ -37,7 +37,7 @@ integer function foo2
foo2 = j foo2 = j
end function foo2 end function foo2
integer function foo3 integer function foo3 ()
integer j ! { dg-warning "Duplicate SAVE" } integer j ! { dg-warning "Duplicate SAVE" }
save save
save j ! { dg-warning "SAVE statement" } save j ! { dg-warning "SAVE statement" }
@ -46,7 +46,7 @@ integer function foo3
foo3 = j foo3 = j
end function foo3 end function foo3
integer function foo4 integer function foo4 ()
integer j ! { dg-warning "Duplicate SAVE" } integer j ! { dg-warning "Duplicate SAVE" }
save j save j
save save

8
gcc/testsuite/gfortran.dg/dup_save_2.f90
View File

@ -20,7 +20,7 @@ program save_2
end do end do
end program save_2 end program save_2
integer function foo1 integer function foo1 ()
integer j integer j
save save
save ! { dg-error "Blanket SAVE" } save ! { dg-error "Blanket SAVE" }
@ -29,7 +29,7 @@ integer function foo1
foo1 = j foo1 = j
end function foo1 end function foo1
integer function foo2 integer function foo2 ()
integer j integer j
save j save j
save j ! { dg-error "Duplicate SAVE" } save j ! { dg-error "Duplicate SAVE" }
@ -38,7 +38,7 @@ integer function foo2
foo2 = j foo2 = j
end function foo2 end function foo2
integer function foo3 integer function foo3 ()
integer j integer j
save save
save j ! { dg-error "SAVE statement" } save j ! { dg-error "SAVE statement" }
@ -47,7 +47,7 @@ integer function foo3
foo3 = j foo3 = j
end function foo3 end function foo3
integer function foo4 integer function foo4 ()
integer j ! { dg-error "Duplicate SAVE" } integer j ! { dg-error "Duplicate SAVE" }
save j save j
save save

8
gcc/testsuite/gfortran.dg/f2c_6.f90
View File

@ -38,22 +38,22 @@ function f() result(r)
end function f end function f
interface interface
function c function c ()
complex, pointer :: c complex, pointer :: c
end function c end function c
end interface end interface
interface interface
function d function d()
complex, pointer :: d complex, pointer :: d
end function d end function d
end interface end interface
interface interface
function e result(r) function e () result(r)
complex, pointer :: r complex, pointer :: r
end function e end function e
end interface end interface
interface interface
function f result(r) function f () result(r)
complex, pointer :: r complex, pointer :: r
end function f end function f
end interface end interface

8
gcc/testsuite/gfortran.dg/f2c_7.f90
View File

@ -17,12 +17,12 @@ end function d
subroutine test_without_result subroutine test_without_result
interface interface
function c function c ()
complex :: c(5) complex :: c(5)
end function c end function c
end interface end interface
interface interface
function d function d ()
complex :: d(5) complex :: d(5)
end function d end function d
end interface end interface
@ -35,12 +35,12 @@ end subroutine test_without_result
subroutine test_with_result subroutine test_with_result
interface interface
function c result(r) function c () result(r)
complex :: r(5) complex :: r(5)
end function c end function c
end interface end interface
interface interface
function d result(r) function d () result(r)
complex :: r(5) complex :: r(5)
end function d end function d
end interface end interface

26
gcc/testsuite/gfortran.dg/func_decl_1.f90 Normal file
View File

@ -0,0 +1,26 @@
! { dg-do compile }
! we didn't correctly reject function declarations without argument lists
! note that there are no end statements for syntactically wrong function
! declarations
interface
function f1 ! { dg-error "Expected formal argument list" }
function f3()
end function f3
function f4 result (x) ! { dg-error "Expected formal argument list" }
function f5() result (x)
end function f5
end interface
f1 = 1.
end
FUNCTION f1 ! { dg-error "Expected formal argument list" }
function f2()
f2 = 1.
end function f2
function f3 result (x) ! { dg-error "Expected formal argument list" }
function f4 () result (x)
x = 4.
end function f4

2
gcc/testsuite/gfortran.dg/func_result_2.f90
View File

@ -3,7 +3,7 @@
program testch program testch
if (ch().ne."hello ") call abort() if (ch().ne."hello ") call abort()
contains contains
function ch result(str) function ch () result(str)
character(len = 10) :: str character(len = 10) :: str
str ="hello" str ="hello"
end function ch end function ch

2
gcc/testsuite/gfortran.fortran-torture/execute/pr23373-2.f90
View File

@ -6,7 +6,7 @@ program main
if (.not. associated (x)) call abort if (.not. associated (x)) call abort
if (size (x) .ne. 10) call abort if (size (x) .ne. 10) call abort
contains contains
function test function test()
real, dimension (:), pointer :: test real, dimension (:), pointer :: test
if (associated (x)) call abort if (associated (x)) call abort
allocate (test (10)) allocate (test (10))