--          This file is part of SmallEiffel The GNU Eiffel Compiler.
--          Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE
--            Dominique COLNET and Suzanne COLLIN - colnet@loria.fr
--                       http://SmallEiffel.loria.fr
-- SmallEiffel 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  2, or (at your option)  any  later
-- version. SmallEiffel 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  SmallEiffel;  see the file COPYING.  If not,
-- write to the  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-- Boston, MA 02111-1307, USA.
--
class CLIENT_LIST
   --
   -- To store a list of clients class like : {FOO,BAR}
   --

inherit GLOBALS;

creation make, omitted, merge

feature

   start_position: POSITION;
         -- Of the the opening bracket when list is really written.

   is_omitted: BOOLEAN is
      do
         Result := start_position.is_unknown;
      end;

   pretty_print is
      do
         if is_omitted then
            if fmt.zen_mode then
            else
               fmt.put_string("{ANY} ");
            end
         else
            if list = Void then
               if fmt.zen_mode then
                  fmt.put_string("{} ");
               else
                  fmt.put_string("{NONE} ");
               end;
            else
               fmt.put_character('{');
               fmt.set_indent_level(2);
               list.pretty_print;
               fmt.put_character('}');
               fmt.put_character(' ');
            end;
         end;
      end;

   gives_permission_to(cn: CLASS_NAME): BOOLEAN is
         -- True if the client list give permission to `cn'.
         -- When false, `eh' is preloaded with beginning of
         -- error message.
      require
         cn /= Void
      do
         if is_omitted then
            -- It is as {ANY} :
            Result := true;
         elseif list = Void then
            -- Because it is as : {NONE}.
         else
            Result := list.gives_permission_to(cn);
         end;
         gives_permission_error(Result,cn.to_string);
      end;

   gives_permission_to_any: BOOLEAN is
      do
         if is_omitted then
            Result := true;
            -- Because it is as : {ANY}.
         elseif list = Void then
            -- Because it is as : {NONE}.
         else
            Result := list.gives_permission_to_any;
         end;
         gives_permission_error(Result,as_any);
      end;

feature {EXPORT_LIST}

   merge_with(other: like Current): like current is
      require
         other /= Void
      local
         sp: POSITION;
      do
         if gives_permission_to_any then
            Result := Current;
         elseif other.gives_permission_to_any then
            Result := other;
         else
            sp := start_position;
            if sp.is_unknown then
               sp := other.start_position;
            end;
            !!Result.merge(sp,list,other.list);
         end;
      end;

feature {PARENT_LIST}

   append(other: like Current): like Current is
      require
         other /= Void
      do
         if Current = other or else is_omitted then
            Result := Current;
         else
            if gives_permission_to_any then
               Result := Current;
            else
               eh.cancel;
               if other.is_omitted then
                  Result := other;
               elseif other.gives_permission_to_any then
                  Result := other;
               else
                  eh.cancel;
                  !!Result.merge(start_position,list,other.list);
               end;
            end;
         end;
      end;

feature {RUN_FEATURE}

   vape_check(call_site: POSITION; other: like Current) is
         -- To enforce VAPE, all clients of Current object must
         -- be allowed by `other'.
      require
         run_control.require_check;
         other /= Void
      local
         vape: BOOLEAN;
         i: INTEGER;
         caller: RUN_FEATURE;
         cn: CLASS_NAME;
      do
         if is_omitted then
            -- It is as {ANY}
            vape := other.gives_permission_to_any;
         elseif list = Void then
            -- It is {NONE}
            vape := true;
            eh.cancel;
         else
            from
               vape := true;
               i := list.count;
            until
               not vape or else i = 0
            loop
               cn := list.item(i);
               vape := other.gives_permission_to(cn);
               i := i - 1;
            end;
         end;
         if not vape then
            if cn /= Void then
               eh.add_position(cn.start_position);
            else
               eh.add_position(start_position);
            end;
            eh.add_position(call_site);
            eh.append("Invalid require assertion (VAPE).");
            eh.print_as_error;
            eh.add_position(call_site);
            eh.add_position(other.start_position);
            caller := small_eiffel.top_rf;
            eh.append(caller.current_type.run_time_mark);
            eh.append(" is the validation-context of the call. %
                      %This feature cannot be called in this %
                      %require clause (VAPE).");
            eh.print_as_error;
            eh.append("VAPE error in require clause of ");
            if cn /= Void then
               eh.add_position(cn.start_position);
            else
               eh.add_position(start_position);
            end;
            eh.add_position(caller.start_position);
            eh.append(caller.name.to_string);
            eh.print_as_fatal_error;
         end;
      end;

feature {CLIENT_LIST}

   list: CLASS_NAME_LIST;

feature {NONE}

   make(sp: like start_position; l: like list) is
         -- When the client list is really written.
         --
         -- Note : {NONE} has the same meaning as {}.
      require
         not sp.is_unknown
      do
         start_position := sp;
         list := l;
      ensure
         start_position = sp;
         list = l
      end;

   omitted is
         -- When the client list is omitted.
         --
         -- Note : it has the same meaning as {ANY}.
      do
      end;

   merge(sp: like start_position; l1, l2: like list) is
      require
         not sp.is_unknown
      do
         start_position := sp;
         !!list.merge(l1,l2);
      end;

   gives_permission_error(no_error: BOOLEAN; cn: STRING) is
      do
         if no_error then
            eh.cancel;
         else
            if start_position.is_unknown then
               if list /= Void then
                  eh.add_position(list.item(1).start_position);
               end;
            else
               eh.add_position(start_position);
            end;
            eh.append(cn);
            eh.append(" is not allowed to use this feature. ");
         end;
      end;

end -- CLIENT_LIST
