intrinsic.c (char_conversions, ncharconv): New static variables.

	* intrinsic.c (char_conversions, ncharconv): New static variables.
	(find_char_conv): New function.
	(add_functions): Add simplification functions for ADJUSTL and
	ADJUSTR. Don't check the kind of their argument. Add checking for
	LGE, LLE, LGT and LLT.
	(add_subroutines): Fix argument type for SLEEP. Fix argument name
	for SYSTEM.
	(add_char_conversions): New function.
	(gfc_intrinsic_init_1): Call add_char_conversions.
	(gfc_intrinsic_done_1): Free char_conversions.
	(check_arglist): Use kind == 0 as a signal that we don't want
	the kind value to be checked.
	(do_simplify): Also simplify character functions.
	(gfc_convert_chartype): New function
	* trans-array.c (gfc_trans_array_ctor_element): Don't force the
	use of default character type.
	(gfc_trans_array_constructor_value): Likewise.
	(get_array_ctor_var_strlen): Use integer kind to build an integer
	instead of a character kind!
	(gfc_build_constant_array_constructor): Don't force the use of
	default character type.
	(gfc_conv_loop_setup): Likewise.
	* trans-expr.c (gfc_conv_string_tmp): Don't force the use of
	default character type. Allocate enough memory for wide strings.
	(gfc_conv_concat_op): Make sure operand kind are the same.
	(string_to_single_character): Remove gfc_ prefix. Reindent.
	Don't force the use of default character type.
	(gfc_conv_scalar_char_value): Likewise.
	(gfc_build_compare_string): Call string_to_single_character.
	(fill_with_spaces): New function
	(gfc_trans_string_copy): Add kind arguments. Use them to deal
	with wide character kinds.
	(gfc_conv_statement_function): Whitespace fix. Call
	gfc_trans_string_copy with new kind arguments.
	(gfc_conv_substring_expr): Call gfc_build_wide_string_const
	instead of using gfc_widechar_to_char.
	(gfc_conv_string_parameter): Don't force the use of default
	character type.
	(gfc_trans_scalar_assign): Pass kind args to gfc_trans_string_copy.
	* intrinsic.h (gfc_check_lge_lgt_lle_llt, gfc_convert_char_constant,
	gfc_resolve_adjustl, gfc_resolve_adjustr): New prototypes.
	* decl.c (gfc_set_constant_character_len): Don't assert the
	existence of a single character kind.
	* trans-array.h (gfc_trans_string_copy): New prototype.
	* gfortran.h (gfc_check_character_range, gfc_convert_chartype):
	New prototypes.
	* error.c (print_wide_char_into_buffer): New function lifting
	code from gfc_print_wide_char. Fix order to output '\x??' instead
	of 'x\??'.
	(gfc_print_wide_char): Call print_wide_char_into_buffer.
	(show_locus): Call print_wide_char_into_buffer with buffer local
	to this function.
	* trans-const.c (gfc_build_wide_string_const): New function.
	(gfc_conv_string_init): Deal with wide characters strings
	constructors.
	(gfc_conv_constant_to_tree): Call gfc_build_wide_string_const.
	* trans-stmt.c (gfc_trans_label_assign): Likewise.
	(gfc_trans_character_select): Deal with wide strings.
	* expr.c (gfc_check_assign): Allow conversion between character
	kinds on assignment.
	* trans-const.h (gfc_build_wide_string_const): New prototype.
	* trans-types.c (gfc_get_character_type_len_for_eltype,
	gfc_get_character_type_len): Create too variants of the old
	gfc_get_character_type_len, one getting kind argument and the
	other one directly taking a type tree.
	* trans.h (gfor_fndecl_select_string_char4,
	gfor_fndecl_convert_char1_to_char4,
	gfor_fndecl_convert_char4_to_char1): New prototypes.
	* trans-types.h (gfc_get_character_type_len_for_eltype): New
	prototype.
	* resolve.c (resolve_operator): Exit early when kind mismatches
	are detected, because that makes us issue an error message later.
	(validate_case_label_expr): Fix wording of error message.
	* iresolve.c (gfc_resolve_adjustl, gfc_resolve_adjustr): New
	functions.
	(gfc_resolve_pack): Call _char4 variants of library function
	when dealing with wide characters.
	(gfc_resolve_reshape): Likewise.
	(gfc_resolve_spread): Likewise.
	(gfc_resolve_transpose): Likewise.
	(gfc_resolve_unpack): Likewise.
	* target-memory.c (size_character): Take character kind bit size
	correctly into account (not that it changes anything for now, but
	it's more generic).
	(gfc_encode_character): Added gfc_ prefix. Encoding each
	character of a string by calling native_encode_expr for the
	corresponding unsigned integer.
	(gfc_target_encode_expr): Add gfc_ prefix to encode_character.
	* trans-decl.c (gfc_build_intrinsic_function_decls): Build
	gfor_fndecl_select_string_char4, gfor_fndecl_convert_char1_to_char4
	and gfor_fndecl_convert_char4_to_char1.
	* target-memory.h (gfc_encode_character): New prototype.
	* arith.c (gfc_check_character_range): New function.
	(eval_intrinsic): Allow non-default character kinds.
	* check.c (gfc_check_access_func): Only allow default
	character kind arguments.
	(gfc_check_chdir): Likewise.
	(gfc_check_chdir_sub): Likewise.
	(gfc_check_chmod): Likewise.
	(gfc_check_chmod_sub): Likewise.
	(gfc_check_lge_lgt_lle_llt): New function.
	(gfc_check_link): Likewise.
	(gfc_check_link_sub): Likewise.
	(gfc_check_symlnk): Likewise.
	(gfc_check_symlnk_sub): Likewise.
	(gfc_check_rename): Likewise.
	(gfc_check_rename_sub): Likewise.
	(gfc_check_fgetputc_sub): Likewise.
	(gfc_check_fgetput_sub): Likewise.
	(gfc_check_stat): Likewise.
	(gfc_check_stat_sub): Likewise.
	(gfc_check_date_and_time): Likewise.
	(gfc_check_ctime_sub): Likewise.
	(gfc_check_fdate_sub): Likewise.
	(gfc_check_gerror): Likewise.
	(gfc_check_getcwd_sub): Likewise.
	(gfc_check_getarg): Likewise.
	(gfc_check_getlog): Likewise.
	(gfc_check_hostnm): Likewise.
	(gfc_check_hostnm_sub): Likewise.
	(gfc_check_ttynam_sub): Likewise.
	(gfc_check_perror): Likewise.
	(gfc_check_unlink): Likewise.
	(gfc_check_unlink_sub): Likewise.
	(gfc_check_system_sub): Likewise.
	* primary.c (got_delim): Perform correct character range checking
	for all kinds.
	* trans-intrinsic.c (gfc_conv_intrinsic_conversion): Generate
	calls to library functions convert_char4_to_char1 and
	convert_char1_to_char4 for character conversions.
	(gfc_conv_intrinsic_char): Allow all character kings.
	(gfc_conv_intrinsic_strcmp): Fix whitespace.
	(gfc_conv_intrinsic_repeat): Take care of all character kinds.
	* intrinsic.texi: For all GNU intrinsics accepting character
	arguments, mention that they're restricted to the default kind.
	* simplify.c (simplify_achar_char): New function.
	(gfc_simplify_achar, gfc_simplify_char): Call simplify_achar_char.
	gfc_simplify_ichar): Don't error out for wide characters.
	(gfc_convert_char_constant): New function.

	* gfortran.dg/achar_3.f90: Adjust error messages.
	* gfortran.dg/achar_5.f90: New test.
	* gfortran.dg/achar_6.F90: New test.
	* gfortran.dg/widechar_1.f90: New test.
	* gfortran.dg/widechar_2.f90: New test.
	* gfortran.dg/widechar_3.f90: New test.
	* gfortran.dg/widechar_4.f90: New test.
	* gfortran.dg/widechar_intrinsics_1.f90: New test.
	* gfortran.dg/widechar_intrinsics_2.f90: New test.
	* gfortran.dg/widechar_intrinsics_3.f90: New test.
	* gfortran.dg/widechar_intrinsics_4.f90: New test.
	* gfortran.dg/widechar_intrinsics_5.f90: New test.
	* gfortran.dg/widechar_select_1.f90: New test.
	* gfortran.dg/widechar_select_2.f90: New test.

From-SVN: r135515

1 files changed, 75 insertions, 51 deletions

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index e8f98df..6852d64 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -428,13 +428,14 @@ Inquiry function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{NAME} @tab Scalar @code{CHARACTER} with the file name.
-Tailing blank are ignored unless the character @code{achar(0)} is
-present, then all characters up to and excluding @code{achar(0)} are
+@item @var{NAME} @tab Scalar @code{CHARACTER} of default kind with the
+file name. Tailing blank are ignored unless the character @code{achar(0)}
+is present, then all characters up to and excluding @code{achar(0)} are
 used as file name.
-@item @var{MODE} @tab Scalar @code{CHARACTER} with the file access mode,
-may be any concatenation of @code{"r"} (readable), @code{"w"} (writable)
-and @code{"x"} (executable), or @code{" "} to check for existence.
+@item @var{MODE} @tab Scalar @code{CHARACTER} of default kind with the
+file access mode, may be any concatenation of @code{"r"} (readable),
+@code{"w"} (writable) and @code{"x"} (executable), or @code{" "} to check
+for existence.
 @end multitable
 
 @item @emph{Return value}:
@@ -644,9 +645,9 @@ Elemental function
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{CHARACTER} where leading spaces 
-are removed and the same number of spaces are inserted on the end
-of @var{STR}. The return value has the same kind as @var{STRING}.
+The return value is of type @code{CHARACTER} and of the same kind as
+@var{STRING} where leading spaces are removed and the same number of
+spaces are inserted on the end of @var{STRING}.
 
 @item @emph{Example}:
 @smallexample
@@ -689,9 +690,9 @@ Elemental function
 @end multitable
 
 @item @emph{Return value}:
-The return value is of type @code{CHARACTER} where trailing spaces 
-are removed and the same number of spaces are inserted at the start
-of @var{STR}. The return value has the same kind as @var{STRING}.
+The return value is of type @code{CHARACTER} and of the same kind as
+@var{STRING} where trailing spaces are removed and the same number of
+spaces are inserted at the start of @var{STRING}.
 
 @item @emph{Example}:
 @smallexample
@@ -2262,8 +2263,9 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{NAME}   @tab The type shall be @code{CHARACTER} and shall
-                        specify a valid path within the file system.
+@item @var{NAME}   @tab The type shall be @code{CHARACTER} of default
+                        kind and shall specify a valid path within the
+			file system.
 @item @var{STATUS} @tab (Optional) @code{INTEGER} status flag of the default
                         kind.  Returns 0 on success, and a system specific
                         and nonzero error code otherwise.
@@ -2314,14 +2316,15 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{NAME} @tab Scalar @code{CHARACTER} with the file name.
-Trailing blanks are ignored unless the character @code{achar(0)} is
-present, then all characters up to and excluding @code{achar(0)} are
-used as the file name.
 
-@item @var{MODE} @tab Scalar @code{CHARACTER} giving the file permission.
-@var{MODE} uses the same syntax as the @var{MODE} argument of
-@code{/bin/chmod}.
+@item @var{NAME} @tab Scalar @code{CHARACTER} of default kind with the
+file name. Trailing blanks are ignored unless the character
+@code{achar(0)} is present, then all characters up to and excluding
+@code{achar(0)} are used as the file name.
+
+@item @var{MODE} @tab Scalar @code{CHARACTER} of default kind giving the
+file permission. @var{MODE} uses the same syntax as the @var{MODE}
+argument of @code{/bin/chmod}.
 
 @item @var{STATUS} @tab (optional) scalar @code{INTEGER}, which is
 @code{0} on success and nonzero otherwise.
@@ -2873,7 +2876,8 @@ Subroutine, function
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{TIME}    @tab The type shall be of type @code{INTEGER(KIND=8)}.
-@item @var{RESULT}  @tab The type shall be of type @code{CHARACTER}.
+@item @var{RESULT}  @tab The type shall be of type @code{CHARACTER} and
+                         of default kind.
 @end multitable
 
 @item @emph{Return value}:
@@ -2940,9 +2944,12 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{DATE}  @tab (Optional) The type shall be @code{CHARACTER(8)} or larger.
-@item @var{TIME}  @tab (Optional) The type shall be @code{CHARACTER(10)} or larger.
-@item @var{ZONE}  @tab (Optional) The type shall be @code{CHARACTER(5)} or larger.
+@item @var{DATE}  @tab (Optional) The type shall be @code{CHARACTER(LEN=8)}
+                                  or larger, and of default kind.
+@item @var{TIME}  @tab (Optional) The type shall be @code{CHARACTER(LEN=10)}
+                                  or larger, and of default kind.
+@item @var{ZONE}  @tab (Optional) The type shall be @code{CHARACTER(LEN=5)}
+                                  or larger, and of default kind.
 @item @var{VALUES}@tab (Optional) The type shall be @code{INTEGER(8)}.
 @end multitable
 
@@ -3887,7 +3894,8 @@ TIME())}.
 This intrinsic is provided in both subroutine and function forms; however,
 only one form can be used in any given program unit.
 
-@var{DATE} is an @code{INTENT(OUT)} @code{CHARACTER} variable.
+@var{DATE} is an @code{INTENT(OUT)} @code{CHARACTER} variable of the
+default kind.
 
 @item @emph{Standard}:
 GNU extension
@@ -3903,7 +3911,8 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{DATE}@tab The type shall be of type @code{CHARACTER}.
+@item @var{DATE}@tab The type shall be of type @code{CHARACTER} of the
+default kind
 @end multitable
 
 @item @emph{Return value}:
@@ -3999,7 +4008,8 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{C}      @tab The type shall be @code{CHARACTER}.
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+                        kind.
 @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
                         Returns 0 on success, -1 on end-of-file, and a
                         system specific positive error code otherwise.
@@ -4061,9 +4071,11 @@ Subroutine, function
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{UNIT}   @tab The type shall be @code{INTEGER}.
-@item @var{C}      @tab The type shall be @code{CHARACTER}.
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. Returns 0 on success,
-                        -1 on end-of-file and a system specific positive error code otherwise.
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+                        kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
+                        Returns 0 on success, -1 on end-of-file and a
+                        system specific positive error code otherwise.
 @end multitable
 
 @item @emph{Example}:
@@ -4241,9 +4253,11 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{C}      @tab The type shall be @code{CHARACTER}.
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. Returns 0 on success,
-                        -1 on end-of-file and a system specific positive error code otherwise.
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+                        kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
+                        Returns 0 on success, -1 on end-of-file and a
+                        system specific positive error code otherwise.
 @end multitable
 
 @item @emph{Example}:
@@ -4296,9 +4310,11 @@ Subroutine, function
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{UNIT}   @tab The type shall be @code{INTEGER}.
-@item @var{C}      @tab The type shall be @code{CHARACTER}.
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}. Returns 0 on success,
-                        -1 on end-of-file and a system specific positive error code otherwise.
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+                        kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
+                        Returns 0 on success, -1 on end-of-file and a
+                        system specific positive error code otherwise.
 @end multitable
 
 @item @emph{Example}:
@@ -4656,7 +4672,7 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{RESULT}  @tab Shall of type @code{CHARACTER}.
+@item @var{RESULT}  @tab Shall of type @code{CHARACTER} and of default
 @end multitable
 
 @item @emph{Example}:
@@ -4703,6 +4719,8 @@ Subroutine
 @multitable @columnfractions .15 .70
 @item @var{POS}   @tab Shall be of type @code{INTEGER} and not wider than
 the default integer kind; @math{@var{POS} \geq 0}
+@item @var{VALUE} @tab Shall be of type @code{CHARACTER} and of default
+kind.
 @item @var{VALUE} @tab Shall be of type @code{CHARACTER}. 
 @end multitable
 
@@ -4757,7 +4775,8 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{COMMAND} @tab Shall be of type @code{CHARACTER}. 
+@item @var{COMMAND} @tab Shall be of type @code{CHARACTER} and of default
+kind.
 @end multitable
 
 @item @emph{Return value}:
@@ -4802,8 +4821,10 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{NUMBER} @tab Shall be a scalar of type @code{INTEGER(4)}, @math{@var{N} \geq 0}.
-@item @var{VALUE}  @tab (Option) Shall be a scalar of type @code{CHARACTER(1)}. 
+@item @var{NUMBER} @tab Shall be a scalar of type @code{INTEGER(4)},
+                        @math{@var{NUMBER} \geq 0}
+@item @var{VALUE}  @tab Shall be a scalar of type @code{CHARACTER}
+                        and of default kind.
 @item @var{LENGTH} @tab (Option) Shall be a scalar of type @code{INTEGER(4)}. 
 @item @var{STATUS} @tab (Option) Shall be a scalar of type @code{INTEGER(4)}. 
 @end multitable
@@ -4865,7 +4886,7 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{C}      @tab The type shall be @code{CHARACTER}.
+@item @var{C} @tab The type shall be @code{CHARACTER} and of default kind.
 @item @var{STATUS} @tab (Optional) status flag. Returns 0 on success, 
                         a system specific and nonzero error code otherwise.
 @end multitable
@@ -4910,8 +4931,8 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{NAME}   @tab Shall be of type @code{CHARACTER}. 
-@item @var{VALUE}  @tab Shall be of type @code{CHARACTER}. 
+@item @var{NAME}  @tab Shall be of type @code{CHARACTER} and of default kind.
+@item @var{VALUE} @tab Shall be of type @code{CHARACTER} and of default kind.
 @end multitable
 
 @item @emph{Return value}:
@@ -5039,7 +5060,7 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{C} @tab Shall be of type @code{CHARACTER}.
+@item @var{C} @tab Shall be of type @code{CHARACTER} and of default kind.
 @end multitable
 
 @item @emph{Return value}:
@@ -5215,7 +5236,7 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{C }      @tab Shall of type @code{CHARACTER}.
+@item @var{C}    @tab Shall of type @code{CHARACTER} and of default kind.
 @item @var{STATUS}  @tab (Optional) status flag of type @code{INTEGER}.
                          Returns 0 on success, or a system specific error
                          code otherwise.
@@ -7132,10 +7153,11 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{FILE}   @tab The type shall be @code{CHARACTER}, a valid path within the file system.
+@item @var{FILE}   @tab The type shall be @code{CHARACTER} of the default
+kind, a valid path within the file system.
 @item @var{BUFF}   @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 
-                        on success and a system specific error code otherwise.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}.
+Returns 0 on success and a system specific error code otherwise.
 @end multitable
 
 @item @emph{Example}:
@@ -8407,7 +8429,8 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{STRING} @tab A scalar of default @code{CHARACTER} type.
+@item @var{STRING} @tab A scalar of type @code{CHARACTER} and of the
+default kind.
 @end multitable
 
 @item @emph{See also}:
@@ -10158,7 +10181,8 @@ Subroutine, function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{FILE}   @tab The type shall be @code{CHARACTER}, a valid path within the file system.
+@item @var{FILE}   @tab The type shall be @code{CHARACTER}, of the
+default kind and a valid path within the file system.
 @item @var{BUFF}   @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
 @item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 
                         on success and a system specific error code otherwise.