The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w

BEGIN { eval { require bytes; }; }
use strict;
no strict "vars";

BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; }

use Date::Calc::Object qw(:all);

# ======================================================================
#   $form = Date::Calc->date_format([FORMAT]);
#   $lang = Date::Calc->language([LANG]);
#   $form = $date->date_format([FORMAT]);
#   $lang = $date->language([LANG]);
#   $text = $date->string([FORMAT[,LANG]]);
# ======================================================================

print "1..30\n";

$n = 1;

Date::Calc->date_format(1);
Date::Calc->language(2);

$date = Date::Calc->new(2001,8,5);

if ("$date" eq '05-aoû-2001')
{print "ok $n\n";} else {print "not ok $n\n";} # 01
$n++;

if (Language_to_Text(Language()) eq 'Français')
{print "ok $n\n";} else {print "not ok $n\n";} # 02
$n++;

$date->date_format(3);
$date->language("Port");

if ("$date" eq 'Domingo, dia 5 de agosto de 2001')
{print "ok $n\n";} else {print "not ok $n\n";} # 03
$n++;

if (Language_to_Text(Language()) eq 'Français')
{print "ok $n\n";} else {print "not ok $n\n";} # 04
$n++;

Date::Calc->date_format(2);
Date::Calc->language(11);

{
    local($date->[0][2]) = undef;
    if ("$date" eq 'Dom 5-ago-2001')
    {print "ok $n\n";} else {print "not ok $n\n";} # 05
    $n++;
    if (Language_to_Text(Language()) eq 'suomi')
    {print "ok $n\n";} else {print "not ok $n\n";} # 06
    $n++;
}

if ("$date" eq 'Domingo, dia 5 de agosto de 2001')
{print "ok $n\n";} else {print "not ok $n\n";} # 07
$n++;

{
    local($date->[0][3]) = undef;
    if ("$date" eq 'sunnuntai, 5. elokuuta 2001')
    {print "ok $n\n";} else {print "not ok $n\n";} # 08
    $n++;
    if (Language_to_Text(Language()) eq 'suomi')
    {print "ok $n\n";} else {print "not ok $n\n";} # 09
    $n++;
}

if ("$date" eq 'Domingo, dia 5 de agosto de 2001')
{print "ok $n\n";} else {print "not ok $n\n";} # 10
$n++;

$text = '<STILL UNTOUCHED>';

{
    if ($text eq '<STILL UNTOUCHED>')
    {print "ok $n\n";} else {print "not ok $n\n";} # 11
    $n++;
    local($date->[0][3]) = -1;
    eval { $text = "$date"; };
    if ($@ =~ /\bDate::Calc::string\(\): no such language\b/)
    {print "ok $n\n";} else {print "not ok $n\n";} # 12
    $n++;
    if ($text eq '<STILL UNTOUCHED>')
    {print "ok $n\n";} else {print "not ok $n\n";} # 13
    $n++;
    if (Language_to_Text(Language()) eq 'suomi')
    {print "ok $n\n";} else {print "not ok $n\n";} # 14
    $n++;
}

$format = sub { Date_to_Text_Long($_[0]->date(),$_[2]); };

if ($date->string($format, 9) eq 'söndag, 5 augusti 2001')
{print "ok $n\n";} else {print "not ok $n\n";} # 15
$n++;

$lang = '<NO LANGUAGE>';

$format = sub { $lang = Language_to_Text($_[2]); Date_to_Text_Long($_[0]->date(),$_[2]); };

if ($lang eq '<NO LANGUAGE>')
{print "ok $n\n";} else {print "not ok $n\n";} # 16
$n++;

if ($date->string($format, 6) eq 'Zondag, 5 augustus 2001')
{print "ok $n\n";} else {print "not ok $n\n";} # 17
$n++;

if ($lang eq 'Nederlands')
{print "ok $n\n";} else {print "not ok $n\n";} # 18
$n++;

if (Language_to_Text(Language()) eq 'suomi')
{print "ok $n\n";} else {print "not ok $n\n";} # 19
$n++;

$format = sub { $lang = Language_to_Text($_[2]); join('~', $_[0]->datetime()); };

if ($lang eq 'Nederlands')
{print "ok $n\n";} else {print "not ok $n\n";} # 20
$n++;

if ($date->string($format, 9) eq '2001~8~5~0~0~0')
{print "ok $n\n";} else {print "not ok $n\n";} # 21
$n++;

if ($lang eq 'Svenska')
{print "ok $n\n";} else {print "not ok $n\n";} # 22
$n++;

if (Language_to_Text(Language()) eq 'suomi')
{print "ok $n\n";} else {print "not ok $n\n";} # 23
$n++;

$lang = '<NO LANGUAGE>';

$format = sub
{
    $lang = Language_to_Text($_[2]);
    die "Let's see if the language is restored nevertheless!";
};

if ($lang eq '<NO LANGUAGE>')
{print "ok $n\n";} else {print "not ok $n\n";} # 24
$n++;

if ($text eq '<STILL UNTOUCHED>')
{print "ok $n\n";} else {print "not ok $n\n";} # 25
$n++;

eval { $text = $date->string($format, 4); };

if ($@ =~ /\bDate::Calc::string\(\): Let's see if the language is restored nevertheless!/)
{print "ok $n\n";} else {print "not ok $n\n";} # 26
$n++;

if (Language_to_Text(Language()) eq 'suomi')
{print "ok $n\n";} else {print "not ok $n\n";} # 27
$n++;

if ($lang eq 'Español')
{print "ok $n\n";} else {print "not ok $n\n";} # 28
$n++;

if ($text eq '<STILL UNTOUCHED>')
{print "ok $n\n";} else {print "not ok $n\n";} # 29
$n++;

if ("$date" eq 'Domingo, dia 5 de agosto de 2001')
{print "ok $n\n";} else {print "not ok $n\n";} # 30
$n++;

exit 0; # vital here: avoid "panic: POPSTACK" in Perl 5.005_03 (and before, probably)

__END__