This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[libgfortran/patch] Support NAMELIST I/O of derived type variables(library side)
- From: Victor Leikehman <lei at haifasphere dot co dot il>
- To: Paul Brook <paul at codesourcery dot com>, gcc-patches at gcc dot gnu dot org, fortran <fortran at gcc dot gnu dot org>
- Date: Sun, 15 Aug 2004 11:55:10 +0300
- Subject: [libgfortran/patch] Support NAMELIST I/O of derived type variables(library side)
- Organization: IBM Research Lab in Haifa, Israel
2004-08-15 Victor Leikehman <lei@il.ibm.com>
* io/transfer.c (st_set_nml_var), io/write.c (namelist_write): Take into
account the possibility that st_set_nml_var is called with nulls in
var_name and var_name_len. This happens when passing anonymous fields
of derived type variables. For strings, use string_length field instead
of len. io/io.h (struct namelist_type): New field string_length.
(st_set_nml_var_char): New argument string_length.
--
Victor Leikehman
IBM Research Labs in Haifa, Israel
? list_read.ps
Index: io.h
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/io.h,v
retrieving revision 1.6
diff -c -p -r1.6 io.h
*** io.h 22 Jun 2004 00:43:55 -0000 1.6
--- io.h 15 Aug 2004 08:29:53 -0000
*************** typedef struct namelist_type
*** 90,95 ****
--- 90,96 ----
void * mem_pos;
int value_acquired;
int len;
+ int string_length;
bt type;
struct namelist_type * next;
}
*************** void st_set_nml_var_int (void * , char *
*** 545,551 ****
void st_set_nml_var_float (void * , char * , int , int );
#define st_set_nml_var_char prefix(st_set_nml_var_char)
! void st_set_nml_var_char (void * , char * , int , int );
#define st_set_nml_var_complex prefix(st_set_nml_var_complex)
void st_set_nml_var_complex (void * , char * , int , int );
--- 546,552 ----
void st_set_nml_var_float (void * , char * , int , int );
#define st_set_nml_var_char prefix(st_set_nml_var_char)
! void st_set_nml_var_char (void * , char * , int , int, int string_length);
#define st_set_nml_var_complex prefix(st_set_nml_var_complex)
void st_set_nml_var_complex (void * , char * , int , int );
Index: transfer.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.8
diff -c -p -r1.8 transfer.c
*** transfer.c 5 Jul 2004 01:19:08 -0000 1.8
--- transfer.c 15 Aug 2004 08:29:54 -0000
*************** Boston, MA 02111-1307, USA. */
*** 24,29 ****
--- 24,30 ----
#include "config.h"
#include <string.h>
+ #include <assert.h>
#include "libgfortran.h"
#include "io.h"
*************** st_write_done (void)
*** 1507,1523 ****
static void
st_set_nml_var (void * var_addr, char * var_name, int var_name_len,
! int kind, bt type)
{
namelist_info *t1 = NULL, *t2 = NULL;
namelist_info *nml = (namelist_info *) get_mem (sizeof(
namelist_info ));
nml->mem_pos = var_addr;
! nml->var_name = (char*) get_mem (var_name_len+1);
! strncpy (nml->var_name,var_name,var_name_len);
! nml->var_name[var_name_len] = 0;
nml->len = kind;
nml->type = type;
nml->next = NULL;
--- 1508,1535 ----
static void
st_set_nml_var (void * var_addr, char * var_name, int var_name_len,
! int kind, bt type, int string_length)
{
namelist_info *t1 = NULL, *t2 = NULL;
namelist_info *nml = (namelist_info *) get_mem (sizeof(
namelist_info ));
nml->mem_pos = var_addr;
! if (var_name)
! {
! assert (var_name_len > 0);
! nml->var_name = (char*) get_mem (var_name_len+1);
! strncpy (nml->var_name, var_name, var_name_len);
! nml->var_name[var_name_len] = 0;
! }
! else
! {
! assert (var_name_len == 0);
! nml->var_name = NULL;
! }
!
nml->len = kind;
nml->type = type;
+ nml->string_length = string_length;
nml->next = NULL;
*************** void
*** 1539,1572 ****
st_set_nml_var_int (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_INTEGER);
}
void
st_set_nml_var_float (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_REAL);
}
void
st_set_nml_var_char (void * var_addr, char * var_name, int var_name_len,
! int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_CHARACTER);
}
void
st_set_nml_var_complex (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_COMPLEX);
}
void
st_set_nml_var_log (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_LOGICAL);
}
--- 1551,1585 ----
st_set_nml_var_int (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_INTEGER, 0);
}
void
st_set_nml_var_float (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_REAL, 0);
}
void
st_set_nml_var_char (void * var_addr, char * var_name, int var_name_len,
! int kind, int string_length)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_CHARACTER,
! string_length);
}
void
st_set_nml_var_complex (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_COMPLEX, 0);
}
void
st_set_nml_var_log (void * var_addr, char * var_name, int var_name_len,
int kind)
{
! st_set_nml_var (var_addr, var_name, var_name_len, kind, BT_LOGICAL, 0);
}
Index: write.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/write.c,v
retrieving revision 1.9
diff -c -p -r1.9 write.c
*** write.c 1 Aug 2004 13:40:52 -0000 1.9
--- write.c 15 Aug 2004 08:29:54 -0000
*************** namelist_write (void)
*** 1122,1129 ****
num ++;
t2 = t1;
t1 = t1->next;
! write_character(t2->var_name, strlen(t2->var_name));
! write_character("=",1);
len = t2->len;
p = t2->mem_pos;
switch (t2->type)
--- 1122,1132 ----
num ++;
t2 = t1;
t1 = t1->next;
! if (t2->var_name)
! {
! write_character(t2->var_name, strlen(t2->var_name));
! write_character("=",1);
! }
len = t2->len;
p = t2->mem_pos;
switch (t2->type)
*************** namelist_write (void)
*** 1135,1141 ****
write_logical (p, len);
break;
case BT_CHARACTER:
! write_character (p, len);
break;
case BT_REAL:
write_real (p, len);
--- 1138,1144 ----
write_logical (p, len);
break;
case BT_CHARACTER:
! write_character (p, t2->string_length);
break;
case BT_REAL:
write_real (p, len);