Code coverage for slot_code.li

///////////////////////////////////////////////////////////////////////////////
//                             Lisaac Compiler                               //
//                                                                           //
//                   LSIIT - ULP - CNRS - INRIA - FRANCE                     //
//                                                                           //
//   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/>.   //
//                                                                           //
//                     http://isaacproject.u-strasbg.fr/                     //
///////////////////////////////////////////////////////////////////////////////
Section Header

  + name      := SLOT_CODE;

  - copyright := "2003-2007 Benoit Sonntag";


  - author    := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment   := "Slot with method";

Section Inherit

  + parent_slot:SLOT := SLOT;

Section Public

  - common_slot:SLOT <- parent_slot;

  + index:INTEGER;

  //
  // Static and Dynamic profil.
  //

  + value:ITM_CODE;

  //
  // Dynamic profil.
  //

  + profil:FAST_ARRAY(PROFIL_SLOT);

  - get_profil args:FAST_ARRAY(EXPR) self type_self:TYPE_FULL :(PROFIL, FAST_ARRAY(WRITE)) <-
  [
    -? {type_self != NULL};
  ]
  ( + result:PROFIL_SLOT;
    + res_lst:FAST_ARRAY(WRITE);
    + pro:PROFIL_SLOT;
    + j,i:INTEGER;
    + loc:LOCAL;
    + typ:TYPE_FULL;
    + typ_block:PROFIL_BLOCK;
    + typ_list:TYPES_TMP;
    + pro_list:FAST_ARRAY(PROFIL_SLOT);
    + is_new:BOOLEAN;

    (args = NULL).if {
      // For auto-load external section.
      result := PROFIL_SLOT.clone;
      profil.add_last result;
      is_new := TRUE;
    } else {
      // Block Detect.
      j := args.lower;
      {(j <= args.upper)    {(typ = NULL) || {! typ.raw.is_block}}}.while_do {
        typ := args.item j.static_type;
        (typ.raw.is_block).if {
          typ_list := TYPES_TMP.new;
          args.item j.get_type typ_list;
          (typ_list.first = TYPE_NULL).if {
            (typ_list.count > 1).if {
              typ_block ?= typ_list.second;
            } else {
              typ := NULL;
            };
          } else {
            typ_block ?= typ_list.first;
          };
          typ_list.free;
        };
        j := j + 1;
      };

      (typ_block != NULL).if {
        pro_list := typ_block.profil_list;
        i := pro_list.lower;
        {(i <= pro_list.upper)    {result = NULL}}.while_do {
          pro := pro_list.item i;
          (
            (pro.slot = Self)    {
              (pro.type_self = NULL) || {pro.type_self == type_self}
            } // BSBS: il fo aussi tester les args comme plus bas...
          ).if {
            result := pro; // Rmq. : It s limit for dispatching (See...)
          };
          i := i + 1;
        };

        (result = NULL).if {
          result := PROFIL_SLOT.clone;
          result.set_context_sensitive;
          typ_block.profil_list.add_last result;
          is_new := TRUE;
        };
      } else {
        // Select classic Profil (no block).
        (id_section.is_external).if {
          result := profil.first;
        } else {
          j := profil.lower;
          {(j <= profil.upper)    {result = NULL}}.while_do {
            pro := profil.item j;
            ((pro.type_self = NULL) || {pro.type_self == type_self}).if {
              result := pro;
              i := args.lower + 1;
              {(i <= args.upper)    {result != NULL}}.while_do {
                loc := pro.argument_list.item i;
                (
                  (loc != NULL)    {loc.require_first != NULL}   
                  {args.item i.static_type != loc.require_first.value.static_type}   
                  {loc.type.raw != type_boolean}
                ).if {
                  result := NULL;
                };
                i := i + 1;
              };
            };
            j := j + 1;
          };
        };
        (result = NULL).if {
          result := PROFIL_SLOT.clone;
          profil.add_last result;
          ((id_section.is_external)    {profil.count > 1}).if {
            semantic_error (position,"Polymorphic External slot is not possible.");
          };
          is_new := TRUE;
        };
      };
    };
    (is_new).if {
      res_lst := result.make Self with (type_self, args) verify (profil.count = 1);
    } else {
      res_lst := result.write_argument args;
    };
    result, res_lst
  );

  //
  // Constructeur.
  //

  - create base:SLOT with val:ITM_CODE :SLOT_CODE <-
  ( + result:SELF;
    result := clone;
    result.make base with val;
    result
  );

  - count_slot:INTEGER;

  - make base:SLOT with val:ITM_CODE <-
  (
    count_slot := count_slot + 1;

    parent_slot := base;
    value := val;
    profil := FAST_ARRAY(PROFIL_SLOT).create_with_capacity 1;
  );

  //
  // Execute.
  //

  + last_type_contract:TYPE;
  + is_require:BOOLEAN;

  - previous_contract:ITM_LIST <-
  ( + slot:ITM_SLOT;
    + contract:ITM_LIST;

    (is_require).if {
      slot := last_type_contract.search_require name;
    } else {
      slot := last_type_contract.search_ensure name;
    };
    (slot != NULL).if {
      (is_require).if {
	contract := slot.require;
      } else {
	contract := slot.ensure;
      };
      last_type_contract := last_type_contract.last_type_contract;
    };
    contract
  );

  - create_code is_first:BOOLEAN <-
  ( + contract:ITM_LIST;
    + slot:ITM_SLOT;
    + result:EXPR;
    + mul:EXPR_MULTIPLE;
    + nb_result_list:INTEGER;

    verify := is_first;
    // Require
    is_require := TRUE;
    contract := require;
    last_type_contract := receiver_type;
    (contract = NULL).if {
      slot := receiver_type.search_require name;
      (slot != NULL).if {
	(verify).if {
	  is_equal_profil slot;
	};
	contract := slot.require;
	last_type_contract := receiver_type.last_type_contract;
      };
    };
    (contract != NULL).if {
      contract.to_run_expr;
    };

    // Body.
    result := value.to_run_expr;
    (result.static_type.raw != TYPE_VOID).if {
      mul ?= result;
      (mul != NULL).if {
        nb_result_list := mul.count;
      } else {
        nb_result_list := 1;
      };
    } else {
      list_current.add_last result;
    };
    (profil_slot.result_list.count != nb_result_list).if {
      string_tmp.copy "Incorrect value result (slot:";
      profil_slot.result_list.count.append_in string_tmp;
      string_tmp.append ", list:";
      nb_result_list.append_in string_tmp;
      string_tmp.append ").";
      semantic_error (result.position,string_tmp);
    };
    (nb_result_list = 1).if {
      put_result result in (profil_slot.result_list.first);
    }.elseif {nb_result_list > 1} then {
      (mul.lower).to (mul.upper) do { j:INTEGER;
        put_result (mul.item j) in (profil_slot.result_list.item j);
      };
    };

    // Ensure
    is_require := FALSE;
    contract := ensure;
    last_type_contract := receiver_type;
    (contract = NULL).if {
      slot := receiver_type.search_ensure name;
      (slot != NULL).if {
	(verify).if {
	  is_equal_profil slot;
	};
	contract := slot.ensure;
	last_type_contract := receiver_type.last_type_contract;
      };
    };
    (contract != NULL).if {
      contract.to_run_expr;
    };
    // Result.
    (id_section.is_interrupt).if {
      list_current.add_first (
        EXTERNAL_C.create position text "__BEGIN_INTERRUPT__" access NULL
        persistant TRUE type (TYPE_VOID.default)
      );
      list_current.add_last (
        EXTERNAL_C.create position text "__END_INTERRUPT__" access NULL
        persistant TRUE type (TYPE_VOID.default)
      );
    };
  );

  - remove_profil prof:PROFIL_SLOT <-
  ( + idx:INTEGER;

    idx := profil.fast_first_index_of prof;
    (idx <= profil.upper).if { // Else, This profil is in BLOCK
      profil.remove idx;
    };
  );

  //
  // Display.
  //

  - display buffer:STRING <-
  (
    buffer.append name;
    (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
      buffer.add_last ' ';
      argument_list.item j.display buffer;
    };
    buffer.add_last ' ';
    buffer.add_last ':';
    type.display buffer;
  );

  - display_all <-
  ( + prof:PROFIL;

    string_tmp.clear;
    (profil != NULL).if {
      (profil.upper).downto (profil.lower) do { k:INTEGER;
	prof := profil.item k;
	prof.display_all string_tmp;
      };
    };
    string_tmp.print;
  );

Section Private

  - put_result e:EXPR in v:LOCAL <-
  ( + val:EXPR;
    + wrt:WRITE;
    val := e.check_type (v.type) with (v.position);
    wrt := v.write position value val;
    list_current.add_last wrt;
  );