re PR libfortran/17631 (libfortran: intrinsic subroutine MVBITS not implemented)

PR fortran/17631
fortran/
* intrinsic.c (add_sym_5): Remove.
(add_subroutines): Add resolution function for MVBITS.
* intrinsic.h (gfc_resolve_mvbits): Declare resolution function for
MVBITS
* iresolve.c (gfc_resolve_mvbits): New function.
(gfc_resolve_random_number): Remove empty line at end of function.
libgfortran/
* Makefile.am (gfor_helper_src): Add intrinsics/mvbits.h.
* intrinsics/mvbits.h: New file.
testsuite/
* gfortran.fortran-torture/execute/intrinsic_mvbits.f90: New test.

From-SVN: r88527

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 204e8eb5c3148f537cc8cae83230a880a9c3eecf..c0b6d151a327e5f76e3083de93100b5400755257 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -4,6 +4,14 @@
        * iresolve.c (gfc_resolve_pack): Choose function depending if mask
        is scalar.
 
+       PR fortran/17631
+       * intrinsic.c (add_sym_5): Remove.
+       (add_subroutines): Add resolution function for MVBITS.
+       * intrinsic.h (gfc_resolve_mvbits): Declare resolution function for
+       MVBITS
+       * iresolve.c (gfc_resolve_mvbits): New function.
+       (gfc_resolve_random_number): Remove empty line at end of function.
+
 2004-10-04  Erik Schnetter  <schnetter@aei.mpg.de>
 
        * scanner.c (preprocessor_line): Accept preprocessor lines without

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 949f399dda61f24f297e98fd247857e1cb7197e1..2875321ec9a96c5ccb13cf7a53140db601b59118 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -600,35 +600,6 @@ static void add_sym_4s (const char *name, int elemental, int actual_ok,
 }
 
 
-static void add_sym_5 (const char *name, int elemental, int actual_ok, bt type,
-                      int kind,
-                      try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
-                      gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
-                      void (*resolve)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
-                      const char* a1, bt type1, int kind1, int optional1,
-                      const char* a2, bt type2, int kind2, int optional2,
-                      const char* a3, bt type3, int kind3, int optional3,
-                      const char* a4, bt type4, int kind4, int optional4,
-                      const char* a5, bt type5, int kind5, int optional5
-                      ) {
-  gfc_check_f cf;
-  gfc_simplify_f sf;
-  gfc_resolve_f rf;
-
-  cf.f5 = check;
-  sf.f5 = simplify;
-  rf.f5 = resolve;
-
-  add_sym (name, elemental, actual_ok, type, kind, cf, sf, rf,
-          a1, type1, kind1, optional1,
-          a2, type2, kind2, optional2,
-          a3, type3, kind3, optional3,
-          a4, type4, kind4, optional4,
-          a5, type5, kind5, optional5,
-          (void*)0);
-}
-
-
 static void add_sym_5s  
 (
  const char *name, int elemental, int actual_ok, bt type, int kind,
@@ -1960,12 +1931,11 @@ add_subroutines (void)
             trim_name, BT_LOGICAL, dl, 1);
 
 
-  /* This needs changing to add_sym_5s if it gets a resolution function.  */
-  add_sym_5 ("mvbits", 1, 1, BT_UNKNOWN, 0,
-            gfc_check_mvbits, gfc_simplify_mvbits, NULL,
-            f, BT_INTEGER, di, 0, fp, BT_INTEGER, di, 0,
-            ln, BT_INTEGER, di, 0, t, BT_INTEGER, di, 0,
-            tp, BT_INTEGER, di, 0);
+  add_sym_5s ("mvbits", 1, 1, BT_UNKNOWN, 0,
+             gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
+             f, BT_INTEGER, di, 0, fp, BT_INTEGER, di, 0,
+             ln, BT_INTEGER, di, 0, t, BT_INTEGER, di, 0,
+             tp, BT_INTEGER, di, 0);
 
   add_sym_1s ("random_number", 0, 1, BT_UNKNOWN, 0,
              gfc_check_random_number, NULL, gfc_resolve_random_number,

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 839f750791b4d7af2a4d8cc355d22a6e84a8179d..ec68828df12bbcc47f92486e24fbb9884a5025fd 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -323,6 +323,7 @@ void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 
 /* Intrinsic subroutine resolution.  */
 void gfc_resolve_cpu_time (gfc_code *);
+void gfc_resolve_mvbits (gfc_code *);
 void gfc_resolve_system_clock(gfc_code *);
 void gfc_resolve_random_number (gfc_code *);
 void gfc_resolve_getarg (gfc_code *);

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 36597fa6d844d0fbeab86c2fc92f2b1b605fa32d..9ae912ef73c7488ffee682e9a285b382699d6cce 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1461,6 +1461,19 @@ gfc_resolve_cpu_time (gfc_code * c ATTRIBUTE_UNUSED)
 }
 
 
+void
+gfc_resolve_mvbits (gfc_code * c)
+{
+  const char *name;
+  int kind;
+
+  kind = c->ext.actual->expr->ts.kind;
+  name = gfc_get_string (PREFIX("mvbits_i%d"), kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
 void
 gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED)
 {
@@ -1474,7 +1487,6 @@ gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED)
     name = gfc_get_string (PREFIX("arandom_r%d"), kind);
   
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
-
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0587e7fa07a243d2ba1b6db279616b5282d8a3b0..6bb5309db71f16dcc92dd392bb7cdf380bd42ab9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -3,6 +3,9 @@
        PR fortran/17283
        * gfortran.fortran-torture/execute/intrinsic_pack.f90: Add more tests.
 
+       PR fortran/17631
+       * gfortran.fortran-torture/execute/intrinsic_mvbits.f90: New test.
+
 2004-10-04  Chao-ying Fu  <fu@mips.com>
 
        * gcc.dg/vect/pr16105.c: Enable for mipsisa64*-*-*.

diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90
new file mode 100644 (file)
index 0000000..8aaaf09
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mvbits.f90
@@ -0,0 +1,10 @@
+! Test the MVBITS intrinsic subroutine
+INTEGER*4 :: from, to, result
+
+DATA from / z'0003FFFC' /
+DATA to / z'77760000' /
+DATA result / z'7777FFFE' /
+
+CALL mvbits(from, 2, 16, to, 1)
+if (to /= result) CALL abort()
+end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 0c2b3818bc610156f356463608a4fa3d4c9a25e8..8b9d6a7ef4153d01ef2db42a6b416a7fa0b5d933 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -7,6 +7,11 @@
        * runtime/memory.c (internal_malloc, internal_malloc64): Allow
        allocating zero memory.
 
+       PR fortran/17631
+       * Makefile.am (gfor_helper_src): Add intrinsics/mvbits.h.
+       * Makefile.in: Regenerate.
+       * intrinsics/mvbits.h: New file.
+
 2004-10-04  Paul Brook  <paul@codesourcery.com>
        Bud Davis  <bdavis9659@comcast.net>
 

diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 060166ade6a70953b7622e570c41e99b96a4bff9..d34a3dd6e66c71913ba235d1b3eddf2f06294d94 100644 (file)
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -52,6 +52,7 @@ intrinsics/etime.c \
 intrinsics/getcwd.c \
 intrinsics/getXid.c \
 intrinsics/ishftc.c \
+intrinsics/mvbits.c \
 intrinsics/pack_generic.c \
 intrinsics/size.c \
 intrinsics/spread_generic.c \

diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index fb06ca5d4a5734774c3e07297cf99aa520cf6cba..219baa69b49354ee146d3b624be4569d8d579986 100644 (file)
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -1,4 +1,4 @@
-# Makefile.in generated by automake 1.8.5 from Makefile.am.
+# Makefile.in generated by automake 1.8.3 from Makefile.am.
 # @configure_input@
 
 # Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
@@ -121,11 +121,12 @@ am__objects_32 = backspace.lo close.lo endfile.lo format.lo inquire.lo \
 am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
        c99_functions.lo cpu_time.lo cshift0.lo date_and_time.lo \
        env.lo erf.lo eoshift0.lo eoshift2.lo etime.lo getcwd.lo \
-       getXid.lo ishftc.lo pack_generic.lo size.lo spread_generic.lo \
-       string_intrinsics.lo rand.lo random.lo reshape_generic.lo \
-       reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \
-       system_clock.lo transpose_generic.lo unpack_generic.lo \
-       in_pack_generic.lo in_unpack_generic.lo normalize.lo
+       getXid.lo ishftc.lo mvbits.lo pack_generic.lo size.lo \
+       spread_generic.lo string_intrinsics.lo rand.lo random.lo \
+       reshape_generic.lo reshape_packed.lo selected_int_kind.lo \
+       selected_real_kind.lo system_clock.lo transpose_generic.lo \
+       unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
+       normalize.lo
 am__objects_34 =
 am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \
        _abs_r4.lo _abs_r8.lo _exp_r4.lo _exp_r8.lo _exp_c4.lo \
@@ -324,6 +325,7 @@ intrinsics/etime.c \
 intrinsics/getcwd.c \
 intrinsics/getXid.c \
 intrinsics/ishftc.c \
+intrinsics/mvbits.c \
 intrinsics/pack_generic.c \
 intrinsics/size.c \
 intrinsics/spread_generic.c \
@@ -740,7 +742,7 @@ clean-toolexeclibLTLIBRARIES:
        -test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
        @list='$(toolexeclib_LTLIBRARIES)'; for p in $$list; do \
          dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
-         test "$$dir" != "$$p" || dir=.; \
+         test "$$dir" = "$$p" && dir=.; \
          echo "rm -f \"$${dir}/so_locations\""; \
          rm -f "$${dir}/so_locations"; \
        done
@@ -2114,6 +2116,15 @@ ishftc.obj: intrinsics/ishftc.c
 ishftc.lo: intrinsics/ishftc.c
        $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ishftc.lo `test -f 'intrinsics/ishftc.c' || echo '$(srcdir)/'`intrinsics/ishftc.c
 
+mvbits.o: intrinsics/mvbits.c
+       $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.o `test -f 'intrinsics/mvbits.c' || echo '$(srcdir)/'`intrinsics/mvbits.c
+
+mvbits.obj: intrinsics/mvbits.c
+       $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.obj `if test -f 'intrinsics/mvbits.c'; then $(CYGPATH_W) 'intrinsics/mvbits.c'; else $(CYGPATH_W) '$(srcdir)/intrinsics/mvbits.c'; fi`
+
+mvbits.lo: intrinsics/mvbits.c
+       $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mvbits.lo `test -f 'intrinsics/mvbits.c' || echo '$(srcdir)/'`intrinsics/mvbits.c
+
 pack_generic.o: intrinsics/pack_generic.c
        $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pack_generic.o `test -f 'intrinsics/pack_generic.c' || echo '$(srcdir)/'`intrinsics/pack_generic.c
 
@@ -2932,11 +2943,9 @@ TAGS:  $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
          done | \
          $(AWK) '    { files[$$0] = 1; } \
               END { for (i in files) print i; }'`; \
-       if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \
-         test -n "$$unique" || unique=$$empty_fix; \
-         $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
-           $$tags $$unique; \
-       fi
+       test -z "$(ETAGS_ARGS)$$tags$$unique" \
+         || $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
+            $$tags $$unique
 ctags: CTAGS
 CTAGS:  $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) \
                $(TAGS_FILES) $(LISP)
@@ -3032,7 +3041,7 @@ distcheck: dist
        *.tar.Z*) \
          uncompress -c $(distdir).tar.Z | $(AMTAR) xf - ;;\
        *.shar.gz*) \
-         GZIP=$(GZIP_ENV) gunzip -c $(distdir).shar.gz | unshar ;;\
+         GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | unshar ;;\
        *.zip*) \
          unzip $(distdir).zip ;;\
        esac