re PR fortran/29600 ([F03] MINLOC and MAXLOC take an optional KIND argument)

	PR fortran/29600

	* intrinsic.c (add_functions): Add optional KIND argument to ACHAR.
	* iresolve.c (gfc_resolve_achar): Handle the KIND argument.
	* check.c (gfc_check_achar): Check for the optional KIND argument.
	* simplify.c (gfc_simplify_achar): Use KIND argument.
	* intrinsic.h (gfc_check_achar, gfc_simplify_achar,
	gfc_resolve_achar): Adjust prototypes.

	* gfortran.dg/intrinsics_kind_argument_1.f90: Add test for ACHAR
	intrinsic.

From-SVN: r127385

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index acbe9a7cf773926f6866e4390c7a266bf1d1fd60..7ea4735fbeaacb2f17e8b8c723b4e5b35bfaf6d9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/29600
+       * intrinsic.c (add_functions): Add optional KIND argument to ACHAR.
+       * iresolve.c (gfc_resolve_achar): Handle the KIND argument.
+       * check.c (gfc_check_achar): Check for the optional KIND argument.
+       * simplify.c (gfc_simplify_achar): Use KIND argument.
+       * intrinsic.h (gfc_check_achar, gfc_simplify_achar,
+       gfc_resolve_achar): Adjust prototypes.
+
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        PR fortran/30964

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 23955deab9d33ea9cd685a7ca58952674869696c..634d6b4f05b9f60ab6f64c26b67a05cf0a02f774 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -443,10 +443,12 @@ gfc_check_abs (gfc_expr *a)
 
 
 try
-gfc_check_achar (gfc_expr *a)
+gfc_check_achar (gfc_expr *a, gfc_expr *kind)
 {
   if (type_check (a, 0, BT_INTEGER) == FAILURE)
     return FAILURE;
+  if (kind_check (kind, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
 
   return SUCCESS;
 }

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 7f02245c7fbfb978764887ba6e77dfe5c9a52f8e..3f999b4210c8a30c6b12e2fcbb77562ba7c81a69 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -946,9 +946,10 @@ add_functions (void)
 
   make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
 
-  add_sym_1 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
+  add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
+            BT_CHARACTER, dc, GFC_STD_F95,
             gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
-            i, BT_INTEGER, di, REQUIRED);
+            i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
 

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 1e03e0cdd307c23cfe07fe4e9405b528187a8bd7..cf242b8995dad2e66b854b876288529407e9cc3c 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -32,7 +32,7 @@ try gfc_check_a_p (gfc_expr *, gfc_expr *);
 
 try gfc_check_abs (gfc_expr *);
 try gfc_check_access_func (gfc_expr *, gfc_expr *);
-try gfc_check_achar (gfc_expr *);
+try gfc_check_achar (gfc_expr *, gfc_expr *);
 try gfc_check_all_any (gfc_expr *, gfc_expr *);
 try gfc_check_allocated (gfc_expr *);
 try gfc_check_associated (gfc_expr *, gfc_expr *);
@@ -185,7 +185,7 @@ try gfc_check_unlink_sub (gfc_expr *, gfc_expr *);
 
 /* Simplification functions.  */
 gfc_expr *gfc_simplify_abs (gfc_expr *);
-gfc_expr *gfc_simplify_achar (gfc_expr *);
+gfc_expr *gfc_simplify_achar (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_acos (gfc_expr *);
 gfc_expr *gfc_simplify_acosh (gfc_expr *);
 gfc_expr *gfc_simplify_adjustl (gfc_expr *);
@@ -303,7 +303,7 @@ gfc_expr *gfc_convert_constant (gfc_expr *, bt, int);
 /* Resolution functions.  */
 void gfc_resolve_abs (gfc_expr *, gfc_expr *);
 void gfc_resolve_access (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_achar (gfc_expr *, gfc_expr *);
+void gfc_resolve_achar (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_acos (gfc_expr *, gfc_expr *);
 void gfc_resolve_acosh (gfc_expr *, gfc_expr *);
 void gfc_resolve_aimag (gfc_expr *, gfc_expr *);

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 6232374161e2763241a28bbaebdb0857e6b12490..c030898a43b546e3bf97bfb3d15834328bbe3fa0 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -133,18 +133,19 @@ gfc_resolve_access (gfc_expr *f, gfc_expr *name ATTRIBUTE_UNUSED,
 
 
 void
-gfc_resolve_achar (gfc_expr *f, gfc_expr *x)
+gfc_resolve_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind)
 {
-  
   f->ts.type = BT_CHARACTER;
-  f->ts.kind = gfc_default_character_kind;
+  f->ts.kind = (kind == NULL)
+            ? gfc_default_character_kind : mpz_get_si (kind->value.integer);
   f->ts.cl = gfc_get_charlen ();
   f->ts.cl->next = gfc_current_ns->cl_list;
   gfc_current_ns->cl_list = f->ts.cl;
   f->ts.cl->length = gfc_int_expr (1);
 
-  f->value.function.name
-    = gfc_get_string ("__achar_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+  f->value.function.name = gfc_get_string ("__achar_%d_%c%d", f->ts.kind,
+                                          gfc_type_letter (x->ts.type),
+                                          x->ts.kind);
 }
 
 

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c3c23cb921573364f3bb93b5051cd46ce216c426..a395b04a5991b22c8d40d49283c9a24f75250380 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -257,15 +257,19 @@ gfc_simplify_abs (gfc_expr *e)
    systems that gfortran currently works on are ASCII.  */
 
 gfc_expr *
-gfc_simplify_achar (gfc_expr *e)
+gfc_simplify_achar (gfc_expr *e, gfc_expr *k)
 {
   gfc_expr *result;
-  int c;
+  int c, kind;
   const char *ch;
 
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
+  kind = get_kind (BT_CHARACTER, k, "ACHAR", gfc_default_character_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
   ch = gfc_extract_int (e, &c);
 
   if (ch != NULL)
@@ -275,8 +279,7 @@ gfc_simplify_achar (gfc_expr *e)
     gfc_warning ("Argument of ACHAR function at %L outside of range [0,127]",
                 &e->where);
 
-  result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind,
-                               &e->where);
+  result = gfc_constant_result (BT_CHARACTER, kind, &e->where);
 
   result->value.character.string = gfc_getmem (2);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6640aee6794c5c9e31b3be20ea354c2a8e99c948..b039444e0f95f97ef564f4e238684a51b9665114 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/29600
+       * gfortran.dg/intrinsics_kind_argument_1.f90: Add test for ACHAR
+       intrinsic.
+
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        PR fortran/30964

diff --git a/gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90 b/gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90
index b02ff749aed6b44d5376e5522c0c29adbff7fb39..0a3ca0791272f5184853c933eaaac45809f7627a 100644 (file)
--- a/gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90
+++ b/gcc/testsuite/gfortran.dg/intrinsics_kind_argument_1.f90
@@ -21,6 +21,8 @@ program test
   call check (ichar (s, k), 117)
   call check (ichar (s, kind=k), 117)
 
+  if (achar(107) /= achar(107,1)) call abort
+
   call check (index (t, s, .true., k), 7)
   call check (index (t, s, kind=k, back=.false.), 5)