valitydev/parse_trans
14
0
Fork 0
mirror of https://github.com/valitydev/parse_trans.git synced 2024-11-06 08:35:17 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

git-svn-id: http://svn.ulf.wiger.net/parse_trans/trunk/parse_trans@1 ae7daa23-5771-0410-ae54-ec81a0701e84

Browse Source
This commit is contained in:
uwiger 2009-08-18 08:09:34 +00:00
commit 34926f300b
29 changed files with 5647 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
Makefile Normal file
View File

@ -0,0 +1,65 @@
APPLICATION := parse_trans
APP_FILE := ebin/$(APPLICATION).app
SOURCES := $(wildcard src/*.erl)
HEADERS := $(wildcard src/*.hrl)
MODULES := $(patsubst src/%.erl,%,$(SOURCES))
BEAMS := $(patsubst %,ebin/%.beam,$(MODULES))
comma := ,
e :=
space := $(e) $(e)
MODULELIST := $(subst $(space),$(comma),$(MODULES))
TEST_SOURCES := $(wildcard test/*.erl)
TEST_BEAMS := $(patsubst %.erl,%.beam, $(TEST_SOURCES))
include vsn.mk
.PHONY: all clean dialyzer
all: $(APPLICATION) doc
$(APPLICATION): $(BEAMS) $(APP_FILE)
test: $(APPLICATION) $(TEST_BEAMS) util/run_test.beam
@echo Running tests
@erl -pa util/ -pa ebin/ -pa test/ -noinput -s run_test run
test/%.beam: test/%.erl
@echo Compiling $<
@erlc +debug_info -o test/ $<
$(APP_FILE): src/$(APPLICATION).app.src
@echo Generating $@
@sed -e 's/@MODULES@/$(MODULELIST)/' -e 's/@VSN@/$(VSN)/' $< > $@
ebin/%.beam: src/%.erl $(HEADERS) $(filter-out $(wildcard ebin), ebin)
@echo Compiling $<
@erlc +debug_info +warn_missing_spec -o ebin/ $<
ebin:
@echo Creating ebin/
@mkdir ebin/
doc: doc/edoc-info
dialyzer:
@echo Running dialyzer on sources
@dialyzer --src -r src/
doc/edoc-info: doc/overview.edoc $(SOURCES)
@erlc -o util/ util/make_doc.erl
@echo Generating documentation from edoc
@erl -pa util/ -noinput -s make_doc edoc
util/%.beam: util/%.erl
@erlc -o util/ util/run_test.erl
clean:
@echo Cleaning
@rm -f ebin/*.{beam,app} test/*.beam doc/*.{html,css,png} doc/edoc-info
@rm -r cover_report
@rm -f util/*.beam
release: clean all test dialyzer
@util/releaser $(APPLICATION) $(VSN)

14
doc/overview.edoc Normal file
View File

@ -0,0 +1,14 @@
@author Ulf Wiger <ulf.wiger@erlang-consulting.com>
@doc A generic parse transform library
This library is intended to simplify the task of writing parse transform
modules for Erlang.
<h1>Introduction</h1>
<h2>`transform/4'</h2>
<p>...</p>
<h1>Current limitations</h1>
<p>...</p>
@end

6
examples/commands.txt Normal file
View File

@ -0,0 +1,6 @@
Info = fun(Class) -> io:fwrite("~s~n",[io_lib_pretty:print(Class:'#new-wooper_info'(),fun(wooper_info,6) -> Class:'#info-wooper_info'(fields); (_,_) -> no end)]) end.
C = fun(F) -> {ok,Mod} = compile:file("../examples/" ++ atom_to_list(F) ++".erl",[{parse_transform,wooper_xform},report,debug_info]), c:l(Mod) end.
C = fun(F) -> {ok,Mod} = compile:file(atom_to_list(F) ++".erl",[{parse_transform,wooper_xform},report,debug_info]), c:l(Mod) end.

11
examples/test.erl Normal file
View File

@ -0,0 +1,11 @@
-module(test).
%-compile({parse_transform,wooper_xform}).
-compile({parse_transform, test_pt}).
-export([f/1]).
-export_records([r]).
-record(r, {a = [1,2,3],
b}).
f(X) ->
X.

10
examples/test_pt.erl Normal file
View File

@ -0,0 +1,10 @@
-module(test_pt).
-export([parse_transform/2]).
-compile(export_all).
parse_transform(Forms, Options) ->
io:fwrite("Forms = ~p~n", [Forms]),
Forms.

82
examples/wooper/class_Cat.erl Executable file
View File

@ -0,0 +1,82 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
-module(class_Cat).
% Determines what are the mother classes of this class (if any):
-define( wooper_superclasses, [class_Mammal,class_ViviparousBeing] ).
% Parameters taken by the constructor ('construct').
% They are here the ones of the Mammal mother class (the viviparous being
% constructor does not need any parameter) plus whisker color.
% These are class-specific data needing to be set in the constructor:
-define( wooper_construct_parameters, Age, Gender, FurColor, WhiskerColor ).
% Declaring all variations of WOOPER standard life-cycle operations:
% (template pasted, two replacements performed to update arities)
-define( wooper_construct_export, new/4, new_link/4,
synchronous_new/4, synchronous_new_link/4,
synchronous_timed_new/4, synchronous_timed_new_link/4,
remote_new/5, remote_new_link/5, remote_synchronous_new/5,
remote_synchronous_new_link/5, remote_synchronous_timed_new/5,
remote_synchronous_timed_new_link/5, construct/5, delete/1 ).
% Method declarations.
-define( wooper_method_export, getTeatCount/1, canEat/2, getWhiskerColor/1 ).
% Allows to define WOOPER base variables and methods for that class:
-include("wooper.hrl").
% Constructs a new Cat.
construct( State, ?wooper_construct_parameters ) ->
% First the direct mother classes:
MammalState = class_Mammal:construct( State, Age, Gender, FurColor ),
ViviparousMammalState = class_ViviparousBeing:construct( MammalState ),
% Then the class-specific attributes:
?setAttribute( ViviparousMammalState, whisker_color, WhiskerColor ).
delete(State) ->
io:format( "Deleting cat ~w! (overridden destructor)~n", [self()] ),
State.
% No guarantee on biological fidelity:
getTeatCount(State) ->
?wooper_return_state_result( State, 6 ).
% Cats are supposed carnivorous though:
canEat(State,soup) ->
?wooper_return_state_result( State, true );
canEat(State,chocolate) ->
?wooper_return_state_result( State, true );
canEat(State,croquette) ->
?wooper_return_state_result( State, true );
canEat(State,meat) ->
?wooper_return_state_result( State, true );
canEat(State,_) ->
?wooper_return_state_result( State, false ).
getWhiskerColor(State)->
?wooper_return_state_result( State, ?getAttr(whisker_color) ).

299
examples/wooper/class_Cat_test.erl Executable file
View File

@ -0,0 +1,299 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Unit tests for the Cat class implementation.
% See the class_Cat.erl tested module.
-module(class_Cat_test).
-export([run/0]).
-define(Tested_module,class_Cat).
-define(Prefix,"--> ").
% Comment out to be able to use the interpreter after the test:
-define(ExitAfterTest,).
-ifdef(ExitAfterTest).
testFinished() ->
erlang:halt().
-else.
testFinished() ->
io:format( "(interpreter still running)~n" ),
test_success.
-endif.
testFailed(Reason) ->
% For some reason erlang:error is unable to interpret strings as strings,
% they are always output as unreadable list.
io:format( "~n!!!! Test failed for module ~s, reason: ~s~n~n",
[ ?Tested_module, Reason ] ),
erlang:error( "Test failed" ).
run() ->
io:format( ?Prefix "Testing module ~s.~n", [ ?Tested_module ] ),
io:format( ?Prefix "Debug mode: ~s.~n",
[ class_Cat:is_wooper_debug() ] ),
% General tests.
io:format( ?Prefix "Statically, class name is ~s, superclasses are ~w.~n",
[
class_Cat:get_class_name(),
class_Cat:get_superclasses() ] ),
MyC = class_Cat:new(3,female,sand,white),
MyC ! {get_class_name,[],self()},
receive
{wooper_result,class_Cat} ->
io:format( ?Prefix
"After constructor, get_class_name returned 'class_Cat' "
"as expected.~n");
{wooper_result,UnexpectedClass} ->
testFailed( io_lib:format( "wrong class: ~p",
[ UnexpectedClass ] ) )
end,
MyC ! {get_superclasses,[],self()},
receive
{wooper_result, [class_Mammal,class_ViviparousBeing]} ->
io:format( ?Prefix
"After constructor, get_superclasses returned "
"[class_Creature,class_ViviparousBeing] as expected.~n");
{wooper_result,UnexpectedSuperclasses} ->
testFailed( io_lib:format( "wrong superclasses: ~p",
[ UnexpectedSuperclasses ] ) )
end,
% Tests related to Mammals and Creatures.
MyC ! {getAge,[],self()},
receive
{wooper_result,3} ->
io:format( ?Prefix
"After constructor, getAge returned 3 as expected.~n");
{wooper_result,UnexpectedAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedAge ] ) )
end,
MyC ! {getGender,[],self()},
receive
{wooper_result,female} ->
io:format( ?Prefix
"After constructor, getGender returned female as expected.~n");
{wooper_result,UnexpectedGender} ->
testFailed( io_lib:format( "wrong gender: ~p",
[ UnexpectedGender ] ) )
end,
MyC ! {setAge,5},
MyC ! {getAge,[],self()},
receive
{wooper_result,5}->
io:format(?Prefix
"After setAge, getAge returned 5 as expected.~n");
{wooper_result,UnexpectedNewAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedNewAge ] ) )
end,
MyC ! declareBirthday,
MyC ! {getAge,[],self()},
receive
{wooper_result,6}->
io:format(?Prefix
"After declareBirthday, getAge returned 6 as expected.~n");
{wooper_result,UnexpectedLastAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedLastAge ] ) )
end,
MyC ! declareBirthday,
MyC ! {isHotBlooded,[],self()},
receive
{wooper_result,true}->
io:format(?Prefix
"isHotBlooded returned true as expected.~n");
{wooper_result,UnexpectedBlood} ->
testFailed( io_lib:format( "wrong blood type: ~p",
[ UnexpectedBlood ] ) )
end,
MyC ! {getFurColor,[],self()},
receive
{wooper_result,sand}->
io:format(?Prefix
"getFurColor returned sand as expected.~n");
{wooper_result,UnexpectedFurColor} ->
testFailed( io_lib:format( "wrong fur color: ~p",
[ UnexpectedFurColor ] ) )
end,
% Tests related to ViviparousBeings.
MyC ! {getMeanChildrenCount,[],self()},
receive
{wooper_result,4} ->
io:format( ?Prefix
"After constructor, getMeanChildrenCount returned 4 "
"as expected.~n");
{wooper_result,UnexpectedMeanCount} ->
testFailed( io_lib:format( "wrong mean children count: ~p",
[ UnexpectedMeanCount ] ) )
end,
MyC ! {getBirthGivenCount,[],self()},
receive
{wooper_result,0} ->
io:format( ?Prefix
"After constructor, getBirthGivenCount returned 0 "
"as expected.~n");
{wooper_result,UnexpectedFirstCount} ->
testFailed( io_lib:format( "wrong first children count: ~p",
[ UnexpectedFirstCount ] ) )
end,
MyC ! {giveBirth,5},
MyC ! {getBirthGivenCount,[],self()},
receive
{wooper_result,5}->
io:format(?Prefix
"After giveBirth, getBirthGivenCount returned 5 "
"as expected.~n");
{wooper_result,UnexpectedSecondCount} ->
testFailed( io_lib:format( "wrong second children count: ~p",
[ UnexpectedSecondCount ] ) )
end,
% Tests related to Cats.
MyC ! {getTeatCount,[],self()},
receive
{wooper_result,6}->
io:format(?Prefix
"getTeatCount returned 6 as expected.~n");
{wooper_result,UnexpectedTeatCount} ->
testFailed( io_lib:format( "wrong teat count: ~p",
[ UnexpectedTeatCount ] ) )
end,
MyC ! {canEat,soup,self()},
receive
{wooper_result,true}->
io:format(?Prefix
"This cat can eat soup, as expected.~n");
{wooper_result,UnexpectedFoodPreference} ->
testFailed( io_lib:format( "wrong food preference: ~p",
[ UnexpectedFoodPreference ] ) )
end,
MyC ! {canEat,tangerine,self()},
receive
{wooper_result,false}->
io:format(?Prefix
"This cat cannot eat tangerine, as expected.~n");
{wooper_result,UnexpectedOtherFoodPreference} ->
testFailed( io_lib:format( "wrong food preference: ~p",
[ UnexpectedOtherFoodPreference ] ) )
end,
MyC ! {getWhiskerColor,[],self()},
receive
{wooper_result,white}->
io:format(?Prefix
"This cat has white whiskers, as expected.~n");
{wooper_result,UnexpectedWhiskerColor} ->
testFailed( io_lib:format( "wrong whisker color: ~p",
[ UnexpectedWhiskerColor ] ) );
UnexpectedReturn ->
testFailed( io_lib:format( "unexpected method return: ~p",
[ UnexpectedReturn ] ) )
end,
case class_Cat:is_wooper_debug() of
true ->
MyC ! { wooper_get_instance_description,[], self() },
receive
{wooper_result,InspectString} ->
io:format( "~s~n", [ InspectString ] )
end ;
false ->
ok
end,
% Some waiting could be needed in cases where the interpreter is to stop
% immediatly afterwards, so that the actions performed in the destructor
% can be performed:
MyC ! delete,
MyOtherC = class_Cat:new(3,male,black,white),
MyOtherC ! {synchronous_delete,self()},
receive
{deleted,MyOtherC} ->
io:format(?Prefix "This cat could be created and be synchronously deleted, as expected.~n")
end,
io:format( ?Prefix "End of test for module ~s.~n", [ ?Tested_module ] ),
testFinished().

122
examples/wooper/class_Creature.erl Executable file
View File

@ -0,0 +1,122 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
-module(class_Creature).
% Determines what are the mother classes of this class (if any):
-define(wooper_superclasses,[]).
% Parameters taken by the constructor ('construct'):
-define(wooper_construct_parameters, Age, Gender ).
% Construction-related exported operators:
% Declaring all variations of WOOPER standard life-cycle operations:
% (template pasted, two replacements performed to update arities)
-define(wooper_construct_export, new/2, new_link/2,
synchronous_new/2, synchronous_new_link/2,
synchronous_timed_new/2, synchronous_timed_new_link/2,
remote_new/3, remote_new_link/3, remote_synchronous_new/3,
remote_synchronous_new_link/3, remote_synchronous_timed_new/3,
remote_synchronous_timed_new_link/3, construct/3 ).
% Declarations of class-specific methods (besides inherited ones).
% isHotBlooded/1 and canEat/2 are abstract here, hence not mentioned:
-define(wooper_method_export, getAge/1, setAge/2, declareBirthday/1,
getGender/1, getArbitraryNumber/1, testDirectMethodExecution/2 ).
% Non-method exported functions:
-export([ example_fun/0, toString/1 ]).
% Allows to define WOOPER base variables and methods for that class:
-include("wooper.hrl").
% Constructs a new Creature.
construct(State,?wooper_construct_parameters) ->
% No mother class.
?setAttributes(State, [ {age,Age}, {gender,Gender} ] ).
% Method implementations.
% Returns the age of this creature.
getAge(State) ->
?wooper_return_state_result(State,?getAttr(age)).
% Sets the age of this creature.
setAge(State,_NewAge) ->
% Mother implementation chosen faulty to check override:
?wooper_return_state_only(?setAttribute(State,age,36)).
% Increments the age of this creature.
declareBirthday(State) ->
?wooper_return_state_only(
?setAttribute(State,age,?getAttr(age)+1)).
% Returns the gender of this creature.
getGender(State) ->
?wooper_return_state_result(State,?getAttr(gender)).
% Returns a class-specific arbitrary number.
% (request)
getArbitraryNumber(State) ->
?wooper_return_state_result(State,10).
% Tests direct (synchronous) self-invocation of methods.
% (oneway).
testDirectMethodExecution(State,NewAge) ->
io:format( "Testing executeOneway.~n" ),
NewState = executeOneway(State,setAge,NewAge),
% Use this instead to test error management:
%NewState = executeOneway(test_not_a_state,setAge,NewAge),
%NewState = executeOneway(State,42,NewAge),
% Not the 36 returned by this class (347 given by the test of Mammal) :
347 = ?getAttribute(NewState,age),
io:format( "Testing executeRequest.~n" ),
% 15 from Mammal child classes, not 10 from here:
{OtherState,15} = executeRequest(NewState,getArbitraryNumber,[]),
%{OtherState,15} = executeRequest(test_not_a_state,getArbitraryNumber,[]),
%{OtherState,15} = executeRequest(NewState,43,[]),
io:format( "Direct self-invocation success.~n" ),
?wooper_return_state_only(OtherState).
% Helper function.
% Just to show it can exist:
example_fun() ->
ok.
% This looks like a method, but it is not (returning only a string):
% (function)
toString(State) ->
hashtable:toString( State#state_holder.attribute_table ).

112
examples/wooper/class_Creature_test.erl Executable file
View File

@ -0,0 +1,112 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Unit tests for the Creature class implementation.
% See the class_Creature.erl tested module.
-module(class_Creature_test).
-export([run/0]).
-define(Tested_module,class_Creature).
-define(Prefix,"--> ").
% Comment out to be able to use the interpreter after the test:
-define(ExitAfterTest,).
-ifdef(ExitAfterTest).
testFinished() ->
erlang:halt().
-else.
testFinished() ->
io:format( "(interpreter still running)~n" ),
test_success.
-endif.
testFailed(Reason) ->
% For some reason erlang:error is unable to interpret strings as strings,
% they are always output as unreadable list.
io:format( "~n!!!! Test failed for module ~s, reason: ~s~n~n",
[ ?Tested_module, Reason ] ),
erlang:error( "Test failed" ).
run() ->
io:format( ?Prefix "Testing module ~s.~n", [ ?Tested_module ] ),
io:format( ?Prefix "Debug mode: ~s.~n",
[ class_Creature:is_wooper_debug() ] ),
io:format( ?Prefix "Class name is ~s, superclasses are ~w.~n", [
class_Creature:get_class_name(), class_Creature:get_superclasses() ] ),
MyC = class_Creature:new(30,male),
MyC ! {getAge,[],self()},
receive
{wooper_result,30} ->
io:format( ?Prefix
"After constructor, getAge returned 30 as expected.~n");
{wooper_result,UnexpectedAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedAge ] ) )
end,
MyC ! {getGender,[],self()},
receive
{wooper_result,male} ->
io:format( ?Prefix
"After constructor, getGender returned male as expected.~n");
{wooper_result,UnexpectedGender} ->
testFailed( io_lib:format( "wrong gender: ~p",
[ UnexpectedGender ] ) )
end,
MyC ! {setAge,5},
% class_Creature:setAge returns always 36 for executeRequest test purposes:
MyC ! {getAge,[],self()},
receive
{wooper_result,36}->
io:format(?Prefix
"After setAge, getAge returned 36 as expected.~n");
{wooper_result,UnexpectedNewAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedNewAge ] ) )
end,
MyC ! declareBirthday,
MyC ! {getAge,[],self()},
receive
{wooper_result,37}->
io:format(?Prefix
"After declareBirthday, getAge returned 37 as expected.~n");
{wooper_result,UnexpectedLastAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedLastAge ] ) )
end,
MyC ! declareBirthday,
MyC ! delete,
io:format( ?Prefix "End of test for module ~s.~n", [ ?Tested_module ] ),
testFinished().

87
examples/wooper/class_Mammal.erl Executable file
View File

@ -0,0 +1,87 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
-module(class_Mammal).
% Determines what are the mother classes of this class (if any):
-define(wooper_superclasses,[class_Creature]).
% Parameters taken by the constructor ('construct').
% They are here the ones of the mother class (creature) plus fur color:
-define(wooper_construct_parameters, Age, Gender, FurColor ).
% Declaring all variations of WOOPER standard life-cycle operations:
% (template pasted, two replacements performed to update arities)
-define( wooper_construct_export, new/3, new_link/3,
synchronous_new/3, synchronous_new_link/3,
synchronous_timed_new/3, synchronous_timed_new_link/3,
remote_new/4, remote_new_link/4, remote_synchronous_new/4,
remote_synchronous_new_link/4, remote_synchronous_timed_new/4,
remote_synchronous_timed_new_link/4, construct/4, delete/1 ).
% Declarations of class-specific methods (besides inherited ones).
-define(wooper_method_export, setAge/2, isHotBlooded/1, getFurColor/1,
getArbitraryNumber/1 ).
% Allows to define WOOPER base variables and methods for that class:
-include("wooper.hrl").
% Constructs a new Mammal.
construct(State,?wooper_construct_parameters) ->
CreatureState = class_Creature:construct(State,Age,Gender),
?setAttribute(CreatureState,fur_color,FurColor).
% Overriding default destructor:
% State should be returned, and destructors should be called in leaf-to-root
% order in inheritance tree.
delete(State) ->
io:format( "Deleting mammal ~w! (overridden destructor)~n", [self()] ),
State.
% Method implementations.
% Sets correctly the age of this Mammal (not like faulty implementation of the
% Creature mother class).
% Overridden from Creature, useful to show the use of executeOneway.
% (oneway)
setAge(State,NewAge) ->
?wooper_return_state_only(?setAttribute(State,age,NewAge)).
% All mammals are hot-blooded:
% (request)
isHotBlooded(State) ->
?wooper_return_state_result(State,true).
% Attribute names could be defined in '-define().' header (.hrl) clauses,
% to ensure consistency.
getFurColor(State) ->
?wooper_return_state_result( State, ?getAttribute(State,fur_color) ).
% Returns a class-specific arbitrary number.
% Overridden from Creature, useful to show the use of executeRequest.
% (request)
getArbitraryNumber(State) ->
% Interesting test for the stack trace, when called from the Mammal test:
%throw( exception_throw_test_from_request ),
?wooper_return_state_result(State,15).

180
examples/wooper/class_Mammal_test.erl Executable file
View File

@ -0,0 +1,180 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Unit tests for the Mammal class implementation.
% See the class_Mammal.erl tested module.
-module(class_Mammal_test).
-export([run/0]).
-define(Tested_module,class_Mammal).
-define(Prefix,"--> ").
% Comment out to be able to use the interpreter after the test:
-define(ExitAfterTest,).
-ifdef(ExitAfterTest).
testFinished() ->
erlang:halt().
-else.
testFinished() ->
io:format( "(interpreter still running)~n" ),
test_success.
-endif.
testFailed(Reason) ->
% For some reason erlang:error is unable to interpret strings as strings,
% they are always output as unreadable list.
io:format( "~n!!!! Test failed for module ~s, reason: ~s~n~n",
[ ?Tested_module, Reason ] ),
erlang:error( "Test failed" ).
run() ->
io:format( ?Prefix "Testing module ~s.~n", [ ?Tested_module ] ),
io:format( ?Prefix "Debug mode: ~s.~n",
[ class_Mammal:is_wooper_debug() ] ),
io:format( ?Prefix "Statically, class name is ~s, superclasses are ~w.~n",
[
class_Mammal:get_class_name(),
class_Mammal:get_superclasses() ] ),
MyM = class_Mammal:new(30,male,brown),
MyM ! {get_class_name,[],self()},
receive
{wooper_result,class_Mammal} ->
io:format( ?Prefix
"After constructor, get_class_name returned 'class_Mammal' "
"as expected.~n");
{wooper_result,UnexpectedClass} ->
testFailed( io_lib:format( "wrong class: ~p",
[ UnexpectedClass ] ) )
end,
MyM ! {get_superclasses,[],self()},
receive
{wooper_result, [class_Creature]} ->
io:format( ?Prefix
"After constructor, get_superclasses returned [class_Creature] "
"as expected.~n");
{wooper_result,UnexpectedSuperclasses} ->
testFailed( io_lib:format( "wrong superclasses: ~p",
[ UnexpectedSuperclasses ] ) )
end,
MyM ! {getAge,[],self()},
receive
{wooper_result,30} ->
io:format( ?Prefix
"After constructor, getAge returned 30 as expected.~n");
{wooper_result,UnexpectedAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedAge ] ) )
end,
MyM ! {getGender,[],self()},
receive
{wooper_result,male} ->
io:format( ?Prefix
"After constructor, getGender returned male as expected.~n");
{wooper_result,UnexpectedGender} ->
testFailed( io_lib:format( "wrong gender: ~p",
[ UnexpectedGender ] ) )
end,
MyM ! {setAge,5},
MyM ! {getAge,[],self()},
receive
{wooper_result,5}->
io:format(?Prefix
"After setAge, getAge returned 5 as expected.~n");
{wooper_result,UnexpectedNewAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedNewAge ] ) )
end,
MyM ! declareBirthday,
MyM ! {getAge,[],self()},
receive
{wooper_result,6}->
io:format(?Prefix
"After declareBirthday, getAge returned 6 as expected.~n");
{wooper_result,UnexpectedLastAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedLastAge ] ) )
end,
MyM ! declareBirthday,
MyM ! {isHotBlooded,[],self()},
receive
{wooper_result,true}->
io:format(?Prefix
"isHotBlooded returned true as expected.~n");
{wooper_result,UnexpectedBlood} ->
testFailed( io_lib:format( "wrong blood type: ~p",
[ UnexpectedBlood ] ) )
end,
% Not too late in the test to have enough time to execute fully:
io:format( ?Prefix "Testing direct method invocation.~n" ),
% Inherited from Creature:
MyM ! {testDirectMethodExecution,347},
MyM ! {getFurColor,[],self()},
receive
{wooper_result,brown}->
io:format(?Prefix
"getFurColor returned brown as expected.~n");
{wooper_result,UnexpectedFurColor} ->
testFailed( io_lib:format( "wrong fur color: ~p",
[ UnexpectedFurColor ] ) )
end,
case class_Mammal:is_wooper_debug() of
true ->
MyM ! { wooper_get_instance_description,[], self() },
receive
{wooper_result,InspectString} ->
io:format( "~s~n", [ InspectString ] )
end ;
false ->
ok
end,
MyM ! delete,
io:format( ?Prefix "End of test for module ~s.~n", [ ?Tested_module ] ),
testFinished().

63
examples/wooper/class_OvoviviparousBeing.erl Executable file
View File

@ -0,0 +1,63 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
-module(class_OvoviviparousBeing).
% Determines what are the mother classes of this class (if any):
-define(wooper_superclasses,[]).
% Declaring all variations of WOOPER standard life-cycle operations:
% (template pasted, two replacements performed to update arities)
-define( wooper_construct_export, new/0, new_link/0,
synchronous_new/0, synchronous_new_link/0,
synchronous_timed_new/0, synchronous_timed_new_link/0,
remote_new/1, remote_new_link/1, remote_synchronous_new/1,
remote_synchronous_new_link/1, remote_synchronous_timed_new/1,
remote_synchronous_timed_new_link/1, construct/1 ).
% Declarations of class-specific methods (besides inherited ones).
-define(wooper_method_export, getMeanEggsCount/1, getEggsLaidCount/1,
layEggs/2 ).
% Allows to define WOOPER base variables and methods for that class:
-include("wooper.hrl").
% Constructs a new Ovoviviparous being (parameter-less constructor).
construct(State) ->
?setAttribute(State,eggs_count,0).
% Method implementations.
% Let's say an average means something here:
% (this is a static method, as it does not depend on a state)
getMeanEggsCount(State) ->
?wooper_return_state_result( State, 1000 ).
% Returns the number of eggs this ovoviviparous laid:
getEggsLaidCount(State) ->
?wooper_return_state_result( State,
?getAttribute(State,eggs_count) ).
% Increase the number of eggs this ovoviviparous laid:
layEggs(State,NumberOfNewEggs) ->
?wooper_return_state_only( ?setAttribute(State,eggs_count,
?getAttribute(State,eggs_count) + NumberOfNewEggs ) ).

138
examples/wooper/class_OvoviviparousBeing_test.erl Executable file
View File

@ -0,0 +1,138 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Unit tests for the OvoviviparousBeing class implementation.
% See the class_OvoviviparousBeing.erl tested module.
-module(class_OvoviviparousBeing_test).
-export([run/0]).
-define(Tested_module,class_OvoviviparousBeing).
-define(Prefix,"--> ").
% Comment out to be able to use the interpreter after the test :
-define(ExitAfterTest,).
-ifdef(ExitAfterTest).
testFinished() ->
erlang:halt().
-else.
testFinished() ->
io:format( "(interpreter still running)~n" ),
test_success.
-endif.
testFailed(Reason) ->
% For some reason erlang:error is unable to interpret strings as strings,
% they are always output as unreadable list.
io:format( "~n!!!! Test failed for module ~s, reason : ~s~n~n",
[ ?Tested_module, Reason ] ),
erlang:error( "Test failed" ).
run() ->
io:format( ?Prefix "Testing module ~s.~n", [ ?Tested_module ] ),
io:format( ?Prefix "Debug mode : ~s.~n",
[ class_OvoviviparousBeing:is_wooper_debug() ] ),
io:format( ?Prefix "Statically, class name is ~s, superclasses are ~w.~n",
[
class_OvoviviparousBeing:get_class_name(),
class_OvoviviparousBeing:get_superclasses() ] ),
MyV = class_OvoviviparousBeing:new(),
MyV ! {get_class_name,[],self()},
receive
{wooper_result,class_OvoviviparousBeing} ->
io:format( ?Prefix
"After constructor, get_class_name returned "
"'class_OvoviviparousBeing' as expected.~n");
{wooper_result,UnexpectedClass} ->
testFailed( io_lib:format( "wrong class : ~p",
[ UnexpectedClass ] ) )
end,
MyV ! {get_superclasses,[],self()},
receive
{wooper_result, []} ->
io:format( ?Prefix
"After constructor, get_superclasses returned [] "
"as expected.~n");
{wooper_result,UnexpectedSuperclasses} ->
testFailed( io_lib:format( "wrong superclasses : ~p",
[ UnexpectedSuperclasses ] ) )
end,
MyV ! {getMeanEggsCount,[],self()},
receive
{wooper_result,1000} ->
io:format( ?Prefix
"After constructor, getMeanEggsCount returned 1000 "
"as expected.~n");
{wooper_result,UnexpectedMeanCount} ->
testFailed( io_lib:format( "wrong mean egg count : ~p",
[ UnexpectedMeanCount ] ) )
end,
MyV ! {getEggsLaidCount,[],self()},
receive
{wooper_result,0} ->
io:format( ?Prefix
"After constructor, getEggsLaidCount returned 0 "
"as expected.~n");
{wooper_result,UnexpectedFirstCount} ->
testFailed( io_lib:format( "wrong first egg count : ~p",
[ UnexpectedFirstCount ] ) )
end,
MyV ! {layEggs,747},
MyV ! {getEggsLaidCount,[],self()},
receive
{wooper_result,747}->
io:format(?Prefix
"After giveBirth, getEggsLaidCount returned 747 "
"as expected.~n");
{wooper_result,UnexpectedSecondCount} ->
testFailed( io_lib:format( "wrong second egg count : ~p",
[ UnexpectedSecondCount ] ) )
end,
case class_OvoviviparousBeing:is_wooper_debug() of
true ->
MyV ! { wooper_get_instance_description,[], self() },
receive
{wooper_result,InspectString} ->
io:format( "~s~n", [ InspectString ] )
end ;
false ->
ok
end,
MyV ! delete,
io:format( ?Prefix "End of test for module ~s.~n", [ ?Tested_module ] ),
testFinished().

99
examples/wooper/class_Platypus.erl Executable file
View File

@ -0,0 +1,99 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
-module(class_Platypus).
% Determines what are the mother classes of this class (if any):
-define(wooper_superclasses,[class_Mammal,class_OvoviviparousBeing]).
% Parameters taken by the constructor ('construct').
% They are here the ones of the Mammal mother class (the ovoviviparous being
% constructor does not need any parameter) plus nozzle color.
% These are class-specific data needing to be set in the constructor:
-define(wooper_construct_parameters, Age, Gender, FurColor, NozzleColor ).
% Declaring all variations of WOOPER standard life-cycle operations:
% (template pasted, two replacements performed to update arities)
-define( wooper_construct_export, new/4, new_link/4,
synchronous_new/4, synchronous_new_link/4,
synchronous_timed_new/4, synchronous_timed_new_link/4,
remote_new/5, remote_new_link/5, remote_synchronous_new/5,
remote_synchronous_new_link/5, remote_synchronous_timed_new/5,
remote_synchronous_timed_new_link/5, construct/5 ).
% Method declarations.
-define(wooper_method_export, getMeanEggsCount/1, getTeatCount/1, canEat/2,
getNozzleColor/1, getAlternateNames/1, popFirstAlternateName/1 ).
% Allows to define WOOPER base variables and methods for that class:
-include("wooper.hrl").
% Constructs a new Platypus.
construct(State,?wooper_construct_parameters) ->
% First the direct mother classes:
MammalState = class_Mammal:construct( State, Age, Gender, FurColor ),
OvoviviparousMammalState = class_OvoviviparousBeing:construct(
MammalState ),
% Then the class-specific attributes:
?setAttributes( OvoviviparousMammalState,
[ {nozzle_color,NozzleColor},
{alternate_names,[hector,edgar,roger,sean]} ] ).
getMeanEggsCount(State) ->
?wooper_return_state_result( State, 2 ).
% It is a mammal, though !
getTeatCount(State) ->
?wooper_return_state_result( State, 0 ).
% Platypuses are supposed carnivorous though:
canEat(State,leaf) ->
?wooper_return_state_result( State, true );
canEat(State,chocolate) ->
?wooper_return_state_result( State, true );
canEat(State,weed) ->
?wooper_return_state_result( State, true );
canEat(State,fish) ->
?wooper_return_state_result( State, true );
canEat(State,_) ->
?wooper_return_state_result( State, false ).
getNozzleColor(State)->
?wooper_return_state_result( State, ?getAttribute(State,nozzle_color) ).
% Returns the list of alternate names for this platypus.
getAlternateNames(State) ->
?wooper_return_state_result( State, ?getAttribute(State,alternate_names) ).
% Returns the first alternate name for this platypus and forget it.
popFirstAlternateName(State) ->
{NewState,Name} = ?popFromAttribute(State,alternate_names),
?wooper_return_state_result( NewState, Name ).

331
examples/wooper/class_Platypus_test.erl Executable file
View File

@ -0,0 +1,331 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Unit tests for the Platypus class implementation.
% See the class_Platypus.erl tested module.
-module(class_Platypus_test).
-export([run/0]).
-define(Tested_module,class_Platypus).
-define(Prefix,"--> ").
% Comment out to be able to use the interpreter after the test :
-define(ExitAfterTest,).
-ifdef(ExitAfterTest).
testFinished() ->
erlang:halt().
-else.
testFinished() ->
io:format( "(interpreter still running)~n" ),
test_success.
-endif.
testFailed(Reason) ->
% For some reason erlang:error is unable to interpret strings as strings,
% they are always output as unreadable list.
io:format( "~n!!!! Test failed for module ~s, reason : ~s~n~n",
[ ?Tested_module, Reason ] ),
erlang:error( "Test failed" ).
run() ->
io:format( ?Prefix "Testing module ~s.~n", [ ?Tested_module ] ),
io:format( ?Prefix "Debug mode : ~s.~n",
[ class_Platypus:is_wooper_debug() ] ),
% General tests.
io:format( ?Prefix "Statically, class name is ~s, superclasses are ~w.~n",
[
class_Platypus:get_class_name(),
class_Platypus:get_superclasses() ] ),
MyP = class_Platypus:new(4,male,brown,black),
MyP ! {get_class_name,[],self()},
receive
{wooper_result,class_Platypus} ->
io:format( ?Prefix
"After constructor, get_class_name returned 'class_Platypus' "
"as expected.~n");
{wooper_result,UnexpectedClass} ->
testFailed( io_lib:format( "wrong class : ~p",
[ UnexpectedClass ] ) )
end,
MyP ! {get_superclasses,[],self()},
receive
{wooper_result, [class_Mammal,class_OvoviviparousBeing]} ->
io:format( ?Prefix
"After constructor, get_superclasses returned "
"[class_Creature,class_OvoviviparousBeing] as expected.~n");
{wooper_result,UnexpectedSuperclasses} ->
testFailed( io_lib:format( "wrong superclasses : ~p",
[ UnexpectedSuperclasses ] ) )
end,
% Tests related to Mammals and Creatures.
MyP ! {getAge,[],self()},
receive
{wooper_result,4} ->
io:format( ?Prefix
"After constructor, getAge returned 4 as expected.~n");
{wooper_result,UnexpectedAge} ->
testFailed( io_lib:format( "wrong age : ~p",
[ UnexpectedAge ] ) )
end,
MyP ! {getGender,[],self()},
receive
{wooper_result,male} ->
io:format( ?Prefix
"After constructor, getGender returned male as expected.~n");
{wooper_result,UnexpectedGender} ->
testFailed( io_lib:format( "wrong gender : ~p",
[ UnexpectedGender ] ) )
end,
MyP ! {setAge,5},
MyP ! {getAge,[],self()},
receive
{wooper_result,5}->
io:format(?Prefix
"After setAge, getAge returned 5 as expected.~n");
{wooper_result,UnexpectedNewAge} ->
testFailed( io_lib:format( "wrong age : ~p",
[ UnexpectedNewAge ] ) )
end,
MyP ! declareBirthday,
MyP ! {getAge,[],self()},
receive
{wooper_result,6}->
io:format(?Prefix
"After declareBirthday, getAge returned 6 as expected.~n");
{wooper_result,UnexpectedLastAge} ->
testFailed( io_lib:format( "wrong age : ~p",
[ UnexpectedLastAge ] ) )
end,
MyP ! declareBirthday,
MyP ! {isHotBlooded,[],self()},
receive
{wooper_result,true}->
io:format(?Prefix
"isHotBlooded returned true as expected.~n");
{wooper_result,UnexpectedBlood} ->
testFailed( io_lib:format( "wrong blood type : ~p",
[ UnexpectedBlood ] ) )
end,
MyP ! {getFurColor,[],self()},
receive
{wooper_result,brown}->
io:format(?Prefix
"getFurColor returned brown as expected.~n");
{wooper_result,UnexpectedFurColor} ->
testFailed( io_lib:format( "wrong fur color : ~p",
[ UnexpectedFurColor ] ) )
end,
% Tests related to OvoviviparousBeings.
MyP ! {getMeanEggsCount,[],self()},
receive
{wooper_result,2} ->
io:format( ?Prefix
"After constructor, getMeanEggsCount returned 2 "
"as expected.~n");
{wooper_result,UnexpectedMeanCount} ->
testFailed( io_lib:format( "wrong mean egg count : ~p",
[ UnexpectedMeanCount ] ) )
end,
MyP ! {getEggsLaidCount,[],self()},
receive
{wooper_result,0} ->
io:format( ?Prefix
"After constructor, getEggsLaidCount returned 0 "
"as expected.~n");
{wooper_result,UnexpectedFirstCount} ->
testFailed( io_lib:format( "wrong first egg count : ~p",
[ UnexpectedFirstCount ] ) )
end,
MyP ! {layEggs,1},
MyP ! {getEggsLaidCount,[],self()},
receive
{wooper_result,1}->
io:format(?Prefix
"After giveBirth, getEggsLaidCount returned 1 "
"as expected.~n");
{wooper_result,UnexpectedSecondCount} ->
testFailed( io_lib:format( "wrong second egg count : ~p",
[ UnexpectedSecondCount ] ) )
end,
% Tests related to Platypuses.
MyP ! {getTeatCount,[],self()},
receive
{wooper_result,0}->
io:format(?Prefix
"getTeatCount returned 0 as expected.~n");
{wooper_result,UnexpectedTeatCount} ->
testFailed( io_lib:format( "wrong teat count : ~p",
[ UnexpectedTeatCount ] ) )
end,
MyP ! {canEat,weed,self()},
receive
{wooper_result,true}->
io:format(?Prefix
"This Platypus can eat weed, as expected.~n");
{wooper_result,UnexpectedFoodPreference} ->
testFailed( io_lib:format( "wrong food preference : ~p",
[ UnexpectedFoodPreference ] ) )
end,
MyP ! {canEat,mammoth,self()},
receive
{wooper_result,false}->
io:format(?Prefix
"This Platypus cannot eat mammoth, as expected.~n");
{wooper_result,UnexpectedOtherFoodPreference} ->
testFailed( io_lib:format( "wrong food preference : ~p",
[ UnexpectedOtherFoodPreference ] ) )
end,
MyP ! {getNozzleColor,[],self()},
receive
{wooper_result,black}->
io:format(?Prefix
"This Platypus has a black nozzle, as expected.~n");
{wooper_result,UnexpectedNozzleColor} ->
testFailed( io_lib:format( "wrong nozzle color : ~p",
[ UnexpectedNozzleColor ] ) )
end,
MyP ! {getAlternateNames,[],self()},
receive
{wooper_result,[hector,edgar,roger,sean]}->
io:format(?Prefix
"This Platypus has the right alternate names: ~w.~n",
[ [hector,edgar,roger,sean] ] )
end,
MyP ! {popFirstAlternateName,[],self()},
receive
{wooper_result,FirstName}->
io:format(?Prefix
"This Platypus forgot its first alternate name: ~w.~n",
[ FirstName ] )
end,
MyP ! {getAlternateNames,[],self()},
receive
{wooper_result,[edgar,roger,sean]}->
io:format(?Prefix
"Finally this Platypus has the right alternate names: ~w.~n",
[ [edgar,roger,sean] ] )
end,
io:format(?Prefix "Testing now synchronous operations.~n" ),
MySyncP = class_Platypus:synchronous_new_link(3,female,violet,grey),
MySyncP ! {getNozzleColor,[],self()},
receive
{wooper_result,grey}->
io:format(?Prefix
"This synchronous Platypus has a grey nozzle, as expected.~n");
{wooper_result,UnexpectedSyncNozzleColor} ->
testFailed( io_lib:format( "wrong nozzle color : ~p",
[ UnexpectedSyncNozzleColor ] ) )
end,
case class_Platypus:is_wooper_debug() of
true ->
MyP ! { wooper_get_instance_description,[], self() },
receive
{wooper_result,InspectString} ->
io:format( "~s~n", [ InspectString ] )
end ;
false ->
ok
end,
MyP ! delete,
io:format( ?Prefix "End of test for module ~s.~n", [ ?Tested_module ] ),
testFinished().

85
examples/wooper/class_Reptile.erl Executable file
View File

@ -0,0 +1,85 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
-module(class_Reptile).
% Determines what are the mother classes of this class (if any):
-define(wooper_superclasses,[class_Creature]).
% Parameters taken by the constructor ('construct').
% They are here the ones of the mother class (creature):
-define(wooper_construct_parameters, Age, Gender ).
% Declaring all variations of WOOPER standard life-cycle operations:
% (template pasted, two replacements performed to update arities)
-define( wooper_construct_export, new/2, new_link/2,
synchronous_new/2, synchronous_new_link/2,
synchronous_timed_new/2, synchronous_timed_new_link/2,
remote_new/3, remote_new_link/3, remote_synchronous_new/3,
remote_synchronous_new_link/3, remote_synchronous_timed_new/3,
remote_synchronous_timed_new_link/3, construct/3, delete/1 ).
% Declarations of class-specific methods (besides inherited ones).
-define(wooper_method_export, setAge/2, isHotBlooded/1, canMoult/1 ).
% Allows to define WOOPER base variables and methods for that class:
-include("wooper.hrl").
% Constructs a new Reptile.
construct(State,?wooper_construct_parameters) ->
class_Creature:construct(State,Age,Gender).
% To test constructor checking:
%an_unexpected_initial_state.
% Overridden destructor
delete(State) ->
io:format( "Deleting a Reptile." ),
State.
% To test destructor checking use instead:
%an_unexpected_final_state.
% Method implementations.
% Sets correctly the age of this Mammal (not like faulty implementation of the
% Creature mother class).
% Overridden from Creature, useful to show the use of executeOneway.
% Note: used to test WOOPER management of error conditions.
% (oneway)
setAge(State,NewAge) ->
%throw( exception_throw_test_from_oneway ),
%exit( exception_exit_test_from_oneway ),
?wooper_return_state_only( ?setAttribute(State,age,NewAge) ).
% All reptiles are cold-blooded
% Note: used to test WOOPER management of error conditions.
% (request)
isHotBlooded(State) ->
%throw( exception_throw_test_from_request ),
%exit( exception_exit_test_from_request ),
?wooper_return_state_result(State,false).
% All reptiles can moult:
canMoult(State) ->
?wooper_return_state_result(State,true).

182
examples/wooper/class_Reptile_test.erl Executable file
View File

@ -0,0 +1,182 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Unit tests for the Reptile class implementation.
% See the class_Reptile.erl tested module.
-module(class_Reptile_test).
-export([run/0]).
-define(Tested_module,class_Reptile).
-define(Prefix,"--> ").
% Comment out to be able to use the interpreter after the test:
-define(ExitAfterTest,).
-ifdef(ExitAfterTest).
testFinished() ->
erlang:halt().
-else.
testFinished() ->
io:format( "(interpreter still running)~n" ),
test_success.
-endif.
testFailed(Reason) ->
% For some reason erlang:error is unable to interpret strings as strings,
% they are always output as unreadable list.
io:format( "~n!!!! Test failed for module ~s, reason: ~s~n~n",
[ ?Tested_module, Reason ] ),
erlang:error( "Test failed" ).
run() ->
io:format( ?Prefix "Testing module ~s.~n", [ ?Tested_module ] ),
io:format( ?Prefix "Debug mode: ~s.~n",
[ class_Reptile:is_wooper_debug() ] ),
io:format( ?Prefix "Statically, class name is ~s, superclasses are ~w.~n",
[
class_Reptile:get_class_name(),
class_Reptile:get_superclasses() ] ),
MyR = class_Reptile:new(1,male),
MyR ! {get_class_name,[],self()},
receive
{wooper_result,class_Reptile} ->
io:format( ?Prefix
"After constructor, get_class_name returned 'class_Reptile' "
"as expected.~n");
{wooper_result,UnexpectedClass} ->
testFailed( io_lib:format( "wrong class: ~p",
[ UnexpectedClass ] ) )
end,
MyR ! {get_superclasses,[],self()},
receive
{wooper_result, [class_Creature]} ->
io:format( ?Prefix
"After constructor, get_superclasses returned [class_Creature] "
"as expected.~n");
{wooper_result,UnexpectedSuperclasses} ->
testFailed( io_lib:format( "wrong superclasses: ~p",
[ UnexpectedSuperclasses ] ) )
end,
MyR ! {getAge,[],self()},
receive
{wooper_result,1} ->
io:format( ?Prefix
"After constructor, getAge returned 1 as expected.~n");
{wooper_result,UnexpectedAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedAge ] ) )
end,
MyR ! {getGender,[],self()},
receive
{wooper_result,male} ->
io:format( ?Prefix
"After constructor, getGender returned male as expected.~n");
{wooper_result,UnexpectedGender} ->
testFailed( io_lib:format( "wrong gender: ~p",
[ UnexpectedGender ] ) )
end,
MyR ! {setAge,2},
MyR ! {getAge,[],self()},
receive
{wooper_result,2}->
io:format(?Prefix
"After setAge, getAge returned 2 as expected.~n");
{wooper_result,UnexpectedNewAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedNewAge ] ) )
end,
MyR ! declareBirthday,
MyR ! {getAge,[],self()},
receive
{wooper_result,3}->
io:format(?Prefix
"After declareBirthday, getAge returned 3 as expected.~n");
{wooper_result,UnexpectedLastAge} ->
testFailed( io_lib:format( "wrong age: ~p",
[ UnexpectedLastAge ] ) )
end,
MyR ! declareBirthday,
MyR ! {isHotBlooded,[],self()},
receive
{wooper_result,false}->
io:format(?Prefix
"isHotBlooded returned false as expected.~n");
{wooper_result,UnexpectedBlood} ->
testFailed( io_lib:format( "wrong blood type: ~p",
[ UnexpectedBlood ] ) )
end,
MyR ! {canMoult,[],self()},
receive
{wooper_result,true}->
io:format(?Prefix
"canMoult returned true as expected.~n");
{wooper_result,UnexpectedMoultType} ->
testFailed( io_lib:format( "wrong moult type: ~p",
[ UnexpectedMoultType ] ) )
end,
case class_Reptile:is_wooper_debug() of
true ->
MyR ! { wooper_get_instance_description,[], self() },
receive
{wooper_result,InspectString} ->
io:format( "~s~n", [ InspectString ] )
end ;
false ->
ok
end,
% To check the result when using a faulty destructor:
io:format(?Prefix "synchronous deletion of the instance.~n" ),
MyR ! {synchronous_delete,self()},
receive
{deleted,MyR} ->
ok
end,
io:format( ?Prefix "End of test for module ~s.~n", [ ?Tested_module ] ),
testFinished().

64
examples/wooper/class_ViviparousBeing.erl Executable file
View File

@ -0,0 +1,64 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
-module(class_ViviparousBeing).
% Determines what are the mother classes of this class (if any):
-define(wooper_superclasses,[]).
% Declaring all variations of WOOPER standard life-cycle operations:
% (template pasted, two replacements performed to update arities)
-define( wooper_construct_export, new/0, new_link/0,
synchronous_new/0, synchronous_new_link/0,
synchronous_timed_new/0, synchronous_timed_new_link/0,
remote_new/1, remote_new_link/1, remote_synchronous_new/1,
remote_synchronous_new_link/1, remote_synchronous_timed_new/1,
remote_synchronous_timed_new_link/1, construct/1 ).
% Declarations of class-specific methods (besides inherited ones).
-define(wooper_method_export, getMeanChildrenCount/1, getBirthGivenCount/1,
giveBirth/2 ).
% Allows to define WOOPER base variables and methods for that class:
-include("wooper.hrl").
% Constructs a new Viviparous being (parameter-less constructor).
construct(State) ->
?setAttribute(State,birth_given_count,0).
% Method implementations.
% Let's say an average means something here:
% (this is a static method, as it does not depend on a state)
getMeanChildrenCount(State) ->
?wooper_return_state_result( State, 4 ).
% Returns the number of times this viviparous being gave birth:
getBirthGivenCount(State) ->
?wooper_return_state_result( State,
?getAttribute(State,birth_given_count) ).
% Increase the number of times this viviparous being gave birth:
giveBirth(State,NumberOfNewChildren) ->
?wooper_return_state_only( ?setAttribute(State,birth_given_count,
?getAttribute(State,birth_given_count) + NumberOfNewChildren ) ).

138
examples/wooper/class_ViviparousBeing_test.erl Executable file
View File

@ -0,0 +1,138 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER examples.
%
% It has been placed in the public domain.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Unit tests for the ViviparousBeing class implementation.
% See the class_ViviparousBeing.erl tested module.
-module(class_ViviparousBeing_test).
-export([run/0]).
-define(Tested_module,class_ViviparousBeing).
-define(Prefix,"--> ").
% Comment out to be able to use the interpreter after the test :
-define(ExitAfterTest,).
-ifdef(ExitAfterTest).
testFinished() ->
erlang:halt().
-else.
testFinished() ->
io:format( "(interpreter still running)~n" ),
test_success.
-endif.
testFailed(Reason) ->
% For some reason erlang:error is unable to interpret strings as strings,
% they are always output as unreadable list.
io:format( "~n!!!! Test failed for module ~s, reason : ~s~n~n",
[ ?Tested_module, Reason ] ),
erlang:error( "Test failed" ).
run() ->
io:format( ?Prefix "Testing module ~s.~n", [ ?Tested_module ] ),
io:format( ?Prefix "Debug mode : ~s.~n",
[ class_ViviparousBeing:is_wooper_debug() ] ),
io:format( ?Prefix "Statically, class name is ~s, superclasses are ~w.~n",
[
class_ViviparousBeing:get_class_name(),
class_ViviparousBeing:get_superclasses() ] ),
MyV = class_ViviparousBeing:new(),
MyV ! {get_class_name,[],self()},
receive
{wooper_result,class_ViviparousBeing} ->
io:format( ?Prefix
"After constructor, get_class_name returned "
"'class_ViviparousBeing' as expected.~n");
{wooper_result,UnexpectedClass} ->
testFailed( io_lib:format( "wrong class : ~p",
[ UnexpectedClass ] ) )
end,
MyV ! {get_superclasses,[],self()},
receive
{wooper_result, []} ->
io:format( ?Prefix
"After constructor, get_superclasses returned [] "
"as expected.~n");
{wooper_result,UnexpectedSuperclasses} ->
testFailed( io_lib:format( "wrong superclasses : ~p",
[ UnexpectedSuperclasses ] ) )
end,
MyV ! {getMeanChildrenCount,[],self()},
receive
{wooper_result,4} ->
io:format( ?Prefix
"After constructor, getMeanChildrenCount returned 4 "
"as expected.~n");
{wooper_result,UnexpectedMeanCount} ->
testFailed( io_lib:format( "wrong mean children count : ~p",
[ UnexpectedMeanCount ] ) )
end,
MyV ! {getBirthGivenCount,[],self()},
receive
{wooper_result,0} ->
io:format( ?Prefix
"After constructor, getBirthGivenCount returned 0 "
"as expected.~n");
{wooper_result,UnexpectedFirstCount} ->
testFailed( io_lib:format( "wrong first children count : ~p",
[ UnexpectedFirstCount ] ) )
end,
MyV ! {giveBirth,7},
MyV ! {getBirthGivenCount,[],self()},
receive
{wooper_result,7}->
io:format(?Prefix
"After giveBirth, getBirthGivenCount returned 7 "
"as expected.~n");
{wooper_result,UnexpectedSecondCount} ->
testFailed( io_lib:format( "wrong second children count : ~p",
[ UnexpectedSecondCount ] ) )
end,
case class_ViviparousBeing:is_wooper_debug() of
true ->
MyV ! { wooper_get_instance_description,[], self() },
receive
{wooper_result,InspectString} ->
io:format( "~s~n", [ InspectString ] )
end ;
false ->
ok
end,
MyV ! delete,
io:format( ?Prefix "End of test for module ~s.~n", [ ?Tested_module ] ),
testFinished().

2500
examples/wooper/wooper.hrl Executable file
View File

File diff suppressed because it is too large Load Diff

43
examples/wooper/wooper_class_manager.hrl Executable file
View File

@ -0,0 +1,43 @@
%
% Copyright (C) 2003-2009 Olivier Boudeville
%
% This file is part of the WOOPER library.
%
% This library is free software: you can redistribute it and/or modify
% it under the terms of the GNU Lesser General Public License or
% the GNU General Public License, as they are published by the Free Software
% Foundation, either version 3 of these Licenses, or (at your option)
% any later version.
% You can also redistribute it and/or modify it under the terms of the
% Mozilla Public License, version 1.1 or later.
%
% This library is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU Lesser General Public License and the GNU General Public License
% for more details.
%
% You should have received a copy of the GNU Lesser General Public
% License, of the GNU General Public License and of the Mozilla Public License
% along with this library.
% If not, see <http://www.gnu.org/licenses/> and
% <http://www.mozilla.org/MPL/>.
%
% Author: Olivier Boudeville (olivier.boudeville@esperide.com)
% Header sharing defines for the WOOPER class manager.
% See documentation at:
% http://ceylan.sourceforge.net/main/documentation/wooper/
% Creation date: Friday, July 12, 2007.
% Author: Olivier Boudeville (olivier.boudeville@esperide.com).
% Licensed under a disjunctive tri-license: MPL/GPL/LGPL, see:
% http://ceylan.sourceforge.net/main/documentation/wooper/index.html#license
% The class manager name that will be registered :
-define(WooperClassManagerName,wooper_class_manager).

273
examples/wooper_xform.erl Executable file
View File

@ -0,0 +1,273 @@
%%% The contents of this file are subject to the Erlang Public License,
%%% Version 1.0, (the "License"); you may not use this file except in
%%% compliance with the License. You may obtain a copy of the License at
%%% http://www.erlang.org/license/EPL1_0.txt
%%%
%%% Software distributed under the License is distributed on an "AS IS"
%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%%% the License for the specific language governing rights and limitations
%%% under the License.
%%%
%%% The Original Code is exprecs-0.2.
%%%
%%% The Initial Developer of the Original Code is Ericsson AB.
%%% Portions created by Ericsson are Copyright (C), 2006, Ericsson AB.
%%% All Rights Reserved.
%%%
%%% Contributor(s): ______________________________________.
%%%-------------------------------------------------------------------
%%% File : exprecs.erl
%%% @author : Ulf Wiger <ulf.wiger@ericsson.com>
%%% @end
%%% Description :
%%%
%%% Created : 13 Feb 2006 by Ulf Wiger <ulf.wiger@ericsson.com>
%%%-------------------------------------------------------------------
%%% @doc Parse transform for generating record access functions.
%%% <p>This parse transform can be used to reduce compile-time
%%% dependencies in large systems.</p>
%%% <p>In the old days, before records, Erlang programmers often wrote
%%% access functions for tuple data. This was tedious and error-prone.
%%% The record syntax made this easier, but since records were implemented
%%% fully in the pre-processor, a nasty compile-time dependency was
%%% introduced.</p>
%%% <p>This module automates the generation of access functions for
%%% records. While this method cannot fully replace the utility of
%%% pattern matching, it does allow a fair bit of functionality on
%%% records without the need for compile-time dependencies.</p>
%%% <p>Whenever record definitions need to be exported from a module,
%%% inserting a compiler attribute,
%%% <code>export_records([RecName|...])</code> causes this transform
%%% to lay out access functions for the exported records:</p>
%%%
%%% <pre>
%%% -module(foo)
%%% -compile({parse_transform, dia_exprecs}).
%%%
%%% -record(a, {a, b, c}).
%%% -export_records([a]).
%%% -export(['#info-'/1, '#info-'/2,
%%% '#get-'/2, '#set-'/2,
%%% '#new-a'/0, '#new-a'/1,
%%% '#get-a'/2, '#set-a'/2,
%%% '#info-a'/1]).
%%%
%%% '#info-'(Rec) -&gt;
%%% '#info-'(Rec, fields).
%%%
%%% '#info-'(a, Info) -&gt;
%%% '#info-a'(Info).
%%%
%%% '#new-a'() -&gt; #a{}.
%%% '#new-a'(Vals) -&gt; '#set-a'(Vals, #a{}).
%%%
%%% '#get-'(Attrs, Rec) when is_record(Rec, a) -&gt;
%%% '#get-a'(Attrs, Rec).
%%%
%%% '#get-a'(Attrs, R) when is_list(Attrs) -&gt;
%%% ['#get-a'(A, R) || A &lt;- Attrs];
%%% '#get-a'(a, R) -&gt; R#a.a;
%%% '#get-a'(b, R) -&gt; R#a.b;
%%% '#get-a'(c, R) -&gt; R#a.c.
%%%
%%% '#set-'(Vals, Rec) when is_record(Rec, a) -&gt;
%%% '#set-a'(Vals, Rec).
%%%
%%% '#set-a'(Vals, Rec) -&gt;
%%% F = fun ([], R, _F1) -> R;
%%% ([{a, V} | T], R, F1) -&gt; F1(T, R#a{a = V}, F1);
%%% ([{b, V} | T], R, F1) -&gt; F1(T, R#a{b = V}, F1);
%%% ([{c, V} | T], R, F1) -&gt; F1(T, R#a{c = V}, F1)
%%% end,
%%% F(Vals, Rec, F).
%%%
%%% '#info-a'(fields) -&gt; record_info(fields, a);
%%% '#info-a'(size) -&gt; record_info(size, a).
%%% </pre>
%%% @end
-module(wooper_xform).
-export([parse_transform/2]).
parse_transform(Forms, Options) ->
%%
%% get macros using epp_dodger
%%
Ctxt = parse_trans:initial_context(Forms, Options),
File = parse_trans:context(file, Ctxt),
Dodge = parse_trans:get_orig_syntax_tree(File),
Macros = wooper_get_macros(Dodge),
io:fwrite("Macros = ~p~n", [Macros]),
WInfo = wooper_info(Macros, Ctxt),
WRec = {wooper_info, [{record_field, 1, {atom,1,K},
erl_parse:abstract(V)} ||
{K,V} <- WInfo]},
SRec = wooper_state_rec(Macros),
Above =
[{attribute, 1, export_records, [wooper_info, wooper_state]},
{attribute, 1, record, WRec},
{attribute, 1, record, SRec}],
io:fwrite("Above = ~p~n", [Above]),
MethodsToAdd = methods_to_add(WInfo, Forms),
io:fwrite("MethodsToAdd = ~p~n", [MethodsToAdd]),
Methods = generate_methods(MethodsToAdd),
MethodExport = {attribute,1,export,[M || {M,_} <- MethodsToAdd]},
Add = fun(Where, What, Fs) ->
parse_trans:do_insert_forms(Where, What, Fs, Ctxt)
end,
Result = exprecs:parse_transform(Add(above, [MethodExport|Above],
Add(below, Methods, Forms)),
Options),
parse_trans:optionally_pretty_print(
Result, Options, Ctxt),
Result.
wooper_get_macros(Forms) ->
Attrs = [a_info(A) ||
A <- Forms,
erl_syntax:type(A) == attribute,
erl_syntax:atom_value(
erl_syntax:attribute_name(A)) == define,
is_wooper_define(A)],
Attrs.
wooper_info(Macros, Ctxt) ->
SuperClasses = proplists:get_value(wooper_superclasses,Macros,[]),
ConstructParams =
proplists:get_value(wooper_construct_parameters,Macros,[]),
MemberExports = proplists:get_value(wooper_member_export,Macros,[]),
MethodExports = proplists:get_value(wooper_method_export,Macros,[]),
Class = parse_trans:context(module, Ctxt),
{LocalAttrs, ParentAttrs} =
wooper_attributes(ConstructParams, SuperClasses),
[{class, Class},
{superclasses,SuperClasses},
{construct_parameters, ConstructParams},
{specific_attributes, LocalAttrs},
{parent_attributes, ParentAttrs},
{member_exports, MemberExports},
{method_exports, MethodExports},
{inherited_methods, inherited_methods(MethodExports, SuperClasses)}].
wooper_state_rec(Macros) ->
ConstructParams =
proplists:get_value(wooper_construct_parameters,Macros,[]),
{wooper_state,
[{record_field, 1, {atom,1,N}} || N <- ConstructParams]}.
%% HACK! The attribute names used to get and set state attributes
%% are lexically derived here from the construct parameters. Maybe this is
%% acceptable? At any rate, it would be confusing to depart from the naming
%% convention.
%%
wooper_attributes(ConstructParams, SuperClasses) ->
Attrs = [from_camel(P) || P <- ConstructParams],
SuperAttrs = lists:concat([[{A,C} || A <- get_attributes(C)] ||
C <- SuperClasses]),
Specific = Attrs -- [A || {A,_} <- SuperAttrs],
{Specific, SuperAttrs}.
inherited_methods(Local, SuperClasses) ->
lists:foldr(
fun(C, Acc) ->
Methods = get_value(method_exports, C),
case [{M,C} || M <- Methods,
not lists:member(M, Local)] of
[] -> Acc;
Inherited ->
Acc ++ Inherited
end
end, [], SuperClasses).
methods_to_add(Info, Forms) ->
Functions = proplists:get_value(functions,
erl_syntax_lib:analyze_forms(Forms)),
Methods = proplists:get_value(inherited_methods, Info),
[{M,C} || {M,C} <- Methods,
not lists:member(M, Functions)].
generate_methods(Methods) ->
[abstract_method(F, A, C) || {{F,A}, C} <- Methods].
abstract_method(Fname, Arity, Class) ->
L = 999,
Vars = [{var, L, list_to_atom("V" ++ integer_to_list(N))} ||
N <- lists:seq(1,Arity)],
{function, 999, Fname, Arity,
[{clause, L, [V || V <- Vars], [],
[{call, L, {remote, L, {atom, L, Class}, {atom, L, Fname}}, Vars}]}]}.
from_camel(P) ->
[H|T] = atom_to_list(P),
list_to_atom(
[to_lower_c(H) | to_lower(re:replace(T,"[A-Z]","_&",[{return,list}]))]).
to_lower_c(C) when $A =< C, C =< $Z ->
C + $a - $A;
to_lower_c(C) ->
C.
get_attributes(C) -> get_value(specific_attributes, C).
get_value(Attr, C) ->
I = C:'#new-wooper_info'(),
C:'#get-wooper_info'(Attr, I).
to_lower(S) ->
[to_lower_c(C) || C <- S].
a_info(A) ->
Name = macro_name(A),
Args = macro_args(A),
{Name, macro_def_args(Name, Args)}.
a_args(A) -> erl_syntax:attribute_arguments(A).
macro_name(A) ->
[N|_] = a_args(A),
erl_syntax:atom_value(N).
macro_args(A) ->
[_|Args] = a_args(A),
Args.
is_wooper_define(A) ->
lists:member(macro_name(A), defines()).
defines() ->
[wooper_superclasses,
wooper_construct_parameters,
wooper_construct_export,
wooper_method_export,
wooper_member_export].
macro_def_args(wooper_superclasses, [List]) ->
Elems = erl_syntax:list_elements(List),
[erl_syntax:atom_value(A) || A <- Elems];
macro_def_args(wooper_construct_parameters, Args) ->
[erl_syntax:variable_name(V) || V <- Args];
macro_def_args(D, Args) when D==wooper_construct_export;
D==wooper_method_export ->
[{erl_syntax:atom_value(erl_syntax:infix_expr_left(A)),
erl_syntax:integer_value(erl_syntax:infix_expr_right(A))} ||
A <- Args];
macro_def_args(_, Args) ->
Args.

38
src/parse_trans.app.src Normal file
View File

@ -0,0 +1,38 @@
%%% ----------------------------------------------------------------------------
%%% Copyright (c) 2009, Erlang Training and Consulting Ltd.
%%% All rights reserved.
%%%
%%% Redistribution and use in source and binary forms, with or without
%%% modification, are permitted provided that the following conditions are met:
%%% * Redistributions of source code must retain the above copyright
%%% notice, this list of conditions and the following disclaimer.
%%% * Redistributions in binary form must reproduce the above copyright
%%% notice, this list of conditions and the following disclaimer in the
%%% documentation and/or other materials provided with the distribution.
%%% * Neither the name of Erlang Training and Consulting Ltd. nor the
%%% names of its contributors may be used to endorse or promote products
%%% derived from this software without specific prior written permission.
%%%
%%% THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
%%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
%%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
%%% ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
%%% LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
%%% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
%%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
%%% OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
%%% ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%%% ----------------------------------------------------------------------------
%%% @author Ulf Wiger <ulf.wiger@erlang-consulting.com>
%%% @doc This is a container for parse_trans modules.
%%% @end
{application, parse_trans,
[{description, "Parse transform library"},
{vsn, "@VSN@"},
{modules, [@MODULES@]},
{registered, []},
{applications, [kernel, stdlib, syntax_tools]},
{env, []}
]}.

428
src/parse_trans.erl Normal file
View File

@ -0,0 +1,428 @@
%%% The contents of this file are subject to the Erlang Public License,
%%% Version 1.0, (the "License"); you may not use this file except in
%%% compliance with the License. You may obtain a copy of the License at
%%% http://www.erlang.org/license/EPL1_0.txt
%%%
%%% Software distributed under the License is distributed on an "AS IS"
%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%%% the License for the specific language governing rights and limitations
%%% under the License.
%%%
%%% The Original Code is exprecs-0.2.
%%%
%%% The Initial Developer of the Original Code is Ericsson AB.
%%% Portions created by Ericsson are Copyright (C), 2006, Ericsson AB.
%%% All Rights Reserved.
%%%
%%% Contributor(s): ______________________________________.
%%%-------------------------------------------------------------------
%%% File : parse_trans.erl
%%% @author : Ulf Wiger <ulf.wiger@erlang-consulting.com>
%%% @end
%%% Description :
%%%
%%% Created : 13 Feb 2006 by Ulf Wiger <ulf.wiger@erlang-consulting.com>
%%%-------------------------------------------------------------------
%%% @doc Generic parse transform library for Erlang.
%%%
%%% <p>...</p>
%%%
%%% @end
-module(parse_trans).
-export([
inspect/4,
transform/4,
revert/1
]).
-export([
error/3,
format_error/1
]).
-export([
initial_context/2,
do_inspect/4,
do_transform/4
]).
-export([do_insert_forms/4]).
-export([
context/2,
get_pos/1,
get_file/1,
get_module/1,
get_attribute/2,
get_orig_syntax_tree/1,
function_exists/3,
optionally_pretty_print/3,
pp_src/2
]).
-import(erl_syntax, [atom_value/1,
attribute_name/1,
attribute_arguments/1,
string_value/1,
type/1
]).
-record(context, {module,
function,
arity,
file,
options}).
%% Useful macros for debugging and error reporting
-define(HERE, {?MODULE, ?LINE}).
-define(DUMMY_LINE, 9999).
-define(ERROR(R, F, I),
begin
rpt_error(R, F, I),
throw({error,get_pos(I),{unknown,R}})
end).
%%% @spec (Reason, Form, Info) -> throw()
%%% Info = [{Key,Value}]
%%%
%%% @doc
%%% <p>Used to report errors detected during the parse transform.</p>
%%% @end
%%%
error(R, F, I) ->
rpt_error(R, F, I),
throw({error,get_pos(I),{unknown,R}}).
get_pos(I) when is_list(I) ->
case proplists:get_value(form, I) of
undefined ->
?DUMMY_LINE;
Form ->
erl_syntax:get_pos(Form)
end.
%%% @spec (Forms) -> string()
%%% @doc
%%% Returns the name of the file being compiled.
%%% @end
%%%
get_file(Forms) ->
string_value(hd(get_attribute(file, Forms))).
%%% @spec (Forms) -> atom()
%%% @doc
%%% Returns the name of the module being compiled.
%%% @end
%%%
get_module(Forms) ->
atom_value(hd(get_attribute(module, Forms))).
%%% @spec (A, Forms) -> any()
%%% A = atom()
%%%
%%% @doc
%%% Returns the value of the first occurence of attribute A.
%%% @end
%%%
get_attribute(A, [F|Forms]) ->
case type(F) == attribute
andalso atom_value(attribute_name(F)) == A of
true ->
attribute_arguments(F);
false ->
get_attribute(A, Forms)
end;
get_attribute(A, []) ->
throw({error, ?DUMMY_LINE, {missing_attribute, A}}).
function_exists(Fname, Arity, Forms) ->
Fns = proplists:get_value(
functions, erl_syntax_lib:analyze_forms(Forms), []),
lists:member({Fname,Arity}, Fns).
%%% @spec (Forms, Options) -> #context{}
%%%
%%% @doc
%%% Initializes a context record. When traversing through the form
%%% list, the context is updated to reflect the current function and
%%% arity. Static elements in the context are the file name, the module
%%% name and the options passed to the transform function.
%%% @end
%%%
initial_context(Forms, Options) ->
File = get_file(Forms),
io:fwrite("File = ~p~n", [File]),
Module = get_module(Forms),
io:fwrite("Module = ~p~n", [Module]),
#context{file = File,
module = Module,
options = Options}.
%%% @spec (Fun, Acc, Forms, Options) -> {TransformedForms, NewAcc}
%%% Fun = function()
%%% Options = [{Key,Value}]
%%%
%%% @doc
%%% Makes one pass
%%% @end
transform(Fun, Acc, Forms, Options) when is_function(Fun, 5) ->
Context = initial_context(Forms, Options),
File = Context#context.file,
try do_transform(Fun, Acc, Forms, Context) of
{_, NewForms} = Result ->
optionally_pretty_print(NewForms, Options, Context),
Result
catch
error:Reason ->
{error,
[{File, [{?DUMMY_LINE, ?MODULE,
{Reason, erlang:get_stacktrace()}}]}]};
throw:{error, Ln, What} ->
{error, [{File, [{Ln, ?MODULE, What}]}], []}
end.
do_insert_forms(above, Insert, Forms, Context) when is_list(Insert) ->
{NewForms, _} =
do_transform(
fun(function, F, _Ctxt, false) ->
{Insert, F, [], _Recurse = false, true};
(_, F, _Ctxt, Acc) ->
{F, _Recurse = false, Acc}
end, false, Forms, Context),
NewForms;
do_insert_forms(below, Insert, Forms, Context) when is_list(Insert) ->
insert_below(Forms, Insert).
insert_below([F|Rest] = Forms, Insert) ->
case type(F) of
eof_marker ->
Insert ++ [F];
_ ->
[F|insert_below(Rest, Insert)]
end.
optionally_pretty_print(Result, Options, Context) ->
case lists:member(pt_pp_src, Options) of
true ->
File = Context#context.file,
Out = outfile(File),
pp_src(Result, Out),
io:fwrite("Pretty-printed in ~p~n", [Out]);
_ ->
io:fwrite("Will not pretty-print~n", []),
ok
end.
%%% @spec (Fun, Forms, Acc, Options) -> NewAcc
%%% Fun = function()
%%% @doc
%%% Equvalent to do_inspect(Fun,Acc,Forms,initial_context(Forms,Options)).
%%% @end
%%%
inspect(F, Acc, Forms, Options) ->
Context = initial_context(Forms, Options),
do_inspect(F, Acc, Forms, Context).
outfile(File) ->
"lre." ++ RevF = lists:reverse(File),
lists:reverse("mfx." ++ RevF).
pp_src(Res, F) ->
Str = [io_lib:fwrite("~s~n",
[lists:flatten([erl_pp:form(Fm) ||
Fm <- revert(Res)])])],
file:write_file(F, list_to_binary(Str)).
%% pp_debug_info(Mod) when is_atom(Mod) ->
%% case code:which(Mod) of
%% F when is_list(F) ->
%% dialyzer_utils:
%%% @spec (File) -> Forms
%%%
%%% @doc
%%% <p>Fetches a Syntax Tree representing the code before pre-processing,
%%% that is, including record and macro definitions. Note that macro
%%% definitions must be syntactically complete forms (this function
%%% uses epp_dodger).</p>
%%% @end
%%%
get_orig_syntax_tree(undefined) ->
?ERROR(unknown_source_file, ?HERE, []);
get_orig_syntax_tree(File) ->
case epp_dodger:parse_file(File) of
{ok, Forms} ->
Forms;
Err ->
error(error_reading_file, ?HERE, [{File,Err}])
end.
%%% @spec (Tree) -> Forms
%%%
%%% @doc Reverts back from Syntax Tools format to Erlang forms.
%%% <p>Note that the Erlang forms are a subset of the Syntax Tools
%%% syntax tree, so this function is safe to call even on a list of
%%% regular Erlang forms.</p>
%%% @end
%%%
revert(Tree) ->
[erl_syntax:revert(T) || T <- lists:flatten(Tree)].
%%% @spec (Attr, Context) -> any()
%%% Attr = module | function | arity | options
%%%
%%% @doc
%%% Accessor function for the Context record.
%%% @end
context(module, #context{module = M} ) -> M;
context(function, #context{function = F}) -> F;
context(arity, #context{arity = A} ) -> A;
context(file, #context{file = F} ) -> F;
context(options, #context{options = O} ) -> O.
do_inspect(F, Acc, Forms, Context) ->
F1 =
fun(Form, Acc0) ->
Type = type(Form),
{Recurse, Acc1} = apply_F(F, Type, Form, Context, Acc0),
if_recurse(
Recurse, Form, Acc1,
fun(ListOfLists) ->
lists:foldl(
fun(L, AccX) ->
do_inspect(
F, AccX, L,
update_context(Form, Context))
end, Acc1, ListOfLists)
end)
end,
lists:foldl(F1, Forms, Acc).
do_transform(F, Acc, Forms, Context) ->
F1 =
fun(Form, Acc0) ->
Type = type(Form),
{Before1, Form1, After1, Recurse, Acc1} =
case apply_F(F, Type, Form, Context, Acc0) of
{Form1x, Rec1x, A1x} ->
{[], Form1x, [], Rec1x, A1x};
{_Be1, _F1, _Af1, _Rec1, _Ac1} = Res1 ->
Res1
end,
if_recurse(
Recurse, Form,
{Before1, Form1, After1, Acc1},
fun(ListOfLists) ->
{NewListOfLists, NewAcc} =
mapfoldl(
fun(L, AccX) ->
do_transform(
F, AccX, L,
update_context(
Form1, Context))
end, Acc1, ListOfLists),
NewForm =
erl_syntax:update_tree(
Form, NewListOfLists),
{Before1, NewForm, After1, NewAcc}
end)
end,
mapfoldl(F1, Acc, Forms).
apply_F(F, Type, Form, Context, Acc) ->
try F(Type, Form, Context, Acc)
catch
error:Reason ->
?ERROR(Reason,
?HERE,
[{type, Type},
{context, Context},
{acc, Acc},
{form, Form}])
end.
if_recurse(true, Form, Else, F) ->
case erl_syntax:subtrees(Form) of
[] ->
Else;
[_|_] = ListOfLists ->
F(ListOfLists)
end;
if_recurse(false, _, Else, _) ->
Else.
update_context(Form, Context0) ->
case type(Form) of
function ->
{Fun, Arity} =
erl_syntax_lib:analyze_function(Form),
Context0#context{function = Fun,
arity = Arity};
_ ->
Context0
end.
%%% Slightly modified version of lists:mapfoldl/3
%%% Here, F/2 is able to insert forms before and after the form
%%% in question. The inserted forms are not transformed afterwards.
mapfoldl(F, Accu0, [Hd|Tail]) ->
{Before, Res, After, Accu1} =
case F(Hd, Accu0) of
{Be, _, Af, _} = Result when is_list(Be), is_list(Af) ->
Result;
{R1, A1} ->
{[], R1, [], A1}
end,
{Rs, Accu2} = mapfoldl(F, Accu1, Tail),
{Before ++ [Res| After ++ Rs], Accu2};
mapfoldl(F, Accu, []) when is_function(F, 2) -> {[], Accu}.
rpt_error(Reason, Fun, Info) ->
Fmt = lists:flatten(
["*** ERROR in parse_transform function:~n"
"*** Reason = ~p~n",
"*** Location: ~p~n",
["*** ~10w = ~p~n" || _ <- Info]]),
Args = [Reason, Fun |
lists:foldr(
fun({K,V}, Acc) ->
[K, V | Acc]
end, [], Info)],
io:format(Fmt, Args).
format_error({_Cat, Error}) ->
Error.

BIN
util/make_doc.beam Normal file
View File

Binary file not shown.

37
util/make_doc.erl Normal file
View File

@ -0,0 +1,37 @@
%%% ----------------------------------------------------------------------------
%%% Copyright (c) 2009, Erlang Training and Consulting Ltd.
%%% All rights reserved.
%%%
%%% Redistribution and use in source and binary forms, with or without
%%% modification, are permitted provided that the following conditions are met:
%%% * Redistributions of source code must retain the above copyright
%%% notice, this list of conditions and the following disclaimer.
%%% * Redistributions in binary form must reproduce the above copyright
%%% notice, this list of conditions and the following disclaimer in the
%%% documentation and/or other materials provided with the distribution.
%%% * Neither the name of Erlang Training and Consulting Ltd. nor the
%%% names of its contributors may be used to endorse or promote products
%%% derived from this software without specific prior written permission.
%%%
%%% THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
%%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
%%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
%%% ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
%%% LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
%%% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
%%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
%%% OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
%%% ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%%% ----------------------------------------------------------------------------
%%% @author Oscar Hellström <oscar@erlang-consulting.com>
-module(make_doc).
-export([edoc/0]).
edoc() ->
try
edoc:application(lhttpc, "./", [{doc, "doc/"}])
catch _:_ ->
halt(1)
end,
halt(0).

117
util/releaser Executable file
View File

@ -0,0 +1,117 @@
#!/bin/sh
# ----------------------------------------------------------------------------
# Copyright (c) 2009, Erlang Training and Consulting Ltd.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# * Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# * Neither the name of Erlang Training and Consulting Ltd. nor the
# names of its contributors may be used to endorse or promote products
# derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
# LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# ----------------------------------------------------------------------------
# Script for making a release of lhttpc. Or any program in hg really. Check
# the Makefile target release for how to use it.
NAME=$1
VSN=$2
yesno() {
prompt=$1
while true; do
read -p "$1 [Y/n] " answer
case "x$answer" in
"x")
return 0
;;
"xY")
return 0
;;
"xy")
return 0
;;
"xN")
return 1
;;
"xn")
return 1
;;
*)
;;
esac
done
}
get_version() {
while true; do
read -p "What is the version of the release? [$VSN] " release_vsn
if [ "$release_vsn" = "" ]; then
release_vsn=$VSN
fi
if $(echo "$TAGS" | grep -q "^$release_vsn\$"); then
if yesno "A tag exists for version $release_vsn, is this correct?"; then
break
fi
else
if yesno "A tag doesn't exist for version $release_vsn, should one be created?"; then
hg tag $release_vsn
fi
break
fi
done
echo $release_vsn
}
if ! hg identify 1>/dev/null 2>&1; then
echo "No hg repository here..."
exit 1
fi
if ! [ "$(hg identify | awk '{print $2};')" = "tip" ]; then
if ! yesno "Repository is not at tip, do you want to continue?"; then
exit 1
fi
fi
if ! yesno "Did the compilation run without warnings?"; then
"Try again..."
exit 1
fi
if ! yesno "Is the changelog up to date?"; then
"Try again..."
exit 1
fi
if ! yesno "Did dialyzer run without warnings?"; then
"Try again..."
exit 1
fi
TAGS=$(hg tags | awk '{print $1 };' | grep -v "^tip$")
LATEST_TAG=$(echo "$TAGS" | head -n 1)
RELEASE_VSN=$(get_version)
echo "Creating a release for $NAME-$RELEASE_VSN now."
archive="./$NAME-$RELEASE_VSN.tar.gz"
if [ -e $archive ]; then
echo "$archive exists, giving up."
exit 1
fi
hg archive -t tgz -X ".hg*" $archive

122
util/run_test.erl Normal file
View File

@ -0,0 +1,122 @@
%%% ----------------------------------------------------------------------------
%%% Copyright (c) 2009, Erlang Training and Consulting Ltd.
%%% All rights reserved.
%%%
%%% Redistribution and use in source and binary forms, with or without
%%% modification, are permitted provided that the following conditions are met:
%%% * Redistributions of source code must retain the above copyright
%%% notice, this list of conditions and the following disclaimer.
%%% * Redistributions in binary form must reproduce the above copyright
%%% notice, this list of conditions and the following disclaimer in the
%%% documentation and/or other materials provided with the distribution.
%%% * Neither the name of Erlang Training and Consulting Ltd. nor the
%%% names of its contributors may be used to endorse or promote products
%%% derived from this software without specific prior written permission.
%%%
%%% THIS SOFTWARE IS PROVIDED BY Erlang Training and Consulting Ltd. ''AS IS''
%%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
%%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
%%% ARE DISCLAIMED. IN NO EVENT SHALL Erlang Training and Consulting Ltd. BE
%%% LIABLE SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
%%% BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
%%% WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
%%% OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
%%% ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
%%% ----------------------------------------------------------------------------
%%% @author Oscar Hellström <oscar@erlang-consulting.com>
-module(run_test).
-export([run/0]).
-include_lib("eunit/include/eunit.hrl").
-include_lib("stdlib/include/ms_transform.hrl").
-define(TEST_LOG, "test/error_logger.log").
-define(SASL_LOG, "test/sasl.log").
-define(FILE_NAME(MODULE),
"cover_report/" ++ atom_to_list(MODULE) ++ ".html").
run() ->
Modules = get_modules(),
ok = cover_compile(Modules),
start_logging(),
Result = eunit:test(?MODULE, [verbose]),
filelib:ensure_dir("cover_report/index.html"),
html_report(Modules),
write_report(Modules),
stop_logging(),
io:format("Cover report in cover_report/index.html~n"),
io:format("Test logs in ~s and ~s~n", [?TEST_LOG, ?SASL_LOG]),
if
Result =:= ok -> halt(0);
Result =/= ok -> halt(1)
end.
start_logging() ->
application:load(sasl),
application:set_env(sasl, sasl_error_logger, {file, ?SASL_LOG}),
file:delete(?TEST_LOG),
file:delete(?SASL_LOG),
error_logger:tty(false),
error_logger:logfile({open, ?TEST_LOG}),
application:start(sasl).
stop_logging() ->
error_logger:logfile(close),
application:stop(sasl).
html_report([Module | Modules]) ->
cover:analyse_to_file(Module, ?FILE_NAME(Module), [html]),
html_report(Modules);
html_report([]) ->
ok.
write_report(Modules) ->
{TotalPercentage, ModulesPersentage} = percentage(Modules, 0, 0, []),
file:write_file("cover_report/index.html",
[
"<html>\n<head><title>Cover report index</title></head>\n"
"<body>\n"
"<h1>Cover report for lhttpc</h1>"
"Total coverage: ", integer_to_list(TotalPercentage), "%"
"<h2>Cover for individual modules</h2>\n"
"<ul>\n\t",
lists:foldl(fun({Module, Percentage}, Acc) ->
Name = atom_to_list(Module),
[
"<li>"
"<a href=\"", Name ++ ".html" "\">",
Name,
"</a> ", integer_to_list(Percentage), "%"
"</li>\n\t" |
Acc
]
end, [], ModulesPersentage),
"</ul></body></html>"
]).
percentage([Module | Modules], TotCovered, TotLines, Percentages) ->
{ok, Analasys} = cover:analyse(Module, coverage, line),
{Covered, Lines} = lists:foldl(fun({_, {C, _}}, {Covered, Lines}) ->
{C + Covered, Lines + 1}
end, {0, 0}, Analasys),
Percent = (Covered * 100) div Lines,
NewPercentages = [{Module, Percent} | Percentages],
percentage(Modules, Covered + TotCovered, Lines + TotLines, NewPercentages);
percentage([], Covered, Lines, Percentages) ->
{(Covered * 100) div Lines, Percentages}.
get_modules() ->
application:load(lhttpc),
{ok, Modules} = application:get_key(lhttpc, modules),
Modules.
cover_compile([Module | Modules]) ->
{ok, Module} = cover:compile_beam(Module),
cover_compile(Modules);
cover_compile([]) ->
ok.
%%% Eunit functions
application_test_() ->
{application, lhttpc}.

1
vsn.mk Normal file
View File

@ -0,0 +1 @@
VSN=0.1