Commit 2b9a33ae by Tobias Schlüter Committed by Tobias Schlüter

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
parent 5487b6e5
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
......
...@@ -2548,7 +2548,12 @@ gfc_match_function_decl (void) ...@@ -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;
......
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
...@@ -13,7 +13,7 @@ contains ...@@ -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
......
...@@ -17,7 +17,7 @@ contains ...@@ -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
......
...@@ -13,7 +13,7 @@ program main ...@@ -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 ...@@ -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
......
...@@ -19,7 +19,7 @@ program save_1 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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
......
...@@ -20,7 +20,7 @@ program save_2 ...@@ -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 ...@@ -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 ...@@ -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 ...@@ -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
......
...@@ -38,22 +38,22 @@ function f() result(r) ...@@ -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
......
...@@ -17,12 +17,12 @@ end function d ...@@ -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 ...@@ -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
......
! { 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
...@@ -3,7 +3,7 @@ ...@@ -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
......
...@@ -6,7 +6,7 @@ program main ...@@ -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))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment