2012-01-31 Tobias Burnus <burnus@net-b.de>
PR fortran/52024
* module.c (MOD_VERSION): Bump.
(mio_typebound_proc): Read/write is_operator from/to the
.mod file.
2012-01-31 Tobias Burnus <burnus@net-b.de>
PR fortran/52024
* gfortran.dg/typebound_operator_14.f90: New.
===================================================================
@@ -74,21 +74,21 @@ along with GCC; see the file COPYING3.
#include "parse.h" /* FIXME */
#include "md5.h"
#include "constructor.h"
#include "cpp.h"
#include "tree.h"
#define MODULE_EXTENSION ".mod"
/* Don't put any single quote (') in MOD_VERSION,
if yout want it to be recognized. */
-#define MOD_VERSION "8"
+#define MOD_VERSION "9"
/* Structure that describes a position within a module file. */
typedef struct
{
int column, line;
fpos_t pos;
}
module_locus;
@@ -3571,36 +3571,44 @@ mio_typebound_proc (gfc_typebound_proc**
mio_pool_string (&((*proc)->pass_arg));
flag = (int) (*proc)->pass_arg_num;
mio_integer (&flag);
(*proc)->pass_arg_num = (unsigned) flag;
if ((*proc)->is_generic)
{
gfc_tbp_generic* g;
+ int iop;
mio_lparen ();
if (iomode == IO_OUTPUT)
for (g = (*proc)->u.generic; g; g = g->next)
- mio_allocated_string (g->specific_st->name);
+ {
+ iop = (int) g->is_operator;
+ mio_integer (&iop);
+ mio_allocated_string (g->specific_st->name);
+ }
else
{
(*proc)->u.generic = NULL;
while (peek_atom () != ATOM_RPAREN)
{
gfc_symtree** sym_root;
g = gfc_get_tbp_generic ();
g->specific = NULL;
+ mio_integer (&iop);
+ g->is_operator = (bool) iop;
+
require_atom (ATOM_STRING);
sym_root = ¤t_f2k_derived->tb_sym_root;
g->specific_st = gfc_get_tbp_symtree (sym_root, atom_string);
free (atom_string);
g->next = (*proc)->u.generic;
(*proc)->u.generic = g;
}
}
===================================================================
@@ -0,0 +1,46 @@
+! { dg-do compile }
+!
+! PR fortran/52024
+!
+! Contributed by Dominique d'Humieres
+!
+! FIXME: The following test case is valid but it is currently rejected.
+!
+! The test case was segfaulting before
+!
+
+module m_sort
+ implicit none
+ type, abstract :: sort_t
+ contains
+ generic :: operator(.gt.) => gt_cmp
+ procedure :: gt_cmp
+ end type sort_t
+contains
+ logical function gt_cmp(a,b)
+ class(sort_t), intent(in) :: a, b
+ gt_cmp = .true.
+ end function gt_cmp
+end module
+
+module test
+ use m_sort
+ implicit none
+ type, extends(sort_t) :: sort_int_t
+ integer :: i
+ contains ! FIXME: The following is actually not true:
+ generic :: operator(.gt.) => gt_cmp_int ! { dg-error "are ambiguous" }
+ procedure :: gt_cmp_int
+ end type
+contains
+ logical function gt_cmp_int(a,b) result(cmp)
+ class(sort_int_t), intent(in) :: a, b
+ if (a%i > b%i) then
+ cmp = .true.
+ else
+ cmp = .false.
+ end if
+ end function gt_cmp_int
+end module
+
+! { dg-final { cleanup-tree-dump "m_sort test" } }