XmlBuilder para NF-e

Esta semana estava escrevendo uma rotina que gravava um arquivo xml para a Nota Fiscal eletrônica. Eu estava usando Delphi 7 pra isso. Começei com o Wizard XML Data Binding e ía tudo bem até que eu comecei a validar o arquivo gerado. Me deu uma dor de cabeça danada! Eu não consegui gerar o arquivo conforme o layout exigido. Daí eu decidi por fazer uma classe pra gerar o XML ao meu gosto e me lembrei de ter lido algo sobre isso mas não sabia exatamente onde. Depois de alguma pesquisa encontrei: Refactoring to Patterns de Addison Wesley.

Ele mostra como simplificar a implementação de um Composite usando o Pattern Builder. Eu peguei a idéia e construí uma classe personalizada. É uma classe simples. Não adicionei muita funcionalidade. Eu queria apenas gerar o Xml para ser validado e enviado ao webservice da SEFAZ. Vejam o resultado:

unit uXmlBuilder;

interface

uses
  SysUtils, Windows, Classes, Contnrs;

type
  TTagNode = class
  private
    FName: string;
    FValue: string;
    FAttributes: TStrings;
    FChildren: TObjectList;
    FParent: TTagNode;
    function GetAttributes: string;
    function GetChildrenXml: string;
    procedure SetParent(const Value: TTagNode);
  public
    constructor Create(TagName: string);
    destructor Destroy; override;
    function ToString: string;
    function AddChild(Child: TTagNode): TTagNode; overload;
    function AddChild(const ChildName: string): TTagNode; overload;
    function RemoveChild(Child: TTagNode): TTagNode;
    procedure SetValue(const Value: string);
    procedure AddAttribute(const Name, Value: string);
    property Name: string read FName;
    property Parent: TTagNode read FParent write SetParent;
  end;

  TXmlBuilder = class
  private
    FEncoding: string;
    FRootNode: TTagNode;
    FVersion: string;
  public
    constructor Create(Version, Encoding, rootTagName: string);
    destructor Destroy; override;
    function ToXml: string;
    property Version: string read FVersion;
    property Encoding: string read FEncoding;
    property RootNode: TTagNode read FRootNode;
  end;

implementation

uses TestFramework;

{ TXmlBuilder }

constructor TXmlBuilder.Create(Version, Encoding, rootTagName: string);
begin
  FVersion := Version;
  FEncoding := Encoding;
  FRootNode := TTagNode.Create(rootTagName);
end;

destructor TXmlBuilder.Destroy;
begin
  FRootNode.Free;
  inherited;
end;

function TXmlBuilder.ToXml: string;
begin
  Result := '<?xml version="'+FVersion+'" encoding="'+FEncoding+'"?>'+FRootNode.ToString;
end;

{ TTagNode }

procedure TTagNode.AddAttribute(const Name, Value: string);
begin
  FAttributes.Add(Format('%s=%s',[Name, Value]));
end;

constructor TTagNode.Create(TagName: string);
begin
  FAttributes := TStringList.Create;
  FChildren := TObjectList.Create(True);
  FName := TagName;
end;

destructor TTagNode.Destroy;
begin
  FChildren.Free;
  FAttributes.Free;
  inherited;
end;

procedure TTagNode.SetValue(const Value: string);
begin
  FValue := Value;
end;

function TTagNode.ToString: string;
begin
  if FValue <> '' then
    Result := Format('<%s%s>%s%s</%s>',[FName, GetAttributes, FValue, GetChildrenXml, FName])
  else if FChildren.Count > 0 then
    Result := Format('<%s%s>%s</%s>',[FName, GetAttributes, GetChildrenXml, FName])
  else
    Result := Format('<%s%s/>',[FName, GetAttributes]);
end;

function TTagNode.GetChildrenXml: string;
var
  i: Integer;
begin
  for i := 0 to FChildren.Count - 1 do
    Result := Result + TTagNode(FChildren[i]).ToString;
end;

function TTagNode.GetAttributes: string;
var
  i: Integer;
begin
  for i := 0 to FAttributes.Count - 1 do
  begin
    Result := Result + ' ' + FAttributes.Names[i]+'="'+FAttributes.ValueFromIndex[i]+'"';
  end;
end;


type
  TTestXmlBuilder = class(TTestCase)
  private
    FXmlBuilder: TXmlBuilder;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCreate;
    procedure TestBuildRootNode;
    procedure TestBuildRootNodeWithAttrib;
  end;

  TTestTagNode = class(TTestCase)
  private
    FTagNode: TTagNode;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCreate;
    procedure TestTagSemValor;
    procedure TestSetValue;
    procedure TestAddAttribute;
    procedure TestAddAttributes;
    procedure TestAddChild;
    procedure TestRemoveChild;
    procedure TestSetParent;
    procedure TestAddChildren;
  end;

{ TXmlBuilderTest }

procedure TTestXmlBuilder.SetUp;
begin
  inherited;
  FXmlBuilder := TXmlBuilder.Create('1.0', 'utf-8', 'nfe');
end;

procedure TTestXmlBuilder.TearDown;
begin
  FXmlBuilder.Free;
  inherited;
end;

procedure TTestXmlBuilder.TestCreate;
begin
  CheckEqualsString('1.0',FXmlBuilder.Version);
  CheckEqualsString('utf-8',FXmlBuilder.Encoding);
end;

procedure TTestXmlBuilder.TestBuildRootNode;
var
  sExpectedXml: string;
  sActualXml: string;
begin
  sExpectedXml := '<?xml version="1.0" encoding="utf-8"?><nfe/>';
  sActualXml := FXmlBuilder.ToXml;
  CheckEqualsString(sExpectedXml, sActualXml);
end;

function TTagNode.AddChild(Child: TTagNode): TTagNode;
begin
  FChildren.Add(Child);
  Child.FParent := Self;
  Result := Child;
end;

function TTagNode.AddChild(const ChildName: string): TTagNode;
begin
  Result := AddChild(TTagNode.Create(ChildName));
end;

procedure TTagNode.SetParent(const Value: TTagNode);
begin
  if Assigned(FParent) then FParent.RemoveChild(Self);
  if Assigned(Value) then Value.AddChild(Self);
  FParent := Value;
end;

function TTagNode.RemoveChild(Child: TTagNode): TTagNode;
begin
  Result := TTagNode(FChildren.Extract(Child));
  Result.FParent := nil;
end;

{ TTestTagNode }

const
  PRECO = '10.25';

procedure TTestTagNode.SetUp;
begin
  inherited;
  FTagNode := TTagNode.Create('preco');
end;

procedure TTestTagNode.TearDown;
begin
  FTagNode.Free;
  inherited;
end;

procedure TTestTagNode.TestAddAttribute;
var
  sExpected: string;
  sActual: string;
begin
  sExpected := '<preco moeda="real">'+PRECO+'</preco>';
  FTagNode.AddAttribute('moeda', 'real');
  FTagNode.SetValue(PRECO);
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestAddAttributes;
var
  sExpected: string;
  sActual: string;
begin
  sExpected := '<preco moeda="real" data_cot="10/10/2008">'+PRECO+'</preco>';
  FTagNode.AddAttribute('moeda', 'real');
  FTagNode.AddAttribute('data_cot', '10/10/2008');
  FTagNode.SetValue(PRECO);
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestAddChild;
var
  sExpected: string;
  sActual: string;
begin
  sExpected := '<preco><moeda/></preco>';
  FTagNode.AddChild(TTagNode.Create('moeda'));
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestAddChildren;
var
  sExpected: string;
  sActual: string;
  moedaTag: TTagNode;
begin
  sExpected := '<preco><moeda><teste1>valor_teste1</teste1><teste2/><teste3/></moeda></preco>';
  moedaTag := FTagNode.AddChild(TTagNode.Create('moeda'));
  moedaTag.AddChild(TTagNode.Create('teste1')).SetValue('valor_teste1');
  moedaTag.AddChild(TTagNode.Create('teste2'));
  moedaTag.AddChild(TTagNode.Create('teste3'));
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestCreate;
var
  sExpected: string;
  sActual: string;
begin
  sExpected := 'preco';
  sActual := FTagNode.Name;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestRemoveChild;
var
  sExpected: string;
  sActual: string;
  moedaTag: TTagNode;
  teste3Tag: TTagNode;
begin
  sExpected := '<preco><moeda><teste1/><teste2/></moeda></preco>';
  moedaTag := FTagNode.AddChild(TTagNode.Create('moeda'));
  moedaTag.AddChild(TTagNode.Create('teste1'));
  moedaTag.AddChild(TTagNode.Create('teste2'));
  teste3Tag := moedaTag.AddChild(TTagNode.Create('teste3'));
  moedaTag.RemoveChild(teste3Tag);
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestSetParent;
var
  sExpected: string;
  sActual: string;
  moedaTag: TTagNode;
  teste2Tag: TTagNode;
begin
  sExpected := '<preco><moeda><teste1/><teste3/></moeda><teste2/></preco>';
  moedaTag := FTagNode.AddChild(TTagNode.Create('moeda'));
  moedaTag.AddChild(TTagNode.Create('teste1'));
  teste2Tag := moedaTag.AddChild(TTagNode.Create('teste2'));
  moedaTag.AddChild(TTagNode.Create('teste3'));
  teste2Tag.SetParent(FTagNode);
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestSetValue;
var
  sExpected: string;
  sActual: string;
begin
  sExpected := '<preco>'+PRECO+'</preco>';
  FTagNode.SetValue(PRECO);
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestTagNode.TestTagSemValor;
var
  sExpected: string;
  sActual: string;
begin
  sExpected := '<preco/>';
  sActual := FTagNode.ToString;
  CheckEqualsString(sExpected, sActual);
end;

procedure TTestXmlBuilder.TestBuildRootNodeWithAttrib;
var
  sExpectedXml: string;
  sActualXml: string;
begin
  sExpectedXml := '<?xml version="1.0" encoding="utf-8"?><nfe atributo="valor_atrib"/>';
  FXmlBuilder.RootNode.AddAttribute('atributo','valor_atrib');
  sActualXml := FXmlBuilder.ToXml;
  CheckEqualsString(sExpectedXml, sActualXml);
end;

initialization
  TestFramework.RegisterTest('TagNode Test', TTestTagNode.Suite);
  TestFramework.RegisterTest('XmlBuilder Test', TTestXmlBuilder.Suite);

end.

No desenvolvimento desta classe eu usei o DUnit como ferramenta para testes unitários. O desenvolvimento foi rápido e a descoberta de erros ocorreu logo cedo no desenvolvimento da classe. Portanto, dentro mais ou menos 30 minutos eu estava com ela funcionando a todo vapor.

Usá-la ficou muito fácil:

var
  XmlBuilder: TXmlBuilder;
  InfNfeTag: TTagNode;
  IdeTag: TTagNode;
begin
  XmlBuilder := TXmlBuilder.Create('1.0', 'utf-8', 'NFe');
  XmlBuilder.RootNode.AddAttribute('xmlns','http://www.portalfiscal.inf.br/nfe');

  InfNfeTag := XmlBuilder.RootNode.AddChild('infNFe');
  InfNfeTag.AddAttribute('Id','NFe'+NotaFiscal.Chave_Acesso);
  InfNfeTag.AddAttribute('versao','1.10');

  IdeTag := InfNfeTag.AddChild('ide');
  IdeTag.AddChild('cUF').SetValue('23');

  // O código continua...

Espero que esta dica seja útil pra vocês.

Eliminado duplicação de código com delegação

É fácil eliminar a duplicação de código quando o bloco código repetido é contínuo, ou seja, não há nenhum trecho dentro do bloco que varia. Neste caso, um simples Extract Method resolveria o problema. Mas o que fazer se os trechos são muito semelhantes mas tem uma(s) linha(s) que são diferentes, como no caso abaixo?

function TMinhaClasse.GetSumVr_Contabil: Double;
var
  CloneItems: TClientDataSet;
begin
  Result:= 0;
  CloneItems := TClientDataSet.Create(nil);
  try
    CloneItems.CloneCursor(MeuDataSet, True);
    while not CloneItems.eof do 
    begin
      Result := Result + CloneItems.FieldByName('vr_contabil').AsFloat;

      CloneItems.Next;
    end;
  finally
    CloneItems.Free;
  end;
end;

function TMinhaClasse.GetSumVr_Desconto: Double;
var
  CloneItems: TClientDataSet;
begin
  Result:= 0;
  CloneItems := TClientDataSet.Create(nil);
  try
    CloneItems.CloneCursor(MeuDataSet, True);
    while not CloneItems.eof do 
    begin
      Result := Result + CloneItems.FieldByName('vr_desconto').AsFloat;

      CloneItems.Next;
    end;
  finally
    CloneItems.Free;
  end;
end;

Bem, este caso é muito simples. Portanto, a resposta parece óbvia: cria-se um novo método para o qual passamos como parâmetro o nome do campo a ser sumarizado. É verdade. Mas se o processamento envolvesse mais do que uma simples linha de código, a resposta poderia ser bem diferente. Como proceder? Usar delegação (em delphi, ponteiro para uma função).

Declaramos o tipo de função que esperamos receber como parâmetro na função que fará o processamento:

type
  TCalcFunc = function (const Value: Double; DataSet: TDataSet): Double of object;

Criamos um novo método com toda a lógica do processamento. E este método receberá como parâmetro um ponteiro para a função que irá fazer o processamento. Isto eliminará a duplicação de código, reduzindo a possibilidade de erros advindos de alterações na lógica (Não é raro esquecermos de alterar o código copiado/colado):

function TMinhaClasse.GetSum(CalcFunc: TCalcFunc): Double;
var
  CloneItems: TClientDataSet;
begin
  Result:= 0;
  CloneItems := TClientDataSet.Create(nil);
  try
    CloneItems.CloneCursor(MeuDataSet, True);
    CloneItems.First;
    while not CloneItems.Eof do
    begin
      Result := CalcFunc(Result, CloneItems);

      CloneItems.Next;
    end;
  finally
    CloneItems.Free;
  end;
end;

Agora modificamos as funcões antigas para adaptá-las à nova metodologia:

function TMinhaClasse.GetSumVr_Contabil: Double;
begin
  Result := GetSum(CalcVrContabil);
end;

function TMinhaClasse.GetSumVr_Desconto: Double;
begin
  Result := GetSum(CalcVrDesconto);
end;

function TMinhaClasse.CalcVrContabil(const Value: Double; DataSet: TDataSet): Double;
begin
  Result := Value + DataSet.FieldByName('vr_contabil').AsFloat;
end;

function TMinhaClasse.CalcVrDesconto(const Value: Double; DataSet: TDataSet): Double;
begin
  Result := Value + DataSet.FieldByName('vr_desconto').AsFloat;
end;

Agora ficou fácil adicionar novas funções aproveitando a mesma lógica: GetSumVr_Frete(), GetSumVr_ICMS(), etc.

Outra maneira de fazer a mesma coisa seria usando design patterns. Mas, às vezes a coisa é tão simples que aplicar um ou vários design patterns seria como usar um martelo para matar uma formiguinha, levando a um excesso de sofisticação na engenharia.

Aguardo os seus comentários e críticas. Ok?

DICA: Como sumarizar dados condicionalmente

Não raro nos deparamos com a necessidade de sumarizar dados e apresenta-los em forma colunar. Ex.:

ano        jan       fev       mar ...
2007 99.999,99 99.999,99 99.999,99 ...
2008 99.999,99 99.999,99 99.999,99 ...

neste caso, contamos com uma grande ajuda na maioria dos SGDB's modernos: a instrução CASE.

Para atender à necessidade acima citada poderiamos escrever um código semelhante a este:

select ano, 
  sum(case when mes=1 then valor else 0 end) mes_01,
  sum(case when mes=2 then valor else 0 end) mes_02,
  sum(case when mes=3 then valor else 0 end) mes_03,
  sum(case when mes=4 then valor else 0 end) mes_04,
  sum(case when mes=5 then valor else 0 end) mes_05,
  sum(case when mes=6 then valor else 0 end) mes_06,
  sum(case when mes=7 then valor else 0 end) mes_07,
  sum(case when mes=8 then valor else 0 end) mes_08,
  sum(case when mes=9 then valor else 0 end) mes_09,
  sum(case when mes=10 then valor else 0 end) mes_10,
  sum(case when mes=11 then valor else 0 end) mes_11,
  sum(case when mes=12 then valor else 0 end) mes_12,
  sum(valor) total
from minha_tabela
where ano between 2006 and 2008
group by ano

É muito importante observar que a instrução CASE fica dentro da função de agregação SUM() e não o contrário.

A nomeação dos campos como mes_xx foi proposital, para facilitar a escrita do programa de forma genérica.

Por enquanto é só. Use a sua criatividade e terá muito poder nas suas mãos.

OBS: A sintaxe do SQL que eu usei funciona em Firebird 1.5+, MySQL 4+ e SQL Server. Quanto a outros bancos de dados não sei dizer...

Refactoring, uma necessidade

Quantas vezes você já precisou adicionar uma nova funcionalidade àquela opção do sistema que você nem lembrava mais que existia, mas que o seu cliente usa e resolveu solicitar uma modificação? Trata-se de um código complexo, com muitos desvios condicionais, métodos enormes e com muitas variáveis... Daí você pensa: “Tô lascado! Nem lembro mais o que faz esta rotina...” E o pior é que quase sempre que isso ocorre, você não tem nenhum comentário, nem qualquer outro tipo de documentação do código. O que fazer? É aí que entra a refatoração ou refactoring.

Mas, afinal de contas, o que é refactoring?

Segundo Martin Fowler, ‘é uma mudança feita na estrutura interna de um software pra fazê-lo mais fácil de entender e/ou modificar sem, contudo, modificar o seu comportamento externo.’
A refatoração envolve várias coisas:

• Remover de duplicação de código;
• Simplificar uma lógica complexa;
• Tornar claro o objetivo de um trecho de código que antes não era tão claro.
  

Às vezes, pode até mesmo envolver uma simples modificação do nome de uma variável, para tornar claro o seu objetivo ou o que ela contém. Outras vezes, pode ser um conjunto de pequenas modificações com o objetivo de otimizar um projeto de software mas que pode, no entanto, constituir uma grande modificação no final.

Algumas pessoas dizem: “Não se mexe em time que está ganhando”. Mas, contrariando esta afirmação, o processo de refatoração é justamente modificar um código que já está funcionando. Por que? Porque queremos arrumar a casa; porque queremos entender melhor; porque queremos fazer melhor! E, além de tudo, pra tornar a codificação menos cansativa, menos chata. Como se isso não bastasse, ainda contamos com uma grande ajuda para encontrar bugs.

Como saber se é preciso refatorar?

Há uma metáfora muito boa sobre mal-cheiro, que ajuda a entender quando é necessário refatorar. Quando você achar que alguma coisa não está cheirando bem é uma evidência de que precisa dar atenção especial aquele trecho do código. Aqui vai uma lista de alguns mal-cheiros sugeridos por Martin Fowler no seu livro Refactoring: Improving the Design of Existing Code:

• Métodos longos;
• Código duplicado;
• Classes muito longas;
• Uma longa lista de parâmetros, etc.
  

Refatorando

Contudo, para tornar a refatoração segura, você precisa estar munido de um bom conjunto de testes unitários e, além disso, fazer a refatoração em pequenos passos, não esquecendo de, a cada passo, executar os testes para se assegurar de que a sua alteração não quebrou o código. Se quebrou, fica mais fácil retornar e começar de novo.

Atire a primeira pedra quem nunca caiu na armadilha de começar uma alteração e, de repente, foi longe demais para voltar atrás, mesmo diante do arrependimento. Seguir a regra de refatorar em pequenos passos evita cair nessa armadilha.

Mantendo a casa limpa

Já experimentou deixar o seu quarto sem arrumação por um longo período? Quanto mais tempo passa, menos vontade você tem de arrumá-lo e mais difícil se torna a arrumação. Portanto, não deixe para refatorar só quando seu código já tiver um acúmulo de mal-cheiro, quando se tornará mais difícil o processo.

Conclusão

Essa foi apenas uma visão geral sobre refatoração, mas já dá pra ter uma idéia de que precisamos aprender mais. Se desejar, consulte um dos sites abaixo:

http://sourcemaking.com/
http://www.refactoring.com/

Factory Method

Suponhamos que temos uma aplicação que é utilizada por vários clientes, mas cada um quer personalizar a "sua" aplicação. Vamos dizer que o objeto da personalização é uma consulta: A consulta de produtos.

O uso do padrão Factory Method poderia nos ajudar bastante a ter uma aplicação limpa e bem estruturada. Vejamos como.

Sem o Factory Method

Sem o padrão Factory Method, nossa aplicação muito provavelmente ficaria lotada de desvios no fluxo para atender a necessidade de cada cliente:

unit Form1;

type
  TForm1 = class(TForm)
// ...
  end;

implementation

uses fmConProdutos1, fmConProdutos2, fmConProdutos3;

procedure TForm1.mnuConProdutosClick(Sender: TObject);
var
  f: TForm;
begin
  if Cod_Cli_Sistema = CS_CLIENTE1 then
    Application.CreateForm(TfrmConProdutos1, f)
  else if Cod_Cli_Sistema = CS_CLIENTE2 then
    Application.CreateForm(TfrmConProdutos2, f)
  else if Cod_Cli_Sistema = CS_CLIENTE3 then
    Application.CreateForm(TfrmConProdutos3, f);
end;

Noutra parte do sistema, também precisamos chamar o mesmo form da consulta de produtos. E agora, como vamos proceder?

unit Form2;

type
  TForm2 = class(TForm)
// ...
  end;

implementation

uses fmConProdutos1, fmConProdutos2, fmConProdutos3;

procedure TForm2.AbrirConsultaProdutos;
var
  f: TForm;
begin
  if Cod_Cli_Sistema = CS_CLIENTE1 then
  begin
    Application.CreateForm(TfrmConProdutos1, f);
    TfrmConProdutos1(f).AlgumMetodo();
  end
  else if Cod_Cli_Sistema = CS_CLIENTE2 then
  begin
    Application.CreateForm(TfrmConProdutos2, f);
    TfrmConProdutos2(f).AlgumMetodo();
  end
  else if Cod_Cli_Sistema = CS_CLIENTE3 then
  begin
    Application.CreateForm(TfrmConProdutos3, f);
    TfrmConProdutos3(f).AlgumMetodo();
  end;
end;

Como se pode perceber, o código fica difícil de entender (talvez não neste caso, porque se trata de um pequeno exemplo, mas numa aplicação grande e complexa, com certeza ficaria) e difícil de manter, visto que pra cada customização precisaríamos procurar por toda a aplicação os lugares onde eles são criados pra adicionar a nova classe. O risco de introduzir bugs é grande. Ademais, criamos um forte acoplamento entre as classes tornando dificil o reaproveitamento dos módulos e aumentando a possibilidade que a alteração em uma ocasione problemas em outras. É bem provável que o seu cliente diga algo parecido com isto, após a implantação da versão nova: "Antes isto aqui funcionava, agora não está mais funcionando".

Por outro lado, o uso dos padrões de projeto podem reduzir significativamente os problemas apresentados. São soluções robustas elaboradas por desenvolvedores experientes e que já foram testadas no mundo todo. Então por que não utilizá-los?

Com o Factory Method

O que precisamos fazer é uma fabrica de objetos que instancie a classe desejada mas que a minha aplicação não precise saber nada sobre a classe específica instanciada. Como conseguir isto?

Precisamos criar uma classe abstrata da qual todas as consultas de produto fossem herdadas e ela seria a única classe que a minha aplicação como um todo conheceria. As outras, herdadas dela, só seriam conhecidas pela fábrica.

unit fmConProdutosAbs;

uses SysUtils, Windows, Classes, Forms, Variants;

type
  TfrmConProdutosAbs = class(TForm)
  private

  public
    {alguns metodos aqui}
  end;

implementation

Agora, iremos criar a nossa fabrica:

unit uConProdutosFactory;

uses SysUtils, Windows, Classes, Forms, Variants, fmConProdutosAbs;

type
  TConProdutosFactory = class(TInterfacedObject, IConProdutosFactory)
  private

  public
    function CriarConProdutos(Cod_Cliente_Sistema: Integer): TfrmConProdutosAbs;
  end;

implementation

uses fmConProdutos1, fmConProdutos2, fmConProdutos3;

function TConProdutosFactory.CriarConProdutos(Cod_Cliente_Sistema: Integer): TfrmConProdutosAbs;
begin
  if Cod_Cli_Sistema = CS_CLIENTE1 then
    Application.CreateForm(TfrmConProdutos1, Result)
  else if Cod_Cli_Sistema = CS_CLIENTE2 then
    Application.CreateForm(TfrmConProdutos2, Result)
  else if Cod_Cli_Sistema = CS_CLIENTE3 then
    Application.CreateForm(TfrmConProdutos3, Result)
  else
    raise Exception.Create('Consulta de Produto não implementada para o cliente especificado');
end;

initilization
  ConProdutosFactory := TConProdutosFactory.Create;
finalization
  ConProdutosFactory := nil;
end.

Agora pense um pouco: Se colocarmos uConProdutosFactory no uses de Form1 ou Form2, estarei criando um vínculo indireto com fmConProdutos1, fmConProdutos2, fmConProdutos3, além de fmConProdutosAbs, aumentadando o acoplamento. Isto não seria legal.

Então vamos fazer o seguinte: modificamos a unit fmConProdutosAbs para acomodar a variável global ConProdutosFactory. Fazemos isto nela porque ela já vai ter que ser referenciada mesmo pelas outras units! A unit modificada fica assim:

unit fmConProdutosAbs;

uses SysUtils, Windows, Classes, Forms, Variants;

type
  TfrmConProdutosAbs = class;

  IConProdutosFactory = interface
  ['{C8E329B0-BCDD-43A3-A5D6-8366055901CA}']
    function CriarConProdutos(Cod_Cliente_Sistema): TfrmConProdutosAbs;
  end;

  TfrmConProdutosAbs = class(TForm)
  private

  public
    {alguns metodos aqui}
    // as classes filhas terão de sobrescrever este método
    procedure AlgumMetodo(); virtual; abstract;  
  end;

var
  ConProdutosFactory: IConProdutosFactory;

implementation

O Resultado final

Agora veja como fica as unit Form1 e Form2 usando a fábrica recém-criada:

unit Form1;

type
  TForm1 = class(TForm)
// ...
  end;

implementation

uses fmConProdutosAbs;

procedure TForm1.mnuConProdutosClick(Sender: TObject);
var
  f: TfrmConProdutosAbs;
begin
  f := ConProdutosFactory.CriarConProdutos(Cod_Cli_Sistema);
end;

unit Form2;

type
  TForm2 = class(TForm)
// ...
  end;

implementation

uses fmConProdutosAbs;

procedure TForm2.AbrirConsultaProdutos;
var
  f: TfrmConProdutosAbs;
begin
  f := ConProdutosFactory.CriarConProdutos(Cod_Cli_Sistema);
  f.AlgumMetodo();
end;

Veja que agora, o acoplamento foi bastante reduzido: só colocamos no uses fmConProdutosAbs! o código ficou mais limpo e fácil de manter. Se quisermos adicionar uma nova classe herdada de TfrmConProdutosAbs só precisamos criar a classe e modificar a fábrica.

Imagine outra aplicação: Você poderia colocar os seus forms em Packages e fazer a sua aplicação modularizada.

Por enquanto é só. Espero que tenham gostado.

SQL em segundo plano

Hoje resolvi falar de um assunto que muitas pessoas têm dúvidas: Threads. Mais especificamente, falarei sobre como rodar consultas ao banco de dados em segundo plano.

Às vezes, temos que efetuar uma consulta ao banco de dados que irá demorar muito ou até mesmo uma pequena consulta mas que o usuário não tenha que parar o que está fazendo para que ela seja realizada. Logo vem à nossa mente: "Vou fazer uma thread".

Embora possa parecer simples, algumas pessoas são pegas de surpresa com mensagens de erro estranhas, Access Violations etc, em virtude do uso indevido de threads para efetuar consultas ao banco de dados em segundo plano.

Threads

Segundo a Wikipédia:
"Thread, ou linha de execução em português, é uma forma de um processo dividir a si mesmo em duas ou mais tarefas que podem ser executadas simultaneamente.
"Uma linha de execução permite que o usuário de programa, por exemplo, utilize uma funcionalidade do ambiente enquanto outras linhas de execução realizam outros cálculos e operações.
"Em hardwares equipados com uma única CPU, cada linha de execução(Thread) é processada de forma aparentemente simultânea, pois a mudança entre uma linha e outra é feita de forma tão rápida que para o usuário isso está acontecendo paralelamente. Em hardwares com multiplos CPUs ou multi-cores as linhas de execução(Threads) podem ser realizadas realmente de forma simultânea"

Quando usar Threads

Você deve considerar o uso de Threads quando:

-Você precisa realizar múltiplas tarefas independentes;

-Sua aplicação roda em um sistema com múltiplos processadores ou um sistema multi-core(dual core, core 2 duo, quad core etc), desde que o sistema operacional dê suporte a eles;

-Você não quer que o usuário fique aguardando o fim de um processamento para continuar trabalhando, dentre outros motivos.

Problemas com Threads

No entanto, usar threads pode ser doloroso se você não souber exatamente o que está fazendo. Pode introduzir diversos bugs e mensagens misteriosas no teu sistema. Numa aplicação com um único Thread você tem o controle total sobre a ordem de execução de suas tarefas, além do acesso às variáveis globais. Numa aplicação multi-thread, por outro lado, você não tem esse tipo de controle. Deve estar ciente que, a qualquer momento, outro thread pode modificar o conteúdo de uma variável global e deve se proteger contra os conflitos que isso pode gerar.

Critical Section

O uso de TCriticalSection visa justamente coordenar o acesso aos recursos do sistema, servindo como uma espécie de semáforo que permite que apenas um thread tenha acesso a um determinado recurso em um determinado momento. Veja um exemplo de uso do TCriticalSection:

// Apartir de agora, somente uma thread por vez terá acesso a este bloco
MinhaSessaoCritica.Enter;
try
  // Acesse o recurso compartilhado aqui.
  // Normalmente, uma variável global.
  // .....
finally
  // Libera para que outras Threads possam entrar no mesmo bloco
  MinhaSessaoCritica.Leave;
end;

Conexões com o Banco de Dados

Muita gente não sabe, mas para o correto funcionamento da aplicação multi-thread que acessa o banco de dados, é preciso que cada thread tenha a sua própria conexão com o banco. Caso contrário você terá problemas.

Fechando a aplicação

Outra coisa importante: Antes de fechar a sua aplicação deve se certificar que todos os threads estão terminados. Pode-se fazer isso por meio de uma variável global que seja incrementada a cada thread iniciado e decrementada para cada thread terminado. Se a variável estiver zerada, então pode-se fechar a aplicação. Caso contrário, devemos solicitar ao usuário que aguarde enquanto os processamentos são concluídos.

Mais uma vez, acho importante lembrar que para incrementar e decrementar uma variável global é preciso usar o TCriticalSection.

Synchronize()

O método Synchronize() executa uma chamada a um método especificado dentro do Thread principal. Portanto, não se deve fazer isto, se desejamos uma consulta em segundo plano:

procedure TQryThread.Execute;
begin
  Synchronize(ConsultarBanco);
end;

procedure TQryThread.ConsultarBanco;
begin
  SQLQuery1.Text := 'select .. from ...';
  SQLQuery1.Open;
end;

Se fizermos isto, e o processamento for demorado, de nada vai adiantar estarmos usando uma Thread separada para efetuar a consulta.
O método Synchronize deve ser usado apenas se precisarmos atualizar alguns controles da VCL que façam parte do Thread Principal ou quando não tivermos certeza de que a chamada a um método é thread-safe.

Desenvolvimento Orientado por Testes

Nesta primeira parte de uma série de artigos, focalizaremos o uso do Dunit para escrever nossos testes e isto irá ilustrar os benefícios de escrever o teste unitário antes de implementar o código.
O Problema

Considere o seguinte problema. Não passe adiante apressadamente. Tome uns 10 minutinhos pra considerar o seguinte:
Desenhe um diagrama UML ou simplemente aliste as classes que você precisaria pra fazer a seguinte aplicação.
Nós queremos fazer um Jogo da Velha neste exercício. Existem dois jogadores que devem utilizar a aplicação. Um coloca a marca “X” e o outro o “O” na casa desejada. Existem três linhas e três colunas. Primeiro, o usuário deve indicar se o primeiro jogador irá colocar o “X” ou o “O”. Depois, o jogador inicial irá começar marcando a primeira casa. O jogador só poderá utilizar uma casa vazia. Os jogadores se alternam e o jogo continua até que um jogador tenha colocado três marcas iguais em uma linha, diagonal ou coluna ou até que não haja mais nenhuma casa vazia (condição de empate). Se um dos jogadores ganha, o JogoDaVelha deve anunciar isto indicando o nome do ganhador. A aplicação deverá controlar os scores (número de vezes que cada jogador ganhou). A qualquer momento o jogador pode querer ver as estatísticas do jogo.
Gastou seus 10 minutos pensando em como fazer este pequeno jogo? Então, agora pode continuar...
Pensando em classes

Quais as classes necessárias pra desenvolver esta pequena aplicação? Pense um pouco... Alguns diriam Tabuleiro, Casa, Marca, Jogador, Score, etc. E você, quais as classes que você acha necessário neste jogo?
Como escrever os testes

Primeiro pense no que seria necessário testar. Existem pelo menos três coisas para as quais você precisa escrever testes: positivo, negativo e exceção. Quando estiver pensando em uma tarefa, pense do lado positivo, ou seja, o que a aplicação deveria fazer corretamente se tudo estiver na situação ideal. Então, pense pelo lado negativo, ou seja, o que poderia dar errado e como a aplicação deveria se comportar. A exceção é uma seqüência alternativa de acontecimentos. Pense em como o código deve se comportar nestes casos. O sucesso de um teste positivo é quando o código se comporta como deveria. O sucesso de um teste negativo ou exceção é quando o código se comporta de forma esperada à uma situação negativa ou de exceção.
Onde escrever os testes

Uma vez que não estejamos interessados em testar apenas os métodos públicos de uma classe, mas também os métodos internos (private), devemos escrevê-los dentro da mesma unit, para que tenhamos acesso aos metodos e dados internos da classe. Se este não for o caso, podemos escrever em outra unit ou até mesmo em outro projeto.
Lista de tarefas

O primeiro passo é escrever uma lista de tarefas. Esta lista conterá um ou mais testes. Então, à medida que formos escrevendo os testes, implementando o código e sendo bem sucedidos, vamos marcando cada item da lista e passando pro próximo item. Enquanto escrevemos os testes e o código, pensaremos em outros testes que precisamos fazer. Mas em vez de escrever os testes enquanto eles vêm à mente, coloque-os no fim da lista de tarefas. É importante continuar a trabalhar nos itens da lista que já tem à mao. Então, você pode voltar e dar-lhes a devida atenção.
Podemos começar a codificar, por favor?

Claro, podemos iniciar. Mas, antes, tome o cuidade de providenciar a lista de tarefas. O que devemos testar primeiro? Que tal criar o tabuleiro? Ok. Mas o que fazer depois de criar o tabuleiro? Bem, sempre devemos escrever os nossos testes com as assertivas em mente. Temos que fazer os testes com assertivas para ver se a criação da nossa classe foi bem sucedida. Vamos então à lista de tarefas:
1. Criar Tabuleiro;
Em primeiro lugar, criamos um projeto em branco chamado JogoDaVelha.dpr, no qual daremos suporte ao teste unitário como se segue (observe que não criamos nenhum form ainda, pois iniciaremos o desenvolvimento pelos testes):

program JogoDaVelha;

uses
  Forms,
  TestFramework,
  GUITestRunner;

{$R *.res}

begin
  {$IFDEF TESTING}
  GUITestRunner.RunRegisteredTests;
  {$ELSE}
  Application.Initialize;
  Application.Run;
  {$ENDIF}
end.

Listagem 1.

Você precisará ter instalado o dunit (9.3 ou mais recente) para executar os testes. Nas opções do projeto ativaremos os testes unitários definindo a diretiva TESTING em conditional defines. Quando esta diretiva estiver definida, o sistema irá rodar no modo de testes, caso contrário irá rodar o nosso aplicativo normalmente. Veja na figura abaixo como fica:





Figura 1.


Os testes são classes especializadas herdadas de TTestCase. Estes testes devem ser registrados para que o Framework de testes tenha conhecimento que ele existe. Utilizamos a sessão initialization para registrar os testes. Devemos nos lembrar de referenciar a unit TestFramework na cláusula uses. Como você deve ter notado na listagem 1, quando definimos a diretiva de compilação TESTING, o sistema irá executar os testes que estiverem registrados:

  GUITestRunner.RunRegisteredTests;

Agora vamos escrever o nosso primeiro teste, que residirá na mesma unit da nossa classe para que possamos testar os membros privados da classe. Pra isso criamos uma unit que chamaremos de uTabuleiro.pas e iniciaremos a codificação pelo teste, como se segue:

unit uTabuleiro;

interface

uses
  SysUtils, Classes;

// A definição de nossa classe tabuleiro vem aki
// TODO: Criar classe TTabuleiro

implementation

uses TestFramework;

// *************************************************
// Esta é a classe que efetuará os testes unitários
// *************************************************
type
  TTabuleiroJVTests = class(TTestCase)
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  end;

{ TTabuleiroTests }

// *****************************************************************************
// Este método é chamado no início de cada teste
// pode ser usado pra configurar o teste, criar variáveis de instância, etc.
// *****************************************************************************
procedure TTabuleiroJVTests.SetUp;
begin
  inherited;

end;

// *****************************************************************************
// Este método é chamado no fim de cada teste
// pode ser usado pra liberar os recursos, entre outras coisas
// *****************************************************************************
procedure TTabuleiroJVTests.TearDown;
begin
  inherited;

end;

initialization
  TestFramework.RegisterTest('TTabuleiroJV Tests', TTabuleiroJVTests.Suite);
end.

Listagem 2.


Execute (F9) o sistema para ver se está tudo ok. Se estiver devemos ver uma tela como esta:





Bem, agora que o nosso teste está configurado, registrado e funcional podemos iniciar a codificação do primeiro item da lista (“criar tabuleiro”):

type
  TTabuleiroJVTests = class(TTestCase)
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published // Os testes devem ficar na sessão published
    procedure TestCriarTabuleiro;
  end;

procedure TTabuleiroTests.TestCriarTabuleiro;
var
  lTabuleiro: TTabuleiroJV;
begin
  lTabuleiro := TTabuleiroJV.Create;
  CheckNotNull(lTabuleiro);
  CheckFalse(lTabuleiro.GameOver);
  lTabuleiro.Free;
end;

Se tentarmos compilar a nossa aplicação agora receberemos uma mensagem de erro, afinal ainda nem existe uma classe chamada TTabuleiroJV. Criamos a classe TTabuleiroJV com uma propriedade GameOver:

type
  TTabuleiroJV = class
  private
    function GetGameOver: Boolean;
  public
    property GameOver: Boolean read GetGameOver;
  end;

implementation


{ TTabuleiroJV }

function TTabuleiroJV.GetGameOver: Boolean;
begin
  Result := False; // Neste ponto implementamos apenas o que for estritamente necessário
                   // para o teste passar
end;

Quando executamos novamente e mandamos executar os testes selecionados, obtemos o seguinte resultado:





Figura 2.


Legal, o nosso teste passou! Agora, diante do resultado positivo, ficamos encorajados a continuar. O que vem em seguida? Que outros testes devemos fazer? Vamos incrementar a nossa lista de tarefas:


1. Criar Tabuleiro;
2. Configurar o primeiro jogador;
3. Configurar o primeiro jogador novamente;
4. Configurar o primeiro jogador depois que o jogo é iniciado;

Nós não queremos apenas testar a configuração do primeiro jogador, mas também pensar sobre o que aconteceria caso tentássemos configurá-lo novamente ou durante o jogo em andamento.


Agora pense um pouco: Como devemos implementar o nosso teste #2?


· Que tal tabuleiro.SetPrimeiroJogador(‘Marcos’)?


· Será relevante pro jogo saber que o jogador A é Marcos?


· Pode ser que sim, pode ser que não. Não temos certeza neste momento;


· Por isso vamos nos lembrar do princípio que diz: “Não faça algo que não tem certeza que irá precisar naquele momento”


Então podemos tentar:

tabuleiro.SetPrimeiroJogadorJogaX(true);

Com isto não precisamos nos preocupar sobre os testes nem sobre o jogador usado. E, como temos apenas duas opções (“X” e “O”) podemos usar um boolean pra indicar se o Jogador A (Que ainda nem sabemos quem é...) irá jogar “X” ou não. Mais fácil, não? Bem, uma vez decidido como será o teste, vamos implementá-lo:

type
  TTabuleiroJVTests = class(TTestCase)
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCriarTabuleiro;
    procedure TestSetPrimeiroJogador;
  end;

procedure TTabuleiroJVTests.TestSetPrimeiroJogador;
var
  lTabuleiro: TTabuleiroJV;
begin
  lTabuleiro := TTabuleiroJV.Create;
  lTabuleiro.PrimeiroJogadorJogaX := True;
  CheckTrue(lTabuleiro.PrimeiroJogadorJogaX);
  lTabuleiro.Free;
end;

Quando tentamos compilar recebemos uma mensagem de erro indicando que a propriedade PrimeiroJogadorJogaX não existe, por isso iremos implementá-la:

  TTabuleiroJV = class
  public
    ...
    property PrimeiroJogadorJogaX: Boolean read GetPrimeiroJogadorJogaX
       write SetPrimeiroJogadorJogaX;
  end;

function TTabuleiroJV.GetPrimeiroJogadorJogaX: Boolean;
begin
  Result := True;
end;

procedure TTabuleiroJV.SetPrimeiroJogadorJogaX(const Value: Boolean);
begin

end;

Lembre-se: Não iremos implementar nada que não seja estritamente necesário pra passar no teste.


Agora executamos o teste novamente e: Tudo verdin... que lindo! E visto que foi bem sucedido, ticamos o teste #2 na nossa lista de tarefas:


1. Criar Tabuleiro;
2. Configurar o primeiro jogador;
3. Configurar o primeiro jogador novamente;
4. Configurar o primeiro jogador depois que o jogo é iniciado;

Agora vamos pro terceiro teste. O que acontece caso tente indicar o primeiro jogador novamente, talvez com um valor diferente? Vamos ao teste:

type
  TTabuleiroJVTests = class(TTestCase)
    ...
  published
    ...
    procedure TestSetPrimeiroJogadorNovamente;
  end;

procedure TTabuleiroJVTests.TestSetPrimeiroJogadorNovamente;
var
  lTabuleiro: TTabuleiroJV;
begin
  lTabuleiro := TTabuleiroJV.Create;
  lTabuleiro.PrimeiroJogadorJogaX := True;
  CheckTrue(lTabuleiro.PrimeiroJogadorJogaX);
  lTabuleiro.PrimeiroJogadorJogaX := False;
  CheckFalse(lTabuleiro.PrimeiroJogadorJogaX);
  lTabuleiro.Free;
end;

Compilamos, tudo ok... Agora vamos executar o teste:





O que aconteceu???! Por que falhou? Falhou porque esperávamos False mas lTabuleiro.PrimeiroJogadorJogaX retornou True. Olhando o código podemos ver o motivo da falha. Ainda não implementamos a propriedade corretamente. Ela vai retornar sempre True. Então mãos à obra. Vamos implementá-la corretamente agora, introduzindo uma variável de instância pra armazenar o valor:

type
  TTabuleiroJV = class
  private
    FProximoJogadorJogaX: Boolean;
    ...
  end;

function TTabuleiroJV.GetPrimeiroJogadorJogaX: Boolean;
begin
  Result := FProximoJogadorJogaX;
end;

procedure TTabuleiroJV.SetPrimeiroJogadorJogaX(const Value: Boolean);
begin
  FProximoJogadorJogaX := Value;
end;

Executamos os testes novamente, e tudo correu bem!


Agora, é uma boa hora pra olhar o código e refatorar. Olhando o código, percebemos que no início de cada teste estamos criando a classe TTabuleiroJV. Isto é uma violação do princípio DRY (Don´t Repeat Yourself). Bem, pra resolver este problema podemos mover a criação do objeto para o método SetUp e atribuindo-o a uma variável de instância, evitando, assim as repetidas instanciações.


Veja como ficou:

// *************************************************
// Esta é a classe que efetuará os testes unitários
// *************************************************
type
  TTabuleiroJVTests = class(TTestCase)
  private
    FTabuleiro: TTabuleiroJV;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCriarTabuleiro;
    procedure TestSetPrimeiroJogador;
    procedure TestSetPrimeiroJogadorNovamente;
  end;

{ TTabuleiroJVTests }

// *****************************************************************************
// Este método é chamado no início de cada teste
// pode ser usado pra configurar o teste, criar variáveis de instância, etc.
// *****************************************************************************
procedure TTabuleiroJVTests.SetUp;
begin
  inherited;
  FTabuleiro := TTabuleiroJV.Create;
end;

// *****************************************************************************
// Este método é chamado no fim de cada teste
// pode ser usado pra liberar os recursos, entre outras coisas
// *****************************************************************************
procedure TTabuleiroJVTests.TearDown;
begin
  inherited;
  FreeAndNil(FTabuleiro);
end;

procedure TTabuleiroJVTests.TestCriarTabuleiro;
begin
  CheckNotNull(FTabuleiro);
  CheckFalse(FTabuleiro.GameOver);
end;

procedure TTabuleiroJVTests.TestSetPrimeiroJogador;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  CheckTrue(FTabuleiro.PrimeiroJogadorJogaX);
end;

procedure TTabuleiroJVTests.TestSetPrimeiroJogadorNovamente;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  CheckTrue(FTabuleiro.PrimeiroJogadorJogaX);
  FTabuleiro.PrimeiroJogadorJogaX := False;
  CheckFalse(FTabuleiro.PrimeiroJogadorJogaX);
end;

Executamos o nosso teste novamente, para nos certificarmos de não ter quebrado nada durante o refatoramento. Uma vez que tudo ocorreu bem, continuamos.


É hora de atualizar a nossa lista:


1. Criar Tabuleiro;
2. Configurar o primeiro jogador;
3. Configurar o primeiro jogador novamente;
4. Configurar o primeiro jogador depois que o jogo é iniciado;

O único teste que ficou na lista é aquele que eu ainda não tenho a menor idéia de como irei testá-lo no momento, visto que o jogo ainda não pode ser iniciado. Por isso, vamos deixá-lo um pouco de lado e retornaremos a ele futuramente, no momento apropriado.


Vamos alistar outros testes:


1. Criar Tabuleiro;
2. Configurar o primeiro jogador;
3. Configurar o primeiro jogador novamente;
4. Configurar o primeiro jogador depois que o jogo é iniciado;
5. Marcar a primeira casa;
6. Marcar duas casas em seguida;
7. Marcar três casas em seguida;
8. Colocar uma marca numa casa ocupada;
9. Colocar uma marca numa coluna fora da faixa;
10. Colocar uma marca numa linha fora da faixa;

Vamos escrever o teste #5:

procedure TTabuleiroJVTests.TestMarcarAPrimeiraCasa;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(1, 1);
  CheckTrue(FTabuleiro.CasaContemUmX(1, 1));
end;

A primeira implementação dos métodos segue abaixo:

function TTabuleiroJV.CasaContemUmX(lin, col: Integer): Boolean;
begin
  Result := False;
end;

procedure TTabuleiroJV.MarcarCasa(lin, col: Integer);
begin

end;

Isto resultará na falha do teste #5, visto que ainda não o implementamos completamente. Vamos atingir o verde com o seguinte código:

  TTabuleiroJV = class
  private
    FCasas: array [1..3, 1..3] of string;
  public
    constructor Create;
    procedure MarcarCasa(lin, col: Integer);
    function CasaContemUmX(lin, col: Integer): Boolean;
  end;

constructor TTabuleiroJV.Create;
begin
  FCasas[1,1] := '';
  FCasas[1,2] := '';
  FCasas[1,3] := '';
  FCasas[2,1] := '';
  FCasas[2,2] := '';
  FCasas[2,3] := '';
  FCasas[3,1] := '';
  FCasas[3,2] := '';
  FCasas[3,3] := '';
end;

procedure TTabuleiroJV.MarcarCasa(lin, col: Integer);
begin
  FCasas[lin, col] := 'X';
end;

function TTabuleiroJV.CasaContemUmX(lin, col: Integer): Boolean;
begin
  Result := (FCasas[lin, col] = 'X');
end;

Ao executarmos os testes novamente obtemos sucesso em todos os testes. Vamos dar continuidade ao processo.


Em primeiro lugar, vamos atualizar a nossa lista:


1. Criar Tabuleiro;
2. Configurar o primeiro jogador;
3. Configurar o primeiro jogador novamente;
4. Configurar o primeiro jogador depois que o jogo é iniciado;
5. Marcar a primeira casa;
6. Marcar duas casas em seguida;
7. Marcar três casas em seguida;
8. Colocar uma marca numa casa ocupada;
9. Colocar uma marca numa coluna fora da faixa;
10. Colocar uma marca numa linha fora da faixa;

E agora, vamos implementar o teste #6.

procedure TTabuleiroJVTests.TestMarcarDuasCasasEmSeguida;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(1, 1);
  CheckTrue(FTabuleiro.CasaContemUmX(1, 1));
  FTabuleiro.MarcarCasa(1, 2);
  CheckFalse(FTabuleiro.CasaContemUmX(1, 2));
end;

Este teste irá falhar. Visto que CasaContemUmX(1, 2) irá retornar True, ao passo que esperamos que seja False. Olhando o código percebemos o motivo disto: Não estamos alternando de “X” pra “O” a cada jogada. Portanto, aqui vai a parte do código que corrige esse comportamento errado:

procedure TTabuleiroJV.MarcarCasa(lin, col: Integer);
begin
  FCasas[lin, col] := 'O';
  if FProximoJogadorJogaX then
  begin
    FCasas[lin, col] := 'X';
    FProximoJogadorJogaX := not FProximoJogadorJogaX;
  end;
end;

Ao executarmos os testes novamento obteremos sucesso. Portanto, atualizamos a nossa lista:


6. Marcar duas casas em seguida;


Vamos pro teste #7:

procedure TTabuleiroJVTests.TestMarcarTresCasasEmSeguida;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(2, 1);
  CheckTrue(FTabuleiro.CasaContemUmX(2, 1), '1ª casa');
  FTabuleiro.MarcarCasa(2, 2);
  CheckFalse(FTabuleiro.CasaContemUmX(2, 2), '2ª casa');
  FTabuleiro.MarcarCasa(1, 2);
  CheckTrue(FTabuleiro.CasaContemUmX(1, 2), '3ª casa'); // <- aki="" end="" falha="" pre="">

Poxa! O que foi que deu errado desta vez??? Não estava funcionando tudo direitinho? Por que agora está dando erro?



Analisando o método marcar descobrimos o erro: 



procedure TTabuleiroJV.MarcarCasa(lin, col: Integer);
begin
  FCasas[lin, col] := 'O';
  if FProximoJogadorJogaX then
  begin
    FCasas[lin, col] := 'X';
    FProximoJogadorJogaX := not FProximoJogadorJogaX;
  end;
end;
Veja que a alternação de jogadores só funcionada se o proximo jogador for X. Portanto temos que tirar FProximoJogadorJogaX := not FproximoJogadorJogaX de dentro do if:



procedure TTabuleiroJV.MarcarCasa(lin, col: Integer);
begin
  FCasas[lin, col] := 'O';
  if FProximoJogadorJogaX then
    FCasas[lin, col] := 'X';

  FProximoJogadorJogaX := not FProximoJogadorJogaX;
end;
Viram como é importante ter uma boa bateria de testes? No primeiro e no segundo teste, parecia estar correto. Mas havia um bug escondidinho lá que só percebemos no terceiro teste. 



Vamos atualizar a nossa lista:



1. Criar Tabuleiro;
2. Configurar o primeiro jogador;
3. Configurar o primeiro jogador novamente;
4. Configurar o primeiro jogador depois que o jogo é iniciado;
5. Marcar a primeira casa;
6. Marcar duas casas em seguida;
7. Marcar três casas em seguida;
8. Colocar uma marca numa casa ocupada;
9. Colocar uma marca numa coluna fora da faixa;
10. Colocar uma marca numa linha fora da faixa;

Agora é a vez do teste #8. O sucesso deste teste está na falha. Como assim? Bem, ele não deve permitir que eu marque uma casa já ocupada não é verdade? Neste caso ele deve reportar um erro. Portanto, vamos codificar o teste:



interface

type
  EJogoDaVelhaError = class(Exception);

implementation
.
.
.

procedure TTabuleiroJVTests.TestMarcarUmaCasaOcupada;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(2, 1);
  // Aki dizemos pro framework que estamos aguardando uma exceção do tipo
  // EJogoDaVelhaError.
  // Se esta exceção não ocorrer, o teste irá falhar
  ExpectedException := EJogoDaVelhaError;
  FTabuleiro.MarcarCasa(2, 1);
  ExpectedException := nil;
end;
Ao executarmos o teste veremos que ele realmente falha. Isto acontece porque ainda não implementamos as alterações para verificação desta condição de erro no método MarcarCasa(). Veja como fica:



procedure TTabuleiroJV.MarcarCasa(lin, col: Integer);
begin
  if FCasas[lin, col] <> '' then
    raise EJogoDaVelhaError.Create('A casa já está ocupada');

  FCasas[lin, col] := 'O';
  if FProximoJogadorJogaX then
    FCasas[lin, col] := 'X';

  FProximoJogadorJogaX := not FProximoJogadorJogaX;
end;
Vamos atualizar a nossa lista:



1. Criar Tabuleiro;
2. Configurar o primeiro jogador;
3. Configurar o primeiro jogador novamente;
4. Configurar o primeiro jogador depois que o jogo é iniciado;
5. Marcar a primeira casa;
6. Marcar duas casas em seguida;
7. Marcar três casas em seguida;
8. Colocar uma marca numa casa ocupada;
9. Colocar uma marca numa coluna fora da faixa;
10. Colocar uma marca numa linha fora da faixa;

Neste momento, eu tenho certeza que você já tem uma boa noção sobre Desenvolvimento Dirigido por testes. Que tal tentar fazer os dois ultimos testes sozinho?



No proximo artigo, veremos:



1. Mais testes unitários (para tornar o nosso JogoDaVelha mais robusto);
2. Como implementar a Interface com o usuário.

Veja o código final no Anexo I:



Referências:







Artigo elaborado e adaptado por Marcos George, baseado em um artigo de Venkat Subramaniam (http://www.agiledeveloper.com/articles/TDDPartI.pdf)



Anexo I – código fonte de uTabuleiro.pas


unit uTabuleiro;

interface

uses
  SysUtils, Classes;

type
  EJogoDaVelhaError = class(Exception);

  TTabuleiroJV = class
  private
    FCasas: array [1..3, 1..3] of string;
    FProximoJogadorJogaX: Boolean;
    function GetGameOver: Boolean;
    procedure SetPrimeiroJogadorJogaX(const Value: Boolean);
    function GetPrimeiroJogadorJogaX: Boolean;
  public
    constructor Create;
    procedure MarcarCasa(lin, col: Integer);
    function CasaContemUmX(lin, col: Integer): Boolean;
    property GameOver: Boolean read GetGameOver;
    property PrimeiroJogadorJogaX: Boolean read GetPrimeiroJogadorJogaX write SetPrimeiroJogadorJogaX;
  end;

implementation

uses TestFramework;

{ TTabuleiroJV }

constructor TTabuleiroJV.Create;
begin
  FCasas[1,1] := '';
  FCasas[1,2] := '';
  FCasas[1,3] := '';
  FCasas[2,1] := '';
  FCasas[2,2] := '';
  FCasas[2,3] := '';
  FCasas[3,1] := '';
  FCasas[3,2] := '';
  FCasas[3,3] := '';
end;

function TTabuleiroJV.GetGameOver: Boolean;
begin
  Result := False;
end;

function TTabuleiroJV.GetPrimeiroJogadorJogaX: Boolean;
begin
  Result := FProximoJogadorJogaX;
end;

function TTabuleiroJV.CasaContemUmX(lin, col: Integer): Boolean;
begin
  Result := (FCasas[lin, col] = 'X');
end;

procedure TTabuleiroJV.MarcarCasa(lin, col: Integer);
begin
  if FCasas[lin, col] <> '' then
    raise EJogoDaVelhaError.Create('A casa já está ocupada');

  FCasas[lin, col] := 'O';
  if FProximoJogadorJogaX then
    FCasas[lin, col] := 'X';

  FProximoJogadorJogaX := not FProximoJogadorJogaX;
end;

procedure TTabuleiroJV.SetPrimeiroJogadorJogaX(const Value: Boolean);
begin
  FProximoJogadorJogaX := Value;
end;

// *************************************************
// Esta é a classe que efetuará os testes unitários
// *************************************************
type
  TTabuleiroJVTests = class(TTestCase)
  private
    FTabuleiro: TTabuleiroJV;
  protected
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCriarTabuleiro;
    procedure TestSetPrimeiroJogador;
    procedure TestSetPrimeiroJogadorNovamente;
    procedure TestMarcarAPrimeiraCasa;
    procedure TestMarcarDuasCasasEmSeguida;
    procedure TestMarcarTresCasasEmSeguida;
    procedure TestMarcarUmaCasaOcupada;
  end;

{ TTabuleiroJVTests }

// *****************************************************************************
// Este método é chamado no início de cada teste
// pode ser usado pra configurar o teste, criar variáveis de instância, etc.
// *****************************************************************************
procedure TTabuleiroJVTests.SetUp;
begin
  inherited;
  FTabuleiro := TTabuleiroJV.Create;
end;

// *****************************************************************************
// Este método é chamado no fim de cada teste
// pode ser usado pra liberar os recursos, entre outras coisas
// *****************************************************************************
procedure TTabuleiroJVTests.TearDown;
begin
  inherited;
  FreeAndNil(FTabuleiro);
end;

procedure TTabuleiroJVTests.TestCriarTabuleiro;
begin
  CheckNotNull(FTabuleiro);
  CheckFalse(FTabuleiro.GameOver);
end;

procedure TTabuleiroJVTests.TestSetPrimeiroJogador;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  CheckTrue(FTabuleiro.PrimeiroJogadorJogaX);
end;

procedure TTabuleiroJVTests.TestSetPrimeiroJogadorNovamente;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  CheckTrue(FTabuleiro.PrimeiroJogadorJogaX);
  FTabuleiro.PrimeiroJogadorJogaX := False;
  CheckFalse(FTabuleiro.PrimeiroJogadorJogaX);
end;

procedure TTabuleiroJVTests.TestMarcarAPrimeiraCasa;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(1, 1);
  CheckTrue(FTabuleiro.CasaContemUmX(1, 1));
end;

procedure TTabuleiroJVTests.TestMarcarDuasCasasEmSeguida;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(1, 1);
  CheckTrue(FTabuleiro.CasaContemUmX(1, 1));
  FTabuleiro.MarcarCasa(1, 2);
  CheckFalse(FTabuleiro.CasaContemUmX(1, 2));
end;

procedure TTabuleiroJVTests.TestMarcarTresCasasEmSeguida;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(2, 1);
  CheckTrue(FTabuleiro.CasaContemUmX(2, 1), '1ª casa');
  FTabuleiro.MarcarCasa(2, 2);
  CheckFalse(FTabuleiro.CasaContemUmX(2, 2), '2ª casa');
  FTabuleiro.MarcarCasa(1, 2);
  CheckTrue(FTabuleiro.CasaContemUmX(1, 2), '3ª casa');
end;

procedure TTabuleiroJVTests.TestMarcarUmaCasaOcupada;
begin
  FTabuleiro.PrimeiroJogadorJogaX := True;
  FTabuleiro.MarcarCasa(2, 1);
  // Aki dizemos pro framework que estamos aguardando uma exceção do tipo
  // EJogoDaVelhaError.
  // Se esta exceção não ocorrer, o teste irá falhar
  ExpectedException := EJogoDaVelhaError;
  FTabuleiro.MarcarCasa(2, 1);
  ExpectedException := nil;
end;

initialization
  TestFramework.RegisterTest('TTabuleiro Tests', TTabuleiroJVTests.Suite);

end.