################################################################################
#
# Copyright (c) 2002-2024 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################

use Test::More tests => 43;
use Convert::Binary::C @ARGV;
use strict;

BEGIN { $^W = 1 }

my $c = eval {
  Convert::Binary::C->new(Define  => ['b=a'],
                          Include => ['tests/include/files', 'include/files']);
};
is($@, '', "create Convert::Binary::C::Cached object");

#--------------------
# check of ucpp bugs
#--------------------

eval {
  $c->parse(<<'END');
#define a int
b x;
END
};
is($@, '', "parse code");

# eval {
#   $c->parse( <<'END' );
# #include "ifnonl.h"
# typedef int foo;
# END
# };
# is($@, '', "failed to parse code");


#----------------------------
# check if #ident is ignored
#----------------------------

my $s = eval {
  $c->parse(<<'END');
#ident "bla bla"
typedef int xxx;
END
  $c->sizeof('xxx');
};
is($@, '', "parse code with #ident correctly");
is($s, $c->sizeof('int'));

#------------------------------
# check #warn / #warning
#------------------------------

{
  my @warn;
  local $SIG{'__WARN__'} = sub { push @warn, $_[0] };

  $s = $c->clean->parse('#warning "A #warning!"');
  ok($s);
  is(scalar @warn, 1);
  like($warn[0], qr/#warning/);
  @warn = ();
  $s = $c->clean->parse('#warn "A #warn!"');
  ok($s);
  is(scalar @warn, 1);
  like($warn[0], qr/#warn/);
}

#----------------
# various checks
#----------------

$c->clean;

eval {
  $c->parse(<<'END');
#include "unmatched.h"
END
};

like($@, qr/unterminated #if construction/);
like($@, qr/included from \[buffer\]:1/);

$c->clean->CharSize(1)->Warnings(1);

my @warn;
$s = eval {
  local $SIG{__WARN__} = sub { push @warn, @_ };
  $c->parse(<<'END');
??=include "trigraph.h"
END
  $c->sizeof('array');
};

is($@, '');
is($s, 42);
is(scalar @warn, 5);
like($warn[0], qr/^\[buffer\], line 1: \(warning\) trigraph \?\?= encountered/);
like($warn[1], qr/trigraph\.h, line 1: \(warning\) trigraph \?\?= encountered/);
like($warn[1], qr/included from \[buffer\]:1/);
like($warn[2], qr/trigraph\.h, line 3: \(warning\) trigraph \?\?\( encountered/);
like($warn[2], qr/included from \[buffer\]:1/);
like($warn[3], qr/trigraph\.h, line 3: \(warning\) trigraph \?\?\) encountered/);
like($warn[3], qr/included from \[buffer\]:1/);
like($warn[4], qr/^\[buffer\]: \(warning\) 4 trigraph\(s\) encountered/);

#--------------------------------------------
# promotion of conditional operator operands
#--------------------------------------------

$c->clean;

eval {
  $c->parse(<<'END');

enum test {

#if 1 > (0 ? (~1) : (~1))
  SS0 = 1,
#else
  SS0 = 0,
#endif

#if 1 > (1 ? (~1) : (~1))
  SS1 = 1,
#else
  SS1 = 0,
#endif

#if 1 > (0 ? (~1U) : (~1))
  US0 = 1,
#else
  US0 = 0,
#endif

#if 1 > (1 ? (~1U) : (~1))
  US1 = 1,
#else
  US1 = 0,
#endif

#if 1 > (0 ? (~1) : (~1U))
  SU0 = 1,
#else
  SU0 = 0,
#endif

#if 1 > (1 ? (~1) : (~1U))
  SU1 = 1,
#else
  SU1 = 0,
#endif

#if 1 > (0 ? (~1U) : (~1U))
  UU0 = 1,
#else
  UU0 = 0,
#endif

#if 1 > (1 ? (~1U) : (~1U))
  UU1 = 1,
#else
  UU1 = 0,
#endif

};

END
};

is($@, '');
is_deeply($c->enum('test')->{enumerators}, {
  SS0 => 1,
  SS1 => 1,
  US0 => 0,
  US1 => 0,
  SU0 => 0,
  SU1 => 0,
  UU0 => 0,
  UU1 => 0,
}, 'operands of conditional operator promoted correctly');

#---------------------------------------------------------
# make sure that the promotion fix doesn't break anything
#---------------------------------------------------------

$c->clean;

eval {
  $c->parse(<<'END');

#if 1 ? 0 : 1/0
#  error broken
#else
#  define OK
#endif

END
};

is($@, '');
ok($c->defined('OK'), 'branch of conditional operator not evaluated');

#---------------------------------------------------------

$c->clean;

eval {
  $c->parse(<<'END');

#if (1 || 1/0) && !(0 && 2/0)
#  define OK
#else
#  error broken
#endif

END
};

is($@, '');
ok($c->defined('OK'), 'branch of short-circuiting operator not evaluated');

#---------------------------------------------------------

$c->clean;

eval {
  $c->parse(<<'END');

#if 1 + 2 + 3 / 3 == 6 - (1 << 1)
#  define OK
#else
#  error broken
#endif

END
};

is($@, '');
ok($c->defined('OK'), 'arithmetic expressions evaluated correctly');

#---------------------------------------------------------

$c->clean;

eval {
  $c->parse(<<'END');

#if (1 && 3 == 4 - 1 ? 5 - 3 : 7) == 2
#  define OK
#else
#  error broken
#endif

END
};

is($@, '');
ok($c->defined('OK'), 'arithmetic expressions evaluated correctly');

#-------------------------
# tests arithmetic errors
#-------------------------

$c->clean;

eval {
  $c->parse(<<'END');
#if 18446744073709551615U
#endif
END
};

is($@, '');

$c->clean;

eval {
  $c->parse(<<'END');
#if 18446744073709551616U
#endif
END
};

like($@, qr/constant too large/);

#------------------------------
# test StdCVersion and HostedC
#------------------------------

$c = Convert::Binary::C->new;

is($c->StdCVersion, 199901, "StdCVersion default");
is($c->HostedC, 1, "HostedC default");

my $code = <<ENDC;
enum test {
  STDC =
#ifdef __STDC_VERSION__
  __STDC_VERSION__
#else
  -1
#endif
  ,
  HOSTED =
#ifdef __STDC_VERSION__
  __STDC_HOSTED__
#else
  -1
#endif
};
ENDC

$c->clean
  ->configure(StdCVersion => undef, HostedC => undef)
  ->parse($code);

is($c->unpack('test', $c->pack('test', 'STDC')), -1);
is($c->unpack('test', $c->pack('test', 'HOSTED')), -1);

$c->clean
  ->configure(StdCVersion => '4711', HostedC => 0)
  ->parse($code);

is($c->unpack('test', $c->pack('test', 'STDC')), 4711);
is($c->unpack('test', $c->pack('test', 'HOSTED')), 0);

$c->clean
  ->configure(StdCVersion => '199901', HostedC => 1)
  ->parse($code);

is($c->unpack('test', $c->pack('test', 'STDC')), 199901);
is($c->unpack('test', $c->pack('test', 'HOSTED')), 1);


# TODO: more arith checks (errors/warnings)