Re: Attributes 'Version and 'Body_Version

[Georg Bauhaus <sb463ba@l1-hrz.uni-duisburg.de>]

Nick Roberts (:) and Robert Dewar debate:

:> There is no point in using the same attribute
:> name for two different purposes.
: 
: Yes there is: simplicity.
 
:> > Far be it from me to wish to perpetuate any confusion,
 
:> You can cure someones confusion with documentation [iff...]
 
I find the level of confusion in the thread unsatisfying,
in that it is at most at O(1). So let me add some loosely
related 2c. Or make that 2 centimes belgique :-)


package Versions is
   -- provide versions at run time, for a change, or maybe not

   type Version is
     -- to be attached to objects
      record
	 Version: Natural;
	 --  XXX provide a decent Version type instead of a Natural
	 -- type for versions
      end record;

   type Versioned_Versions is (Versi_On, Versi_Off);
   --  for toggling versioned versions of Version objects
   -- See Version below.

   procedure Which_Version(Want_Versioned_Version: Versioned_Versions);
   --  toggle versioning feature

   generic
      Max_Version: in Natural;
      --  no more than this number of Versions

   package Versioning is

      function Version (V: Version) return Version;
      --  versions V such that Version V has a Versions.Version iff this feature
      -- has been turned on with Version (See Version above above).

   end Versioning;

end Versions;


package body Versions is

   VV: Versioned_Versions:= Versi_Off;
   --  modus operandi

   -- ----------------
   -- Which_Version
   -- ----------------
   --  adjust the state variable VV to have the same value as
   -- Want_Versioned_Version

   procedure Which_Version(Want_Versioned_Version: Versioned_Versions) is
   begin
      VV:= Want_Versioned_Version;
   end Which_Version;



   package body Versioning is

      protected Versigen is
         --  new version numbers are assigned here up
         --  to a limit XXX remove the limit

         entry Next;
         -- can't proceed when no more versioning could
         -- possibly be done  XXX Add Free(Ver: Natural)
         -- (No, neither free the storage, nor Free the storage)

         function Current return Natural;

      private
         Ver: Natural:= 0;
      end Versigen;


      protected body Versigen is

         entry Next when Ver < Max_Version is
         begin
            Ver:= Natural'Succ(Ver);
         end Next;

         function Current return Natural is
         begin
            return Ver;
         end Current;

      end Versigen;



      -------------
      -- Version --
      -------------

      function Version (V: Versions.Version) return Versions.Version is
         Result: Versions.Version;

      begin
         if VV = Versi_On then

        Want_Versioning:
            declare
               Wanted_Version: Natural;
            begin
               Versigen.Next;
               Wanted_Version:= Versigen.Current;

               Result:= (Version => Wanted_Version);
            end Want_Versioning;

         else  --  Versi_off

            Result:= V;
         end if;

         return Result;
      end Version;

   end Versioning;

end Versions;