re PR fortran/45045 (Named COMMON with different size: No warning with -fwhole-file)

gcc/fortran/
2010-07-24  Tobias Burnus  <burnus@net-b.de>

        * options.c (gfc_init_options): Enable -fwhole-file by default.
        * interface.c (compare_parameter): Assume a Hollerith constant is
        compatible with all other argument types.

libgomp/
2010-07-24  Tobias Burnus  <burnus@net-b.de>

        * testsuite/libgomp.fortran/appendix-a/a.28.5.f90: Add -w to
        silence -fwhole-file warning.

gcc/testsuite/
2010-07-24  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/func_decl_4.f90: Split test into two ...
        * gfortran.dg/func_decl_5.f90: ... parts.
        * gfortran.dg/common_resize_1.f: xfail two warnings (cf. PR 45045).
        * gfortran.dg/bounds_temporaries_1.f90: Add new dg-warning.
        * gfortran.dg/global_references_1.f90: Add new dg-warning.
        * gfortran.dg/generic_actual_arg.f90: Add new dg-warning.
        * gfortran.dg/entry_17.f90: Remove no-longer needed dg-warning.
        * gfortran.dg/used_before_typed_4.f90: Add new dg-warning.
        * gfortran.dg/bounds_check_strlen_1.f90: Add new dg-warning.
        * gfortran.dg/intrinsic_std_1.f90: Split by remove tree dump ...
        * gfortran.dg/intrinsic_std_6.f90: ... and create a dump test.
        * gfortran.dg/sizeof.f90: Make test valid.
        * gfortran.dg/pr20865.f90: Add new dg-error.
        * gfortran.dg/integer_exponentiation_2.f90: Add new dg-warnings.
        * gfortran.dg/g77/19990218-0.f: Ditto.
        * gfortran.dg/g77/19990218-1.f: Ditto.
        * gfortran.dg/g77/970625-2.f: Ditto.
        * gfortran.dg/pr37243.f: Fix function declaration.
        * gfortran.dg/use_only_1.f90: Fix implicit typing.
        * gfortran.dg/loc_1.f90: Fix pointer datatype.

From-SVN: r162491

gcc/fortran/ChangeLog

+2010-07-24  Tobias Burnus  <burnus@net-b.de>
+
+	* options.c (gfc_init_options): Enable -fwhole-file by default.
+	* interface.c (compare_parameter): Assume a Hollerith constant is
+	compatible with all other argument types.
+
 2010-07-23  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/44945

gcc/fortran/interface.c

@@ -1470,6 +1470,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     }
 
   if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
+      && actual->ts.type != BT_HOLLERITH
       && !gfc_compare_types (&formal->ts, &actual->ts))
     {
       if (where)

gcc/fortran/options.c

@@ -96,7 +96,7 @@ gfc_init_options (unsigned int argc, const char **argv)
   gfc_option.flag_default_real = 0;
   gfc_option.flag_dollar_ok = 0;
   gfc_option.flag_underscoring = 1;
-  gfc_option.flag_whole_file = 0;
+  gfc_option.flag_whole_file = 1;
   gfc_option.flag_f2c = 0;
   gfc_option.flag_second_underscore = -1;
   gfc_option.flag_implicit_none = 0;

gcc/testsuite/ChangeLog

+2010-07-24  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.dg/func_decl_4.f90: Split test into two ...
+	* gfortran.dg/func_decl_5.f90: ... parts.
+	* gfortran.dg/common_resize_1.f: xfail two warnings (cf. PR 45045).
+	* gfortran.dg/bounds_temporaries_1.f90: Add new dg-warning.
+	* gfortran.dg/global_references_1.f90: Add new dg-warning.
+	* gfortran.dg/generic_actual_arg.f90: Add new dg-warning.
+	* gfortran.dg/entry_17.f90: Remove no-longer needed dg-warning.
+	* gfortran.dg/used_before_typed_4.f90: Add new dg-warning.
+	* gfortran.dg/bounds_check_strlen_1.f90: Add new dg-warning.
+	* gfortran.dg/intrinsic_std_1.f90: Split by remove tree dump ...
+	* gfortran.dg/intrinsic_std_6.f90: ... and create a dump test.
+	* gfortran.dg/sizeof.f90: Make test valid.
+	* gfortran.dg/pr20865.f90: Add new dg-error.
+	* gfortran.dg/integer_exponentiation_2.f90: Add new dg-warnings.
+	* gfortran.dg/g77/19990218-0.f: Ditto.
+	* gfortran.dg/g77/19990218-1.f: Ditto.
+	* gfortran.dg/g77/970625-2.f: Ditto.
+	* gfortran.dg/pr37243.f: Fix function declaration.
+	* gfortran.dg/use_only_1.f90: Fix implicit typing.
+	* gfortran.dg/loc_1.f90: Fix pointer datatype.
+
 2010-07-23  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/44945

gcc/testsuite/gfortran.dg/bounds_check_strlen_1.f90

@@ -12,7 +12,7 @@ END SUBROUTINE test
 
 PROGRAM main
   IMPLICIT NONE
-  CALL test ('abc') ! String is too short.
+  CALL test ('abc') ! { dg-warning "Character length of actual argument shorter" }
 END PROGRAM main
 
 ! { dg-output "shorter than the declared one for dummy argument 'str' \\(3/5\\)" }

gcc/testsuite/gfortran.dg/bounds_temporaries_1.f90

@@ -22,7 +22,7 @@ end subroutine gfcbug34
 ! This is PR25669
 subroutine foo (a)
   real a(*)
-  call bar (a, LBOUND(a),2)
+  call bar (a, LBOUND(a),2) ! { dg-warning "Rank mismatch in argument" }
 end subroutine foo
 subroutine bar (b, i, j)
   real b(i:j)

gcc/testsuite/gfortran.dg/common_resize_1.f

@@ -49,14 +49,15 @@ c
      7 vy5(lnv),vy6(lnv),vy7(lnv),vy8(lnv),
      8 vz1(lnv),vz2(lnv),vz3(lnv),vz4(lnv),
      9 vz5(lnv),vz6(lnv),vz7(lnv),vz8(lnv)
-      common/aux32/    ! { dg-warning "shall be of the same size" }
+                       ! XFAILed here and below because of PRs 45045 and 45044
+      common/aux32/    ! { dg-warning "shall be of the same size" "" { xfail *-*-*} }
      a a17(lnv),a28(lnv),dett(lnv),
      1 aj1(lnv),aj2(lnv),aj3(lnv),aj4(lnv),
      2 aj5(lnv),aj6(lnv),aj7(lnv),aj8(lnv),
      3 aj9(lnv),x17(lnv),x28(lnv),x35(lnv),
      4 x46(lnv),y17(lnv),y28(lnv),y35(lnv),
      5 y46(lnv),z17(lnv),z28(lnv),z35(lnv),z46(lnv)
-      common/aux33/    ! { dg-warning "shall be of the same size" }
+      common/aux33/    ! { dg-warning "shall be of the same size" "" { xfail *-*-*} }
      a ix1(lnv),ix2(lnv),ix3(lnv),ix4(lnv),ix5(lnv),
      1             ix6(lnv),ix7(lnv),ix8(lnv),mxt(lnv),nmel
       common/aux36/lft,llt

gcc/testsuite/gfortran.dg/entry_17.f90

@@ -24,7 +24,7 @@ function test3() ! { dg-warning "Obsolescent feature" }
   return
 entry bar3()
   bar3 = ""
-end function test3 ! { dg-warning "Obsolescent feature" }
+end function test3
 
 function test4(n) ! { dg-error "returning variables of different string lengths" }
   integer  :: n
@@ -52,4 +52,4 @@ function test6() ! { dg-warning "Obsolescent feature|returning variables of diff
   return
 entry bar6()
   bar6 = ""
-end function test6 ! { dg-warning "Obsolescent feature" }
+end function test6

gcc/testsuite/gfortran.dg/func_decl_4.f90

@@ -3,13 +3,18 @@
 !
 ! Functions shall not have an initializer.
 !
+! Due to -fwhole-file, the function declaration
+! warnings come before the init warnings; thus
+! the warning for the WRONG lines have been moved to
+! func_decl_5.f90
+!
 
-function f1()                      ! { dg-error "cannot have an initializer" }
-  integer :: f1 = 42
+function f1()
+  integer :: f1 = 42 ! WRONG, see  func_decl_5.f90
 end function
 
-function f2() RESULT (r)           ! { dg-error "cannot have an initializer" }
-  integer :: r = 42
+function f2() RESULT (r)
+  integer :: r = 42 ! WRONG, see func_decl_5.f90
 end function
 
 function f3() RESULT (f3)          ! { dg-error "must be different than function name" }

gcc/testsuite/gfortran.dg/g77/19990218-0.f

@@ -2,7 +2,7 @@ c { dg-do compile }
         program test
         double precision a,b,c
         data a,b/1.0d-46,1.0d0/
-        c=fun(a,b)
+        c=fun(a,b) ! { dg-error "Return type mismatch of function" }
         print*,'in main: fun=',c
         end
         double precision function fun(a,b)

gcc/testsuite/gfortran.dg/g77/19990218-1.f

@@ -20,6 +20,6 @@ c
         program test
         double precision a,b,c
         data a,b/1.0d-46,1.0d0/
-        c=fun(a,b)
+        c=fun(a,b) ! { dg-error "Return type mismatch of function" }
         print*,'in main: fun=',c
         end

gcc/testsuite/gfortran.dg/g77/970625-2.f

@@ -40,7 +40,7 @@
          PROGRAM = THEN - IF
          ELSE IF = THEN .GT. IF
          IF (THEN.GT.REAL) THEN
-            CALL FUNCTION PROGRAM (ELSE IF, GO TO PROGRAM, THEN)
+            CALL FUNCTION PROGRAM (ELSE IF, GO TO PROGRAM, THEN) ! { dg-warning "Type mismatch in argument" }
          ELSE IF (ELSE IF) THEN
             REAL = THEN + END DO
          END IF

gcc/testsuite/gfortran.dg/generic_actual_arg.f90

@@ -37,7 +37,7 @@ USE TEST
 USE TEST2
 CALL F(CALCULATION)  ! { dg-error "GENERIC procedure" } 
 
-CALL F(CALCULATION2) ! OK because there is a same name specific 
+CALL F(CALCULATION2) ! OK because there is a same name specific, but: ! { dg-warning "More actual than formal arguments" }
 END
 
 SUBROUTINE F()

gcc/testsuite/gfortran.dg/global_references_1.f90

@@ -32,11 +32,11 @@ function h(x)       ! { dg-error "is already being used as a FUNCTION" }
 end function h
 
 SUBROUTINE TT()
-  CHARACTER(LEN=10), EXTERNAL :: j
+  CHARACTER(LEN=10), EXTERNAL :: j ! { dg-warning "Return type mismatch" }
   CHARACTER(LEN=10)          :: T
 ! PR20881=========================================================== 
 ! Error only appears once but testsuite associates with both lines.
-  T = j () ! { dg-error "is already being used as a FUNCTION" }
+  T = j (1.0) ! { dg-error "is already being used as a SUBROUTINE" }
   print *, T
 END SUBROUTINE TT
 
@@ -78,7 +78,7 @@ end
 ! Lahey - 2636-S: "SOURCE.F90", line 81:
 ! Subroutine 'j' is previously referenced as a function in 'line 39'.
 
-SUBROUTINE j (x)    ! { dg-error "is already being used as a FUNCTION" }
+SUBROUTINE j (x)    ! { dg-error "is already being used as a SUBROUTINE" }
   integer a(10)
   common /bar/ a    ! Global entity foo
   real x

gcc/testsuite/gfortran.dg/integer_exponentiation_2.f90

@@ -139,16 +139,16 @@ subroutine foo(a)
   call gee_i(i**(-huge(0_4)))
   call gee_i(i**(-huge(0_4)-1_4))
 
-  call gee_i(i**0_8)
-  call gee_i(i**1_8)
-  call gee_i(i**2_8)
-  call gee_i(i**3_8)
-  call gee_i(i**(-1_8))
-  call gee_i(i**(-2_8))
-  call gee_i(i**(-3_8))
-  call gee_i(i**huge(0_8))
-  call gee_i(i**(-huge(0_8)))
-  call gee_i(i**(-huge(0_8)-1_8))
+  call gee_i(i**0_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**1_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**2_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**3_8) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-1_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-2_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-3_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**huge(0_8)) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-huge(0_8))) ! { dg-warning "Type mismatch in argument" }
+  call gee_i(i**(-huge(0_8)-1_8)) ! { dg-warning "Type mismatch in argument" }
 
   ! Real
   call gee_r(a**0_1)

gcc/testsuite/gfortran.dg/intrinsic_std_1.f90

 ! { dg-do compile }
-! { dg-options "-std=f95 -Wintrinsics-std -fdump-tree-original" }
+! { dg-options "-std=f95 -Wintrinsics-std" }
+
+!
+! See intrinsic_std_6.f90 for the dump check.
+!
 
 ! PR fortran/33141
 ! Check for the expected behaviour when an intrinsic function/subroutine is
@@ -32,8 +36,8 @@ END SUBROUTINE implicit_type
 
 SUBROUTINE specification_expression
   CHARACTER(KIND=selected_char_kind("ascii")) :: x
-! { dg-error "must be an intrinsic function" "" { target "*-*-*" } 34 }
-! { dg-warning "Fortran 2003" "" { target "*-*-*" } 34 }
+! { dg-error "must be an intrinsic function" "" { target "*-*-*" } 38 }
+! { dg-warning "Fortran 2003" "" { target "*-*-*" } 38 }
 END SUBROUTINE specification_expression
 
 SUBROUTINE intrinsic_decl
@@ -41,9 +45,3 @@ SUBROUTINE intrinsic_decl
   INTRINSIC :: atanh ! { dg-error "Fortran 2008" }
   INTRINSIC :: abort ! { dg-error "extension" }
 END SUBROUTINE intrinsic_decl
-
-! Scan that really external functions are called.
-! { dg-final { scan-tree-dump " abort " "original" } }
-! { dg-final { scan-tree-dump " asinh " "original" } }
-! { dg-final { scan-tree-dump " acosh " "original" } }
-! { dg-final { cleanup-tree-dump "original" } }

gcc/testsuite/gfortran.dg/loc_1.f90

@@ -17,9 +17,10 @@ subroutine fn
 end subroutine fn
 
 subroutine foo (ii)
+  use iso_c_binding, only: c_intptr_t
   common /targ/targ
   integer targ(10)
-  integer ii
+  integer(c_intptr_t) ii
   targ(2) = ii
 end subroutine foo
 

gcc/testsuite/gfortran.dg/pr20865.f90

@@ -8,5 +8,5 @@
 
   integer :: i, st
   st(i) = (i*i+2)
-  call tt(st) ! { dg-error "Statement function .* is not allowed as an actual argument" }
+  call tt(st) ! { dg-error "Statement function .* is not allowed as an actual argument|Invalid procedure argument" }
   end

gcc/testsuite/gfortran.dg/pr37243.f

@@ -53,10 +53,13 @@
       call schmd(V, 1, 18, 18)
       end
 
-      subroutine DAXPY
+      subroutine DAXPY(N,D,V,M,W,L)
+      INTEGER :: N, M, L
+      DOUBLE PRECISION D, V(1,1), W(1,1)
       end
 
-      FUNCTION DDOT ()
-      DOUBLE PRECISION DDOT
+      FUNCTION DDOT (N,V,M,W,L)
+      INTEGER :: N, M, L
+      DOUBLE PRECISION DDOT, V(1,1), W(1,1)
       DDOT = 1
       end

gcc/testsuite/gfortran.dg/sizeof.f90

@@ -82,7 +82,7 @@ subroutine check_derived ()
        call abort
 end subroutine check_derived
 
-call check_int ()
-call check_real ()
+call check_int (1)
+call check_real (1.0, (/1.0, 2.0, 3.0, 4.0, 5.0/))
 call check_derived ()
 end

gcc/testsuite/gfortran.dg/use_only_1.f90

@@ -73,6 +73,7 @@ contains
     USE xmod, ONLY: xfoobar_renamed => xfoobar
     USE ymod, ONLY: yfoobar_renamed => yfoobar
     USE ymod
+    implicit integer(4) (a-z)
     if (xfoobar_renamed (42) == xfoobar ()) call abort ()
     if (yfoobar_renamed (42) == yfoobar ()) call abort ()
   end subroutine

gcc/testsuite/gfortran.dg/used_before_typed_4.f90

@@ -22,5 +22,5 @@ END SUBROUTINE test
 PROGRAM main
   IMPLICIT NONE
   INTEGER :: arr1(42), arr2(42)
-  CALL test (3, arr1, 2, arr2)
+  CALL test (3, arr1, 2, arr2) ! { dg-warning "Type mismatch in argument" }
 END PROGRAM main

libgomp/ChangeLog

+2010-07-24  Tobias Burnus  <burnus@net-b.de>
+
+	* testsuite/libgomp.fortran/appendix-a/a.28.5.f90: Add -w to
+	silence -fwhole-file warning.
+
 2010-07-23  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 	* configure.tgt (*-*-solaris2.[56]*): Removed.

libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90

 ! { dg-do compile }
+! { dg-options "-w" }
+!
+! "-w" added as libgomp/testsuite seemingly cannot parse with
+! dg-warning Fortran's output. Fortran warns for "call sub1(a)"
+! that there is a "Rank mismatch in argument 'x'".
 
       SUBROUTINE SUB1(X)
         DIMENSION X(10)