PR fortran/50515
* resolve.c (resolve_common_blocks): Check for EXTERNAL attribute.
PR fortran/50517
* interface.c (gfc_compare_interfaces): Bugfix in check for result type.
2011-09-26 Janus Weil <janus@gcc.gnu.org>
PR fortran/50515
* gfortran.dg/common_15.f90: New.
PR fortran/50517
* gfortran.dg/dummy_procedure_5.f90: New.
* gfortran.dg/interface_26.f90: Modified error message.
* gfortran.dg/proc_ptr_11.f90: Ditto.
* gfortran.dg/proc_ptr_15.f90: Ditto.
* gfortran.dg/proc_ptr_comp_20.f90: Ditto.
* gfortran.dg/proc_ptr_result_5.f90: Ditto.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179213
138bc75d-0d04-0410-961f-
82ee72b054a4
+2011-09-26 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50515
+ * resolve.c (resolve_common_blocks): Check for EXTERNAL attribute.
+
+ PR fortran/50517
+ * interface.c (gfc_compare_interfaces): Bugfix in check for result type.
+
2011-09-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/41733
{
if (s1->attr.function && s2->attr.function)
{
- /* If both are functions, check type and kind. */
+ /* If both are functions, check result type. */
if (s1->ts.type == BT_UNKNOWN)
return 1;
- if ((s1->ts.type != s2->ts.type) || (s1->ts.kind != s2->ts.kind))
+ if (!compare_type_rank (s1,s2))
{
if (errmsg != NULL)
- snprintf (errmsg, err_len, "Type/kind mismatch in return value "
+ snprintf (errmsg, err_len, "Type/rank mismatch in return value "
"of '%s'", name2);
return 0;
}
gfc_error ("COMMON block '%s' at %L is used as PARAMETER at %L",
sym->name, &common_root->n.common->where, &sym->declared_at);
+ if (sym->attr.external)
+ gfc_error ("COMMON block '%s' at %L can not have the EXTERNAL attribute",
+ sym->name, &common_root->n.common->where);
+
if (sym->attr.intrinsic)
gfc_error ("COMMON block '%s' at %L is also an intrinsic procedure",
sym->name, &common_root->n.common->where);
+2011-09-26 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50515
+ * gfortran.dg/common_15.f90: New.
+
+ PR fortran/50517
+ * gfortran.dg/dummy_procedure_5.f90: New.
+ * gfortran.dg/interface_26.f90: Modified error message.
+ * gfortran.dg/proc_ptr_11.f90: Ditto.
+ * gfortran.dg/proc_ptr_15.f90: Ditto.
+ * gfortran.dg/proc_ptr_comp_20.f90: Ditto.
+ * gfortran.dg/proc_ptr_result_5.f90: Ditto.
+
2011-09-26 Jason Merrill <jason@redhat.com>
PR c++/50512
--- /dev/null
+! { dg-do compile }
+!
+! PR 50515: gfortran should not accept an external that is a common (r178939)
+!
+! Contributed by Vittorio Zecca <zeccav@gmail.com>
+
+common/sub/ a ! { dg-error "can not have the EXTERNAL attribute" }
+external sub
+end
--- /dev/null
+! { dg-do compile }
+!
+! PR 50517: gfortran must detect that actual argument type is different from dummy argument type (r178939)
+!
+! Contributed by Vittorio Zecca <zeccav@gmail.com>
+
+program main
+
+ type t
+ integer g
+ end type
+
+ type u
+ integer g
+ end type
+
+ type(u), external :: ufunc
+ call sub(ufunc) ! { dg-error "Type/rank mismatch in return value" }
+
+contains
+
+ subroutine sub(tfunc)
+ type(t), external :: tfunc
+ end subroutine
+
+end program
END INTERFACE
INTEGER, EXTERNAL :: UserOp
- res = UserFunction( a,b, UserOp ) ! { dg-error "Type/kind mismatch in return value" }
+ res = UserFunction( a,b, UserOp ) ! { dg-error "Type/rank mismatch in return value" }
if( res .lt. 10 ) then
res = recSum( a, res, UserFunction, UserOp )
p2 => p1
p1 => p2
- p1 => abs ! { dg-error "Type/kind mismatch in return value" }
- p2 => abs ! { dg-error "Type/kind mismatch in return value" }
+ p1 => abs ! { dg-error "Type/rank mismatch in return value" }
+ p2 => abs ! { dg-error "Type/rank mismatch in return value" }
p3 => dsin
- p3 => sin ! { dg-error "Type/kind mismatch in return value" }
+ p3 => sin ! { dg-error "Type/rank mismatch in return value" }
contains
p6 => p1
! invalid
-p1 => iabs ! { dg-error "Type/kind mismatch in return value" }
-p1 => p2 ! { dg-error "Type/kind mismatch in return value" }
-p1 => p5 ! { dg-error "Type/kind mismatch in return value" }
-p6 => iabs ! { dg-error "Type/kind mismatch in return value" }
+p1 => iabs ! { dg-error "Type/rank mismatch in return value" }
+p1 => p2 ! { dg-error "Type/rank mismatch in return value" }
+p1 => p5 ! { dg-error "Type/rank mismatch in return value" }
+p6 => iabs ! { dg-error "Type/rank mismatch in return value" }
p4 => p2 ! { dg-error "is not a subroutine" }
contains
procedure(logical),pointer :: pp1
procedure(complex),pointer :: pp2
-pp1 => pp2 ! { dg-error "Type/kind mismatch" }
-pp2 => o2%ppc ! { dg-error "Type/kind mismatch" }
+pp1 => pp2 ! { dg-error "Type/rank mismatch" }
+pp2 => o2%ppc ! { dg-error "Type/rank mismatch" }
-o1%ppc => pp1 ! { dg-error "Type/kind mismatch" }
-o1%ppc => o2%ppc ! { dg-error "Type/kind mismatch" }
+o1%ppc => pp1 ! { dg-error "Type/rank mismatch" }
+o1%ppc => o2%ppc ! { dg-error "Type/rank mismatch" }
contains
program test
procedure(real), pointer :: p
- p => f() ! { dg-error "Type/kind mismatch in return value" }
+ p => f() ! { dg-error "Type/rank mismatch in return value" }
contains
function f()
pointer :: f