/******************************************************************************
 * Copyright (c) 2000-2015 Ericsson Telecom AB
 * All rights reserved. This program and the accompanying materials
 * are made available under the terms of the Eclipse Public License v1.0
 * which accompanies this distribution, and is available at
 * http://www.eclipse.org/legal/epl-v10.html
 ******************************************************************************/
module Untagged {
modulepar boolean Untagged_verbose := false;
#define verbose Untagged_verbose
#include "../macros.ttcnin"

/* * * * * * * * * * * Untagged applied to a field * * * * * * * * * * */

type enumerated ProductColor { red(0), green(1), blue(2) }

type record ProductInfo {
  charstring   name,
  ProductColor color
}

type record AdditionalInfo {
  integer size,
  boolean available
}

type record ProductU {
  record of ProductColor color,
  ProductInfo info,
  AdditionalInfo addInfo,
  union {
    integer usd,
    integer euro
  } priceInfo
}
with {
  variant (color)     "untagged";
  variant (info)      "untagged";
  variant (addInfo)   "untagged";
  variant (priceInfo) "untagged";
  // It's getting a bit monotonous...
  variant (priceInfo.usd)  "name as uppercased";
  variant (priceInfo.euro) "name as uppercased";
}

const ProductU val := {
  color := { red, green, blue },
  info  := {
    name := "shirt",
    color:= red
  },
  addInfo := {
    size := 44,
    available := false
  },
  priceInfo := { usd := 25 }
}

const universal charstring str_prodU_e :=
"<ProductU>\n" &
"\t<ProductColor>red</ProductColor>\n" &
"\t<ProductColor>green</ProductColor>\n" &
"\t<ProductColor>blue</ProductColor>\n" &
"\t<name>shirt</name>\n" &
"\t<color>red</color>\n" &
"\t<size>44</size>\n" &
"\t<available>false</available>\n" &
"\t<USD>25</USD>\n" &
"</ProductU>\n" &
"\n";

const universal charstring str_prodU_b :=
"<ProductU>\n" &
"\t<color>\n" &
"\t\t<red/><green/><blue/>\n" &
"\t</color>\n" &
"\t<info>\n" &
"\t\t<name>shirt</name>\n" &
"\t\t<color><red/></color>\n" &
"\t</info>\n" &
"\t<addInfo>\n" &
"\t\t<size>44</size>\n" &
"\t\t<available><false/></available>\n" &
"\t</addInfo>\n" &
"\t<priceInfo>\n" &
"\t\t<usd>25</usd>\n" &
"\t</priceInfo>\n" &
"</ProductU>\n" &
"\n";

DECLARE_XER_ENCODERS(ProductU, prodU);
DECLARE_EXER_ENCODERS(ProductU, prodU);

type component UTA {}

testcase encode_ut() runs on UTA
{
  CHECK_METHOD(bxer_enc_prodU, val, str_prodU_b);
  CHECK_METHOD(exer_enc_prodU, val, str_prodU_e);
}

testcase decode_ut() runs on UTA
{
  CHECK_DECODE(bxer_dec_prodU, str_prodU_b, ProductU, val);
  CHECK_DECODE(exer_dec_prodU, str_prodU_e, ProductU, val);
}

/* * * * * * * * * * * Untagged applied to a type * * * * * * * * * * */

type record ProductInfo2 {
  charstring   name,
  ProductColor color
}
with {
  variant "untagged";
  variant "name as 'ProductInfo'";
}

type record AdditionalInfo2 {
  integer size,
  boolean available
}
with {
  variant "untagged";
  variant "name as 'AdditionalInfo'";
}

type record Product2 {
  record of ProductColor color,
  ProductInfo2 info,
  AdditionalInfo2 addInfo,
  union {
    integer usd,
    integer euro
  } priceInfo
}
with {
  variant "name as 'ProductU'"
  variant (color)     "untagged";
  variant (info)      "untagged";
  variant (priceInfo) "untagged";
  // It's getting a bit monotonous...
  variant (priceInfo.usd)  "name as uppercased";
  variant (priceInfo.euro) "name as uppercased";
}

DECLARE_XER_ENCODERS(Product2, prod2);
DECLARE_EXER_ENCODERS(Product2, prod2); // EXER only

const Product2 val2 := {
  color := { red, green, blue },
  info  := {
    name := "shirt",
    color:= red
  },
  addInfo := {
    size := 44,
    available := false
  },
  priceInfo := { usd := 25 }
}

const universal charstring str_prod_b2 :=
"<Product2>\n" &
"\t<color>\n" &
"\t\t<red/><green/><blue/>\n" &
"\t</color>\n" &
"\t<info>\n" &
"\t\t<name>shirt</name>\n" &
"\t\t<color><red/></color>\n" &
"\t</info>\n" &
"\t<addInfo>\n" &
"\t\t<size>44</size>\n" &
"\t\t<available><false/></available>\n" &
"\t</addInfo>\n" &
"\t<priceInfo>\n" &
"\t\t<usd>25</usd>\n" &
"\t</priceInfo>\n" &
"</Product2>\n" &
"\n";

testcase encode_ut2() runs on UTA
{
  CHECK_METHOD(bxer_enc_prod2, val2, str_prod_b2);
  CHECK_METHOD(exer_enc_prod2, val2, str_prodU_e);
}

testcase decode_ut2() runs on UTA
{
  CHECK_DECODE(bxer_dec_prod2, str_prod_b2, Product2, val2);
  CHECK_DECODE(exer_dec_prod2, str_prodU_e, Product2, val2);
}

/* * * * * * * * * * * Nested untagged * * * * * * * * * * */

type record level0 {
  level1 f1
}
with {
  variant (f1) "untagged";
  variant "untagged"
}

type record level1 {
  level2 f2
}
with { variant (f2) "untagged" }

type record level2 {
  level3 f3
}
with { variant (f3) "untagged" }

type union level3 {
  integer i,
  float   f
}

DECLARE_XER_ENCODERS(level0, l0);
DECLARE_EXER_ENCODERS(level0, l0);

const level0 cl0 := {
  f1 := { // a level1
    f2 := { // a level2
      f3 := { i := 13 }
    }
  }
}

const universal charstring bstr_cl0 :=
"<level0>\n" &
"\t<f1>\n" &
"\t\t<f2>\n" &
"\t\t\t<f3>\n" &
"\t\t\t\t<i>13</i>\n" &
"\t\t\t</f3>\n" &
"\t\t</f2>\n" &
"\t</f1>\n" &
"</level0>\n\n";

const universal charstring estr_cl0 :=
// This is the "right thing" because UNTAGGED is ignored for top-level types
"<level0>\n" &
"\t<i>13</i>\n" &
"</level0>\n\n";

testcase encode_deep() runs on UTA
{
  CHECK_METHOD(bxer_enc_l0, cl0, bstr_cl0);
  CHECK_METHOD(exer_enc_l0, cl0, estr_cl0);
}

testcase decode_deep() runs on UTA
{
  CHECK_DECODE(bxer_dec_l0, bstr_cl0, level0, cl0);
  CHECK_DECODE(exer_dec_l0, estr_cl0, level0, cl0);
}

/* * * * * * * * * * * Deeper * * * * * * * * * * */

type union ch0 {
  level0 l0,
  record of integer numbers
}
with {
  variant (numbers) "untagged"
}

type record wrapper {
  ch0 c0
}
with {
  variant (c0) "untagged"
}

DECLARE_XER_ENCODERS(wrapper, w);
DECLARE_EXER_ENCODERS(wrapper, w);

const wrapper cw0 := {
  c0 := {
    l0 := cl0
  }
}

const wrapper cw1 := {
  c0 := {
    numbers := { 3, 14, 15, 92, 6 }
  }
}

const universal charstring bstr_cw0 :=
"<wrapper>\n" &
"\t<c0>\n" &
"\t\t<l0>\n" &
"\t\t\t<f1>\n" &
"\t\t\t\t<f2>\n" &
"\t\t\t\t\t<f3>\n" &
"\t\t\t\t\t\t<i>13</i>\n" &
"\t\t\t\t\t</f3>\n" &
"\t\t\t\t</f2>\n" &
"\t\t\t</f1>\n" &
"\t\t</l0>\n" &
"\t</c0>\n" &
"</wrapper>\n\n";

const universal charstring estr_cw0 :=
"<wrapper>\n" &
"\t<i>13</i>\n" &
"</wrapper>\n\n";

const universal charstring bstr_cw1 :=
"<wrapper>\n" &
"\t<c0>\n" &
"\t\t<numbers>\n" &
"\t\t\t<INTEGER>3</INTEGER>\n" &
"\t\t\t<INTEGER>14</INTEGER>\n" &
"\t\t\t<INTEGER>15</INTEGER>\n" &
"\t\t\t<INTEGER>92</INTEGER>\n" &
"\t\t\t<INTEGER>6</INTEGER>\n" &
"\t\t</numbers>\n" &
"\t</c0>\n" &
"</wrapper>\n\n";

const universal charstring estr_cw1 :=
"<wrapper>\n" &
"\t<INTEGER>3</INTEGER>\n" &
"\t<INTEGER>14</INTEGER>\n" &
"\t<INTEGER>15</INTEGER>\n" &
"\t<INTEGER>92</INTEGER>\n" &
"\t<INTEGER>6</INTEGER>\n" &
"</wrapper>\n\n";

testcase encode_wrap() runs on UTA
{
  CHECK_METHOD(bxer_enc_w, cw0, bstr_cw0);
  CHECK_METHOD(exer_enc_w, cw0, estr_cw0);
  CHECK_METHOD(bxer_enc_w, cw1, bstr_cw1);
  CHECK_METHOD(exer_enc_w, cw1, estr_cw1);
}

testcase decode_wrap() runs on UTA
{
  CHECK_DECODE(bxer_dec_w, bstr_cw1, wrapper, cw1);
  CHECK_DECODE(exer_dec_w, estr_cw1, wrapper, cw1);
  CHECK_DECODE(bxer_dec_w, bstr_cw0, wrapper, cw0);
  CHECK_DECODE(exer_dec_w, estr_cw0, wrapper, cw0);
}

/* * * * * * * * HK76145 * * * * * * * * * */

type record dir {
  record of record {
    record {
      charstring name,
      integer    size
    } folder
  } lista
}
with {
  variant (lista)    "untagged"
  variant (lista[-]) "untagged"
}

DECLARE_XER_ENCODERS(dir, dir);
DECLARE_EXER_ENCODERS(dir, dir);

const dir durr := {
  lista := {{
    folder := {
      name := "foo",
      size := 13
    }
  }}
}

const universal charstring bstr_durr :=
"<dir>\n" &
"\t<lista>\n" &
"\t\t<SEQUENCE>\n" &
"\t\t\t<folder>\n" &
"\t\t\t\t<name>foo</name>\n" &
"\t\t\t\t<size>13</size>\n" &
"\t\t\t</folder>\n" &
"\t\t</SEQUENCE>\n" &
"\t</lista>\n" &
"</dir>\n\n";

const universal charstring estr_durr :=
"<dir>\n" &
"\t<folder>\n" &
"\t\t<name>foo</name>\n" &
"\t\t<size>13</size>\n" &
"\t</folder>\n" &
"</dir>\n\n";



testcase encode_dir() runs on UTA
{
  CHECK_METHOD(bxer_enc_dir, durr, bstr_durr);
  CHECK_METHOD(exer_enc_dir, durr, estr_durr);
}

testcase decode_dir() runs on UTA
{
  CHECK_DECODE(bxer_dec_dir, bstr_durr, dir, durr);
  CHECK_DECODE(exer_dec_dir, estr_durr, dir, durr);
}

/* * * * * * * * Empty record in an untagged record-of * * * * * * * */

type record Envelope {
  //record of Header header optional,
  Body body
}

type union Body {
  record {} fault,
  record of Content content_list
}
with {
  variant (content_list)    "untagged";
  variant (content_list[-]) "untagged";
}

type union Content {
  Logout         logout,
  LogoutResponse logoutResponse
}
with {
  variant (logout        ) "name as capitalized"
  variant (logoutResponse) "name as capitalized"
}

type record Logout {};
type record LogoutResponse {};

DECLARE_XER_ENCODERS(Envelope, env);
DECLARE_EXER_ENCODERS(Envelope, env);

const Envelope resp := {
  body := {
    content_list := {{ logoutResponse := {} }}
  }
}

const universal charstring str_resp :=
"<Envelope>\n" &
"\t<body>\n" &
"\t\t<LogoutResponse/>\n" &
"\t</body>" &
"\n</Envelope>\n\n";

const universal charstring str_resp_non_canon :=
"<Envelope>\n" &
"\t<body>\n" &
"\t\t<LogoutResponse>\n" &
"\t\t</LogoutResponse>\n" &
"\t</body>" &
"\n</Envelope>\n\n";


testcase encode_env() runs on UTA
{
  CHECK_METHOD(exer_enc_env, resp, str_resp);
}

testcase decode_env() runs on UTA
{
  CHECK_DECODE(exer_dec_env, str_resp,           Envelope, resp);
  CHECK_DECODE(exer_dec_env, str_resp_non_canon, Envelope, resp);
}


/* * * * * Untagged simple types as fields * * * * */
/* * * * * * * * * Tests for HL75936 * * * * * * * */
// bitstring is exempt : not character-encodable

// ~~~~~~~~~~~~ boolean
type record r_b {
  boolean field
}
with {
  variant (field) "untagged";
}
DECLARE_EXER_ENCODERS(r_b, b);

const r_b c_b := { field := true }
const universal charstring s_b :=
"<r_b>true</r_b>\n\n";

testcase encode_ut_bool() runs on UTA
{
  CHECK_METHOD(exer_enc_b, c_b, s_b);
}

testcase decode_ut_bool() runs on UTA
{
  CHECK_DECODE(exer_dec_b, s_b, r_b, c_b);
}

// ~~~~~~~~~~~~~~~ charstring
type record r_cs {
  charstring field
}
with {
  variant (field) "untagged"
}
DECLARE_EXER_ENCODERS(r_cs, cs);

const r_cs c_cs := { field := "Hello, world!" }
const universal charstring s_cs :=
"<r_cs>Hello, world!</r_cs>\n\n";

testcase encode_ut_cs() runs on UTA
{
  CHECK_METHOD(exer_enc_cs, c_cs, s_cs);
}

testcase decode_ut_cs() runs on UTA
{
  CHECK_DECODE(exer_dec_cs, s_cs, r_cs, c_cs);
}

// ~~~~~~~~~~~~~~~ float
type record r_f {
  float field
}
with {
  variant (field) "untagged"
}
DECLARE_EXER_ENCODERS(r_f, f);

const r_f c_f := { field := 42.42 }
const universal charstring s_f :=
"<r_f>42.420000</r_f>\n\n";

testcase encode_ut_f() runs on UTA
{
  CHECK_METHOD(exer_enc_f, c_f, s_f);
}

testcase decode_ut_f() runs on UTA
{
  CHECK_DECODE(exer_dec_f, s_f, r_f, c_f);
}

// ~~~~~~~~~~~~~~~ integer
type record r_i {
  integer field
}
with {
  variant (field) "untagged"
}
DECLARE_EXER_ENCODERS(r_i, i);

const r_i c_i := { field := 42 }
const universal charstring s_i :=
"<r_i>42</r_i>\n\n";

testcase encode_ut_i() runs on UTA
{
  CHECK_METHOD(exer_enc_i, c_i, s_i);
}

testcase decode_ut_i() runs on UTA
{
  CHECK_DECODE(exer_dec_i, s_i, r_i, c_i);
}

// ~~~~ octetstring (needs hexBinary or base64Binary to be character-encodable)
type record r_ostr {
  octetstring field
}
with {
  variant (field) "untagged"
  variant (field) "XSD:hexBinary"
}
DECLARE_EXER_ENCODERS(r_ostr, ostr);

const r_ostr c_ostr := { field := 'DEADBEEF'O }
const universal charstring s_ostr :=
"<r_ostr>DEADBEEF</r_ostr>\n\n";

testcase encode_ut_ostr() runs on UTA
{
  CHECK_METHOD(exer_enc_ostr, c_ostr, s_ostr);
}

testcase decode_ut_ostr() runs on UTA
{
  CHECK_DECODE(exer_dec_ostr, s_ostr, r_ostr, c_ostr);
}

type record r_ostr64 {
  octetstring field
}
with {
  variant (field) "untagged"
  variant (field) "XSD:base64Binary"
}
DECLARE_EXER_ENCODERS(r_ostr64, ostr64);

const r_ostr64 c_ostr64 := { field := 'DEADBEEF'O }
const universal charstring s_ostr64 :=
"<r_ostr64>3q2+7w==</r_ostr64>\n\n";

testcase encode_ut_ostr64() runs on UTA
{
  CHECK_METHOD(exer_enc_ostr64, c_ostr64, s_ostr64);
}

testcase decode_ut_ostr64() runs on UTA
{
  CHECK_DECODE(exer_dec_ostr64, s_ostr64, r_ostr64, c_ostr64);
}



// ~~~~~~~~~~~~~~~ universal charstring
type record r_ustr {
  charstring missing optional,
  universal charstring field
}
with {
  variant (missing) "attribute";
  variant (field) "untagged";
}
DECLARE_EXER_ENCODERS(r_ustr, ustr);

const r_ustr c_ustr := {
  missing := omit,
  // LATIN CAPITAL LETTER A WITH RING ABOVE
  //                  |                LATIN SMALL LETTER O WITH DIAERESIS
  field := char(0,0,0,197) & "ngstr" & char(0,0,0,246) & "m"
}
const universal charstring s_ustr :=
"<r_ustr>" & c_ustr.field & "</r_ustr>\n\n";

const r_ustr c_ustr0 := {
  missing := omit,
  field   := ""
}
const universal charstring s_ustr0 :=
"<r_ustr/>\n\n";

testcase encode_ut_ustr() runs on UTA
{
  CHECK_METHOD(exer_enc_ustr, c_ustr, s_ustr);
  CHECK_METHOD(exer_enc_ustr, c_ustr0,s_ustr0);
}

testcase decode_ut_ustr() runs on UTA
{
  CHECK_DECODE(exer_dec_ustr, s_ustr, r_ustr, c_ustr);
  CHECK_DECODE(exer_dec_ustr, s_ustr0,r_ustr, c_ustr0);
}



/* * * * * * * * * * * Run it! * * * * * * * * * * */

control {
  execute(encode_ut());
  execute(decode_ut());
  execute(encode_ut2());
  execute(decode_ut2());
  execute(encode_deep());
  execute(decode_deep());
  execute(encode_wrap());
  execute(decode_wrap());
  execute(encode_dir());
  execute(decode_dir());
  execute(encode_env());
  execute(decode_env());
  // // // //
  execute(encode_ut_bool());
  execute(decode_ut_bool());

  execute(encode_ut_cs());
  execute(decode_ut_cs());

  execute(encode_ut_f());
  execute(decode_ut_f());

  execute(encode_ut_i());
  execute(decode_ut_i());

  execute(encode_ut_ostr());
  execute(decode_ut_ostr());
  execute(encode_ut_ostr64());
  execute(decode_ut_ostr64());

  execute(encode_ut_ustr());
  execute(decode_ut_ustr());

}

}
with {
encode "XML";
}