From a39faface6511df98bd39a8f6134a992a3feee35 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois-Xavier=20Coudert?= <fxcoudert@gcc.gnu.org>
Date: Wed, 30 Apr 2008 21:45:02 +0000
Subject: [PATCH] intrinsic.c (add_functions): Add SELECTED_CHAR_KIND
intrinsic.
* intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic.
* intrinsic.h (gfc_check_selected_char_kind,
gfc_simplify_selected_char_kind): New prototypes.
* gfortran.h (gfc_isym_id): Add GFC_ISYM_SC_KIND.
* trans.h (gfor_fndecl_sc_kind): New function decl.
* trans-decl.c (gfor_fndecl_sc_kind): Build new decl.
* arith.c (gfc_compare_with_Cstring): New function.
* arith.h (gfc_compare_with_Cstring): New prototype.
* check.c (gfc_check_selected_char_kind): New function.
* primary.c (match_string_constant, match_kind_param): Mark
symbols used as literal constant kind param as referenced.
* trans-intrinsic.c (gfc_conv_intrinsic_sc_kind): New function.
(gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_sc_kind.
* intrinsic.texi (SELECTED_CHAR_KIND): Document new intrinsic.
* simplify.c (gfc_simplify_selected_char_kind): New function.
* intrinsics/selected_char_kind.c: New file.
* Makefile.am: Add intrinsics/selected_char_kind.c.
* Makefile.in: Regenerate.
* gfortran.dg/selected_char_kind_1.f90: New test.
* gfortran.dg/selected_char_kind_2.f90: New test.
* gfortran.dg/selected_char_kind_3.f90: New test.
From-SVN: r134839
---
gcc/fortran/ChangeLog | 24 ++++++-
gcc/fortran/arith.c | 35 +++++++++-
gcc/fortran/arith.h | 2 +
gcc/fortran/check.c | 16 +++++
gcc/fortran/gfortran.h | 1 +
gcc/fortran/intrinsic.c | 7 ++
gcc/fortran/intrinsic.h | 2 +
gcc/fortran/intrinsic.texi | 43 ++++++++++++
gcc/fortran/primary.c | 3 +
gcc/fortran/simplify.c | 22 +++++++
gcc/fortran/trans-decl.c | 18 +++--
gcc/fortran/trans-intrinsic.c | 17 +++++
gcc/fortran/trans.h | 3 +-
gcc/testsuite/ChangeLog | 10 ++-
.../gfortran.dg/selected_char_kind_1.f90 | 65 +++++++++++++++++++
.../gfortran.dg/selected_char_kind_2.f90 | 14 ++++
.../gfortran.dg/selected_char_kind_3.f90 | 10 +++
libgfortran/ChangeLog | 7 ++
libgfortran/Makefile.am | 1 +
libgfortran/Makefile.in | 24 +++++--
libgfortran/gfortran.map | 1 +
libgfortran/intrinsics/selected_char_kind.c | 49 ++++++++++++++
22 files changed, 353 insertions(+), 21 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/selected_char_kind_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/selected_char_kind_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
create mode 100644 libgfortran/intrinsics/selected_char_kind.c
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 13fb0528e553..2abc96d00982 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,8 +1,26 @@
+2008-04-30 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ * intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic.
+ * intrinsic.h (gfc_check_selected_char_kind,
+ gfc_simplify_selected_char_kind): New prototypes.
+ * gfortran.h (gfc_isym_id): Add GFC_ISYM_SC_KIND.
+ * trans.h (gfor_fndecl_sc_kind): New function decl.
+ * trans-decl.c (gfor_fndecl_sc_kind): Build new decl.
+ * arith.c (gfc_compare_with_Cstring): New function.
+ * arith.h (gfc_compare_with_Cstring): New prototype.
+ * check.c (gfc_check_selected_char_kind): New function.
+ * primary.c (match_string_constant, match_kind_param): Mark
+ symbols used as literal constant kind param as referenced.
+ * trans-intrinsic.c (gfc_conv_intrinsic_sc_kind): New function.
+ (gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_sc_kind.
+ * intrinsic.texi (SELECTED_CHAR_KIND): Document new intrinsic.
+ * simplify.c (gfc_simplify_selected_char_kind): New function.
+
2008-04-28 Paul Thomas <pault@gcc.gnu.org>
- PR fortran/35997
- * module.c (find_symbol): Do not return a result for a symbol
- that has been renamed in another module.
+ PR fortran/35997
+ * module.c (find_symbol): Do not return a result for a symbol
+ that has been renamed in another module.
2008-04-26 George Helffrich <george@gcc.gnu.org>
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index fdd6f6a7d77b..4b8d45b189b2 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1208,7 +1208,7 @@ gfc_compare_string (gfc_expr *a, gfc_expr *b)
alen = a->value.character.length;
blen = b->value.character.length;
- len = (alen > blen) ? alen : blen;
+ len = MAX(alen, blen);
for (i = 0; i < len; i++)
{
@@ -1224,7 +1224,40 @@ gfc_compare_string (gfc_expr *a, gfc_expr *b)
}
/* Strings are equal */
+ return 0;
+}
+
+
+int
+gfc_compare_with_Cstring (gfc_expr *a, const char *b, bool case_sensitive)
+{
+ int len, alen, blen, i, ac, bc;
+
+ alen = a->value.character.length;
+ blen = strlen (b);
+
+ len = MAX(alen, blen);
+
+ for (i = 0; i < len; i++)
+ {
+ /* We cast to unsigned char because default char, if it is signed,
+ would lead to ac < 0 for string[i] > 127. */
+ ac = (unsigned char) ((i < alen) ? a->value.character.string[i] : ' ');
+ bc = (unsigned char) ((i < blen) ? b[i] : ' ');
+ if (!case_sensitive)
+ {
+ ac = TOLOWER (ac);
+ bc = TOLOWER (bc);
+ }
+
+ if (ac < bc)
+ return -1;
+ if (ac > bc)
+ return 1;
+ }
+
+ /* Strings are equal */
return 0;
}
diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
index f370c1cbce8a..e27186ae92fa 100644
--- a/gcc/fortran/arith.h
+++ b/gcc/fortran/arith.h
@@ -40,6 +40,8 @@ arith gfc_range_check (gfc_expr *);
int gfc_compare_expr (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
int gfc_compare_string (gfc_expr *, gfc_expr *);
+int gfc_compare_with_Cstring (gfc_expr *, const char *, bool);
+
/* Constant folding for gfc_expr trees. */
gfc_expr *gfc_parentheses (gfc_expr * op);
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index c02656ce669f..5f782400dd3d 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2349,6 +2349,22 @@ gfc_check_secnds (gfc_expr *r)
}
+try
+gfc_check_selected_char_kind (gfc_expr *name)
+{
+ if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+ return FAILURE;
+
+ if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+ return FAILURE;
+
+ if (scalar_check (name, 0) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
try
gfc_check_selected_int_kind (gfc_expr *r)
{
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6035f629f561..855305cb278b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -465,6 +465,7 @@ enum gfc_isym_id
GFC_ISYM_RESHAPE,
GFC_ISYM_RRSPACING,
GFC_ISYM_RSHIFT,
+ GFC_ISYM_SC_KIND,
GFC_ISYM_SCALE,
GFC_ISYM_SCAN,
GFC_ISYM_SECNDS,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 258123b92b57..441fbecdc17d 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -2141,6 +2141,13 @@ add_functions (void)
make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
+ add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
+ ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
+ gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
+ NULL, nm, BT_CHARACTER, dc, REQUIRED);
+
+ make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
+
add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
GFC_STD_F95, gfc_check_selected_int_kind,
gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index dc91e77caafb..91645fbb1e58 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -120,6 +120,7 @@ try gfc_check_scale (gfc_expr *, gfc_expr *);
try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_second_sub (gfc_expr *);
try gfc_check_secnds (gfc_expr *);
+try gfc_check_selected_char_kind (gfc_expr *);
try gfc_check_selected_int_kind (gfc_expr *);
try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *);
try gfc_check_set_exponent (gfc_expr *, gfc_expr *);
@@ -287,6 +288,7 @@ gfc_expr *gfc_simplify_reshape (gfc_expr *, gfc_expr *, gfc_expr *,
gfc_expr *gfc_simplify_rrspacing (gfc_expr *);
gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *);
gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index c2630b249be5..9d3553da1110 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -225,6 +225,7 @@ Some basic guidelines for editing this document:
* @code{SCAN}: SCAN, Scan a string for the presence of a set of characters
* @code{SECNDS}: SECNDS, Time function
* @code{SECOND}: SECOND, CPU time function
+* @code{SELECTED_CHAR_KIND}: SELECTED_CHAR_KIND, Choose character kind
* @code{SELECTED_INT_KIND}: SELECTED_INT_KIND, Choose integer kind
* @code{SELECTED_REAL_KIND}: SELECTED_REAL_KIND, Choose real kind
* @code{SET_EXPONENT}: SET_EXPONENT, Set the exponent of the model
@@ -9256,6 +9257,48 @@ seconds.
+@node SELECTED_CHAR_KIND
+@section @code{SELECTED_CHAR_KIND} --- Choose character kind
+@fnindex SELECTED_CHAR_KIND
+@cindex character kind
+@cindex kind, character
+
+@table @asis
+@item @emph{Description}:
+
+@code{SELECTED_CHAR_KIND(NAME)} returns the kind value for the character
+set named @var{NAME}, if a character set with such a name is supported,
+or @math{-1} otherwise. Currently, supported character sets include
+``ASCII'' and ``DEFAULT'', which are equivalent.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = SELECTED_CHAR_KIND(NAME)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME} @tab Shall be a scalar and of the default character type.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program ascii_kind
+ integer,parameter :: ascii = selected_char_kind("ascii")
+ character(kind=ascii, len=26) :: s
+
+ s = ascii_"abcdefghijklmnopqrstuvwxyz"
+ print *, s
+end program ascii_kind
+@end smallexample
+@end table
+
+
+
@node SELECTED_INT_KIND
@section @code{SELECTED_INT_KIND} --- Choose integer kind
@fnindex SELECTED_INT_KIND
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 8f85873ce031..6b7fd519d6a3 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -60,6 +60,8 @@ match_kind_param (int *kind)
if (p != NULL)
return MATCH_NO;
+ gfc_set_sym_referenced (sym);
+
if (*kind < 0)
return MATCH_NO;
@@ -907,6 +909,7 @@ match_string_constant (gfc_expr **result)
gfc_error (q);
return MATCH_ERROR;
}
+ gfc_set_sym_referenced (sym);
}
if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0)
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 2272bb567b5f..62c1cd45aec9 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -3628,6 +3628,28 @@ gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind)
}
+gfc_expr *
+gfc_simplify_selected_char_kind (gfc_expr *e)
+{
+ int kind;
+ gfc_expr *result;
+
+ if (e->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ if (gfc_compare_with_Cstring (e, "ascii", false) == 0
+ || gfc_compare_with_Cstring (e, "default", false) == 0)
+ kind = 1;
+ else
+ kind = -1;
+
+ result = gfc_int_expr (kind);
+ result->where = e->where;
+
+ return result;
+}
+
+
gfc_expr *
gfc_simplify_selected_int_kind (gfc_expr *e)
{
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4e6dddbf5013..d204579c75f7 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -124,7 +124,8 @@ tree gfor_fndecl_size0;
tree gfor_fndecl_size1;
tree gfor_fndecl_iargc;
-/* Intrinsic functions implemented in FORTRAN. */
+/* Intrinsic functions implemented in Fortran. */
+tree gfor_fndecl_sc_kind;
tree gfor_fndecl_si_kind;
tree gfor_fndecl_sr_kind;
@@ -2099,19 +2100,22 @@ gfc_build_intrinsic_function_decls (void)
pchar_type_node,
gfc_charlen_type_node, pchar_type_node);
+ gfor_fndecl_sc_kind =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("selected_char_kind")),
+ gfc_int4_type_node, 2,
+ gfc_charlen_type_node, pchar_type_node);
+
gfor_fndecl_si_kind =
gfc_build_library_function_decl (get_identifier
(PREFIX("selected_int_kind")),
- gfc_int4_type_node,
- 1,
- pvoid_type_node);
+ gfc_int4_type_node, 1, pvoid_type_node);
gfor_fndecl_sr_kind =
gfc_build_library_function_decl (get_identifier
(PREFIX("selected_real_kind")),
- gfc_int4_type_node,
- 2, pvoid_type_node,
- pvoid_type_node);
+ gfc_int4_type_node, 2,
+ pvoid_type_node, pvoid_type_node);
/* Power functions. */
{
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index f3cd4de9bca0..9f022e7a09d2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3736,6 +3736,19 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
}
+/* Generate code for SELECTED_CHAR_KIND (NAME) intrinsic function. */
+
+static void
+gfc_conv_intrinsic_sc_kind (gfc_se *se, gfc_expr *expr)
+{
+ tree args[2];
+
+ gfc_conv_intrinsic_function_args (se, expr, args, 2);
+ se->expr = build_call_expr (gfor_fndecl_sc_kind, 2, args[0], args[1]);
+ se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
/* Generate code for SELECTED_INT_KIND (R) intrinsic function. */
static void
@@ -4049,6 +4062,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
gfc_conv_intrinsic_trim (se, expr);
break;
+ case GFC_ISYM_SC_KIND:
+ gfc_conv_intrinsic_sc_kind (se, expr);
+ break;
+
case GFC_ISYM_SI_KIND:
gfc_conv_intrinsic_si_kind (se, expr);
break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1dfb0a59dab8..3e812a89028a 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -556,7 +556,8 @@ extern GTY(()) tree gfor_fndecl_size0;
extern GTY(()) tree gfor_fndecl_size1;
extern GTY(()) tree gfor_fndecl_iargc;
-/* Implemented in FORTRAN. */
+/* Implemented in Fortran. */
+extern GTY(()) tree gfor_fndecl_sc_kind;
extern GTY(()) tree gfor_fndecl_si_kind;
extern GTY(()) tree gfor_fndecl_sr_kind;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0d468f09c284..da38b1bedcbe 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,7 +1,13 @@
+2008-04-30 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ * gfortran.dg/selected_char_kind_1.f90: New test.
+ * gfortran.dg/selected_char_kind_2.f90: New test.
+ * gfortran.dg/selected_char_kind_3.f90: New test.
+
2008-04-28 Paul Thomas <pault@gcc.gnu.org>
- PR fortran/35997
- * gfortran.dg/use_rename_3.f90
+ PR fortran/35997
+ * gfortran.dg/use_rename_3.f90
2008-04-30 Richard Guenther <rguenther@suse.de>
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_1.f90
new file mode 100644
index 000000000000..f11fd0fb3f46
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_1.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! Checks for the SELECTED_CHAR_KIND intrinsic
+!
+ integer, parameter :: ascii = selected_char_kind ("ascii")
+ integer, parameter :: default = selected_char_kind ("default")
+
+ character(kind=ascii) :: s1
+ character(kind=default) :: s2
+ character(kind=selected_char_kind ("ascii")) :: s3
+ character(kind=selected_char_kind ("default")) :: s4
+
+ if (kind (s1) /= selected_char_kind ("ascii")) call abort
+ if (kind (s2) /= selected_char_kind ("default")) call abort
+ if (kind (s3) /= ascii) call abort
+ if (kind (s4) /= default) call abort
+
+ if (selected_char_kind("ascii") /= 1) call abort
+ if (selected_char_kind("default") /= 1) call abort
+ if (selected_char_kind("defauLt") /= 1) call abort
+ if (selected_char_kind("foo") /= -1) call abort
+ if (selected_char_kind("asciiiii") /= -1) call abort
+ if (selected_char_kind("default ") /= 1) call abort
+
+ call test("ascii", 1)
+ call test("default", 1)
+ call test("defauLt", 1)
+ call test("asciiiiii", -1)
+ call test("foo", -1)
+ call test("default ", 1)
+ call test("default x", -1)
+
+ call test(ascii_"ascii", 1)
+ call test(ascii_"default", 1)
+ call test(ascii_"defauLt", 1)
+ call test(ascii_"asciiiiii", -1)
+ call test(ascii_"foo", -1)
+ call test(ascii_"default ", 1)
+ call test(ascii_"default x", -1)
+
+ call test(default_"ascii", 1)
+ call test(default_"default", 1)
+ call test(default_"defauLt", 1)
+ call test(default_"asciiiiii", -1)
+ call test(default_"foo", -1)
+ call test(default_"default ", 1)
+ call test(default_"default x", -1)
+
+ if (kind (selected_char_kind ("")) /= kind(0)) call abort
+end
+
+subroutine test(s,i)
+ character(len=*,kind=selected_char_kind("ascii")) s
+ integer i
+
+ call test2(s,i)
+ if (selected_char_kind (s) /= i) call abort
+end subroutine test
+
+subroutine test2(s,i)
+ character(len=*,kind=selected_char_kind("default")) s
+ integer i
+
+ if (selected_char_kind (s) /= i) call abort
+end subroutine test2
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_2.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_2.f90
new file mode 100644
index 000000000000..28ecd96ba3e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+!
+! Check that nonexisting character kinds are not rejected by the compiler
+!
+ character(kind=selected_char_kind("")) :: s1 ! { dg-error "is not supported for CHARACTER" }
+ character(kind=selected_char_kind(" ")) :: s2 ! { dg-error "is not supported for CHARACTER" }
+ character(kind=selected_char_kind("asciii")) :: s3 ! { dg-error "is not supported for CHARACTER" }
+ character(kind=selected_char_kind("I don't exist")) :: s4 ! { dg-error "is not supported for CHARACTER" }
+
+ print *, selected_char_kind() ! { dg-error "Missing actual argument" }
+ print *, selected_char_kind(12) ! { dg-error "must be CHARACTER" }
+ print *, selected_char_kind(["foo", "bar"]) ! { dg-error "must be a scalar" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90 b/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
new file mode 100644
index 000000000000..5cc7b112496f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -pedantic -Wall" }
+!
+! Check that SELECTED_CHAR_KIND is rejected with -std=f95
+!
+ implicit none
+ character(kind=selected_char_kind("ascii")) :: s ! { dg-error "is not included in the selected standard" }
+ s = "" ! { dg-error "has no IMPLICIT type" }
+ print *, s
+end
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 0ee684858ad5..dbdaa0decee4 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-04-30 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ * intrinsics/selected_char_kind.c: New file.
+ * gfortran.map (GFORTRAN_1.1): Add _gfortran_selected_char_kind.
+ * Makefile.am: Add intrinsics/selected_char_kind.c.
+ * Makefile.in: Regenerate.
+
2008-04-30 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/35993
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 62ae5f31db83..93a4072d7d85 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -87,6 +87,7 @@ 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 \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 42192604bc2a..686308a7fa0f 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -416,7 +416,8 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.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/signal.c intrinsics/size.c intrinsics/sleep.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 \
@@ -698,12 +699,12 @@ am__objects_35 = associated.lo abort.lo access.lo args.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 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 \
+ 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_36 =
am__objects_37 = _abs_c4.lo _abs_c8.lo _abs_c10.lo _abs_c16.lo \
@@ -986,6 +987,7 @@ 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 \
@@ -2073,6 +2075,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r4.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/rrspacing_r8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/select.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/selected_char_kind.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r10.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r16.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/set_exponent_r4.Plo@am__quote@
@@ -5372,6 +5375,13 @@ perror.lo: intrinsics/perror.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o perror.lo `test -f 'intrinsics/perror.c' || echo '$(srcdir)/'`intrinsics/perror.c
+selected_char_kind.lo: intrinsics/selected_char_kind.c
+@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT selected_char_kind.lo -MD -MP -MF "$(DEPDIR)/selected_char_kind.Tpo" -c -o selected_char_kind.lo `test -f 'intrinsics/selected_char_kind.c' || echo '$(srcdir)/'`intrinsics/selected_char_kind.c; \
+@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/selected_char_kind.Tpo" "$(DEPDIR)/selected_char_kind.Plo"; else rm -f "$(DEPDIR)/selected_char_kind.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/selected_char_kind.c' object='selected_char_kind.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o selected_char_kind.lo `test -f 'intrinsics/selected_char_kind.c' || echo '$(srcdir)/'`intrinsics/selected_char_kind.c
+
signal.lo: intrinsics/signal.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT signal.lo -MD -MP -MF "$(DEPDIR)/signal.Tpo" -c -o signal.lo `test -f 'intrinsics/signal.c' || echo '$(srcdir)/'`intrinsics/signal.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/signal.Tpo" "$(DEPDIR)/signal.Plo"; else rm -f "$(DEPDIR)/signal.Tpo"; exit 1; fi
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 2d0537246e37..0c6b7b1b7af1 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1037,6 +1037,7 @@ GFORTRAN_1.1 {
_gfortran_erfc_scaled_r8;
_gfortran_erfc_scaled_r10;
_gfortran_erfc_scaled_r16;
+ _gfortran_selected_char_kind;
_gfortran_st_wait;
} GFORTRAN_1.0;
diff --git a/libgfortran/intrinsics/selected_char_kind.c b/libgfortran/intrinsics/selected_char_kind.c
new file mode 100644
index 000000000000..c10d5b2efafb
--- /dev/null
+++ b/libgfortran/intrinsics/selected_char_kind.c
@@ -0,0 +1,49 @@
+/* Copyright 2008 Free Software Foundation, Inc.
+ Contributed by Paul Brook <paul@nowt.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 2 of the License, or (at your option) any later version.
+
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+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.
+
+You should have received a copy of the GNU General Public
+License along with libgfortran; see the file COPYING. If not,
+write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+
+#include "libgfortran.h"
+
+#include <string.h>
+
+
+extern GFC_INTEGER_4 selected_char_kind (gfc_charlen_type, char *);
+export_proto(selected_char_kind);
+
+GFC_INTEGER_4
+selected_char_kind (gfc_charlen_type name_len, char *name)
+{
+ gfc_charlen_type len = fstrlen (name, name_len);
+
+ if ((len == 5 && strncasecmp (name, "ascii", 5) == 0)
+ || (len == 7 && strncasecmp (name, "default", 7) == 0))
+ return 1;
+ else
+ return -1;
+}
--
GitLab