Code coverage for dta_block.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        := DTA_BLOCK;

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


  - author      := "Sonntag Benoit (bsonntag@loria.fr)";
  - comment     := "Lisaac IS A Advanced Compiler";

Section Inherit

  + parent_dta_rd_args:Expanded DTA_RD_ARGS;

Section Public

  + result_expr:EXPR;

  // Add.

  + model:TYPE_BLOCK;

  //
  // Creation.
  //

  - create mod:TYPE_BLOCK with larg:FAST_ARRAY(EXPR) :SELF <-
  ( + result:SELF;
    result := clone;
    result.make mod with larg;
    result
  );

  - make mod:TYPE_BLOCK with larg:FAST_ARRAY(EXPR) <-
  [ -? {mod.position != 0}; ]
  (
    (profil_current = NULL).if {
      context := context_main;
    } else {
      context := profil_current.context;
    };
    model         := mod;
    position      := mod.position;
    argument_list := larg;
    result_expr   := mod.get_expr_for (mod.position);
  );

  //
  // Display.
  //

  - display buffer:STRING <-
  (
    buffer.append "DTA_BLOCK";
  );

Section NODE_STYLE, SELF

  - get_argument:FAST_ARRAY(EXPR) <-
  ( + result:FAST_ARRAY(EXPR);
    + rd:READ_SLOT;
    (copy_argument).if {
      result := FAST_ARRAY(EXPR).create_with_capacity (argument_list.count);
      rd ?= argument_list.first;
      result.add_last (rd.receiver.my_copy);
      (argument_list.lower+1).to (argument_list.upper) do { j:INTEGER;
	result.add_last (argument_list.item j.my_copy);
      };
    } else {
      result := argument_list;
      copy_argument := TRUE;
    };
    result
  );

Section NODE_TYPE, DTA

  - product t:TYPE with e:EXPR self type_self:TYPE_FULL :LIST <-
  ( + result:LIST;
    + t_block:PROFIL_BLOCK;
    + wrt:WRITE;
    + wrt_larg:FAST_ARRAY(WRITE);
    + call:CALL_SLOT;
    + em:EXPR_MULTIPLE;
    + rd:READ;
    + result_var:VARIABLE;

    result := LIST.create (e.position);
    (t = TYPE_NULL).if {
      TYPE_NULL.product_error (e.position) in result with context;
    } else {
      t_block ?= t;


      (t_block = NULL).if { // BSBS: debug
        "<<<".print;
        t.print;
        ">>>".print; '\n'.print;
        list_current.debug_display;
        syntax_error (argument_list.first.position,"Block not found");
      };

      wrt_larg := t_block.write_argument get_argument;
      call := CALL_SLOT.create (e.position) profil t_block with wrt_larg cop NULL;
      (result_expr.static_type.raw != TYPE_VOID).if {
	em ?= result_expr;
	(em != NULL).if {
	  (em.lower).to (em.upper) do { j:INTEGER;
	    rd ?= em.item j;
	    ? {rd != NULL};
	    result_var := rd.variable;
	    rd  := call.profil.result_list.item j.read (e.position);
	    wrt := result_var.write (e.position) value rd;
	    call.result_list.add_last (RESULT.create wrt);
	  };
	} else {
          rd ?= result_expr;
          result_var := rd.variable;
          rd  := call.profil.result_list.first.read (e.position);
          wrt := result_var.write (e.position) value rd;
          call.result_list.add_last (RESULT.create wrt);
	};
      };
      result.add_last call;
    };
    result
  );

  - update_branch l:LIST self type_self:TYPE_FULL :BOOLEAN <-
  (
    TRUE
  );