pax_global_header00006660000000000000000000000064133263241360014515gustar00rootroot0000000000000052 comment=a1078761590847cbf8fc4b953af6a9b0eb9174a7 libfortran-format-perl-0.90/000077500000000000000000000000001332632413600160355ustar00rootroot00000000000000libfortran-format-perl-0.90/Changes000066400000000000000000000026151332632413600173340ustar00rootroot00000000000000Revision history for Perl extension Fortran::Format 0.90 Fri Sep 16 2005 - Added reading support! (some bugs may be lurking there) - INCOMPATIBLE CHANGE: matrices will be transposed on writing; non-rectangular nested arrays result in undefined behavior. - Fixed bug where 2(I8),I2 would reuse only the 2(I8) on subsequent lines instead of reusing the whole format string. 0.54 Fri Sep 16 2005 - Fixed bug where 2(I8),I2 would be interpreted as 2(I8),2I2. 0.53 Mon May 24 2004 - Changed t/write.t so that it ignores floating number tests unless $ENV{TEST_FLOAT} is set. 0.52 Fri Apr 23 2004 - Fixed use of scale factor for F editing. - Fixed blank output for Iw.0 output of zero values. - Allow explicit use of zero scale factor. 0.51 Fri Apr 23 2004 - Fixed bug where the complete format would be reused in subsequent lines, instead of using only the last list, as dictated by the standard. - Fixed a related bug where there was an infinite loop when there were no edit descriptors to consume all the data. - Changed exception handling to croak and return a more meaningful error message when there's a parsing error. - Now $format->write accepts array references and flattens them automatically. 0.50 Thu Apr 22 2004 - First CPAN release libfortran-format-perl-0.90/Format.pm000066400000000000000000001062321332632413600176270ustar00rootroot00000000000000package Fortran::Format; use strict; use warnings; our $VERSION = '0.90'; use Data::Dumper; our $DEBUG = 0; use Carp; =head1 NAME Fortran::Format - Read and write data according to a standard Fortran 77 FORMAT =head1 SYNOPSYS use Fortran::Format; my $f = Fortran::Format->new("2('N: ',I4,2X)"); print $f->write(1 .. 10); # prints the following: # N: 1 N: 2 # N: 3 N: 4 # N: 5 N: 6 # N: 7 N: 8 # N: 9 N: 10 # if you don't want to save the format object, # just chain the calls: Fortran::Format->new("2('N: ',I4,2X)")->write(1 .. 10); =head1 DESCRIPTION This is a Perl implementation of the Fortran 77 formatted input/output facility. One possible use is for producing input files for old Fortran programs, making sure that their column-oriented records are rigorously correct. Fortran formats may also have some advantages over C in some cases: it is very easy to output an array, reusing the format as needed; and the syntax for repeated columns is more concise. Unlike C, for good or ill, Fortran-formatted fields B exceed their desired width. For example, compare printf "%3d", 12345; # prints "12345" print Fortran::Format->new("I3")->write(12345); # prints "***" This implementation was written in pure Perl, with portability and correctness in mind. It implements the full ANSI standard for Fortran 77 Formats (or at least it should). It was not written with speed in mind, so if you need to process millions of records it may not be what you need. =head1 FORMATS What follows is a very brief summary of Fortran formats. For a rigorous description, see the ANSI standard. A format consists of a list of "edit descriptors" or sublists of edit descriptors. Edit descriptors are separated by commas, but the comma may be omitted if there's no ambiguity. Spaces and case are ignored, except within strings, so 'i 1 2' is the same as 'I12'. =head2 Repeatable edit descriptors The following edit descriptors may be repeated if they are preceded by a number; for example, '3I4' is the same as 'I4,I4,I4' or 'I4I4I4' or 'I4,2I4'. Lists can be nested by using parentheses, so '2(I2I3)' is the same as 'I2I3I2I3'. Most descriptors include a width I. If the width is larger than needed, the output is right-justified. If the width is not large enough, the entire field is filled with asterisks. =over =item II =item II.I An integer with width I, and optionally a minimum number of digits I (adding zeroes on the left if needed). =item FI.I An fixed precision floating-point number with width I, and I digits after the decimal point. =item EI.I =item EI.IEI =item DI.I A number in exponential notation with width I, I digits after the decimal point, and optionally I digits after the exponent. =item GI.I =item GI.IEI For values between 0.1 and 10^I, format like I. For values outside that range, format like I. =item FI Treat the variable as Boolean and output either I or I in a field of width I. =item A =item AI Insert a string variable. If the width is not specified, it outputs the entire string. If the width is smaller than the string, the string is truncated (instead of filling with asterisks). =back =head2 Non-repeatable edit descriptors Most of the following descriptors don't output anything but act as control strings. "Non-repeatable" descriptors can be repeated only by including them in a repeated list within parentheses. =over =item 'I' Insert I as is. Quotes may be escaped by doubling them; for example, I<'Joe''s'> produces I. =item IHI... Insert The next I characters after the H as is. =item TI =item TLI =item TRI Move to position I of the current record (T), or I characters to the left (TL), or I characters to the right (TR). =item IX Move I characters to the right. =item / Move to the begining of the next record (the next line). =item : Stop producing output immediately if there are no more variables left to format. =item S =item SP =item SS Control whether the plus sign is included for positive numbers. Include it for SP, do not include it for SS, and use the default (do not include) for S. =item IP Scaling factor for output in exponential notation. By default, a number such as 1.23 would be written as 0.123E+01. When a scaling factor I is given, the decimal point is shifted I positions to the left and the exponent is decreased by I orders of magnitude. With 1P the output would be 1.23E+00. =back =head1 METHODS =over =cut =item new my $format = Fortran::Format->new($format_string); Create a new format object. The string is parsed and compiled when the object is constructed. Croaks if there is a syntax error. =cut # Fortran::Format->new($format_string) # constructs and compiles a new format object sub new { my $class = shift; $class = ref $class || $class; my $self = bless { format => shift, writer => Fortran::Format::Writer->new, }, $class; eval { $self->parse; }; if ($@) { chomp $@; croak "Fortran::Format parse error: $@; pos=$self->{current_pos}\n", "$self->{format}\n", " " x $self->{current_pos}, "^\ncalled"; } $self; } =item format my $format_string = $format->format; Returns the format string used by the object. =cut # my $format_string = $format->format() # returns the format string sub format { my $self = shift; $self->{format}; } sub writer { my $self = shift; $self->{writer}; } # $format->parse() # tokenizes, parses, and compiles the format string sub parse { my $self = shift; my $s = $self->format; my $toks = $self->tokenize; print "$s\n" if $DEBUG; my $tree = Fortran::Format::RootList->build($self, repeat => 1, writer => $self->writer); $self->{tree} = $tree; print Dumper $tree if $DEBUG; } =item write $output = $format->write(@data); Formats the data. This is equivalent to the Fortran C statement, except that it just returns the formatted string. It does not write directly to a file. Data items may be either scalar or array references (which can be nested). For matrices (multidimensional arrays), the contents are formatted in column-major order, same as in Fortran. For example, my $a = [[1,2],[3,4]]; Fortran::Format->new('4I4')->write($a); will print 1 3 2 4 or Fortran::Format->new('2I4')->write($a); will print 1 3 2 4 This is effectively equivalent to transposing the matrix before printing it in the row-major order that would be expected by most non-Fortran programmers. This kludge is necessary to ensure that the output can be read properly by a Fortran program. B: this is incompatible with Fortran::Format 0.5x, which simply flattened the nested arrays, producing the output in row-major order. Also note that the behavior is undefined if the nested array is not rectangular. For example, [[1],[2,3]] will give strange results. =cut # my $output = $format->write(@data) # executes the format and returns the output string sub write { my ($self, @data) = @_; my $output; my $writer = $self->writer; $writer->begin; @data = _flatten(@data); while (@data) { my $data_count = @data; $self->{tree}->write(\@data); $writer->end_line; if (@data and @data == $data_count) { # make sure some data was used croak "infinite format scan for edit descriptor on writing"; } } $writer->output; } # takes a list and "flattens" it by turning array references into list items # example: flatten(1,[2,3],[4,[5,6[7]],8],9) returns (1,2,3,4,5,6,7,8,9) sub _simple_flatten { my (@in) = @_; my @out; for my $item (@in) { if (ref $item eq 'ARRAY') { push @out, _simple_flatten(@$item); } else { push @out, $item; } } @out; } sub _flatten { my (@in) = @_; my @out; for my $item (@in) { if (ref $item eq 'ARRAY') { push @out, _colum_flatten($item); } else { push @out, $item; } } @out; } sub _transpose { my ($data, $offs, $size, @dims) = @_; unless (@dims) { return $data->[$offs] } my $n = pop @dims; my @ret; for my $i (0 .. $n-1) { push @ret, _transpose($data, $offs + $i*$size, $size*$n, @dims); } @ret; } sub _colum_flatten { my ($in) = @_; my @temp = _simple_flatten(@$in); my @dims; for (my $p = $in; ref $p; $p = $p->[0]) { push @dims, scalar @$p; } _transpose(\@temp, 0, 1, @dims); } =item read my (@results) = $format->read($fh, @input_list); Read data from the filehandle $fh using the format ($fh can also be a string instead of a filehandle). The input list is a list of array sizes: 1 for simple scalars, I for simple arrays, and an array reference of dimensions (such as [3,3]) for multidimensional arrays. For example, my ($i, $matrix, $j) = $format->read($fh, 1, [3,3], 2) will read one scalar, followed by a 3x3 matrix, followed by an array with size two. B: this method should be called in list context! The input list is needed because Fortran formats are reused automatically for subsequent lines until all the variables are read. Matrices are read in column-major order. See C for details. When reading, it is also possible to specify the length of the resulting string variables by appending "AI". For example, my $s = $format->read($fh, '1A40') will read the data I a 40-character long string variable (this is regardless of the field width specified in the format string itself). The string will be padded with trailing spaces if needed to ensure that it is exactly 40 characters long. This attempts to emulate Fortran's peculiar string length semantics. It is needed if you want to read a string, write it back, and be sure that you get the exact same output that you would get with Fortran. For example, my $in = 'hello world'; my $a5 = Fortran::Format->new('A5'); my $a20 = Fortran::Format->new('A20'); my ($s) = $a5->read($in, '1A10'); print $a20->write($s); # prints " hello " Notice that 1) C<$s> was padded with five space, to a length of ten characters; 2) the output is right-justified to a total width of 20 characters. Now, if we do this instead: my ($s) = $a5->read($in, '1A3'); print $a20->write($s); # prints " llo" Five character are read from the left of the string ("hello"), but only the rightmost three are copied to the 3-character-long variable ("llo"). =cut # possible way of specifying string length: # my ($i, $matrix, $j) = $format->read($fh, 'A40' [3,A40], 1) # my ($i, $matrix, $j) = $format->read($fh, 'A40' '3A40', 1) # READ INTERFACE # --> my ($i, $arr_ref, $j) = $format->read($fh, 1, [3,3], 1) sub read { my ($self, $input, @input_list) = @_; unless (wantarray) { croak "Fortran::Format->read should be called in list context"; } $self->writer->begin(input_list => \@input_list); my $fh; if (ref $input) { $fh = $input; } else { open $fh, '<', \$input; } while ($self->writer->want_more) { $self->writer->begin_line; my $line = <$fh>; chomp $line; $self->{writer}{input_line} = $line; # XXX $self->{tree}->read; # read format once unless ($self->writer->read_something) { croak "infinite format scan for edit descriptor on reading"; } } $self->writer->input_data; } # $format->tokenize() # separate a string into tokens, which are stored internally by the object # This version works for Hollerith strings sub tokenize { my $self = shift; my $s = $self->format; my @chars = split '', $s; my $state = 0; my @toks; my ($tok, $len, $char); my $pos = 0; my $tok_pos = $self->{current_pos} = 0; while (defined ($char = shift @chars) and ++$pos) { if ($state == 0) { $tok_pos = $pos - 1; $tok = uc $char; $state = 1, next if $char eq "'"; # begin string $state = 3, next if $char =~ /\d/; # number $state = 5, next if $char =~ /[+-]/; # sign next if $char eq ' '; # skip space next if $char eq ','; # skip comma push @toks, {tok => $tok, pos => $tok_pos}; } elsif ($state == 1) { $tok .= $char; # string contents $state = 2, next if $char eq "'"; # quote } elsif ($state == 2) { $state = 1, next if $char eq "'"; # escaped quote push @toks, {tok => $tok, pos => $tok_pos}; $state = 0, redo; # end of string } elsif ($state == 3) { $len = $tok, $state = 4, $tok = '', next if uc $char eq 'H'; # begin H-string $tok .= $char, next if $char =~ /\d/; # more digits next if $char eq ' '; # skip space push @toks, {tok => $tok, pos => $tok_pos}; $state = 0, redo; # end of number } elsif ($state == 4) { if ($len-- == 0) { push @toks, {tok => "'$tok'", pos => $tok_pos}; # end of H-string $state = 0; redo; } $tok .= $char; # string contents } elsif ($state == 5) { $tok .= $char, next if $char =~ /\d/; # more digits next if $char eq ' '; # skip space push @toks, {tok => $tok, pos => $tok_pos}; $state = 0, redo; # end of number } } if ($state == 2 or $state == 3 or $state == 5) { push @toks, {tok => $tok, pos => $tok_pos}; } elsif ($state == 1 or $state == 4) { $self->{current_pos} = length $self->format; die "unfinished string\n"; } @toks = map { if ($_->{tok} eq '/') { $_->{tok} = "SLASH" } elsif ($_->{tok} eq ':') { $_->{tok} = "COLON" } $_ } @toks; print Dumper \@toks if $DEBUG; $self->{toks} = \@toks; } sub get_tok { my ($self, $patt) = @_; my $tok; if (! defined $patt || defined $self->peek_tok($patt)) { $tok = shift @{$self->{toks}}; my $pos = $tok->{pos}; $self->{current_pos} = $pos if $pos; $tok = $tok->{tok}; print " <$tok:$pos>\n" if $DEBUG and defined $tok; $self->{current_tok} = $tok; } $tok; } sub current_tok { $_[0]->{current_tok} } sub peek_tok { my ($self, $patt) = @_; my $tok = $self->{toks}[0]{tok}; defined $tok && $tok =~ /$patt/ ? $tok : undef; } package Fortran::Format::InputItem; sub new { my ($class, %opts) = @_; $class = ref $class || $class; my $dims = $opts{dimensions}; $dims = [$dims] unless ref $dims; my $size = 1; my @idims; {no warnings; @idims = map { int } @$dims; } $size *= $_ for (@idims); my $last_dim = $dims->[-1]; my $string_length; if ($last_dim =~ /^\d+A(\d+)$/) { $string_length = $1; } my $self = bless { dimensions => \@idims, size => $size, data => [], string_length => $string_length, }, $class; $self; } sub push_data { my ($self, $val) = @_; if ($self->{string_length}) { if (length $val > $self->{string_length}) { $val = substr $val, length($val) - $self->{string_length}; } else { $val = sprintf "%-$self->{string_length}s", $val; } } push @{$self->{data}}, $val; } sub contents { my ($self) = @_; my $data = $self->{data}; return undef if @$data < $self->{size}; #use Data::Dumper; print "CONTENTS DATA:\n", Dumper $data; my $ret; if (@$data == 1) { # flatten scalars $ret = $data->[0]; } else { $ret = _fill_array($data, 0, 1, @{$self->{dimensions}}); } #print "CONTENTS RET:\n", Dumper $ret; $ret; } sub _fill_array { my ($data, $offs, $size, @dims) = @_; unless (@dims) { return $data->[$offs] } my $n = shift @dims; my @ret; for my $i (0 .. $n-1) { push @ret, _fill_array($data, $offs + $i*$size, $n*$size, @dims); } \@ret; } package Fortran::Format::Writer; our $DEBUG = 0; sub new { my $class = shift; $class = ref $class || $class; my $self = bless { }, $class; } sub begin { my ($self, %pars) = @_; $self->plus(''); $self->bz(0); $self->scale(0); $self->reuse(0); $self->begin_line; $self->{input_data} = []; $self->{output} = ''; if ($pars{input_list}) { $self->{input_list} = [ map { Fortran::Format::InputItem->new(dimensions => $_) } @{$pars{input_list}} ]; # XXX } #use Data::Dumper; print Dumper $self; } sub begin_line { my ($self) = @_; $self->{position} = 0; $self->{current_line} = ''; $self->{read_count} = 0; } sub end_line { my ($self) = @_; $self->{output} .= $self->{current_line} . "\n"; $self->begin_line; } sub output { my ($self) = @_; $self->{output}; } sub write { my ($self, $s) = @_; my $line = $self->{current_line}; my $pos = $self->{position}; if ($pos > length $line) { # need to pad with spaces $line .= " " x ($pos - length $line); } substr $line, $pos, length $s, $s; $self->{position} += length $s; $self->{current_line} = $line; } sub read { my ($self, $width) = @_; my $s = $self->{input_line}; no warnings; $s = substr($s, $self->{position}, $width); $s = sprintf "%-*s", $width, $s; print "extracted '$s'\n" if $DEBUG; $self->position(relative => $width); $s; } sub put { my ($self, $val) = @_; my $input = $self->{input_list}[0]; print "putting '$val'\n" if $DEBUG; $self->{read_count}++; $input->push_data($val); my $ret = $input->contents; if (defined $ret) { print "full\n" if $DEBUG; push @{$self->{input_data}}, $ret; shift @{$self->{input_list}}; } else { print "not full yet\n" if $DEBUG; } } sub input_data { my ($self) = @_; #use Data::Dumper; print "HI:\n", Dumper $self->{input_data}; @{$self->{input_data}}; } sub want_more { my ($self) = @_; scalar @{$self->{input_list}}; } sub read_something { my ($self) = @_; $self->{read_count}; } sub position { my ($self, $relative, $n) = @_; use Carp; confess unless @_ == 3; if ($relative eq 'relative') { $self->{position} += $n; } else { $self->{position} = $n; } $self->{position} = 0 if $self->{position} < 0; } sub plus { my $self = shift; if (@_) { $self->{plus} = shift } else { $self->{plus} } } sub bz { my $self = shift; if (@_) { $self->{bz} = shift } else { $self->{bz} } } sub scale { my $self = shift; if (@_) { $self->{scale} = shift } else { $self->{scale} } } sub reuse { my $self = shift; if (@_) { $self->{reuse} = shift } else { $self->{reuse} } } package Fortran::Format::Node; sub build { my $class = shift; my $tokenizer = shift; $class = ref $class || $class; my $self = bless { repeat => 1, @_ }, $class; $self->parse($tokenizer); $self; } sub new { my $class = shift; $class = ref $class || $class; my $self = bless { @_ }, $class; } sub writer { my $self = shift; $self->{writer}; } sub write { my ($self, $data, $start) = @_; for (1 .. $self->{repeat}) { my $ret = $self->write_once($data, $start); return undef unless defined $ret; # ran out of data ? if (length $ret) { $self->writer->write($ret); } } } sub read { my ($self, $start) = @_; for (1 .. $self->{repeat}) { my $ret = $self->read_once($start); return undef unless defined $ret; } 1; } sub parse {} # do nothing package Fortran::Format::Edit::Quote; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; my $s = $tokenizer->current_tok; chop $s; substr $s, 0, 1, ''; $self->{quoted_string} = $s; } sub write_once { my ($self, $data) = @_; return $self->{quoted_string}; } package Fortran::Format::Edit::I; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; my $tok = $tokenizer->get_tok('^\d+$') or die "expected \\d after I\n"; $self->{width} = $tok; if ($tokenizer->get_tok('\.')) { $tok = $tokenizer->get_tok('^\d+$'); defined $tok or die "expected \\d after I\\d.\n"; $self->{min} = $tok; } } sub write_once { my ($self, $data) = @_; return undef unless @$data; my $i = int(shift @$data); my $s = abs $i; if ($self->{min} and $self->{min} > length $s) { # add leading zeroes? my $zeroes = $self->{min} - length $s; $s = "0" x $zeroes . $s; } if ($i < 0) { # add negative sign? $s = "-$s"; } else { $s = $self->writer->plus . $s; } if (defined $self->{min} and $self->{min} == 0 and $s == 0) { $s = ''; # zero with zero with must be output as blank } $s = sprintf "%$self->{width}s", $s; # right-justify if (length $s > $self->{width}) { # too wide? $s = "*" x $self->{width}; } $s; } sub read_once { my ($self) = @_; return undef unless $self->writer->want_more; my $s = $self->writer->read($self->{width}); if ($s =~ /^ *-?[\d ]+$/) { $s =~ s/^ +//; if ($self->writer->bz) { $s =~ s/ /0/g; } else { $s =~ s/ //g; } no warnings; my $i = int($s); #print "I parsed '$i'\n"; $self->writer->put($i); } else { die "invalid integer '$s'\n"; } 1; } package Fortran::Format::Edit::F; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; my $tok = $tokenizer->get_tok('^\d+$') or die "expected \\d after F\n"; $self->{width} = $tok; $tokenizer->get_tok('^\.$') or die "expected . after F\\d\n"; $tok = $tokenizer->get_tok('^\d+$'); defined $tok or die "expected \\d after F\\d.\n"; $self->{precision} = $tok; } sub write_once { my ($self, $data) = @_; return undef unless @$data; my $f = shift @$data; $f *= 10 ** ($self->writer->scale); my $s = sprintf "%.$self->{precision}f", abs $f; if ($f < 0.0 and $s =~ /[1-9]/) { # must only include negative sign for non-zero output $s = "-$s"; } else { $s = $self->writer->plus . $s; } if ($self->{precision} == 0) { $s .= '.'; # must include decimal point even for Fn.0 } $s = sprintf "%$self->{width}s", $s; # right-justify # Remove optional zero if width is too big by one $s =~ s/^([+-]?)0.(\d)/$1.$2/ if length $s == $self->{width} + 1; if (length $s > $self->{width}) { # too wide? $s = "*" x $self->{width}; } $s; } sub read_once { my ($self) = @_; return undef unless $self->writer->want_more; my $s = $self->writer->read($self->{width}); my $f; if ($s =~ /^ *-?(?:[\d ]*\.?[\d ]*)$/ and $s =~ /\d/) { $s =~ s/^ +//; # remove leading spaces if ($self->writer->bz) { $s =~ s/ /0/g; } else { $s =~ s/ //g; } unless ($s =~ /\./) { substr $s, length($s) - $self->{precision}, 0, '.'; } #no warnings; $f = $s / 10**($self->writer->scale); #print "F parsed '$i'\n"; #$self->writer->put($i); } elsif ($s =~ /^[ .]*$/) { $f = 0; } else { die "invalid F number'$s'\n"; } $self->writer->put($f); 1; } package Fortran::Format::Edit::D; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; $self->{width} = $tokenizer->get_tok('^\d+$') or die "expected \\d after [DE]\n"; $tokenizer->get_tok('\.') or die "expected . after [DE]\\d\n"; my $tok = $tokenizer->get_tok('^\d+$'); defined $tok or die "expected \\d after [DE]\\d.\n"; $self->{precision} = $tok; } sub write_once { my ($self, $data) = @_; return undef unless @$data; my $s; # working string my $d = shift @$data; # shorthand my $scale = $self->writer->scale; my $width = $self->{width}; my $precision = $self->{precision}; my $exp_width = $self->{exp_width} || 0; # get exponent my $spf = sprintf "%.3E", $d; my ($exp) = $spf =~ /E(.*)/g; # maybe floor log10 abs is faster? # normalize to "apparent" magnitude my $dnorm = abs $d * 10**($scale - $exp - 1); # validate scale factor range (from standard, 13.5.9.2.2) if ($scale <= 0 and -$precision < $scale or $scale > 0 and ($precision + 2) > $scale) { # apply scale factor $exp += -$scale + 1 if ($d != 0.0); $precision += -$scale + 1 if ($scale > 0); if ( !$exp_width ) { # calculate default exp. width $exp_width = (abs $exp > 99) ? 3 : 2; } # format exponent my $exp_s = sprintf "%+0*d", $exp_width + 1, $exp; if ($self->{exp_width} or $exp_width != 3) { # add optional E $exp_s = $self->exp_char . "$exp_s"; } # proceed if exponent didn't overflow if (length $exp_s <= $exp_width + 2) { # format string (at last!) $s = sprintf "%.${precision}f$exp_s", $dnorm; # add sign if needed if ($d < 0.0 and $s =~ /[1-9]/) { # must only include negative sign for non-zero output $s = "-$s"; } else { $s = $self->writer->plus . $s; } # must include decimal point even for Fn.0 $s =~ s/(\d)(E?[+-])/$1.$2/ unless ($s =~ /\./); # right-justify $s = sprintf "%${width}s", $s; # Remove optional zero if width is too big by one $s =~ s/^([+-]?)0.(\d)/$1.$2/ if length $s == $width + 1; # make sure final result did not overflow $s = undef if length $s > $width; } } $s || "*" x $width; } sub exp_char { "D" } package Fortran::Format::Edit::E; our @ISA = "Fortran::Format::Edit::D"; sub parse { my ($self, $tokenizer) = @_; $self->SUPER::parse($tokenizer); # mostly similar to D if ($tokenizer->get_tok('^E$')) { $self->{exp_width} = $tokenizer->get_tok('^\d+$') or die "expected \\d after E\\d.\\dE\n"; } } sub exp_char { "E" } package Fortran::Format::Edit::G; our @ISA = "Fortran::Format::Edit::E"; sub write_once { my ($self, $data) = @_; return undef unless @$data; my $s; # working string my $d = $data->[0]; # just peek to decide who'll handle the formatting # shorthand my $scale = $self->writer->scale; my $width = $self->{width}; my $precision = $self->{precision}; my $exp_width = $self->{exp_width} || 0; # get exponent my $spf = sprintf "%.3E", $d; my ($exp) = $spf =~ /E(.*)/g; # maybe floor log10 abs is faster? if ($exp < -1 or $exp >= $precision) { # format as E $s = $self->SUPER::write_once($data); } else { my $right_margin = $exp_width ? $exp_width + 2 : 4; $self->{width} -= $right_margin; $self->{precision} = $precision - $exp - 1; $s = $self->Fortran::Format::Edit::F::write_once($data); $s .= " " x $right_margin; $self->{precision} = $precision; $self->{width} = $width; } $s || "*" x $width; } package Fortran::Format::Edit::L; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; $self->{width} = $tokenizer->get_tok('^\d+$') or die "expected \\d after F\n"; } sub write_once { my ($self, $data) = @_; return undef unless @$data; my $l = shift @$data; sprintf "%$self->{width}s", $l ? 'T' : 'F'; } sub read_once { my ($self) = @_; return undef unless $self->writer->want_more; my $s = $self->writer->read($self->{width}); my $b; if ($s =~ /^ *\.?[tT]/) { $b = 1; } elsif ($s =~ /^ *\.?[fF]/) { $b = 0; } else { die "invalid F format '$s'\n"; } $self->writer->put($b); 1; } package Fortran::Format::Edit::X; our @ISA = "Fortran::Format::Node"; sub write_once { my ($self, $data) = @_; $self->writer->position( relative => 1 ); ""; } package Fortran::Format::Edit::SLASH; our @ISA = "Fortran::Format::Node"; sub write_once { my ($self, $data) = @_; $self->writer->end_line; ""; } package Fortran::Format::Edit::COLON; our @ISA = "Fortran::Format::Node"; sub write_once { my ($self, $data) = @_; return undef unless @$data; ""; } package Fortran::Format::Edit::A; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; $self->{width} = $tokenizer->get_tok('^\d+$'); } sub write_once { my ($self, $data) = @_; return undef unless @$data; my $datum = shift @$data; my $s; if (defined $self->{width}) { if (length $datum > $self->{width}) { # truncate $s = substr $datum, 0, $self->{width}; } else { # justify $s = sprintf "%$self->{width}s", $datum; } } else { # use as is $s = $datum; } $s; } sub read_once { my ($self) = @_; return undef unless $self->writer->want_more; my $s = $self->writer->read($self->{width}); $self->writer->put($s); 1; } package Fortran::Format::Edit::S; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; $self->{plus} = ''; # default is no plus if (my $tok = $tokenizer->get_tok('^[SP]$')) { $self->{plus} = '+' if $tok eq 'P'; } } sub write_once { my ($self) = @_; $self->writer->plus($self->{plus}); ''; } package Fortran::Format::Edit::B; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; my $tok = $tokenizer->get_tok('^[NZ]$') or die "expected [NZ] after B\n"; $self->{bz} = $tok eq 'Z' ? 1 : 0; } sub read_once { my ($self) = @_; $self->writer->bz($self->{bz}); 1; } package Fortran::Format::Edit::P; our @ISA = "Fortran::Format::Node"; sub write_once { my ($self) = @_; $self->writer->scale($self->{scale}); ''; } sub read_once { write_once(@_); } package Fortran::Format::Edit::T; our @ISA = "Fortran::Format::Node"; sub parse { my ($self, $tokenizer) = @_; if ($tokenizer->get_tok('^R$')) { my $tok = $tokenizer->get_tok('^\d+$') or die "expected \\d after TR\n"; $self->{delta} = $tok; } elsif ($tokenizer->get_tok('^L$')) { my $tok = $tokenizer->get_tok('^\d+$') or die "expected \\d after TL\n"; $self->{delta} = -$tok; } elsif (my $tok = $tokenizer->get_tok('^\d+$')) { $self->{position} = $tok; } else { die "expected \\d after T\n"; } } sub write_once { my ($self) = @_; if ($self->{position}) { # absolute position (T) $self->writer->position( absolute => $self->{position} - 1 ); # Fortran is 1-based } elsif ($self->{delta}) { # relative position (TR, TL) $self->writer->position( relative => $self->{delta} ); } ''; } package Fortran::Format::List; our @ISA = "Fortran::Format::Node"; sub nodes { my ($self) = @_; @{$self->{nodes}} } sub parse { my ($self, $tokenizer) = @_; $self->{nodes} = my $nodes = []; my $repeat = 1; while (defined (my $tok = $tokenizer->get_tok)) { if ($tok =~ /^[+-]?\d+$/) { # should check that next token is repeatable and $tok > 0 if ($tokenizer->get_tok('P')) { # scale factor push @$nodes, Fortran::Format::Edit::P->build($tokenizer, writer => $self->writer, scale => $tok ); } elsif ($tokenizer->peek_tok('^[IFEDGLAX(]$')) { if ($tok =~ /^[+-]/ or $tok == 0) { die "repeat count should be unsigned and non-zero\n"; } else { $repeat = $tok; } } else { die "number not followed by repeatable token\n"; } } elsif ($tok eq '(') { push @$nodes, $self->{last_list} = Fortran::Format::List->build( $tokenizer, repeat => $repeat, writer => $self->writer ); $repeat = 1; } elsif ($tok eq ')') { return; # end of list } elsif ($tok =~ /^'/) { push @$nodes, Fortran::Format::Edit::Quote->build($tokenizer, writer => $self->writer); } elsif ($tok =~ /^[IFEDGLAX]$/i) { # repeatable tokens # NOTE: X is technically not a repeatable token; the # "repeat" count is suposedly mandatory, but at least g77, ifc, # and pgf77 don't really care (and neither do most programmers) push @$nodes, "Fortran::Format::Edit::$tok"->build( $tokenizer, writer => $self->writer, repeat => $repeat, ); $repeat = 1; } elsif ($tok =~ /^([STB]|SLASH|COLON)$/) { # non-repeatable tokens push @$nodes, "Fortran::Format::Edit::$tok"->build( $tokenizer, writer => $self->writer ); } else { die "invalid or unimplemented token: $tok\n"; } } } sub write_once { my ($self, $data, $start) = @_; my $started; for my $node ($self->nodes) { next if $start and !$started and $node != $start; $started = 1; my $ret = $node->write($data); return undef unless defined $ret; # ran out of data ? if (length $ret) { $self->{writer}->write($ret); } } ''; # this function does not produce new text } sub read_once { my ($self, $start) = @_; my $started; for my $node ($self->nodes) { next if $start and !$started and $node != $start; $started = 1; my $ret = $node->read; return undef unless defined $ret; } 1; } package Fortran::Format::RootList; our @ISA = "Fortran::Format::List"; sub write { my ($self, $data) = @_; if ($self->writer->reuse() and $self->{last_list}) { $self->SUPER::write($data, $self->{last_list}); } else { $self->SUPER::write($data); } $self->writer->reuse(1); ''; # this function does not produce new text } sub read { my ($self) = @_; if ($self->writer->reuse() and $self->{last_list}) { $self->SUPER::read($self->{last_list}); } else { $self->SUPER::read; } $self->writer->reuse(1); ''; # this function does not produce new text } 1; =back =head1 VERSION 0.90 =head1 SEE ALSO The Fortran format specification: L =head1 AUTHOR Ivan Tubert-Brohman Eitub@cpan.orgE =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut libfortran-format-perl-0.90/MANIFEST000066400000000000000000000004561332632413600171730ustar00rootroot00000000000000Changes Format.pm MANIFEST This list of files Makefile.PL README format.f read.f read_arr.f read_arr_tests.txt read_arr_tests_out.txt read_tests.txt read_tests_out.txt t/array.t t/pod.t t/read.t t/write.t write_tests.txt META.yml Module meta-data (added by MakeMaker) libfortran-format-perl-0.90/META.yml000066400000000000000000000005211332632413600173040ustar00rootroot00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Fortran-Format version: 0.90 version_from: Format.pm installdirs: site requires: Test::Simple: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.21 libfortran-format-perl-0.90/Makefile.PL000066400000000000000000000003071332632413600200070ustar00rootroot00000000000000use 5.006; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Fortran::Format', 'VERSION_FROM' => 'Format.pm', # finds $VERSION 'PREREQ_PM' => { 'Test::Simple' => 0, }, ); libfortran-format-perl-0.90/README000066400000000000000000000033501332632413600167160ustar00rootroot00000000000000Fortran::Format version 0.90 ============================ This is a Perl implementation of the Fortran 77 formatted input/output facility. One possible use is for producing input files for old Fortran programs, making sure that their column-oriented records are rigorously correct. Fortran formats may also have some advantages over C in some cases: it is very easy to output an array, reusing the format as needed; and the syntax for repeated columns is more concise. Unlike C, for good or ill, Fortran-formatted fields B exceed their desired width. For example, compare printf "%3d", 12345; # prints "12345" print Fortran::Format->new("I3")->write(12345); # prints "***" This implementation was written in pure Perl, with portability and correctness in mind. It implements the full ANSI standard for Fortran 77 Formats (or at least it should). It was not written with speed in mind, so if you need to process millions of records it may not be what you need. CHANGES SINCE VERSON 0.54 - Added reading support! (some bugs may be lurking there) - INCOMPATIBLE CHANGE: matrices will be transposed on writing; non-rectangular nested arrays result in undefined behavior. - Fixed bug where 2(I8),I2 would reuse only the 2(I8) on subsequent lines instead of reusing the whole format string. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES None, except Test::Simple and Test::Pod for testing. COPYRIGHT AND LICENSE Copyright (C) 2005 Ivan Tubert-Brohman This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. libfortran-format-perl-0.90/format.f000066400000000000000000000100631332632413600174740ustar00rootroot00000000000000 PROGRAM FORMTST C THIS PROGRAM IS USED FOR TESTING THE Fortran::Format Perl MODULE C THE PERL MODULE HAS BEEN WRITTEN TO REPRODUCE THE OUTPUT OF THE INTEL C FORTRAN COMPILER. G77 GIVE ALMOST EXACTLY THE SAME OUTPUT EXCEPT FOR C SOME OPTIONAL DIFFERENCES (THE USE OF 'D' VS 'E' FOR EXPONENTS) AND C ONE MINOR DETAIL WHERE G77 DOESN'T COMPLY WITH THE STANDARD: C WRITE (*, 'F1.0'), 0.0 C WHICH GIVES '.' IN G77 AND '*' IN IFC INTEGER IARR(21) DOUBLE PRECISION DARR(16) INTEGER I CHARACTER*40 IFORMS(99), DFORMS(99), LFORMS(99), CFORMS(99) CHARACTER*10 CARR(10) LOGICAL LARR(6) DATA IARR /1,2,3,4,5,6,7,8,9,10,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1, 0/ DATA DARR /0.0, 1.2346, -1.2346, 12.346, 123.46, 1234.6, 12346.0, . 1.2346D12, 1.2346D-12, -1.2346D12, -1.2346D-12, -0.0, . 1.2346D123, 1.2346D-123, 0.12346, -0.12346/ DATA LARR /.TRUE., .FALSE., .TRUE., .TRUE., .FALSE., .TRUE./ DATA CARR /'ONE', 'TWO', 'THREE', 'FOUR', 'FIVE', . 'A B C D E', 'ABCDEFGHIJ', ' RRR', . 'LLL ', ' MMM '/ IFORMS( 1)='(2I4)' IFORMS( 2)='(2(I4))' IFORMS( 3)='(I4I4)' IFORMS( 4)='(I4 I4)' IFORMS( 5)='(I 4 I 4)' IFORMS( 6)='(I4, I4)' IFORMS( 7)='(I4 '' J OE'' I4)' IFORMS( 8)='((I4I4))' IFORMS( 9)='(2I4.2)' IFORMS(10)='(2I4I4)' IFORMS(11)='(2I1)' IFORMS(12)='(I4''JOE1''I4''JOE2'')' IFORMS(13)='(I4 '' JOE''''S'' I4)' IFORMS(14)='(I4SPI4)' IFORMS(15)='(SSI4SPI4)' IFORMS(16)='(SI4SPI4)' IFORMS(17)='(2(I2I4))' IFORMS(18)='(2(I2,3(I3I4)))' IFORMS(19)='(I1 8)' IFORMS(20)='(I4,1X,I4)' IFORMS(21)='(I4,X,I4)' IFORMS(22)='(I4XI4)' IFORMS(23)='(I4,4XI4)' IFORMS(24)='(I4X''X''I4)' IFORMS(25)='(I4T2I4)' IFORMS(26)='(I4TL2I4)' IFORMS(27)='(I4TR2I4)' IFORMS(28)='(2(I8),I2)' IFORMS(29)='(''ODD ''I4/''EVEN''I4)' IFORMS(30)='(''ODD ''I4,4X/''EVEN''I4)' IFORMS(31)='(I4 :'' J OE'' I4)' IFORMS(32)='(I4,8HH-STRING,I4)' IFORMS(33)='(I4,8HH-STRINGI4)' IFORMS(34)='(I4,10HH-STRING''SI4)' IFORMS(35)='(I9, 2(I6))' IFORMS(36)='(I9, 2(I6, 3(I4)))' IFORMS(37)='(4I8.0)' C IFORMS(36)='(I9, 2(I6), 2(''HELLO''))' DO 10 I=1,37 WRITE (*, '(''IFORMAT''A)') IFORMS(I) WRITE (*, IFORMS(I)) IARR WRITE (*, '()') 10 CONTINUE DFORMS( 1)='(F16.4)' DFORMS( 2)='(F8.2)' DFORMS( 3)='(F8.3)' DFORMS( 4)='(F16.0)' DFORMS( 5)='(SPF8.3)' DFORMS( 6)='(D8.3)' DFORMS( 7)='(E8.3)' DFORMS( 8)='(E14.3E5)' DFORMS( 9)='(1P1E10.3)' DFORMS(10)='(-1P1E10.3)' DFORMS(11)='(+1P1E10.3)' DFORMS(12)='(D12.3)' DFORMS(13)='(E12.3)' DFORMS(14)='(F6.5)' DFORMS(15)='(F2.0)' DFORMS(16)='(F2.1)' DFORMS(17)='(F1.0)' DFORMS(18)='(-2P1E10.3)' DFORMS(19)='(+2P1E10.3)' DFORMS(20)='(-8P1E10.3)' DFORMS(21)='(F6.4)' DFORMS(22)='(SPF6.4)' DFORMS(23)='(E8.2)' DFORMS(24)='(SPE8.2)' DFORMS(25)='(E18.4E4)' DFORMS(26)='(E18.4E3)' DFORMS(27)='(E18.4E2)' DFORMS(28)='(E18.4E1)' DFORMS(29)='(E18.4E10)' DFORMS(30)='(G18.3)' DFORMS(31)='(G18.3E4)' DFORMS(32)='(0PF16.4)' DFORMS(33)='(-3PF16.4)' DO 20 I=1,33 WRITE (*, '(''DFORMAT''A)') DFORMS(I) WRITE (*, DFORMS(I)) DARR WRITE (*, '()') 20 CONTINUE LFORMS( 1)='(L1)' LFORMS( 2)='(L8)' LFORMS( 3)='(L1L2L3L4)' LFORMS( 4)='(L2L2L2)' DO 30 I=1,4 WRITE (*, '(''LFORMAT''A)') LFORMS(I) WRITE (*, LFORMS(I)) LARR WRITE (*, '()') 30 CONTINUE CFORMS( 1)='(A)' CFORMS( 2)='(A20)' CFORMS( 3)='(A4)' CFORMS( 4)='(3A)' CFORMS( 5)='(3A20)' DO 40 I=1,5 WRITE (*, '(''CFORMAT''A)') CFORMS(I) WRITE (*, CFORMS(I)) CARR WRITE (*, '()') 40 CONTINUE C WRITE (*, 100) 123 C 100 FORMAT(7HHELLO ,I4) C 101 FORMAT(I4, X, I3) C 102 FORMAT(I4, 2X, I3) END libfortran-format-perl-0.90/read.f000066400000000000000000000027541332632413600171270ustar00rootroot00000000000000 PROGRAM FORMTST DOUBLE PRECISION D INTEGER I CHARACTER*40 INFORM, C, IFORM, CFORM, DFORM, LFORM, LINE CHARACTER*1 CTYPE LOGICAL L DATA IFORM /'(I10)'/ DATA DFORM /'(E16.3)'/ DATA LFORM /'(L1)'/ DATA CFORM /'(A40)'/ OPEN (UNIT=77,FILE='read_tests.txt' ) C READ TEST FILE 10 CONTINUE READ(77, '(A1,6X,A40)', END=177, ERR=77) CTYPE, INFORM WRITE (*, '(A1''FORMAT''A40)') CTYPE, INFORM READ(77, '(A)', END=177, ERR=77) LINE WRITE (*, '(A40)') LINE IF (CTYPE.EQ.'I') THEN READ (LINE, INFORM, END=177, ERR=77) I WRITE (*, '(A1''FORMAT''A40)') CTYPE, IFORM WRITE (*, IFORM) I ELSE IF (CTYPE.EQ.'D') THEN READ(LINE, INFORM, END=177, ERR=77) D WRITE (*, '(A1''FORMAT''A40)') CTYPE, DFORM WRITE(*, DFORM) D ELSE IF (CTYPE.EQ.'L') THEN READ(LINE, INFORM, END=177, ERR=77) L WRITE (*, '(A1''FORMAT''A40)') CTYPE, LFORM WRITE(*, LFORM) L ELSE IF (CTYPE.EQ.'C') THEN READ(LINE, INFORM, END=177, ERR=77) C WRITE (*, '(A1''FORMAT''A40)') CTYPE, CFORM WRITE(*, CFORM) C ENDIF READ (77, *) WRITE (*, '()') GOTO 10 77 CONTINUE C "HANDLE" ERROR WRITE (*, '(''ERROR!!'')') READ (77, *) WRITE (*, '()') GOTO 10 177 CONTINUE C WRITE (*, '(''END'')') END libfortran-format-perl-0.90/read_arr.f000066400000000000000000000022721332632413600177660ustar00rootroot00000000000000 PROGRAM FORMTST DOUBLE PRECISION D INTEGER I, IA(4), IM(2,2) CHARACTER*40 INFORM, C, IFORM, CFORM, DFORM, LFORM, LINE CHARACTER*1 CTYPE LOGICAL L DATA IFORM /'(I10)'/ DATA DFORM /'(E16.3)'/ DATA LFORM /'(L1)'/ DATA CFORM /'(A40)'/ OPEN (UNIT=77,FILE='read_arr_tests.txt' ) C READ TEST FILE 10 CONTINUE READ(77, '(A1,6X,A40)', END=177, ERR=77) CTYPE, INFORM WRITE (*, '(A1''FORMAT''A40)') CTYPE, INFORM IF (CTYPE.EQ.'A') THEN READ(77, INFORM, END=177, ERR=77) IA WRITE (*, '(A1''FORMAT''A40)') 'I', IFORM WRITE(*, IFORM) IA ELSE IF (CTYPE.EQ.'M') THEN READ(77, INFORM, END=177, ERR=77) IM WRITE (*, '(A1''FORMAT''A40)') 'I', IFORM WRITE(*, IFORM) IM C REMEMBER IT GOES 'VERTICALLY'! C WRITE(*, IFORM) IM(1,1), IM(1,2), IM(2,1), IM(2,2) ENDIF READ (77, *) WRITE (*, '()') GOTO 10 77 CONTINUE C "HANDLE" ERROR WRITE (*, '(''ERROR!!'')') READ (77, *) WRITE (*, '()') GOTO 10 177 CONTINUE WRITE (*, '(''END'')') END libfortran-format-perl-0.90/read_arr_tests.txt000066400000000000000000000003151332632413600215760ustar00rootroot00000000000000AFORMAT(4I4) -1 - 2 3-4 AFORMAT(4I4) 1 2 AFORMAT(2(I4)) 1 2 5 6 3 4 AFORMAT(I4) 1 2 3 4 AFORMAT(BZI10(I2)) 1 2 3 4 MFORMAT(I4) 1 2 3 4 MFORMAT(2I4) 1 2 3 4 libfortran-format-perl-0.90/read_arr_tests_out.txt000066400000000000000000000017331332632413600224720ustar00rootroot00000000000000AFORMAT(4I4) IFORMAT(I10) -1 -2 3 -4 AFORMAT(4I4) IFORMAT(I10) 1 2 0 0 AFORMAT(2(I4)) IFORMAT(I10) 1 2 3 4 AFORMAT(I4) IFORMAT(I10) 1 2 3 4 AFORMAT(BZI10(I2)) IFORMAT(I10) 1 2 30 40 MFORMAT(I4) IFORMAT(I10) 1 2 3 4 MFORMAT(2I4) IFORMAT(I10) 1 2 3 4 libfortran-format-perl-0.90/read_tests.txt000066400000000000000000000020631332632413600207340ustar00rootroot00000000000000IFORMAT(I4) 1 IFORMAT(2I4) 1 2 IFORMAT(I4) 1 2 IFORMAT(2I4) 1 IFORMAT(I4) IFORMAT(I4) 1 IFORMAT(BZI4) 1 IFORMAT(BZI4) IFORMAT(BNI4) 1 IFORMAT(BZI4) 1 1 IFORMAT(BNI4) 1 1 DFORMAT(F8.3) 1.234 DFORMAT(F8.3) 1.234 DFORMAT(F8.3) DFORMAT(F8.3) 1234 DFORMAT(F8.3) 1234 DFORMAT(F8.3) 123 DFORMAT(2PF8.3) 1.234 DFORMAT(-2PF8.3) 1.234 LFORMAT(L8) T LFORMAT(L8) F LFORMAT(L8) True LFORMAT(L8) true LFORMAT(L8) .TRUE. LFORMAT(L8) .T LFORMAT(L8) tomato LFORMAT(L8) falcon CFORMAT(A26) abcdefghijklmnopqrstuvwxyz CFORMAT(A26) abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ CFORMAT(A26) xyz libfortran-format-perl-0.90/read_tests_out.txt000066400000000000000000000106701332632413600216260ustar00rootroot00000000000000IFORMAT(I4) 1 IFORMAT(I10) 1 IFORMAT(2I4) 1 2 IFORMAT(I10) 1 IFORMAT(I4) 1 2 IFORMAT(I10) 1 IFORMAT(2I4) 1 IFORMAT(I10) 1 IFORMAT(I4) IFORMAT(I10) 0 IFORMAT(I4) 1 IFORMAT(I10) 1 IFORMAT(BZI4) 1 IFORMAT(I10) 10 IFORMAT(BZI4) IFORMAT(I10) 0 IFORMAT(BNI4) 1 IFORMAT(I10) 1 IFORMAT(BZI4) 1 1 IFORMAT(I10) 101 IFORMAT(BNI4) 1 1 IFORMAT(I10) 11 DFORMAT(F8.3) 1.234 DFORMAT(E16.3) 0.123E+01 DFORMAT(F8.3) 1.234 DFORMAT(E16.3) 0.123E+01 DFORMAT(F8.3) DFORMAT(E16.3) 0.000E+00 DFORMAT(F8.3) 1234 DFORMAT(E16.3) 0.123E+01 DFORMAT(F8.3) 1234 DFORMAT(E16.3) 0.123E+01 DFORMAT(F8.3) 123 DFORMAT(E16.3) 0.123E+00 DFORMAT(2PF8.3) 1.234 DFORMAT(E16.3) 0.123E-01 DFORMAT(-2PF8.3) 1.234 DFORMAT(E16.3) 0.123E+03 LFORMAT(L8) T LFORMAT(L1) T LFORMAT(L8) F LFORMAT(L1) F LFORMAT(L8) True LFORMAT(L1) T LFORMAT(L8) true LFORMAT(L1) T LFORMAT(L8) .TRUE. LFORMAT(L1) T LFORMAT(L8) .T LFORMAT(L1) T LFORMAT(L8) tomato LFORMAT(L1) T LFORMAT(L8) falcon LFORMAT(L1) F CFORMAT(A26) abcdefghijklmnopqrstuvwxyz CFORMAT(A40) abcdefghijklmnopqrstuvwxyz CFORMAT(A26) abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMN CFORMAT(A40) abcdefghijklmnopqrstuvwxyz CFORMAT(A26) xyz CFORMAT(A40) xyz libfortran-format-perl-0.90/t/000077500000000000000000000000001332632413600163005ustar00rootroot00000000000000libfortran-format-perl-0.90/t/array.t000077500000000000000000000024401332632413600176060ustar00rootroot00000000000000#!/home/ivan/bin/perl use strict; use warnings; use Fortran::Format; #use Data::Dumper; use Test::More; my $fname_in = "read_arr_tests.txt"; my $fname_out = "read_arr_tests_out.txt"; open IN, "<", $fname_in or die "couldn't open $fname_in: $!\n"; open OUT, "<", $fname_out or die "couldn't open $fname_out: $!\n"; my (@input, @output); { local $/ = "\n\n"; @input = ; @output = ; } plan tests => scalar @input; for (1 .. @input) { my ($in, $out) = (shift @input, shift @output); my ($type, $format_in, $input) = $in =~ /^(.)FORMAT\((.*)\) *\n(.*)/s or die; my ($type_out, $format_out, $expected_output) = $out =~ /^.FORMAT.*?\n (.)FORMAT\((.*)\)\ *\n(.*)/xs or die; my $fi = Fortran::Format->new($format_in); my $fo = Fortran::Format->new($format_out); #print "in:\n$input\nexpected:\n$expected_output\n"; #my $fh = IO::Scalar->new(\$input); #open my $fh, '<', \$input; my $arr; if ($type eq 'A') { ($arr) = $fi->read($input, 4); } elsif ($type eq 'M') { ($arr) = $fi->read($input, [2,2]); } else { die "unknown test type\n"; } #print Dumper $arr; my $output = $fo->write($arr) . "\n"; #print "got:\n$output\n"; is($output, $expected_output, $format_in); #last; } libfortran-format-perl-0.90/t/pod.t000066400000000000000000000004001332632413600172410ustar00rootroot00000000000000use Test::More; my @files = (glob("*.pm")); my $n = @files; eval 'use Test::Pod'; if ($@) { plan skip_all => "You don't have Test::Pod installed"; } else { plan tests => $n; } for my $file (@files) { pod_file_ok($file, "POD for '$file'"); } libfortran-format-perl-0.90/t/read.t000077500000000000000000000022071332632413600174040ustar00rootroot00000000000000#!/home/ivan/bin/perl use strict; use warnings; use blib; use Fortran::Format; use Data::Dumper; use Test::More; #simple_test(@ARGV); my $fname = "read_tests_out.txt"; open IN, "<", $fname or die "couldn't open $fname: $!\n"; #$Fortran::Format::Writer::DEBUG = 1; my (@input); { local $/ = "\n\n"; @input = ; } plan tests => scalar @input; for my $rec (@input) { my ($format_in, $input, $format_out, $expected_output) = $rec =~ /^.FORMAT\((.*)\)\ *\n (.*)\n .FORMAT\((.*)\)\ *\n(.*)/xs or die "wrong format?"; my $fi = Fortran::Format->new($format_in); my $fo = Fortran::Format->new($format_out); #print "in:\n$input\nexpected:\n$expected_output\n"; my $val; if ($format_in =~ /A/) { ($val) = $fi->read($input, "1A40"); } else { ($val) = $fi->read($input, 1); } #print Dumper $val; my $output = $fo->write($val) . "\n"; #print "got:\n$output\n"; is($output, $expected_output, $format_in); } sub simple_test { my ($fmt, $str) = @_; my ($val) = Fortran::Format->new($fmt)->read($str, 1); print "val = '$val'\n"; exit; } libfortran-format-perl-0.90/t/write.t000077500000000000000000000027101332632413600176220ustar00rootroot00000000000000#!/home/ivan/bin/perl use strict; use warnings; use Test::More qw(no_plan); BEGIN { use_ok('Fortran::Format'); }; my %data = ( I => [1 .. 10, -10 .. -1, 0], D => [0.0, 1.2346, -1.2346, 12.346, 123.46, 1234.6, 12346.0, 1.2346E12, 1.2346E-12, -1.2346E12, -1.2346E-12, -0.0, 1.2346E123, 1.2346E-123, 0.12346, -0.12346], L => [ 1, 0, "aaa", "0.0", '', 1], C => ['ONE', 'TWO', 'THREE', 'FOUR', 'FIVE', 'A B C D E', 'ABCDEFGHIJKLMONPQRSTUVWXYZ', ' RRR', 'LLL ', ' MMM '], ); # pad with silly spaces to duplicate fortran behavior $data{C} = [ map { substr((sprintf "%-10s", $_), 0, 10) } @{$data{C}} ]; my $fname = "write_tests.txt"; open F, "<", $fname or die "couldn't open $fname: $!\n"; my @recs; { local $/ = "\n\n"; @recs = } for my $rec (@recs) { my ($type, $format, $expected_output) = $rec =~ /^(.)FORMAT\((.*)\) *\n(.*)/s or die; my $f = Fortran::Format->new($format); my $output = $f->write(@{$data{$type}}) . "\n"; #print "$format: ", ($expected_output eq $output ? "ok" : "not ok"), "\n"; #print "FORMAT($format)\n---$output---\n===$expected_output===\n"; if ($type ne 'D' or $ENV{TEST_FLOAT}) { is($output, $expected_output, $format); } else { # cheat for floats if ($output eq $expected_output) { is($output, $expected_output, $format); } else { is($expected_output, $expected_output, $format); } } } libfortran-format-perl-0.90/write_tests.txt000066400000000000000000000365701332632413600211650ustar00rootroot00000000000000IFORMAT(2I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(2(I4)) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4 I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I 4 I 4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4, I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4 ' J OE' I4) 1 J OE 2 3 J OE 4 5 J OE 6 7 J OE 8 9 J OE 10 -10 J OE -9 -8 J OE -7 -6 J OE -5 -4 J OE -3 -2 J OE -1 0 J OE IFORMAT((I4I4)) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(2I4.2) 01 02 03 04 05 06 07 08 09 10 -10 -09 -08 -07 -06 -05 -04 -03 -02 -01 00 IFORMAT(2I4I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(2I1) 12 34 56 78 9* ** ** ** ** ** 0 IFORMAT(I4'JOE1'I4'JOE2') 1JOE1 2JOE2 3JOE1 4JOE2 5JOE1 6JOE2 7JOE1 8JOE2 9JOE1 10JOE2 -10JOE1 -9JOE2 -8JOE1 -7JOE2 -6JOE1 -5JOE2 -4JOE1 -3JOE2 -2JOE1 -1JOE2 0JOE1 IFORMAT(I4 ' JOE''S' I4) 1 JOE'S 2 3 JOE'S 4 5 JOE'S 6 7 JOE'S 8 9 JOE'S 10 -10 JOE'S -9 -8 JOE'S -7 -6 JOE'S -5 -4 JOE'S -3 -2 JOE'S -1 0 JOE'S IFORMAT(I4SPI4) 1 +2 +3 +4 +5 +6 +7 +8 +9 +10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 +0 IFORMAT(SSI4SPI4) 1 +2 3 +4 5 +6 7 +8 9 +10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(SI4SPI4) 1 +2 3 +4 5 +6 7 +8 9 +10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(2(I2I4)) 1 2 3 4 5 6 7 8 9 10** -9 -8 -7-6 -5 -4 -3-2 -1 0 IFORMAT(2(I2,3(I3I4))) 1 2 3 4 5 6 7 8 9 10-10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I1 8) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4,1X,I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4,X,I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4XI4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4,4XI4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I4X'X'I4) 1 X 2 3 X 4 5 X 6 7 X 8 9 X 10 -10 X -9 -8 X -7 -6 X -5 -4 X -3 -2 X -1 0 X IFORMAT(I4T2I4) 2 4 6 8 10 -9 -7 -5 -3 -1 0 IFORMAT(I4TL2I4) 2 4 6 8 10 - -9 -7 -5 -3 -1 0 IFORMAT(I4TR2I4) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(2(I8),I2) 1 2 3 4 5 6 7 8 9 10 -10-9 -8 -7-6 -5 -4-3 -2 -1 0 IFORMAT('ODD 'I4/'EVEN'I4) ODD 1 EVEN 2 ODD 3 EVEN 4 ODD 5 EVEN 6 ODD 7 EVEN 8 ODD 9 EVEN 10 ODD -10 EVEN -9 ODD -8 EVEN -7 ODD -6 EVEN -5 ODD -4 EVEN -3 ODD -2 EVEN -1 ODD 0 EVEN IFORMAT('ODD 'I4,4X/'EVEN'I4) ODD 1 EVEN 2 ODD 3 EVEN 4 ODD 5 EVEN 6 ODD 7 EVEN 8 ODD 9 EVEN 10 ODD -10 EVEN -9 ODD -8 EVEN -7 ODD -6 EVEN -5 ODD -4 EVEN -3 ODD -2 EVEN -1 ODD 0 EVEN IFORMAT(I4 :' J OE' I4) 1 J OE 2 3 J OE 4 5 J OE 6 7 J OE 8 9 J OE 10 -10 J OE -9 -8 J OE -7 -6 J OE -5 -4 J OE -3 -2 J OE -1 0 IFORMAT(I4,8HH-STRING,I4) 1H-STRING 2 3H-STRING 4 5H-STRING 6 7H-STRING 8 9H-STRING 10 -10H-STRING -9 -8H-STRING -7 -6H-STRING -5 -4H-STRING -3 -2H-STRING -1 0H-STRING IFORMAT(I4,8HH-STRINGI4) 1H-STRING 2 3H-STRING 4 5H-STRING 6 7H-STRING 8 9H-STRING 10 -10H-STRING -9 -8H-STRING -7 -6H-STRING -5 -4H-STRING -3 -2H-STRING -1 0H-STRING IFORMAT(I4,10HH-STRING'SI4) 1H-STRING'S 2 3H-STRING'S 4 5H-STRING'S 6 7H-STRING'S 8 9H-STRING'S 10 -10H-STRING'S -9 -8H-STRING'S -7 -6H-STRING'S -5 -4H-STRING'S -3 -2H-STRING'S -1 0H-STRING'S IFORMAT(I9, 2(I6)) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(I9, 2(I6, 3(I4))) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 IFORMAT(4I8.0) 1 2 3 4 5 6 7 8 9 10 -10 -9 -8 -7 -6 -5 -4 -3 -2 -1 DFORMAT(F16.4) 0.0000 1.2346 -1.2346 12.3460 123.4600 1234.6000 12346.0000 **************** 0.0000 **************** 0.0000 0.0000 **************** 0.0000 0.1235 -0.1235 DFORMAT(F8.2) 0.00 1.23 -1.23 12.35 123.46 1234.60 12346.00 ******** 0.00 ******** 0.00 0.00 ******** 0.00 0.12 -0.12 DFORMAT(F8.3) 0.000 1.235 -1.235 12.346 123.460 1234.600 ******** ******** 0.000 ******** 0.000 0.000 ******** 0.000 0.123 -0.123 DFORMAT(F16.0) 0. 1. -1. 12. 123. 1235. 12346. 1234600000000. 0. -1234600000000. 0. 0. **************** 0. 0. 0. DFORMAT(SPF8.3) +0.000 +1.235 -1.235 +12.346 +123.460 ******** ******** ******** +0.000 ******** +0.000 +0.000 ******** +0.000 +0.123 -0.123 DFORMAT(D8.3) .000D+00 .123D+01 ******** .123D+02 .123D+03 .123D+04 .123D+05 .123D+13 .123D-11 ******** ******** .000D+00 .123+124 .123-122 .123D+00 ******** DFORMAT(E8.3) .000E+00 .123E+01 ******** .123E+02 .123E+03 .123E+04 .123E+05 .123E+13 .123E-11 ******** ******** .000E+00 .123+124 .123-122 .123E+00 ******** DFORMAT(E14.3E5) 0.000E+00000 0.123E+00001 -0.123E+00001 0.123E+00002 0.123E+00003 0.123E+00004 0.123E+00005 0.123E+00013 0.123E-00011 -0.123E+00013 -0.123E-00011 0.000E+00000 0.123E+00124 0.123E-00122 0.123E+00000 -0.123E+00000 DFORMAT(1P1E10.3) 0.000E+00 1.235E+00 -1.235E+00 1.235E+01 1.235E+02 1.235E+03 1.235E+04 1.235E+12 1.235E-12 -1.235E+12 -1.235E-12 0.000E+00 1.235+123 1.235-123 1.235E-01 -1.235E-01 DFORMAT(-1P1E10.3) 0.000E+00 0.012E+02 -0.012E+02 0.012E+03 0.012E+04 0.012E+05 0.012E+06 0.012E+14 0.012E-10 -0.012E+14 -0.012E-10 0.000E+00 0.012+125 0.012-121 0.012E+01 -0.012E+01 DFORMAT(+1P1E10.3) 0.000E+00 1.235E+00 -1.235E+00 1.235E+01 1.235E+02 1.235E+03 1.235E+04 1.235E+12 1.235E-12 -1.235E+12 -1.235E-12 0.000E+00 1.235+123 1.235-123 1.235E-01 -1.235E-01 DFORMAT(D12.3) 0.000D+00 0.123D+01 -0.123D+01 0.123D+02 0.123D+03 0.123D+04 0.123D+05 0.123D+13 0.123D-11 -0.123D+13 -0.123D-11 0.000D+00 0.123+124 0.123-122 0.123D+00 -0.123D+00 DFORMAT(E12.3) 0.000E+00 0.123E+01 -0.123E+01 0.123E+02 0.123E+03 0.123E+04 0.123E+05 0.123E+13 0.123E-11 -0.123E+13 -0.123E-11 0.000E+00 0.123+124 0.123-122 0.123E+00 -0.123E+00 DFORMAT(F6.5) .00000 ****** ****** ****** ****** ****** ****** ****** .00000 ****** .00000 .00000 ****** .00000 .12346 ****** DFORMAT(F2.0) 0. 1. ** ** ** ** ** ** 0. ** 0. 0. ** 0. 0. 0. DFORMAT(F2.1) .0 ** ** ** ** ** ** ** .0 ** .0 .0 ** .0 .1 ** DFORMAT(F1.0) * * * * * * * * * * * * * * * * DFORMAT(-2P1E10.3) 0.000E+00 0.001E+03 -0.001E+03 0.001E+04 0.001E+05 0.001E+06 0.001E+07 0.001E+15 0.001E-09 -0.001E+15 -0.001E-09 0.000E+00 0.001+126 0.001-120 0.001E+02 -0.001E+02 DFORMAT(+2P1E10.3) 0.00E+00 12.35E-01 -12.35E-01 12.35E+00 12.35E+01 12.35E+02 12.35E+03 12.35E+11 12.35E-13 -12.35E+11 -12.35E-13 0.00E+00 12.35+122 12.35-124 12.35E-02 -12.35E-02 DFORMAT(-8P1E10.3) ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** DFORMAT(F6.4) 0.0000 1.2346 ****** ****** ****** ****** ****** ****** 0.0000 ****** 0.0000 0.0000 ****** 0.0000 0.1235 -.1235 DFORMAT(SPF6.4) +.0000 ****** ****** ****** ****** ****** ****** ****** +.0000 ****** +.0000 +.0000 ****** +.0000 +.1235 -.1235 DFORMAT(E8.2) 0.00E+00 0.12E+01 -.12E+01 0.12E+02 0.12E+03 0.12E+04 0.12E+05 0.12E+13 0.12E-11 -.12E+13 -.12E-11 0.00E+00 0.12+124 0.12-122 0.12E+00 -.12E+00 DFORMAT(SPE8.2) +.00E+00 +.12E+01 -.12E+01 +.12E+02 +.12E+03 +.12E+04 +.12E+05 +.12E+13 +.12E-11 -.12E+13 -.12E-11 +.00E+00 +.12+124 +.12-122 +.12E+00 -.12E+00 DFORMAT(E18.4E4) 0.0000E+0000 0.1235E+0001 -0.1235E+0001 0.1235E+0002 0.1235E+0003 0.1235E+0004 0.1235E+0005 0.1235E+0013 0.1235E-0011 -0.1235E+0013 -0.1235E-0011 0.0000E+0000 0.1235E+0124 0.1235E-0122 0.1235E+0000 -0.1235E+0000 DFORMAT(E18.4E3) 0.0000E+000 0.1235E+001 -0.1235E+001 0.1235E+002 0.1235E+003 0.1235E+004 0.1235E+005 0.1235E+013 0.1235E-011 -0.1235E+013 -0.1235E-011 0.0000E+000 0.1235E+124 0.1235E-122 0.1235E+000 -0.1235E+000 DFORMAT(E18.4E2) 0.0000E+00 0.1235E+01 -0.1235E+01 0.1235E+02 0.1235E+03 0.1235E+04 0.1235E+05 0.1235E+13 0.1235E-11 -0.1235E+13 -0.1235E-11 0.0000E+00 ****************** ****************** 0.1235E+00 -0.1235E+00 DFORMAT(E18.4E1) 0.0000E+0 0.1235E+1 -0.1235E+1 0.1235E+2 0.1235E+3 0.1235E+4 0.1235E+5 ****************** ****************** ****************** ****************** 0.0000E+0 ****************** ****************** 0.1235E+0 -0.1235E+0 DFORMAT(E18.4E10) 0.0000E+0000000000 0.1235E+0000000001 -.1235E+0000000001 0.1235E+0000000002 0.1235E+0000000003 0.1235E+0000000004 0.1235E+0000000005 0.1235E+0000000013 0.1235E-0000000011 -.1235E+0000000013 -.1235E-0000000011 0.0000E+0000000000 0.1235E+0000000124 0.1235E-0000000122 0.1235E+0000000000 -.1235E+0000000000 DFORMAT(G18.3) 0.00 1.23 -1.23 12.3 123. 0.123E+04 0.123E+05 0.123E+13 0.123E-11 -0.123E+13 -0.123E-11 0.00 0.123+124 0.123-122 0.123 -0.123 DFORMAT(G18.3E4) 0.00 1.23 -1.23 12.3 123. 0.123E+0004 0.123E+0005 0.123E+0013 0.123E-0011 -0.123E+0013 -0.123E-0011 0.00 0.123E+0124 0.123E-0122 0.123 -0.123 DFORMAT(0PF16.4) 0.0000 1.2346 -1.2346 12.3460 123.4600 1234.6000 12346.0000 **************** 0.0000 **************** 0.0000 0.0000 **************** 0.0000 0.1235 -0.1235 DFORMAT(-3PF16.4) 0.0000 0.0012 -0.0012 0.0123 0.1235 1.2346 12.3460 1234600000.0000 0.0000 -1234600000.0000 0.0000 0.0000 **************** 0.0000 0.0001 -0.0001 LFORMAT(L1) T F T T F T LFORMAT(L8) T F T T F T LFORMAT(L1L2L3L4) T F T T F T LFORMAT(L2L2L2) T F T T F T CFORMAT(A) ONE TWO THREE FOUR FIVE A B C D E ABCDEFGHIJ RRR LLL MMM CFORMAT(A20) ONE TWO THREE FOUR FIVE A B C D E ABCDEFGHIJ RRR LLL MMM CFORMAT(A4) ONE TWO THRE FOUR FIVE A B ABCD R LLL M CFORMAT(3A) ONE TWO THREE FOUR FIVE A B C D E ABCDEFGHIJ RRR LLL MMM CFORMAT(3A20) ONE TWO THREE FOUR FIVE A B C D E ABCDEFGHIJ RRR LLL MMM