From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00, T_TVD_MIME_NO_HEADERS autolearn=ham autolearn_force=no version=3.4.4 X-Google-Thread: 103376,2843c5eea3415584 X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit From: Brian May Newsgroups: comp.lang.ada Subject: Re: APQ References: Date: Sat, 18 Dec 2004 09:55:00 +1100 Message-ID: User-Agent: Gnus/5.1007 (Gnus v5.10.7) Emacs/21.3 (gnu/linux) Cancel-Lock: sha1:6m0O7C9QD9i1tLbXy1205DHGnbg= MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" NNTP-Posting-Host: snoopy.microcomaustralia.com.au X-Trace: news.melbourne.pipenetworks.com 1103324074 202.173.153.89 (18 Dec 2004 08:54:34 +1000) X-Complaints-To: abuse@pipenetworks.com X-Abuse-Info: Please forward all headers to enable your complaint to be properly processed. Path: g2news1.google.com!news4.google.com!news.glorb.com!newsfeed-east.nntpserver.com!nntpserver.com!news1.optus.net.au!optus!news.mel.connect.com.au!news-north.connect.com.au!duster.adelaide.on.net!news.melbourne.pipenetworks.com!not-for-mail Xref: g2news1.google.com comp.lang.ada:7038 Date: 2004-12-18T09:55:00+11:00 List-Id: --=-=-= >>>>> "Brian" == Brian May writes: Brian> Good point. I meant to change it in both places, but I think I ended Brian> up changing it in only one place... You were right, I missed it up. Here is a patch that turns all methods into abstract methods. Unfortunately, I could not make Finalize abstract, the compiler complained that abstract methods must be visible (Finalize is in the private section). This restriction seems strange to me, but I am not going to argue with the compiler and left the function generating an exception at run-time. I suspect Finalize doesn't need to be abstract, but didn't go exploring enough to verify why it is abstract. Also, I noticed that the pointers are "access all". I couldn't see any requirement for "all", and my code still compiles, so I changed them to "access". This eliminates a potential source of errors. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=patch Content-Description: patch for abstract methods --- apq-2.1-old/apq.ads 2003-09-25 05:56:24.000000000 +1000 +++ apq-2.1/apq.ads 2004-12-18 09:50:31.000000000 +1100 @@ -90,7 +90,7 @@ type Column_Index_Type is new Positive; - type Root_Connection_Type is new Ada.Finalization.Limited_Controlled with private; + type Root_Connection_Type is abstract new Ada.Finalization.Limited_Controlled with private; type Trace_Mode_Type is ( Trace_None, -- No tracing @@ -101,10 +101,10 @@ type Fetch_Mode_Type is ( Sequential_Fetch, Random_Fetch ); - type Root_Query_Type is new Ada.Finalization.Controlled with private; + type Root_Query_Type is abstract new Ada.Finalization.Controlled with private; - function Engine_Of(C : Root_Connection_Type) return Database_Type; + function Engine_Of(C : Root_Connection_Type) return Database_Type is Abstract; function New_Query(C : Root_Connection_Type) return Root_Query_Type'Class; procedure Set_Host_Name(C : in out Root_Connection_Type; Host_Name : String); @@ -123,13 +123,13 @@ function User(C : Root_Connection_Type) return String; function Password(C : Root_Connection_Type) return String; - procedure Connect(C : in out Root_Connection_Type); -- IS ABSTRACT - procedure Connect(C : in out Root_Connection_Type; Same_As : Root_Connection_Type'Class); -- IS ABSTRACT - procedure Disconnect(C : in out Root_Connection_Type); -- IS ABSTRACT - - function Is_Connected(C : Root_Connection_Type) return Boolean; -- IS ABSTRACT - procedure Reset(C : in out Root_Connection_Type); -- IS ABSTRACT - function Error_Message(C : Root_Connection_Type) return String; -- IS ABSTRACT + procedure Connect(C : in out Root_Connection_Type) is abstract; + procedure Connect(C : in out Root_Connection_Type; Same_As : Root_Connection_Type'Class) is abstract; + procedure Disconnect(C : in out Root_Connection_Type) is abstract; + + function Is_Connected(C : Root_Connection_Type) return Boolean is abstract; + procedure Reset(C : in out Root_Connection_Type) is abstract; + function Error_Message(C : Root_Connection_Type) return String is abstract; function In_Abort_State(C : Root_Connection_Type) return Boolean; @@ -137,7 +137,7 @@ function Will_Rollback_On_Finalize(C : Root_Connection_Type) return Boolean; - function Engine_Of(Q : Root_Query_Type) return Database_Type; + function Engine_Of(Q : Root_Query_Type) return Database_Type is Abstract; procedure Clear(Q : in out Root_Query_Type); function Fetch_Mode(Q : Root_Query_Type) return Fetch_Mode_Type; @@ -160,40 +160,40 @@ procedure Append_Quoted(Q : in out Root_Query_Type; Connection : Root_Connection_Type'Class; SQL : String; After : String := ""); procedure Append_Quoted(Q : in out Root_Query_Type; Connection : Root_Connection_Type'Class; SQL : Ada.Strings.Unbounded.Unbounded_String; After : String := ""); - procedure Execute(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class); - procedure Execute_Checked(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class; Msg : String := ""); + procedure Execute(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is abstract; + procedure Execute_Checked(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class; Msg : String := "") is abstract; - procedure Begin_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class); - procedure Commit_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class); - procedure Rollback_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class); + procedure Begin_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is abstract; + procedure Commit_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is abstract; + procedure Rollback_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is abstract; procedure Raise_Exceptions(Query : in out Root_Query_Type; Raise_On : Boolean := True); procedure Report_Errors(Query : in out Root_Query_Type; Report_On : Boolean := True); - procedure Rewind(Q : in out Root_Query_Type); - procedure Fetch(Q : in out Root_Query_Type); - procedure Fetch(Q : in out Root_Query_Type; TX : Tuple_Index_Type); - - function End_of_Query(Q : Root_Query_Type) return Boolean; - function Tuple(Q : Root_Query_Type) return Tuple_Index_Type; - function Tuples(Q : Root_Query_Type) return Tuple_Count_Type; + procedure Rewind(Q : in out Root_Query_Type) is abstract; + procedure Fetch(Q : in out Root_Query_Type) is abstract; + procedure Fetch(Q : in out Root_Query_Type; TX : Tuple_Index_Type) is abstract; + + function End_of_Query(Q : Root_Query_Type) return Boolean is abstract; + function Tuple(Q : Root_Query_Type) return Tuple_Index_Type is abstract; + function Tuples(Q : Root_Query_Type) return Tuple_Count_Type is abstract; - function Value(Query : Root_Query_Type; CX : Column_Index_Type) return String; -- Abstract + function Value(Query : Root_Query_Type; CX : Column_Index_Type) return String is abstract; procedure Value(Query: Root_Query_Type; CX : Column_Index_Type; V : out String); function Value(Query : Root_Query_Type; CX : Column_Index_Type) return Ada.Strings.Unbounded.Unbounded_String; function Value(Query : Root_Query_Type; CX : Column_Index_Type) return Row_ID_Type; function Value(Query : Root_Query_Type; CX : Column_Index_Type) return APQ_Bitstring; - function Result(Query : Root_Query_Type) return Natural; -- Returns Result_Type'Pos() + function Result(Query : Root_Query_Type) return Natural is abstract; -- Returns Result_Type'Pos() - function Is_Null(Q : Root_Query_Type; CX : Column_Index_Type) return Boolean; + function Is_Null(Q : Root_Query_Type; CX : Column_Index_Type) return Boolean is abstract; - function Command_Oid(Query : Root_Query_Type) return Row_ID_Type; - function Null_Oid(Query : Root_Query_Type) return Row_ID_Type; + function Command_Oid(Query : Root_Query_Type) return Row_ID_Type is abstract; + function Null_Oid(Query : Root_Query_Type) return Row_ID_Type is abstract; - function Error_Message(Query : Root_Query_Type) return String; - function Is_Duplicate_Key(Query : Root_Query_Type) return Boolean; + function Error_Message(Query : Root_Query_Type) return String is abstract; + function Is_Duplicate_Key(Query : Root_Query_Type) return Boolean is abstract; function To_String(Query : Root_Query_Type) return String; @@ -573,15 +573,15 @@ package CStr renames Interfaces.C_Streams; - type String_Ptr is access all String; + type String_Ptr is access String; type String_Ptr_Array is array(Natural range <>) of String_Ptr; - type String_Ptr_Array_Access is access all String_Ptr_Array; - type Stream_Element_Array_Ptr is access all Ada.Streams.Stream_Element_Array; + type String_Ptr_Array_Access is access String_Ptr_Array; + type Stream_Element_Array_Ptr is access Ada.Streams.Stream_Element_Array; subtype Port_Integer is Integer range 0..32768; type Port_Format_Type is ( IP_Port, UNIX_Port ); - type Root_Connection_Type is new Ada.Finalization.Limited_Controlled with + type Root_Connection_Type is abstract new Ada.Finalization.Limited_Controlled with record Host_Name : String_Ptr; -- Host name string or.. Host_Address : String_Ptr; -- Host IP address @@ -602,7 +602,7 @@ procedure Clear_Abort_State(C : in out Root_Connection_Type); - type Root_Query_Type is new Ada.Finalization.Controlled with + type Root_Query_Type is abstract new Ada.Finalization.Controlled with record Count : Natural := 0; -- # of elements in the Collection Alloc : Natural := 0; -- # of allocated elements in the Collection --- apq-2.1-old/apq.adb 2003-09-25 05:56:24.000000000 +1000 +++ apq-2.1/apq.adb 2004-12-18 09:10:51.000000000 +1100 @@ -198,38 +198,6 @@ -- ABSTRACT PRIMITIVES - procedure Connect(C : in out Root_Connection_Type) is - begin - raise Is_Abstract; - end Connect; - - procedure Connect(C : in out Root_Connection_Type; Same_As : Root_Connection_Type'Class) is - begin - raise Is_Abstract; - end Connect; - - procedure Disconnect(C : in out Root_Connection_Type) is - begin - raise Is_Abstract; - end Disconnect; - - function Is_Connected(C : Root_Connection_Type) return Boolean is - begin - raise Is_Abstract; - return False; - end Is_Connected; - - procedure Reset(C : in out Root_Connection_Type) is - begin - raise Is_Abstract; - end Reset; - - function Error_Message(C : Root_Connection_Type) return String is - begin - raise Is_Abstract; - return ""; - end Error_Message; - procedure Clear(Q : in out Root_Query_Type) is begin for X in 1..Q.Count loop @@ -368,45 +336,6 @@ end; end To_String; - procedure Rewind(Q : in out Root_Query_Type) is - begin - raise Is_Abstract; - end Rewind; - - procedure Fetch(Q : in out Root_Query_Type) is - begin - raise Is_Abstract; - end Fetch; - - procedure Fetch(Q : in out Root_Query_Type; TX : Tuple_Index_Type) is - begin - raise Is_Abstract; - end Fetch; - - function End_of_Query(Q : Root_Query_Type) return Boolean is - begin - raise Is_Abstract; - return False; - end End_of_Query; - - function Tuple(Q : Root_Query_Type) return Tuple_Index_Type is - begin - raise Is_Abstract; - return Tuple_Index_Type'First; - end Tuple; - - function Tuples(Q : Root_Query_Type) return Tuple_Count_Type is - begin - raise Is_Abstract; - return Tuple_Count_Type'First; - end Tuples; - - function Value(Query : Root_Query_Type; CX : Column_Index_Type) return String is - begin - raise Is_Abstract; - return ":-)"; - end Value; - function Value(Query : Root_Query_Type; CX : Column_Index_Type) return Ada.Strings.Unbounded.Unbounded_String is use Ada.Strings.Unbounded; begin @@ -443,73 +372,6 @@ return C.Rollback_Finalize; end Will_Rollback_On_Finalize; - function Result(Query : Root_Query_Type) return Natural is - begin - raise Is_Abstract; -- This primitive must be overridden by the implementation - return 0; -- This is just to satisfy the compiler (not executed) - end Result; - - function Engine_Of(C : Root_Connection_Type) return Database_Type is - begin - raise Is_Abstract; -- Must be overridden - return Database_Type'First; -- To quiet the compiler - end Engine_Of; - - function Engine_Of(Q : Root_Query_Type) return Database_Type is - begin - raise Is_Abstract; -- Must be overridden - return Database_Type'First; -- To quiet the compiler - end Engine_Of; - - function Command_Oid(Query : Root_Query_Type) return Row_ID_Type is - begin - raise Is_Abstract; - return Row_ID_Type'First; - end Command_Oid; - - function Null_Oid(Query : Root_Query_Type) return Row_ID_Type is - begin - raise Is_Abstract; - return Row_ID_Type'First; - end Null_Oid; - - function Error_Message(Query : Root_Query_Type) return String is - begin - raise Is_Abstract; - return ""; - end Error_Message; - - function Is_Duplicate_Key(Query : Root_Query_Type) return Boolean is - begin - raise Is_Abstract; - return False; - end Is_Duplicate_Key; - - procedure Execute(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is - begin - raise Is_Abstract; - end Execute; - - procedure Execute_Checked(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class; Msg : String := "") is - begin - raise Is_Abstract; - end Execute_Checked; - - procedure Begin_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is - begin - raise Is_Abstract; - end Begin_Work; - - procedure Commit_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is - begin - raise Is_Abstract; - end Commit_Work; - - procedure Rollback_Work(Query : in out Root_Query_Type; Connection : in out Root_Connection_Type'Class) is - begin - raise Is_Abstract; - end Rollback_Work; - function Time_Component(TM : Ada.Calendar.Day_Duration; Unit : Time_Unit) return Natural is begin case Unit is @@ -1178,12 +1040,6 @@ end if; end Encode_Bitstring; - function Is_Null(Q : Root_Query_Type; CX : Column_Index_Type) return Boolean is - begin - raise Is_Abstract; -- Must be overriden - return False; - end Is_Null; - function Column_Is_Null(Q : Root_Query_Type'Class; CX : Column_Index_Type) return Ind_Type is begin return Ind_Type(Is_Null(Root_Query_Type'Class(Q),CX)); @@ -1373,7 +1229,6 @@ procedure Date_Fetch(Query : Root_Query_Type'Class; CX : Column_Index_Type; V : out Val_Type; Indicator : out Ind_Type) is function Value is new Date_Value(Val_Type); - D : APQ_Date; begin Indicator := Ind_Type( Is_Null(Root_Query_Type'Class(Query),CX) ); if not Indicator then --=-=-= -- Brian May --=-=-=--