mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-12-22 20:57:53 +00:00
332 lines
8.2 KiB
Perl
332 lines
8.2 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
# Copyright (C) 2007,2008,2009,2010,2011 Ole Tange and Free Software
|
|
# Foundation, Inc.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
# General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, see <http://www.gnu.org/licenses/>
|
|
# or write to the Free Software Foundation, Inc., 51 Franklin St,
|
|
# Fifth Floor, Boston, MA 02110-1301 USA
|
|
#
|
|
# SPDX-FileCopyrightText: 2021-2022 Ole Tange, http://ole.tange.dk and Free Software and Foundation, Inc.
|
|
# SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
=head1 NAME
|
|
|
|
christmastree - use memory similar to a christmas tree profile
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
B<christmastree> [-s I<per_second>] [-m I<min>] <max>
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
GNU B<christmastree> is a test script that increases and decreases its
|
|
memory usage. The increase and descrease will happen at random, but
|
|
the memory usage will grow on average.
|
|
|
|
=over 9
|
|
|
|
=item I<max>
|
|
|
|
The maximal amount of memory to use before exitting.
|
|
|
|
|
|
=item B<-s> I<per_second>
|
|
|
|
The amount of memory it should grow per second on average. Default to max/10.
|
|
|
|
|
|
=item B<-m> I<min>
|
|
|
|
The minimal amount of memory to use before exitting.
|
|
|
|
=back
|
|
|
|
|
|
=head1 EXAMPLES
|
|
|
|
|
|
|
|
=head1 REPORTING BUGS
|
|
|
|
B<christmastree> is part of GNU B<parallel>. Report bugs to <bug-parallel@gnu.org>.
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
Copyright (C) 2011 Ole Tange, http://ole.tange.dk and Free
|
|
Software Foundation, Inc.
|
|
|
|
=head1 LICENSE
|
|
|
|
Copyright (C) 2011 Free Software Foundation, Inc.
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 3 of the License, or
|
|
at your option any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
=head2 Documentation license I
|
|
|
|
Permission is granted to copy, distribute and/or modify this documentation
|
|
under the terms of the GNU Free Documentation License, Version 1.3 or
|
|
any later version published by the Free Software Foundation; with no
|
|
Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
|
|
Texts. A copy of the license is included in the file fdl.txt.
|
|
|
|
=head2 Documentation license II
|
|
|
|
You are free:
|
|
|
|
=over 9
|
|
|
|
=item B<to Share>
|
|
|
|
to copy, distribute and transmit the work
|
|
|
|
=item B<to Remix>
|
|
|
|
to adapt the work
|
|
|
|
=back
|
|
|
|
Under the following conditions:
|
|
|
|
=over 9
|
|
|
|
=item B<Attribution>
|
|
|
|
You must attribute the work in the manner specified by the author or
|
|
licensor (but not in any way that suggests that they endorse you or
|
|
your use of the work).
|
|
|
|
=item B<Share Alike>
|
|
|
|
If you alter, transform, or build upon this work, you may distribute
|
|
the resulting work only under the same, similar or a compatible
|
|
license.
|
|
|
|
=back
|
|
|
|
With the understanding that:
|
|
|
|
=over 9
|
|
|
|
=item B<Waiver>
|
|
|
|
Any of the above conditions can be waived if you get permission from
|
|
the copyright holder.
|
|
|
|
=item B<Public Domain>
|
|
|
|
Where the work or any of its elements is in the public domain under
|
|
applicable law, that status is in no way affected by the license.
|
|
|
|
=item B<Other Rights>
|
|
|
|
In no way are any of the following rights affected by the license:
|
|
|
|
=over 9
|
|
|
|
=item *
|
|
|
|
Your fair dealing or fair use rights, or other applicable
|
|
copyright exceptions and limitations;
|
|
|
|
=item *
|
|
|
|
The author's moral rights;
|
|
|
|
=item *
|
|
|
|
Rights other persons may have either in the work itself or in
|
|
how the work is used, such as publicity or privacy rights.
|
|
|
|
=back
|
|
|
|
=item B<Notice>
|
|
|
|
For any reuse or distribution, you must make clear to others the
|
|
license terms of this work.
|
|
|
|
=back
|
|
|
|
A copy of the full license is included in the file as cc-by-sa.txt.
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
B<christmastree> uses Perl.
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
B<parallel>(1)
|
|
|
|
=cut
|
|
|
|
use Getopt::Long;
|
|
|
|
parse_options();
|
|
my $start_time = time;
|
|
my $max = multiply_binary_prefix(shift);
|
|
my $min = (multiply_binary_prefix($::opt_m) or $max);
|
|
my $target_max = int(rand($max - $min)) + $min;
|
|
my $per_second = (multiply_binary_prefix($::opt_s) or $target_max/10);
|
|
my ($memusage,@a,$target,$this_round);
|
|
|
|
do {
|
|
$memusage = my_memory_usage();
|
|
$target = (time - $start_time)*int($per_second);
|
|
$this_round = $target - my_memory_usage();
|
|
if($this_round > 0) {
|
|
my $this_size = min(rand($this_round*3), $target_max-$memusage);
|
|
my $a = "x"x$this_size;
|
|
push @a,$a;
|
|
} else {
|
|
pop @a;
|
|
}
|
|
debug("$#a memusage $memusage target $target this_round $this_round target_max $target_max\n");
|
|
usleep(500);
|
|
} while($memusage < $target_max);
|
|
|
|
|
|
sub min {
|
|
# Returns:
|
|
# Minimum value of array
|
|
my $min;
|
|
for (@_) {
|
|
# Skip undefs
|
|
defined $_ or next;
|
|
defined $min or do { $min = $_; next; }; # Set $_ to the first non-undef
|
|
$min = ($min < $_) ? $min : $_;
|
|
}
|
|
return $min;
|
|
}
|
|
|
|
|
|
sub debug {
|
|
# Returns: N/A
|
|
$Global::debug or return;
|
|
@_ = grep { defined $_ ? $_ : "" } @_;
|
|
if($Global::original_stdout) {
|
|
print $Global::original_stdout @_;
|
|
} else {
|
|
print @_;
|
|
}
|
|
}
|
|
|
|
sub parse_options {
|
|
$Global::version = 20110822;
|
|
$Global::progname = 'christmastree';
|
|
|
|
Getopt::Long::Configure ("bundling","require_order");
|
|
GetOptions("s=s" => \$::opt_s,
|
|
"m=s" => \$::opt_m,
|
|
"r=s" => \$::opt_r,
|
|
"debug" => \$::opt_debug,
|
|
# GNU requirements
|
|
"help|h" => \$::opt_help,
|
|
"version|V" => \$::opt_version,
|
|
) || die_usage();
|
|
|
|
if(defined $::opt_r) { srand($::opt_r); }
|
|
if(defined $::opt_help) { die_usage(); }
|
|
if(defined $::opt_version) { version(); exit(0); }
|
|
$Global::debug = $::opt_debug;
|
|
}
|
|
|
|
sub usleep {
|
|
# Sleep this many milliseconds.
|
|
my $secs = shift;
|
|
::debug("Sleeping ",$secs," millisecs\n");
|
|
select(undef, undef, undef, $secs/1000);
|
|
if($::opt_timeout) {
|
|
::debug(my_dump($Global::timeoutq));
|
|
$Global::timeoutq->process_timeouts();
|
|
}
|
|
}
|
|
|
|
sub undef_as_zero {
|
|
my $a = shift;
|
|
return $a ? $a : 0;
|
|
}
|
|
|
|
sub undef_as_empty {
|
|
my $a = shift;
|
|
return $a ? $a : "";
|
|
}
|
|
|
|
sub my_memory_usage {
|
|
# Returns:
|
|
# memory usage if found
|
|
# 0 otherwise
|
|
use strict;
|
|
use FileHandle;
|
|
|
|
my $pid = $$;
|
|
if(-e "/proc/$pid/stat") {
|
|
my $fh = FileHandle->new("</proc/$pid/stat");
|
|
|
|
my $data = <$fh>;
|
|
chomp $data;
|
|
$fh->close;
|
|
|
|
my @procinfo = split(/\s+/,$data);
|
|
|
|
return undef_as_zero($procinfo[22]);
|
|
} else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
sub multiply_binary_prefix {
|
|
# Evalualte numbers with binary prefix
|
|
# k=10^3, m=10^6, g=10^9, t=10^12, p=10^15, e=10^18, z=10^21, y=10^24
|
|
# K=2^10, M=2^20, G=2^30, T=2^40, P=2^50, E=2^70, Z=2^80, Y=2^80
|
|
# Ki=2^10, Mi=2^20, Gi=2^30, Ti=2^40, Pi=2^50, Ei=2^70, Zi=2^80, Yi=2^80
|
|
# ki=2^10, mi=2^20, gi=2^30, ti=2^40, pi=2^50, ei=2^70, zi=2^80, yi=2^80
|
|
# 13G = 13*1024*1024*1024 = 13958643712
|
|
my $s = undef_as_empty(shift);
|
|
$s =~ s/k/*1000/g;
|
|
$s =~ s/M/*1000*1000/g;
|
|
$s =~ s/G/*1000*1000*1000/g;
|
|
$s =~ s/T/*1000*1000*1000*1000/g;
|
|
$s =~ s/P/*1000*1000*1000*1000*1000/g;
|
|
$s =~ s/E/*1000*1000*1000*1000*1000*1000/g;
|
|
$s =~ s/Z/*1000*1000*1000*1000*1000*1000*1000/g;
|
|
$s =~ s/Y/*1000*1000*1000*1000*1000*1000*1000*1000/g;
|
|
$s =~ s/X/*1000*1000*1000*1000*1000*1000*1000*1000*1000/g;
|
|
|
|
$s =~ s/Ki?/*1024/gi;
|
|
$s =~ s/Mi?/*1024*1024/gi;
|
|
$s =~ s/Gi?/*1024*1024*1024/gi;
|
|
$s =~ s/Ti?/*1024*1024*1024*1024/gi;
|
|
$s =~ s/Pi?/*1024*1024*1024*1024*1024/gi;
|
|
$s =~ s/Ei?/*1024*1024*1024*1024*1024*1024/gi;
|
|
$s =~ s/Zi?/*1024*1024*1024*1024*1024*1024*1024/gi;
|
|
$s =~ s/Yi?/*1024*1024*1024*1024*1024*1024*1024*1024/gi;
|
|
$s =~ s/Xi?/*1024*1024*1024*1024*1024*1024*1024*1024*1024/gi;
|
|
$s = eval $s;
|
|
return $s;
|
|
}
|
|
|