* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@109451
138bc75d-0d04-0410-961f-
82ee72b054a4
+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>
PR fortran/22146
m = gfc_match_formal_arglist (sym, 0, 0);
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)
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>
PR fortran/22146
end do
end subroutine test
- function f
+ function f ()
integer, dimension (10) :: f
integer :: i
forall (i = 1:10) f (i) = i * 100
end do
end subroutine test
- function f1
+ function f1 ()
integer, dimension (n) :: f1
integer :: i
forall (i = 1:n) f1 (i) = i * 100
call indirect (100)
contains
- function f1
+ function f1 ()
character (len = 30) :: f1
f1 = ''
end function f1
f2 = ''
end function f2
- function f3
+ function f3 ()
character (len = 30), pointer :: f3
f3 => string
end function f3
end do
end program save_1
-integer function foo1
+integer function foo1 ()
integer j
save
save ! { dg-warning "Blanket SAVE" }
foo1 = j
end function foo1
-integer function foo2
+integer function foo2 ()
integer j
save j
save j ! { dg-warning "Duplicate SAVE" }
foo2 = j
end function foo2
-integer function foo3
+integer function foo3 ()
integer j ! { dg-warning "Duplicate SAVE" }
save
save j ! { dg-warning "SAVE statement" }
foo3 = j
end function foo3
-integer function foo4
+integer function foo4 ()
integer j ! { dg-warning "Duplicate SAVE" }
save j
save
end do
end program save_2
-integer function foo1
+integer function foo1 ()
integer j
save
save ! { dg-error "Blanket SAVE" }
foo1 = j
end function foo1
-integer function foo2
+integer function foo2 ()
integer j
save j
save j ! { dg-error "Duplicate SAVE" }
foo2 = j
end function foo2
-integer function foo3
+integer function foo3 ()
integer j
save
save j ! { dg-error "SAVE statement" }
foo3 = j
end function foo3
-integer function foo4
+integer function foo4 ()
integer j ! { dg-error "Duplicate SAVE" }
save j
save
end function f
interface
- function c
+ function c ()
complex, pointer :: c
end function c
end interface
interface
- function d
+ function d()
complex, pointer :: d
end function d
end interface
interface
- function e result(r)
+ function e () result(r)
complex, pointer :: r
end function e
end interface
interface
- function f result(r)
+ function f () result(r)
complex, pointer :: r
end function f
end interface
subroutine test_without_result
interface
- function c
+ function c ()
complex :: c(5)
end function c
end interface
interface
- function d
+ function d ()
complex :: d(5)
end function d
end interface
subroutine test_with_result
interface
- function c result(r)
+ function c () result(r)
complex :: r(5)
end function c
end interface
interface
- function d result(r)
+ function d () result(r)
complex :: r(5)
end function d
end interface
--- /dev/null
+! { 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
program testch
if (ch().ne."hello ") call abort()
contains
- function ch result(str)
+ function ch () result(str)
character(len = 10) :: str
str ="hello"
end function ch
if (.not. associated (x)) call abort
if (size (x) .ne. 10) call abort
contains
- function test
+ function test()
real, dimension (:), pointer :: test
if (associated (x)) call abort
allocate (test (10))