Incorporate some sqlscript updates from FPC trunk

modsqlscript.pas

@@ -44,13 +44,14 @@ interface
 
 {$IF FPC_FULLVERSION<20701}
 uses
-  Classes, SysUtils, sqlscript, db, dbconst, sqldb, trunksqlscript;
+  Classes, SysUtils, db, dbconst, sqldb, trunksqlscript;
 {$ELSE}
 uses
   Classes, SysUtils, db, sqldb;
 {$ENDIF}
 
 {$IF FPC_FULLVERSION<20701}
+// Only use this customised version for non-trunk FPC
 type
   { TModCustomSQLQuery }
     TModCustomSQLQuery = class(TCustomSQLQuery)
@@ -152,6 +153,7 @@ constructor TModSQLScript.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FQuery := TModCustomSQLQuery.Create(nil);
+  CommentsInSQL:=false; //don't process comments by default
   FQuery.ParamCheck := false; // Do not parse for parameters; breaks use of e.g. select bla into :bla in Firebird procedures
   FQuery.ParseSQL:= false; //added for extra protection against messing with parameters
 end;
@@ -176,7 +178,7 @@ end;
 {$ELSE}
 // In FPC trunk, we can just use existing code
 type
-  TModSQLScript = TSQLscript;
+  TModSQLScript = TSQLScript;
 implementation
 {$ENDIF}
 end.

trunksqlscript.pas

@@ -48,8 +48,10 @@ type
     FCommentsInSQL: Boolean;
     FTerminator: AnsiString;
     FSQL: TStrings;
+    FCurrentStripped,
     FCurrentStatement: TStrings;
     FDirectives: TStrings;
+    FComment,
     FEmitLine: Boolean;
     procedure SetDefines(const Value: TStrings);
     function FindNextSeparator(sep: array of string): AnsiString;
@@ -58,15 +60,16 @@ type
     procedure SetSQL(value: TStrings);
     procedure SQLChange(Sender: TObject);
     function GetLine: Integer;
-    Function ProcessConditional(Directive : String; Param : String) : Boolean; virtual;
-    function NextStatement: AnsiString;
-    procedure ProcessStatement;
-    function Available: Boolean;
-    procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean);
-    procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean);
-    // Runs commit. If ComitRetaining, use CommitRetraining if possible, else stop/starttransaction
-    procedure InternalCommit(CommitRetaining: boolean=true);
   protected
+    procedure ClearStatement; virtual;
+    procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean); virtual;
+    procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean); virtual;
+    // Runs commit. If ComitRetaining, use CommitRetraining if possible, else stop/starttransaction
+    procedure InternalCommit(CommitRetaining: boolean=true); virtual;
+    Function ProcessConditional(Directive : String; Param : String) : Boolean; virtual;
+    function NextStatement: AnsiString; virtual;
+    procedure ProcessStatement; virtual;
+    function Available: Boolean; virtual;
     procedure DefaultDirectives; virtual;
     procedure ExecuteStatement (Statement: TStrings; var StopExecution: Boolean); virtual; abstract;
     procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); virtual; abstract;
@@ -79,7 +82,7 @@ type
   protected
     property Aborted: Boolean read FAborted;
     property Line: Integer read GetLine;
-    Property AutoCommit : Boolean Read FAutoCommit Write FAutoCommit;
+    property AutoCommit : Boolean Read FAutoCommit Write FAutoCommit;
     property CommentsInSQL: Boolean read FCommentsInSQL write FCommentsInSQL;
     property UseSetTerm: Boolean read FUseSetTerm write FUseSetTerm;
     property UseCommit: Boolean read FUseCommit write FUseCommit;
@@ -180,21 +183,6 @@ begin
   Result:=Trim(Result);
 end;
 
-function DeleteComments(SQL_Text: AnsiString; ATerminator: AnsiString = ';'): AnsiString;
-
-begin
-  With TTrunkCustomSQLScript.Create (Nil) do
-    try
-      Terminator:=ATerminator;
-      Script.Add(SQL_Text);
-      Script.Add(Terminator);
-      CommentsInSQL:=False;
-      Result:=ConvertWhiteSpace(NextStatement);
-    finally
-      Free;
-    end;
-end;
-
 { ---------------------------------------------------------------------
     TSQLScript
   ---------------------------------------------------------------------}
@@ -238,13 +226,18 @@ begin
 end;
 
 procedure TTrunkCustomSQLScript.AddToStatement(value: AnsiString; ForceNewLine : Boolean);
-
+  Procedure DA(L : TStrings);
+  begin
+    With L do
+      if ForceNewLine or (Count=0) then
+        Add(value)
+      else
+        Strings[Count-1]:=Strings[Count-1] + value;
+  end;
 begin
-  With FCurrentStatement do
-    if ForceNewLine or (Count=0) then
-      Add(value)
-    else
-      Strings[Count-1]:=Strings[Count-1] + value;
+ DA(FCurrentStatement);
+ if Not FComment then
+ 	 DA(FCurrentStripped);
 end;
 
 function TTrunkCustomSQLScript.FindNextSeparator(Sep: array of string): AnsiString;
@@ -376,6 +369,12 @@ begin
   end;
 end;
 
+procedure TTrunkCustomSQLScript.ClearStatement;
+begin
+  FCurrentStatement.Clear;
+  FCurrentStripped.Clear;
+end;
+
 procedure TTrunkCustomSQLScript.ProcessStatement;
 
 Var
@@ -386,7 +385,7 @@ Var
 begin
   if (FCurrentStatement.Count=0) then
     Exit;
-  S:=DeleteComments(FCurrentStatement.Text, Terminator);
+  S:=Trim(FCurrentStripped.Text);
   I:=0;
   Directive:='';
   While (i<FDirectives.Count) and (Directive='') do
@@ -442,7 +441,8 @@ begin
   while not FAborted and Available() do
     begin
     NextStatement();
-    ProcessStatement;
+    if Length(Trim(FCurrentStripped.Text))>0 then
+      ProcessStatement;
     end;
 end;
 
@@ -454,10 +454,10 @@ var
 
 begin
   terminator_found:=False;
-  FCurrentStatement.Clear;
+  ClearStatement;
   while FLine <= FSQL.Count do
     begin
-    pnt:=FindNextSeparator([FTerminator, '/*', '"', '''']);
+    pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
     if (pnt=FTerminator) then
       begin
       if pnt='' then
@@ -473,6 +473,7 @@ begin
       end
     else if pnt = '/*' then
       begin
+      FComment:=True;
       if FCommentsInSQL then
         AddToStatement(pnt,false)
       else
@@ -484,6 +485,16 @@ begin
       else
         FEmitLine:=True;
       FCol:=FCol + length(pnt);
+      FComment:=False;
+      end
+    else if pnt = '--' then
+      begin
+      FComment:=True;
+      if FCommentsInSQL then
+       AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),True);
+      Inc(Fline);
+      FCol:=0;
+      FComment:=False;
       end
     else if pnt = '"' then
       begin
@@ -503,9 +514,11 @@ begin
       end;
     end;
   if not terminator_found then
-    FCurrentStatement.Clear();
+    ClearStatement;
   while (FCurrentStatement.Count > 0) and (trim(FCurrentStatement.Strings[0]) = '') do
     FCurrentStatement.Delete(0);
+  while (FCurrentStripped.Count > 0) and (trim(FCurrentStripped.Strings[0]) = '') do
+    FCurrentStripped.Delete(0);
   Result:=FCurrentStatement.Text;
 end;
 
@@ -529,6 +542,7 @@ begin
   L.OnChange:=@SQLChange;
   FSQL:=L;
   FDirectives:=TStringList.Create();
+  FCurrentStripped:=TStringList.Create();
   FCurrentStatement:=TStringList.Create();
   FLine:=1;
   FCol:=1;
@@ -542,6 +556,7 @@ end;
 destructor TTrunkCustomSQLScript.Destroy;
 begin
   FreeAndNil(FCurrentStatement);
+  FreeAndNil(FCurrentStripped);
   FreeAndNil(FSQL);
   FreeAndNil(FDirectives);
   FreeAndNil(FDefines);