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

4 files changed, 27 insertions, 36 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 204e8eb..c0b6d15 100644
--- 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 949f399..2875321 100644
--- 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 839f750..ec68828 100644
--- 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 36597fa..9ae912ef7 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1462,6 +1462,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)
 {
   const char *name;
@@ -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);
-
 }