This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
> So, I'd say EXTENDS_TYPE_OF is basically done. I will check if there > are any details missing, and then move on to CLASS IS. Before I start with CLASS IS, I'd like to get this patch into the branch. The attached version regtests fine and provides all functionality for EXTENDS_TYPE_OF, AFAICS. Is it ok if I commit to the branch? Cheers, Janus 2009-11-04 Janus Weil <janus@gcc.gnu.org> * intrinsic.h (gfc_resolve_extends_type_of): Add prototype * intrinsic.c (add_functions): Use 'gfc_resolve_extends_type_of'. * iresolve.c (gfc_resolve_extends_type_of): New function, which replaces the call to EXTENDS_TYPE_OF by the library function 'is_extension_of' and modifies the arguments. * trans-intrinsic.c (gfc_conv_extends_type_of): Removed. (gfc_conv_intrinsic_function): FOR EXTENDS_TYPE_OF, don't call gfc_conv_extends_type_of but gfc_conv_intrinsic_funcall. 2009-11-04 Janus Weil <janusw@gcc.gnu.org> * gfortran.map: Add _gfortran_is_extension_of. * Makefile.am: Add intrinsics/extends_type_of.c. * Makefile.in: Regenerated. * intrinsics/extends_type_of.c: New file. 2009-11-04 Janus Weil <janusw@gcc.gnu.org> * gfortran.dg/extends_type_of_1.f03: New test. * gfortran.dg/same_type_as_1.f03: Extended.
Index: gcc/testsuite/gfortran.dg/same_type_as_1.f03 =================================================================== --- gcc/testsuite/gfortran.dg/same_type_as_1.f03 (revision 153893) +++ gcc/testsuite/gfortran.dg/same_type_as_1.f03 (working copy) @@ -1,6 +1,6 @@ ! { dg-do compile } ! -! Error checking for the intrinsic function SAME_TYPE_AS. +! Error checking for the intrinsic functions SAME_TYPE_AS and EXTENDS_TYPE_OF. ! ! Contributed by Janus Weil <janus@gcc.gnu.org> @@ -18,7 +18,10 @@ integer :: i - print *, SAME_TYPE_AS (l,x1) ! { dg-error "must be of a derived type" } + print *, SAME_TYPE_AS (i,x1) ! { dg-error "must be of a derived type" } print *, SAME_TYPE_AS (x1,x2) ! { dg-error "must be of an extensible type" } + print *, EXTENDS_TYPE_OF (i,x1) ! { dg-error "must be of a derived type" } + print *, EXTENDS_TYPE_OF (x1,x2) ! { dg-error "must be of an extensible type" } + end Index: gcc/fortran/intrinsic.c =================================================================== --- gcc/fortran/intrinsic.c (revision 153893) +++ gcc/fortran/intrinsic.c (working copy) @@ -1601,7 +1601,7 @@ add_functions (void) add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003, - gfc_check_same_type_as, NULL, NULL, + gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of, a, BT_UNKNOWN, 0, REQUIRED, mo, BT_UNKNOWN, 0, REQUIRED); Index: gcc/fortran/intrinsic.h =================================================================== --- gcc/fortran/intrinsic.h (revision 153893) +++ gcc/fortran/intrinsic.h (working copy) @@ -390,6 +390,7 @@ void gfc_resolve_eoshift (gfc_expr *, gfc_expr *, void gfc_resolve_etime_sub (gfc_code *); void gfc_resolve_exp (gfc_expr *, gfc_expr *); void gfc_resolve_exponent (gfc_expr *, gfc_expr *); +void gfc_resolve_extends_type_of (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_fdate (gfc_expr *); void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_fnum (gfc_expr *, gfc_expr *); Index: gcc/fortran/iresolve.c =================================================================== --- gcc/fortran/iresolve.c (revision 153893) +++ gcc/fortran/iresolve.c (working copy) @@ -806,7 +806,58 @@ gfc_resolve_exponent (gfc_expr *f, gfc_expr *x) } +/* Resolve the EXTENDS_TYPE_OF intrinsic function. */ + void +gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) +{ + gfc_symbol *vtab; + gfc_symtree *st; + + /* Prevent double resolution. */ + if (f->ts.type == BT_LOGICAL) + return; + + /* Replace the first argument with the corresponding vtab. */ + if (a->ts.type == BT_CLASS) + gfc_add_component_ref (a, "$vptr"); + else if (a->ts.type == BT_DERIVED) + { + vtab = gfc_find_derived_vtab (a->ts.u.derived); + /* Clear the old expr. */ + gfc_free_ref_list (a->ref); + memset (a, '\0', sizeof (gfc_expr)); + /* Construct a new one. */ + a->expr_type = EXPR_VARIABLE; + st = gfc_find_symtree (vtab->ns->sym_root, vtab->name); + a->symtree = st; + a->ts = vtab->ts; + } + + /* Replace the second argument with the corresponding vtab. */ + if (mo->ts.type == BT_CLASS) + gfc_add_component_ref (mo, "$vptr"); + else if (mo->ts.type == BT_DERIVED) + { + vtab = gfc_find_derived_vtab (mo->ts.u.derived); + /* Clear the old expr. */ + gfc_free_ref_list (mo->ref); + memset (mo, '\0', sizeof (gfc_expr)); + /* Construct a new one. */ + mo->expr_type = EXPR_VARIABLE; + st = gfc_find_symtree (vtab->ns->sym_root, vtab->name); + mo->symtree = st; + mo->ts = vtab->ts; + } + + f->ts.type = BT_LOGICAL; + f->ts.kind = gfc_default_logical_kind; + /* Call library function. */ + f->value.function.name = gfc_get_string (PREFIX ("is_extension_of")); +} + + +void gfc_resolve_fdate (gfc_expr *f) { f->ts.type = BT_CHARACTER; Index: gcc/fortran/trans-intrinsic.c =================================================================== --- gcc/fortran/trans-intrinsic.c (revision 153893) +++ gcc/fortran/trans-intrinsic.c (working copy) @@ -4745,21 +4745,6 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) } -/* Generate code for the EXTENDS_TYPE_OF intrinsic. */ - -static void -gfc_conv_extends_type_of (gfc_se *se, gfc_expr *expr) -{ - gfc_expr *e; - /* TODO: Implement EXTENDS_TYPE_OF. */ - gfc_error ("Intrinsic EXTENDS_TYPE_OF at %L not yet implemented", - &expr->where); - /* Just return 'false' for now. */ - e = gfc_logical_expr (false, &expr->where); - gfc_conv_expr (se, e); -} - - /* Generate code for SELECTED_CHAR_KIND (NAME) intrinsic function. */ static void @@ -5172,10 +5157,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr gfc_conv_same_type_as (se, expr); break; - case GFC_ISYM_EXTENDS_TYPE_OF: - gfc_conv_extends_type_of (se, expr); - break; - case GFC_ISYM_ABS: gfc_conv_intrinsic_abs (se, expr); break; @@ -5553,6 +5534,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr case GFC_ISYM_CHMOD: case GFC_ISYM_DTIME: case GFC_ISYM_ETIME: + case GFC_ISYM_EXTENDS_TYPE_OF: case GFC_ISYM_FGET: case GFC_ISYM_FGETC: case GFC_ISYM_FNUM: Index: libgfortran/Makefile.in =================================================================== --- libgfortran/Makefile.in (revision 153893) +++ libgfortran/Makefile.in (working copy) @@ -433,15 +433,15 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrac intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \ intrinsics/eoshift0.c intrinsics/eoshift2.c \ intrinsics/erfc_scaled.c intrinsics/etime.c intrinsics/exit.c \ - intrinsics/fnum.c intrinsics/gerror.c intrinsics/getcwd.c \ - intrinsics/getlog.c intrinsics/getXid.c intrinsics/hostnm.c \ - intrinsics/ierrno.c intrinsics/ishftc.c \ - intrinsics/iso_c_generated_procs.c intrinsics/iso_c_binding.c \ - intrinsics/kill.c intrinsics/link.c intrinsics/malloc.c \ - intrinsics/mvbits.c intrinsics/move_alloc.c \ - intrinsics/pack_generic.c intrinsics/perror.c \ - intrinsics/selected_char_kind.c intrinsics/signal.c \ - intrinsics/size.c intrinsics/sleep.c \ + intrinsics/extends_type_of.c intrinsics/fnum.c \ + intrinsics/gerror.c intrinsics/getcwd.c intrinsics/getlog.c \ + intrinsics/getXid.c intrinsics/hostnm.c intrinsics/ierrno.c \ + intrinsics/ishftc.c intrinsics/iso_c_generated_procs.c \ + intrinsics/iso_c_binding.c intrinsics/kill.c intrinsics/link.c \ + intrinsics/malloc.c intrinsics/mvbits.c \ + intrinsics/move_alloc.c intrinsics/pack_generic.c \ + intrinsics/perror.c intrinsics/selected_char_kind.c \ + intrinsics/signal.c intrinsics/size.c intrinsics/sleep.c \ intrinsics/spread_generic.c intrinsics/string_intrinsics.c \ intrinsics/system.c intrinsics/rand.c intrinsics/random.c \ intrinsics/rename.c intrinsics/reshape_generic.c \ @@ -725,15 +725,16 @@ am__objects_36 = associated.lo abort.lo access.lo bit_intrinsics.lo c99_functions.lo chdir.lo chmod.lo clock.lo \ cpu_time.lo cshift0.lo ctime.lo date_and_time.lo dtime.lo \ env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \ - fnum.lo gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo \ - ierrno.lo ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo \ - kill.lo link.lo malloc.lo mvbits.lo move_alloc.lo \ - pack_generic.lo perror.lo selected_char_kind.lo signal.lo \ - size.lo sleep.lo spread_generic.lo string_intrinsics.lo \ - system.lo rand.lo random.lo rename.lo reshape_generic.lo \ - reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \ - stat.lo symlnk.lo system_clock.lo time.lo transpose_generic.lo \ - umask.lo unlink.lo unpack_generic.lo in_pack_generic.lo \ + extends_type_of.lo fnum.lo gerror.lo getcwd.lo getlog.lo \ + getXid.lo hostnm.lo ierrno.lo ishftc.lo \ + iso_c_generated_procs.lo iso_c_binding.lo kill.lo link.lo \ + malloc.lo mvbits.lo move_alloc.lo pack_generic.lo perror.lo \ + selected_char_kind.lo signal.lo size.lo sleep.lo \ + spread_generic.lo string_intrinsics.lo system.lo rand.lo \ + random.lo rename.lo reshape_generic.lo reshape_packed.lo \ + selected_int_kind.lo selected_real_kind.lo stat.lo symlnk.lo \ + system_clock.lo time.lo transpose_generic.lo umask.lo \ + unlink.lo unpack_generic.lo in_pack_generic.lo \ in_unpack_generic.lo am__objects_37 = am__objects_38 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \ @@ -1027,6 +1028,7 @@ intrinsics/eoshift2.c \ intrinsics/erfc_scaled.c \ intrinsics/etime.c \ intrinsics/exit.c \ +intrinsics/extends_type_of.c \ intrinsics/fnum.c \ intrinsics/gerror.c \ intrinsics/getcwd.c \ @@ -1889,6 +1891,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r16.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r4.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/exponent_r8.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/extends_type_of.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fbuf.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/file_pos.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fmain.Plo@am__quote@ @@ -5475,6 +5478,13 @@ exit.lo: intrinsics/exit.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c +extends_type_of.lo: intrinsics/extends_type_of.c +@am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT extends_type_of.lo -MD -MP -MF $(DEPDIR)/extends_type_of.Tpo -c -o extends_type_of.lo `test -f 'intrinsics/extends_type_of.c' || echo '$(srcdir)/'`intrinsics/extends_type_of.c +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/extends_type_of.Tpo $(DEPDIR)/extends_type_of.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/extends_type_of.c' object='extends_type_of.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o extends_type_of.lo `test -f 'intrinsics/extends_type_of.c' || echo '$(srcdir)/'`intrinsics/extends_type_of.c + fnum.lo: intrinsics/fnum.c @am__fastdepCC_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT fnum.lo -MD -MP -MF $(DEPDIR)/fnum.Tpo -c -o fnum.lo `test -f 'intrinsics/fnum.c' || echo '$(srcdir)/'`intrinsics/fnum.c @am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/fnum.Tpo $(DEPDIR)/fnum.Plo Index: libgfortran/intrinsics/extends_type_of.c =================================================================== --- libgfortran/intrinsics/extends_type_of.c (revision 0) +++ libgfortran/intrinsics/extends_type_of.c (revision 0) @@ -0,0 +1,61 @@ +/* Implementation of the EXTENDS_TYPE_OF intrinsic. + Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc. + Contributed by Janus Weil <janus@gcc.gnu.org>. + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + + +#include "libgfortran.h" + +#ifdef HAVE_STDLIB_H +#include <stdlib.h> +#endif + + +typedef struct vtype +{ + GFC_INTEGER_4 hash; + GFC_INTEGER_4 size; + struct vtype *extends; +} +vtype; + + +extern GFC_LOGICAL_4 is_extension_of (struct vtype *, struct vtype *); +export_proto(is_extension_of); + + +/* This is a helper function for the F2003 intrinsic EXTENDS_TYPE_OF. + While EXTENDS_TYPE_OF accepts CLASS or TYPE arguments, this one here gets + passed the corresponding vtabs. Each call to EXTENDS_TYPE_OF is translated + to a call to is_extension_of. */ + +GFC_LOGICAL_4 +is_extension_of (struct vtype *v1, struct vtype *v2) +{ + while (v1) + { + if (v1->hash == v2->hash) return 1; + v1 = v1->extends; + } + return 0; +} Index: libgfortran/gfortran.map =================================================================== --- libgfortran/gfortran.map (revision 153893) +++ libgfortran/gfortran.map (working copy) @@ -1095,6 +1095,7 @@ GFORTRAN_1.2 { global: _gfortran_clz128; _gfortran_ctz128; + _gfortran_is_extension_of; } GFORTRAN_1.1; F2C_1.0 { Index: libgfortran/Makefile.am =================================================================== --- libgfortran/Makefile.am (revision 153893) +++ libgfortran/Makefile.am (working copy) @@ -82,6 +82,7 @@ intrinsics/eoshift2.c \ intrinsics/erfc_scaled.c \ intrinsics/etime.c \ intrinsics/exit.c \ +intrinsics/extends_type_of.c \ intrinsics/fnum.c \ intrinsics/gerror.c \ intrinsics/getcwd.c \
Attachment:
extends_type_of_1.f03
Description: Binary data
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |