1
0
mirror of https://github.com/postgres/postgres.git synced 2025-08-19 23:22:23 +03:00
Files
config
contrib
adminpack
amcheck
auth_delay
auto_explain
bloom
btree_gin
btree_gist
citext
cube
dblink
dict_int
dict_xsyn
earthdistance
file_fdw
fuzzystrmatch
hstore
hstore_plperl
hstore_plpython
intagg
intarray
bench
bench.pl
create_test.pl
data
expected
sql
.gitignore
Makefile
_int.h
_int_bool.c
_int_gin.c
_int_gist.c
_int_op.c
_int_selfuncs.c
_int_tool.c
_intbig_gist.c
intarray--1.0--1.1.sql
intarray--1.1--1.2.sql
intarray--1.2.sql
intarray--unpackaged--1.0.sql
intarray.control
isn
jsonb_plperl
jsonb_plpython
lo
ltree
ltree_plpython
oid2name
pageinspect
passwordcheck
pg_buffercache
pg_freespacemap
pg_prewarm
pg_standby
pg_stat_statements
pg_trgm
pg_visibility
pgcrypto
pgrowlocks
pgstattuple
postgres_fdw
seg
sepgsql
spi
sslinfo
start-scripts
tablefunc
tcn
test_decoding
tsm_system_rows
tsm_system_time
unaccent
uuid-ossp
vacuumlo
xml2
Makefile
README
contrib-global.mk
doc
src
.dir-locals.el
.gitattributes
.gitignore
COPYRIGHT
GNUmakefile.in
HISTORY
Makefile
README
README.git
aclocal.m4
configure
configure.in
postgres/contrib/intarray/bench/create_test.pl
Andrew Dunstan 3a7cc727c7 Don't fall off the end of perl functions
This complies with the perlcritic policy
Subroutines::RequireFinalReturn, which is a severity 4 policy. Since we
only currently check at severity level 5, the policy is raised to that
level until we move to level 4 or lower, so that any new infringements
will be caught.

A small cosmetic piece of tidying of the pgperlcritic script is
included.

Mike Blackwell

Discussion: https://postgr.es/m/CAESHdJpfFm_9wQnQ3koY3c91FoRQsO-fh02za9R3OEMndOn84A@mail.gmail.com
2018-05-27 09:08:42 -04:00

88 lines
1.6 KiB
Perl
Executable File

#!/usr/bin/perl
# contrib/intarray/bench/create_test.pl
use strict;
print <<EOT;
create table message (
mid int not null,
sections int[]
);
create table message_section_map (
mid int not null,
sid int not null
);
EOT
open(my $msg, '>', "message.tmp") || die;
open(my $map, '>', "message_section_map.tmp") || die;
srand(1);
#foreach my $i ( 1..1778 ) {
#foreach my $i ( 1..3443 ) {
#foreach my $i ( 1..5000 ) {
#foreach my $i ( 1..29362 ) {
#foreach my $i ( 1..33331 ) {
#foreach my $i ( 1..83268 ) {
foreach my $i (1 .. 200000)
{
my @sect;
if (rand() < 0.7)
{
$sect[0] = int((rand()**4) * 100);
}
else
{
my %hash;
@sect =
grep { $hash{$_}++; $hash{$_} <= 1 }
map { int((rand()**4) * 100) } 0 .. (int(rand() * 5));
}
if ($#sect < 0 || rand() < 0.1)
{
print $msg "$i\t\\N\n";
}
else
{
print $msg "$i\t{" . join(',', @sect) . "}\n";
map { print $map "$i\t$_\n" } @sect;
}
}
close $map;
close $msg;
copytable('message');
copytable('message_section_map');
print <<EOT;
CREATE unique index message_key on message ( mid );
--CREATE unique index message_section_map_key1 on message_section_map ( mid, sid );
CREATE unique index message_section_map_key2 on message_section_map ( sid, mid );
CREATE INDEX message_rdtree_idx on message using gist ( sections gist__int_ops );
VACUUM ANALYZE;
select count(*) from message;
select count(*) from message_section_map;
EOT
unlink 'message.tmp', 'message_section_map.tmp';
sub copytable
{
my $t = shift;
print "COPY $t from stdin;\n";
open(my $fff, '<', "$t.tmp") || die;
while (<$fff>) { print; }
close $fff;
print "\\.\n";
return;
}