This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, fortran] PR28585: Add Fortran 2003 NEW_LINE intrinsic function


Tobias Burnus wrote:
> Here is an updated version of the patch.
>   
As suggested by Brooks, I modified the test case.

Tobias

2006-10-08  Tobias Burnus  <burnus@net-b.de>

     PR fortran/28585
     * intrinsic.c(add_functions): Add new_line Fortran 2003 intrinsic
       intrinsic.h: Add gfc_simplify_new_line and gfc_check_new_line prototypes
       check.c: Add gfc_check_new_line
       simplify.c: Add gfc_simplify_new_line
     * intrinsic.text: Document new_line intrinsic
     * gfortran.dg/new_line.f90: new testcase

Index: gcc/fortran/intrinsic.c
===================================================================
*** gcc/fortran/intrinsic.c	(Revision 117554)
--- gcc/fortran/intrinsic.c	(Arbeitskopie)
*************** add_functions (void)
*** 1910,1915 ****
--- 1910,1919 ----
  
    make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
  
+   add_sym_1 ("new_line", 0, 0, BT_CHARACTER, dc, GFC_STD_F2003,
+              gfc_check_new_line, gfc_simplify_new_line, NULL,
+              i, BT_CHARACTER, dc, REQUIRED);
+ 
    add_sym_2 ("nint", 1, 1, BT_INTEGER, di, GFC_STD_F77,
  	     gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
  	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
Index: gcc/fortran/intrinsic.h
===================================================================
*** gcc/fortran/intrinsic.h	(Revision 117554)
--- gcc/fortran/intrinsic.h	(Arbeitskopie)
*************** try gfc_check_merge (gfc_expr *, gfc_exp
*** 98,103 ****
--- 98,104 ----
  try gfc_check_minloc_maxloc (gfc_actual_arglist *);
  try gfc_check_minval_maxval (gfc_actual_arglist *);
  try gfc_check_nearest (gfc_expr *, gfc_expr *);
+ try gfc_check_new_line (gfc_expr *);
  try gfc_check_null (gfc_expr *);
  try gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *);
  try gfc_check_precision (gfc_expr *);
*************** gfc_expr *gfc_simplify_modulo (gfc_expr 
*** 255,260 ****
--- 256,262 ----
  gfc_expr *gfc_simplify_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
  			       gfc_expr *);
  gfc_expr *gfc_simplify_nearest (gfc_expr *, gfc_expr *);
+ gfc_expr *gfc_simplify_new_line (gfc_expr *);
  gfc_expr *gfc_simplify_nint (gfc_expr *, gfc_expr *);
  gfc_expr *gfc_simplify_null (gfc_expr *);
  gfc_expr *gfc_simplify_idnint (gfc_expr *);
Index: gcc/fortran/gfortran.texi
===================================================================
*** gcc/fortran/gfortran.texi	(Revision 117554)
--- gcc/fortran/gfortran.texi	(Arbeitskopie)
*************** it will do everything you expect from an
*** 161,167 ****
  @item
  Read a user's program,
  stored in a file and containing instructions written
! in Fortran 77, Fortran 90 or Fortran 95.
  This file contains @dfn{source code}.
  
  @item
--- 161,167 ----
  @item
  Read a user's program,
  stored in a file and containing instructions written
! in Fortran 77, Fortran 90, Fortran 95 or Fortran 2003.
  This file contains @dfn{source code}.
  
  @item
*************** large real-world programs, including
*** 404,410 ****
  @uref{http://mysite.verizon.net/serveall/moene.pdf, the HIRLAM
  weather-forecasting code} and
  @uref{http://www.theochem.uwa.edu.au/tonto/, the Tonto quantum 
! chemistry package}.
  
  Among other things, the GNU Fortran compiler is intended as a replacement
  for G77.  At this point, nearly all programs that could be compiled with
--- 404,411 ----
  @uref{http://mysite.verizon.net/serveall/moene.pdf, the HIRLAM
  weather-forecasting code} and
  @uref{http://www.theochem.uwa.edu.au/tonto/, the Tonto quantum 
! chemistry package}; see @url{http://gcc.gnu.org/wiki/GfortranApps} for an
! extended list.
  
  Among other things, the GNU Fortran compiler is intended as a replacement
  for G77.  At this point, nearly all programs that could be compiled with
*************** The GNU Fortran compiler aims to be a co
*** 1311,1317 ****
  ISO/IEC 1539:1997 (Fortran 95).
  
  In the future it may also support other variants of and extensions to
! the Fortran language.  These include ANSI Fortran 77, ISO Fortran 90,
  ISO Fortran 2003 and OpenMP.
  
  @menu
--- 1312,1318 ----
  ISO/IEC 1539:1997 (Fortran 95).
  
  In the future it may also support other variants of and extensions to
! the Fortran language. These include ANSI Fortran 77, ISO Fortran 90,
  ISO Fortran 2003 and OpenMP.
  
  @menu
Index: gcc/fortran/check.c
===================================================================
*** gcc/fortran/check.c	(Revision 117554)
--- gcc/fortran/check.c	(Arbeitskopie)
*************** gfc_check_nearest (gfc_expr * x, gfc_exp
*** 1827,1832 ****
--- 1827,1840 ----
    return SUCCESS;
  }
  
+ try
+ gfc_check_new_line (gfc_expr * a)
+ {
+   if (type_check (a, 0, BT_CHARACTER) == FAILURE)
+     return FAILURE;
+ 
+   return SUCCESS;
+ }
  
  try
  gfc_check_null (gfc_expr * mold)
Index: gcc/fortran/intrinsic.texi
===================================================================
*** gcc/fortran/intrinsic.texi	(Revision 117554)
--- gcc/fortran/intrinsic.texi	(Arbeitskopie)
*************** Some intrinsics have documentation yet t
*** 183,188 ****
--- 183,189 ----
  * @code{MODULO}:        MODULO,    Modulo function
  * @code{MVBITS}:        MVBITS,    Move bits from one integer to another
  * @code{NEAREST}:       NEAREST,   Nearest representable number
+ * @code{NEW_LINE}:      NEW_LINE,  New line character
  * @code{NINT}:          NINT,      Nearest whole number
  * @code{NOT}:           NOT,       Logical negation
  * @code{NULL}:          NULL,      Function that returns an disassociated pointer
*************** end program test_abs
*** 386,407 ****
  @findex @code{ACCESS} 
  @cindex file system functions
  
- Not yet implemented in GNU Fortran.
- 
  @table @asis
  @item @emph{Description}:
  
  @item @emph{Standard}:
  GNU extension
  
  @item @emph{Class}:
  @item @emph{Syntax}:
  @item @emph{Arguments}:
  @item @emph{Return value}:
  @item @emph{Example}:
! @item @emph{Specific names}:
! @item @emph{See also}:
! @uref{http://gcc.gnu.org/bugzilla/show_bug.cgi?id=19292, g77 features lacking in gfortran}
  
  @end table
  
--- 387,438 ----
  @findex @code{ACCESS} 
  @cindex file system functions
  
  @table @asis
  @item @emph{Description}:
+ @code{ACCESS(NAME, MODE)} checks whether the file @code{NAME} 
+ exists, is readable, writable or executable. Except for the
+ excecutable check, @code{ACCESS} can be replaced by
+ Fortran 95's @code{INTRINSIC}.
  
  @item @emph{Standard}:
  GNU extension
  
  @item @emph{Class}:
+ Inquiry function
+ 
  @item @emph{Syntax}:
+ @code{I = ACCESS(NAME, MODE)}
+ 
  @item @emph{Arguments}:
+ @multitable @columnfractions .15 .80
+ @item @var{NAME} @tab File name of the type scalar @code{CHARACTER}.
+ 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 File access mode, may be any concatenation of
+ @code{"r"} (readable), @code{"w"} (writable), @code{"x"} (executable),
+ or @code{" "} to check for existance.
+ @end multitable
+ 
  @item @emph{Return value}:
+ Returns a scalar @code{INTEGER}, which is @code{0} if the file is
+ accessable in the given mode; otherwise or if an invalid argument
+ has been given for @code{MODE} the value @code{1} is returned.
+ 
  @item @emph{Example}:
! @smallexample
! program access_test
!   implicit none
!   character(len=*), parameter :: file  = 'test.dat'
!   character(len=*), parameter :: file2 = 'test.dat  '//achar(0)
!   if(access(file,' ') == 0) print *, trim(file),' is exists'
!   if(access(file,'r') == 0) print *, trim(file),' is readable'
!   if(access(file,'w') == 0) print *, trim(file),' is writable'
!   if(access(file,'x') == 0) print *, trim(file),' is executable'
!   if(access(file2,'rwx') == 0) &
!     print *, trim(file2),' is readable, writable and executable'
! end program access_test
! @end smallexample
  
  @end table
  
*************** end program test_nearest
*** 5879,5884 ****
--- 5910,5954 ----
  
  
  
+ @node NEW_LINE
+ @section @code{NEW_LINE} --- New line character
+ @findex @code{NEW_LINE} intrinsic
+ @findex @code{NEW_LINE} intrinsic
+ 
+ @table @asis
+ @item @emph{Description}:
+ @code{NEW_LINE(C)} returns the new-line character
+ 
+ @item @emph{Standard}:
+ F2003 and later
+ 
+ @item @emph{Class}:
+ Elemental function
+ 
+ @item @emph{Syntax}:
+ @code{C = NEW_LINE(C)}
+ 
+ @item @emph{Arguments}:
+ @multitable @columnfractions .15 .80
+ @item @var{C}    @tab The argument shall be a scalar or array of the
+                       type @code{CHARACTER}.
+ @end multitable
+ 
+ @item @emph{Return value}:
+ Returns a @var{CHARACTER} scalar of length one with the new-line character of
+ the same kind as parameter @var{C}.
+ 
+ @item @emph{Example}:
+ @smallexample
+ program newline
+   implicit none
+   write(*,'(A)') 'This is record 1.'//NEW_LINE('A')//'This is record 2.'
+ end program newline
+ @end smallexample
+ @end table
+ 
+ 
+ 
  @node NINT
  @section @code{NINT} --- Nearest whole number
  @findex @code{NINT} intrinsic
Index: gcc/fortran/simplify.c
===================================================================
*** gcc/fortran/simplify.c	(Revision 117554)
--- gcc/fortran/simplify.c	(Arbeitskopie)
*************** simplify_nint (const char *name, gfc_exp
*** 2615,2620 ****
--- 2615,2640 ----
  
  
  gfc_expr *
+ gfc_simplify_new_line (gfc_expr * e)
+ {
+   gfc_expr *result;
+   int index;
+ 
+   if (e->expr_type != EXPR_CONSTANT)
+     return NULL;
+ 
+   result = gfc_constant_result (BT_CHARACTER, e->ts.kind, &e->where);
+ 
+   result->value.character.string = gfc_getmem (2);
+ 
+   result->value.character.length = 1;
+   result->value.character.string[0] = '\n';
+   result->value.character.string[1] = '\0';     /* For debugger */
+   return result;
+ }
+ 
+ 
+ gfc_expr *
  gfc_simplify_nint (gfc_expr * e, gfc_expr * k)
  {
    return simplify_nint ("NINT", e, k);
--- /dev/null	2006-09-26 21:08:37.000000000 +0200
+++ gcc/testsuite/gfortran.dg/new_line.f90	2006-10-08 10:14:05.746452750 +0200
@@ -0,0 +1,7 @@
+! { dg-do run }
+! Checks Fortran 2003's new_line intrinsic function
+! PR fortran/28585
+program new_line_check
+    implicit none
+    if(achar(10) /= new_line('a')) call abort()
+end program new_line_check

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]