2007-07-03 Tobias Burnus <burnus@net-b.de>

	PR fortran/30940
	* interface.c (get_sym_storage_size): New function.
	(get_sym_storage_size): New function.
	(compare_actual_formal): Enhance sequence association
	support and improve checking.

2007-07-03  Tobias Burnus  <burnus@net-b.de>

	PR fortran/30940
	* gfortran.dg/argument_checking_1.f90: New.
	* gfortran.dg/argument_checking_2.f90: New.
	* gfortran.dg/argument_checking_3.f90: New.
	* gfortran.dg/argument_checking_4.f90: New.
	* gfortran.dg/argument_checking_5.f90: New.
	* gfortran.fortran-torture/execute/st_function_1.f90: Add dg-warning.
	* gfortran.fortran-torture/execute/st_function.f90: Add dg-warning.



git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@126271 138bc75d-0d04-0410-961f-82ee72b054a4

9 files changed, 178 insertions, 9 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 92a17bcc6fc..934a38b656e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2007-07-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30940
+	* gfortran.dg/argument_checking_1.f90: New.
+	* gfortran.dg/argument_checking_2.f90: New.
+	* gfortran.dg/argument_checking_3.f90: New.
+	* gfortran.dg/argument_checking_4.f90: New.
+	* gfortran.dg/argument_checking_5.f90: New.
+	* gfortran.fortran-torture/execute/st_function_1.f90: Add dg-warning.
+	* gfortran.fortran-torture/execute/st_function.f90: Add dg-warning.
+
 2007-07-03  Uros Bizjak  <ubizjak@gmail.com>
 
 	* gcc.dg/pr32176.c: Add -w to default dg-options.
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_1.f90 b/gcc/testsuite/gfortran.dg/argument_checking_1.f90
new file mode 100644
index 00000000000..b42047ae624
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_1.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR fortran/30940
+program main
+  implicit none
+  character(len=10) :: digit_string = '123456789', str
+  character :: digit_arr(10)
+  call copy(digit_string, digit_arr)
+  call copy(digit_arr,str)
+  if(str /= '123456789') call abort()
+  digit_string = 'qwertasdf'
+  call copy2(digit_string, digit_arr)
+  call copy2(digit_arr,str)
+  if(str /= 'qwertasdf') call abort()
+  digit_string = '1qayxsw23e'
+  call copy3("1qayxsw23e", digit_arr)
+  call copy3(digit_arr,str)
+  if(str /= '1qayxsw23e') call abort()
+contains
+  subroutine copy(in, out)
+    character, dimension(*)  :: in
+    character, dimension(10) :: out
+    out = in(:10)
+  end subroutine copy
+  subroutine copy2(in, out)
+    character, dimension(2,*)  :: in
+    character, dimension(2,5) :: out
+    out(1:2,1:5) = in(1:2,1:5)
+  end subroutine copy2
+  subroutine copy3(in, out)
+    character(len=2), dimension(5)  :: in
+    character(len=2), dimension(5) :: out
+    out = in
+  end subroutine copy3
+end program main
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_2.f90 b/gcc/testsuite/gfortran.dg/argument_checking_2.f90
new file mode 100644
index 00000000000..ba1dd633a47
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_2.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/30940
+program main
+  implicit none
+  character(len=10) :: digit_string = '123456789', str
+  character :: digit_arr(10)
+  call copy(digit_string, digit_arr)  ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'in'" }
+  call copy(digit_arr,str)            ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'out'" }
+  if(str /= '123456789') call abort()
+  digit_string = 'qwertasdf'
+  call copy2(digit_string, digit_arr) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'in'" }
+  call copy2(digit_arr,str) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'out'" }
+  if(str /= 'qwertasdf') call abort()
+  digit_string = '1qayxsw23e'
+  call copy('1qayxsw23e', digit_arr) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'in'" }
+  call copy(digit_arr,str) ! { dg-error "Scalar CHARACTER actual argument with array dummy argument 'out'" }
+  if(str /= '1qayxsw23e') call abort()
+contains
+  subroutine copy(in, out)
+    character, dimension(*)  :: in
+    character, dimension(10) :: out
+    out = in(:10)
+  end subroutine copy
+  subroutine copy2(in, out)
+    character, dimension(2,*)  :: in
+    character, dimension(2,5) :: out
+    out(1:2,1:5) = in(1:2,1:5)
+  end subroutine copy2
+end program main
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_3.f90 b/gcc/testsuite/gfortran.dg/argument_checking_3.f90
new file mode 100644
index 00000000000..e59a039564b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_3.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/30940
+program test
+implicit none
+interface
+  subroutine foo(a)
+     character(len=1),dimension(:) :: a
+  end subroutine foo
+  subroutine bar(a)
+     character(len=1),dimension(:,:) :: a
+  end subroutine bar
+  subroutine foobar(a)
+     character(len=1),dimension(4) :: a
+  end subroutine foobar
+  subroutine arr(a)
+     character(len=1),dimension(1,2,1,2) :: a
+  end subroutine arr
+end interface
+  character(len=2) :: len2
+  character(len=4) :: len4
+  len2 = '12'
+  len4 = '1234'
+
+  call foo(len2) ! { dg-warning "Type/rank mismatch in argument" }
+  call foo("ca") ! { dg-warning "Type/rank mismatch in argument" }
+  call bar("ca") ! { dg-warning "Type/rank mismatch in argument" }
+  call foobar(len2) ! { dg-warning "contains too few elements" }
+  call foobar(len4)
+  call foobar("bar") ! { dg-warning "contains too few elements" }
+  call foobar("bar33")
+  call arr(len2) ! { dg-warning "contains too few elements" }
+  call arr(len4)
+  call arr("bar") ! { dg-warning "contains too few elements" }
+  call arr("bar33")
+end program test
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_4.f90 b/gcc/testsuite/gfortran.dg/argument_checking_4.f90
new file mode 100644
index 00000000000..a2a56e8dd80
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_4.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! PR fortran/30940
+program test
+implicit none
+interface
+  subroutine foobar(a)
+     character(len=1),dimension(4) :: a
+  end subroutine foobar
+  subroutine arr(a)
+     character(len=1),dimension(1,2,1,2) :: a
+  end subroutine arr
+end interface
+
+  call foobar( [ "bar" ]) ! { dg-warning "contains too few elements" }
+  call foobar( ["ba ","r33"])
+  call arr( [ "bar" ]) ! { dg-warning "contains too few elements" }
+  call arr( reshape(["b","a","r","3"], [2,2]))
+  call arr( reshape(["b","a"], [1,2])) ! { dg-warning "contains too few elements" }
+  call arr( reshape(["b","a"], [2,1])) ! { dg-warning "contains too few elements" }
+end program test
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_5.f90 b/gcc/testsuite/gfortran.dg/argument_checking_5.f90
new file mode 100644
index 00000000000..35a80a06554
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_5.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR fortran/30940
+program test
+implicit none
+interface
+  subroutine foobar(x)
+     integer,dimension(4) :: x
+  end subroutine foobar
+  subroutine arr(y)
+     integer,dimension(1,2,1,2) :: y
+  end subroutine arr
+end interface
+
+integer a(3), b(5)
+call foobar(a) ! { dg-warning "contains too few elements" }
+call foobar(b)
+call foobar(b(1:3)) ! { dg-warning "contains too few elements" }
+call foobar(b(1:5))
+call foobar(b(1:5:2)) ! { dg-warning "contains too few elements" }
+call foobar(b(2))
+call foobar(b(3)) ! TODO: contains too few elements
+call foobar(reshape(a(1:3),[2,1])) ! { dg-warning "contains too few elements" }
+call foobar(reshape(b(2:5),[2,2]))
+
+call arr(a) ! { dg-warning "contains too few elements" }
+call arr(b)
+call arr(b(1:3)) ! { dg-warning "contains too few elements" }
+call arr(b(1:5))
+call arr(b(1:5:2)) ! { dg-warning "contains too few elements" }
+call arr(b(2))
+call arr(b(3)) ! TODO: contains too few elements
+call arr(reshape(a(1:3),[2,1])) ! { dg-warning "contains too few elements" }
+call arr(reshape(b(2:5),[2,2]))
+end program test
diff --git a/gcc/testsuite/gfortran.dg/char_length_3.f90 b/gcc/testsuite/gfortran.dg/char_length_3.f90
index cee55f65f21..97f7fb4c076 100644
--- a/gcc/testsuite/gfortran.dg/char_length_3.f90
+++ b/gcc/testsuite/gfortran.dg/char_length_3.f90
@@ -14,25 +14,25 @@
            character(len=10), allocatable :: alloc1(:)
            character(len=20), allocatable :: alloc2(:)
            character(len=30), allocatable :: alloc3(:)
-           call foo(v) ! { dg-error "actual argument shorter than of dummy" }
-           call foo(x) ! { dg-error "actual argument shorter than of dummy" }
+           call foo(v) ! { dg-warning "actual argument shorter than of dummy" }
+           call foo(x) ! { dg-warning "actual argument shorter than of dummy" }
            call foo(y)
            call foo(z)
            ptr1 => x
-           call foo(ptr1) ! { dg-error "actual argument shorter than of dummy" }
-           call bar(ptr1) ! { dg-error "actual argument shorter than of dummy" }
+           call foo(ptr1) ! { dg-warning "actual argument shorter than of dummy" }
+           call bar(ptr1) ! { dg-warning "Character length mismatch" }
            ptr2 => y
            call foo(ptr2)
            call bar(ptr2)
            ptr3 => z
            call foo(ptr3)
-           call bar(ptr3) ! { dg-error "Character length mismatch" }
+           call bar(ptr3) ! { dg-warning "Character length mismatch" }
            allocate(alloc1(1))
            allocate(alloc2(1))
            allocate(alloc3(1))
-           call arr(alloc1) ! { dg-error "actual argument shorter than of dummy" }
+           call arr(alloc1) ! { dg-warning "Character length mismatch" }
            call arr(alloc2)
-           call arr(alloc3) ! { dg-error "Character length mismatch" }
+           call arr(alloc3) ! { dg-warning "Character length mismatch" }
         contains
         subroutine foo(y)
            character(len=20) :: y
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/st_function.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/st_function.f90
index 8bde9b2f740..e8788025ad8 100644
--- a/gcc/testsuite/gfortran.fortran-torture/execute/st_function.f90
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/st_function.f90
@@ -33,7 +33,7 @@ contains
       st5 (s1, s2) = s1 // s2
 
       if (st4 (1, 4) .ne. "0123" ) call abort
-      if (st5 ("01", "02") .ne. "01  02    ") call abort
+      if (st5 ("01", "02") .ne. "01  02    ") call abort ! { dg-warning "Character length of actual argument shorter" }
    end subroutine
 
    subroutine with_derived_type_dummy
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/st_function_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/st_function_1.f90
index 0387a5f71c7..b851a942e3d 100644
--- a/gcc/testsuite/gfortran.fortran-torture/execute/st_function_1.f90
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/st_function_1.f90
@@ -8,7 +8,7 @@ program st_function_1
   bar(p) = p // "World"
   
   ! Expression longer than function, actual arg shorter than dummy.
-  call check (foo("Hello"), "Hello Wo")
+  call check (foo("Hello"), "Hello Wo") ! { dg-warning "Character length of actual argument shorter" }
 
   ! Expression shorter than function, actual arg longer than dummy.
   ! Result shorter than type