1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14:-module(junitadapter, []).   15
   16:- use_module(library(plunit)).   17
   18:- dynamic file_to_test/1.   19
   20reset_file_to_test :-
   21   retractall(file_to_test(_)).
   22
   23unit_test(UnitName,Name):-
   24    plunit:current_test_set(UnitName),
   25    plunit:unit_from_spec(_, UnitName, Tests, Module, _),
   26    Module:'unit test'(Name, _, _, _), plunit:matching_test(Name, Tests).
   27
   28
   29unit_test(UnitName,Name,File,Line):-
   30    (   file_to_test(File)
   31    *-> true
   32    ;   true
   33    ),
   34    plunit:current_test_set(UnitName),
   35    plunit:unit_from_spec(_, UnitName, Tests, Module, _),
   36    current_module(Module,File),
   37    Module:'unit test'(Name, Line,_, _), 
   38    plunit:matching_test(Name, Tests).
   39	
   40	
   41/*
   42	junit_adapter(+TestName,-ResultKind,-Comment,-File,-Line)
   43	
   44	see exception_kind/3 for result kinds
   45*/
   46
   47junit_adapter(TestName,ResultKind,Comment):-
   48	catch(test(TestName), TestException, true),
   49	exception_kind(TestException,ResultKind,Comment).
   50	
   51	
   52/*
   53	exception_kind(+Exception,-Kind,-Comment)
   54	
   55	-Kind
   56		test succeeded:   'true'
   57		test failed:      'fail'
   58		thrown exception: 'exception'
   59*/
   60
   61exception_kind(TestException,true,''):-
   62    var(TestException),
   63    !.
   64
   65exception_kind(TestException,fail,TestComment):-
   66	TestException=assertion_failed(TestComment),
   67    !.
   68
   69exception_kind(TestException,exception,Message):-
   70    message_to_string(TestException,MessageString),
   71    string_to_atom(MessageString,Message).
   72
   73file_information(TestName,File,Line):-
   74%    nth_clause(test(TestName),_,Ref),
   75    clause(test(TestName),_,Ref),
   76	clause_property(Ref,file(File)),
   77	clause_property(Ref,line_count(Line)).
   78
   79file_information(TestName,__File,__Line):-
   80    format(string(Msg), ' no test case ''~w'' defined in the factbase.',[TestName]),
   81    throw(Msg). 
   82
   83
   84test_failure(assertion,A,  Line):-
   85  plunit:failed_assertion(_Unit, _Test, _Line, _File:Line, _STO, Reason,Module:Goal),
   86  format(atom(A),'Failed assertion in line ~w,~n ~w of goal ~w in module ~w.',[Line,Reason,Goal,Module]).
   87
   88
   89test_failure(assertion,A,Line):-
   90  plunit:failed_assertion(_Unit, _Test, Line, _, _STO, Reason,Module:Goal),
   91  format(atom(A),'Failed assertion in line ~w, ~w of goal ~w in module ~w.',[Line,Reason,Goal,Module]).
   92  
   93
   94test_failure(failed,A, Line):-
   95  plunit:failed(_,_,Line,Reason),
   96  format(atom(A),'Failed test in line ~w, ~w.',[Line,Reason]).
   97
   98test_failure(blocked,A, Line):-
   99   plunit:blocked(_,_,Line,Reason),
  100  format(atom(A),'Blocked Assertion in line ~w, ~w.',[Line,Reason]).
  101
  102	 
  103
  104
  105%mypred2(Info):-
  106%	prolog_current_frame(Frame),
  107%	stack_for_frame(Frame,Info).