Application Development Blog Posts
Learn and share on deeper, cross technology development topics such as integration and connectivity, automation, cloud extensibility, developing at scale, and security.
cancel
Showing results for 
Search instead for 
Did you mean: 
hardyp180
Active Contributor

Change Number Two

Now we come to the so called “boundary condition”. In this case, we don’t want to accept any money if the machine is out of gumballs. More precisely whilst in the “no quarter” state normally the event of a coin being entered would cause a “transition” to the “has quarter” state. We want to introduce a check at that point, and abort the change of state. Naturally we would want to trigger the “eject” event in this case to give the user back their money.

Time for the OO version first. One of the core OO rules is “program to an interface, not an implementation” so let us create an interface. Over time I have moved from wondering what on Earth the purpose of an interface was to thinking that every single class I create should be based on an interface. It’s taken a lot of experimentation and examples to make me get my head round this. These boundary condition checks are likely to be very different from application to application, so you define an interface for the tiny bits which are always going to be the same.

I’ll leave that for the minute just want to re-iterate what it is I am trying to achieve. In a big system I could have assorted programs based on the state machine framework and they all have different boundary conditions.

A Place for Everything, Everything in its Place

The point of OO programming is to separate the things that change from the things that stay the same. The thing that stays the same is that in different programs some nebulous rule could stop an event-based state change. The thing that changes is what that nebulous rule is. That is why I just declared the abstract “concept” of a boundary condition in an interface, as interfaces don’t have any code.

The other side of the coin is to specify the exact rule in any given system. So that would have to live in the class describing the system I presume. So, in the case at hand, I will give the gumball machine class an instance variable to say how many gumballs it has in stock, and set that during the initial configuration of the system. I could put that in the constructor, but the domain specific language concept makes me want to put all the rules in the same place.

CREATE OBJECT out_of_gumballs
     
EXPORTING
        gumball_machine
= me
        trigger_event  
= quarter_was_inserted
        error_message  
= 'Machine is out of Gumballs'
        new_state      
= no_quarter_state.

CREATE OBJECT system_resetter
     
EXPORTING
        io_start_state
= no_quarter_state.

    system_resetter
->add_reset_event( machine_was_refilled->md_code ).
   
    me
->current_gumball_stock = 30.

As far as I can see the wonderful thing about subclasses is that they can have different constructors and take in all sorts of different extra variables. Why is that good? It helps in areas like the one I am now exploring. In this case I define a local class which is not even a subclass, it is a class that implements an interface. As I may have mentioned earlier the funny thing about learning OO is that the SAP training pushes you to create subclasses, and all the academic books say subclasses are the work of the Devil, instead use interfaces. Anyway, now to define and implement the local boundary condition class.

CLASS lcl_boundary_condition DEFINITION.
 
PUBLIC SECTION.
   
INTERFACES zif_sm_boundary_condition.

   
ALIASES: boundary_condition_fulfilled FOR zif_sm_boundary_condition-boundary_condition_fulfilled.
   
   
METHODS: constructor IMPORTING trigger_event TYPE REF TO zcl_sm_event_in
                                   error_message
TYPE string
                                   new_state    
TYPE REF TO zcl_sm_state,
             set_gumball_stock
IMPORTING id_current_stock TYPE sy-tabix.
   
 
PRIVATE SECTION.
   
DATA: current_gumball_stock TYPE sy-tabix.
ENDCLASS.

I intend to add this class as a member variable of the state class, in the same way I did for the illegal combination class. The reason this is a local class is I need to pass in the system at hand as an input variable. I have no idea if I am doing this the correct way, I am just playing, and then HOPEFULLY someone more intelligent than me will suggest a better way.

CLASS lcl_boundary_condition IMPLEMENTATION.

 
METHOD constructor.
*--------------------------------------------------------------------*
* IMPORTING trigger_event   TYPE REF TO zcl_sm_event_in
*           error_message   TYPE string
*           new_state       TYPE REF TO zcl_sm_state
*           gumball_machine TYPE REF TO lcl_gumball_machine
*--------------------------------------------------------------------*
    mo_trigger_event  
= trigger_event.
    md_error_message  
= error_message.
    mo_new_state      
= new_state.
    mo_gumball_machine
= gumball_machine.

 
ENDMETHOD."Constructor

 
METHOD boundary_condition_fulfilled.

   
IF mo_gumball_machine->current_gumball_stock > 0.
      rf_yes_it_is
= abap_true.
   
ELSE.
      rf_yes_it_is
= abap_false.
   
ENDIF.

 
ENDMETHOD.

ENDCLASS."Local Boundary Condition

At the end of this blog I want to talk about so called “functional programming” where you pass In these sort of rules as parameters to a function, but I am getting ahead of myself. The concepts seem to gel to me but that is a diversion, and of course I would never, ever, ever, go off topic in the middle of a blog.

We add an extra instruction to the “configuration” part of the program to add in the extra behaviour we want.

* No Quarter State
    no_quarter_state
->state_changes_after( event           = machine_was_refilled
                                           to_target_state
= no_quarter_state ).
    no_quarter_state
->state_changes_after( event           = quarter_was_inserted
                                           to_target_state
= has_quarter_state ).
    no_quarter_state
->needs_check_after( event         = quarter_was_inserted
                                         for_condition
= out_of_gumballs ).
    no_quarter_state->responds_to( event      = crank_was_turned
                                   with_error
= 'Please enter money before turning crank' ).

I am happy bunny at how much like natural English this reads.

METHOD needs_check_after.
* Local Variables
 
DATA: ls_conditions LIKE LINE OF mt_conditions.

  ls_conditions
-event_code = event->md_code.
  ls_conditions
-condition  = for_condition.

 
APPEND ls_conditions TO me->mt_conditions.

ENDMETHOD.

Debugsy Malone

To show how this is going to work, I will write a unit test, then we will step through it as if we were in the debugger to see what is going on.

METHOD not_sell_when_empty.

* GIVEN....
    mo_class_under_test
->current_gumball_stock = 0.

* WHEN user tries to enter some money.....
   
TRY.
        when_quarter_is_inserted
( ).

     
CATCH zcx_sm_illegal_combination.
        cl_abap_unit_assert
=>assert_equals( act = mo_controller->mo_current_state
                                           
exp = mo_class_under_test->no_quarter_state
                                            msg
= 'Machine in incorrect state' ).
       
RETURN.
   
ENDTRY.

    cl_abap_unit_assert
=>fail( msg = 'Gumball Machine accepted money when machine was empty' ).

 
ENDMETHOD.

This is very similar to the last unit test – the same exception should be thrown, the difference is that this combination of state and event is only illegal in certain circumstances.

  METHOD when_quarter_is_inserted.
    mo_controller
->handle_inbound_event( mo_class_under_test->quarter_was_inserted->md_code ).
 
ENDMETHOD.

No change, so far, though the method to handle the inbound event needs some surgery to enable it to cope with boundary conditions.

METHOD handle_inbound_event.
* Local Variables
 
DATA: lo_failed_condition    TYPE REF TO zif_sm_boundary_condition,
        lo_illegal_combination
TYPE REF TO zcl_sm_illegal_combinations.

* Preconditions
 
CHECK id_event_code IS NOT INITIAL.

* Make sure we actually have a current state...
 
IF mo_current_state IS INITIAL.
    transisition_to
( mo_system_resetter->mo_start_state ).
 
ELSEIF mo_system_resetter->is_reset_event( id_event_code ) = abap_true.
    transisition_to
( mo_system_resetter->mo_start_state ).
 
ENDIF.

* Now respond to the combination of the external event and the current state...
  lo_failed_condition
= mo_current_state->causes_check_after_event( id_event_code ).

 
IF mo_current_state->does_not_allow_event( id_event_code ) = abap_true.
   
"This combination causes an error every time
   
RAISE EXCEPTION TYPE zcx_sm_illegal_combination
     
EXPORTING
        io_illegal_combination
= mo_current_state->illegal_combination( id_event_code ).
 
ELSEIF lo_failed_condition IS BOUND.
    transisition_to
( lo_failed_condition->mo_new_state ).
   
CREATE OBJECT lo_illegal_combination
     
EXPORTING
        io_source_state 
= mo_current_state
        io_trigger_event
= lo_failed_condition->mo_trigger_event
        id_error_message
= lo_failed_condition->md_error_message.
   
"This combination causes an error only if the boundary condition has failed
   
RAISE EXCEPTION TYPE zcx_sm_illegal_combination
     
EXPORTING
        io_illegal_combination
= lo_illegal_combination.
 
ELSEIF mo_current_state->changes_state_after_event( id_event_code ) = abap_true.
    transisition_to
( mo_current_state->target_state_after_event( id_event_code ) ).
 
ENDIF.

ENDMETHOD.

METHOD causes_check_after_event.
* Local Variables
 
DATA: ls_conditions LIKE LINE OF mt_conditions.

 
READ TABLE mt_conditions INTO ls_conditions WITH KEY event_code = id_event_code.

 
CHECK sy-subrc = 0.

 
CHECK ls_conditions-condition->mo_trigger_event->md_code = id_event_code.

 
IF ls_conditions-condition->boundary_condition_fulfilled( ) = abap_true.
   
RETURN.
 
ENDIF.

  ro_failed_condition
= ls_conditions-condition.

ENDMETHOD.

Hopefully you can follow the above; I have tried to make the code read as much like natural language as possible. It has been said that the acid test is when you don’t need comments at all because it is so obvious what is going on.

So, the unit test passes, all is well. There are probably about twenty different ways to do this, I just picked the first one that came to me, I am not 100% happy with it, but it works and that’s what is important. If anyone wants to suggest a better way - please do so.

I did not need to add much extra code, but it did take a lot of thinking about. If I wanted to add another boundary condition I would have to do the following:-

-       Add another class to contain the logic of the boundary condition

-       In the configuration section create that object

-       In the configuration section add a line to the configuration of the state being changed

Procedural at your own risk

Now is the time to make the same change to the procedural version of the program. I don’t have to agonise over what goes in what class because in procedural programming you only have one hammer – the internal table – so everything is a nail.

TYPES: BEGIN OF g_typ_boundary_conditions,
         condition_name   
TYPE string,
         source_state     
TYPE string,
         event_name       
TYPE string,
         error_message    
TYPE string,
         new_state        
TYPE string,
      
END OF g_typ_boundary_conditions.

gt_b_conditions   TYPE STANDARD TABLE OF g_typ_boundary_conditions,
gs_b_conditions  
TYPE                   g_typ_boundary_conditions,

gd_gumball_stock  TYPE i      VALUE 30,

DEFINE state_needs_check_after_event.
 
clear gs_b_conditions.
  gs_b_conditions
-source_state   = &1.
  gs_b_conditions
-event_name     = &2.
  gs_b_conditions
-condition_name = &3.
  gs_b_conditions
-error_message  = &4.
  gs_b_conditions
-new_state      = &5.
 
append gs_b_conditions to gt_b_conditions.
END-OF-DEFINITION.

* Behaviour
* No Quarter State
  state_changes_after_event
:     'no_quarter' 'quarter_was_inserted' 'has_quarter'.
  state_needs_check_after_event
: 'no_quarter' 'quarter_was_inserted'
                                
'are_we_out_of_gumballs'
                                
'The machine has run out of Gumballs'
                                
'no_quarter'.
  state_errors_after_event
:      'no_quarter' 'crank_was_turned'
                                
'Please enter money before turning crank'.

This is the half way through stage and it is already obvious I need less code to achieve the same thing. The question has to be is this just because I don’t yet know enough about OO to do the OO change in a more efficient way?

The unit test is going to look very similar to the OO version, not surprisingly.

  METHOD not_sell_when_empty."     FOR TESTING.

* GIVEN....
    gd_gumball_stock
= 0.

* WHEN user tries to enter some money.....
   
PERFORM when_quarter_is_inserted.

* THEN_the system state does not change....
    cl_abap_unit_assert
=>assert_equals( act = gd_subrc
                                       
exp = 4
                                        msg
= 'Gumball Machine accepted money when machine was empty' ).

    cl_abap_unit_assert
=>assert_equals( act = gd_current_state
                                       
exp = 'no_quarter'
                                        msg
= 'Machine in incorrect state' ).

 
ENDMETHOD."Not Sell When Empty

Once again, let’s step through this to see what is going on.

FORM when_quarter_is_inserted .
 
READ TABLE gt_events INTO gs_events WITH KEY event_name = 'quarter_was_inserted'.
 
PERFORM handle_event USING gs_events-event_code.
ENDFORM.                    " when_quarter_is_inserted

Look at that – the system added the name of the FORM routine at the end of the routine without me having to type it myself. The day that SAP gets serious about OO programming I imagine they will introduce the same thing to local classes. However it has been fourteen years now, so I am not holding my breath.

FORM handle_event USING pud_event_code TYPE char04.
* Preconditions
 
CHECK pud_event_code IS NOT INITIAL.

 
READ TABLE gt_events INTO gs_events WITH KEY event_code = pud_event_code.

 
CHECK sy-subrc = 0.

 
PERFORM check_for_errors USING    gs_events-event_name
                                    gd_current_state
                          
CHANGING gd_subrc."Oh look, a return code!

 
CHECK gd_subrc = 0.

 
PERFORM check_for_conditions USING    gs_events-event_name
                              
CHANGING gd_current_state
                                        gd_subrc
.

 
CHECK gd_subrc = 0.

 
PERFORM transition USING    gs_events-event_name
                    
CHANGING gd_current_state.

ENDFORM.                    " HANDLE_EVENT

FORM check_for_conditions  USING    pud_event_name    TYPE string
                          
CHANGING pcd_current_state TYPE string
                                    pcd_subrc        
TYPE sy-subrc.

  pcd_subrc
= 0.

 
READ TABLE gt_b_conditions INTO gs_b_conditions
 
WITH KEY source_state = pcd_current_state
           event_name  
= pud_event_name.

 
CHECK sy-subrc = 0.

* Now we need to do the boundary condition check
 
CASE gs_b_conditions-condition_name.
   
WHEN 'are_we_out_of_gumballs'.
     
IF gd_gumball_stock LT 1.
        pcd_subrc
= 4.
     
ELSE.
        pcd_subrc
= 0.
       
RETURN.
     
ENDIF.
   
WHEN OTHERS.
      pcd_subrc
= 0.
     
RETURN.
 
ENDCASE.

 
IF pcd_subrc = 4.

    pcd_current_state
= gs_b_conditions-new_state.

   
PERFORM send_error_to_ext_system USING gs_b_conditions-error_message.

 
ENDIF.

ENDFORM.                    " CHECK_FOR_CONDITIONS

An object orientated person would start squawking that this is a clear breach of the “open closed” principle, since every time I add a new boundary condition I would have to change the above routine by adding some extra logic in a new branch of the CASE statement. A “case” statement is called a “switch” statement in Java, by the way, and I think SAP are introducing this into ABAP as well in version 7.4. They like Java. They think its tops. It’s rather like the Orangutan in “The Jungle Book” who wants to walk like you, talk like you etc.

I'm the king of the swingers, the Jungle ERP etc

You see it’s true-ooh-ooh,

An ABAP like me,

Can learn to be just like Java too (take me home daddy!)

I’m Judge Project Manager and you creeps are Under Budget and On Time

So what’s my verdict? That took a lot less thinking about than the OO equivalent, and a lot less time. The procedural program throws all the rules in books like “Clean Code” right into the dustbin. It has global variables all over the place, breaks the “open closed” principle etc etc.

I’m not much for rules, as assorted German managers would attest to, but they are there for a reason and when I am reading books like “Clean Code” all those rules make perfect sense. The question is – can they survive in the real world?

Anyway the aim of the game was to test the theory that OO programs give you the advantage that they are far easier to change than procedural ones. My experiment seems to prove the exact opposite. To be honest that is not what I was expecting. This is like the Michael Moorcock novel “Behold the Man” when he travels back in time to observe the events in the middle east around the time of Jesus because he wants the events described in the New Testament to be true.

This could be because the example programs are so simple and in real life we sometimes write mega-applications. In a blog it is very difficult to show two versions of a million line program. However as Jelena points out whilst I might be writing these gigantic complex programs a lot of ABAP programmers are writing GL upload programs or ALV reports to dump out the contents of BSEG.

So, I throw the question to the world – was this a sensible example? I stress this was not an example I made up, I got both the “gothic” and the “gumball” examples from famous articles/books. If I was making up the example then I could skew the result right from the start.

I’m still not going back to procedural programming though, I have become addicted to OO even if it is more difficult, it just seems right to me somehow, and a thing of beauty. I had hoped to back up this gut feeling with some empirical evidence as opposed to “everyone says this is good”. Alas alack, this seems to be beyond me. Am I forever doomed to be one of the many who sticks to an opinion regardless of any evidence presented to me that disagrees with my point of view? Even when I am the one who produced the evidence? Does that make me a madman? The giant rabbit in the corner of the room which only I can see thinks so.

And now for something completely different

This is going to seem like going down the world’s biggest rabbit hole – i.e. totally off topic – but something I read the other day seemed to have a lot of relevance to both the “domain specific language” concept and the example I was programming where you have a boundary condition where the exact logic is going to be different each time but you want to have a common framework.

On the SCN was this blog:-

http://scn.sap.com/community/abap/blog/2014/02/18/javascript-for-abap-developers

That was talking about how ABAP is an “imperative” language and Javascript being a “functional” language. Oh Grandma! What big words you use! “All the better to talk nonsense at you” said the Big Bad Wolf.

Functional languages are supposed to revolve around saying “how” you solve a problem as opposed to “what” you do to solve. That sounds like a trivial difference, but it ties in with the whole “domain specific language” concept of separating the behaviour from the mechanics of a program.

I found the example almost impossible to get my head round – once again this was something I felt in my gut was important but could not understand it – so I wrote a program in ABAP to try and simulate the Javascript example. Here it is!

This is all about a FIBONACCI sequence which is all about adding numbers to each other - another obscure example with no relevance to anything in the business world, just like all its friends.

REPORT  y_functional_test.

DATA: gd_result TYPE i.

*----------------------------------------------------------------------*
*       CLASS lcl_functional_programming DEFINITION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
CLASS lcl_functional_programming DEFINITION.
 
PUBLIC SECTION.
   
METHODS: do_fib IMPORTING number_to_add  TYPE i
                              result_so_far 
TYPE i
                              loops_left    
TYPE i
                    RETURNING
value(resultTYPE i,
             functional
IMPORTING loops_left    TYPE i
                        RETURNING
value(result) TYPE i.

ENDCLASS.                    "lcl_functional_programming DEFINITION

DATA: go_lcl_functional_programming TYPE REF TO lcl_functional_programming.

START-OF-SELECTION.
*--------------------------------------------------------------------*
* Imperative Programing
*--------------------------------------------------------------------*
 
PERFORM imperative USING    8
                    
CHANGING gd_result.

 
WRITE:/ gd_result.

*--------------------------------------------------------------------*
* Functional Programming
*--------------------------------------------------------------------*
 
CREATE OBJECT go_lcl_functional_programming.

  gd_result
= go_lcl_functional_programming->functional( 8 ).

 
WRITE:/ gd_result.

*&---------------------------------------------------------------------*
*&      Form  IMPERATIVE
*&---------------------------------------------------------------------*
FORM imperative  USING    pud_loops  TYPE i
                
CHANGING pcd_result TYPE i.

 
PERFORM imperative_fibonacci USING     0
                                        
1
                                        
8
                              
CHANGING  gd_result.

ENDFORM.                    " IMPERATIVE
*&---------------------------------------------------------------------*
*&      Form  imperative_fibonacci
*&---------------------------------------------------------------------*
FORM imperative_fibonacci  USING    pud_first_number    TYPE i
                                    pud_second_number  
TYPE i
                                    pud_number_of_loops
TYPE i
                          
CHANGING pcd_result          TYPE i.
* Local Variables
 
DATA: ld_number_to_add TYPE i,
        ld_result_so_far
TYPE i,
        ld_loops_left   
TYPE i.

 
CLEAR pcd_result.

  ld_number_to_add
= pud_first_number.
  ld_result_so_far
= pud_second_number.
  ld_loops_left   
= pud_number_of_loops.

 
WHILE ld_loops_left GT 1.

    pcd_result
= ld_number_to_add + ld_result_so_far.

    ld_number_to_add
= ld_result_so_far.

    ld_result_so_far
= pcd_result.

   
SUBTRACT 1 FROM ld_loops_left.

 
ENDWHILE.

ENDFORM.                    " imperative_fibonacci
*----------------------------------------------------------------------*
*       CLASS lcl_functional_programming IMPLEMENTATION
*----------------------------------------------------------------------*
*
*----------------------------------------------------------------------*
CLASS lcl_functional_programming IMPLEMENTATION.

 
METHOD do_fib.

   
IF loops_left = 1.
      result
= result_so_far.
     
RETURN.
   
ENDIF.

    result
= me->do_fib( number_to_add = result_so_far
                         result_so_far
= ( number_to_add + result_so_far )
                         loops_left   
= ( loops_left - 1 ) ).

 
ENDMETHOD.                                               "do_fib

 
METHOD functional.

    result
= do_fib( number_to_add = 0
                     result_so_far
= 1
                     loops_left   
= loops_left ).

 
ENDMETHOD.                                               "functional

ENDCLASS.                    "lcl_functional_programming IMPLEMENTATION

So what does this tell us? Firstly that you can pass in formulas as arguments using OO programming and you cannot do the same with FORM routines. However that is just a decision SAP made to try and push you into using OO programming. I am sure if they really wanted they could change the compiler to accept formulas as parameters in FORM routines, or optional entries come to that.

My understanding from the article was that “functional” programmers don’t like loops and WHILE blocks and prefer recursion. OK, but what I found strange was the blanket assertion that IF statements are bad because it somehow distracts someone reading the program.

Somehow this

var now = new Date();

var greeting = "Good" + ((now.getHours() > 17) ? " evening." : " day.");

is supposed to read more like proper English than

var now = new Date();
var greeting = "Good";
if (now.getHours() > 17)
   greeting += " evening.";
else
   greeting += " day.";

Things seem to go round in a circle. We moved from machine code to languages which read like English and then back to commands like “?”. Whenever I see code examples on the internet which read like “ X ?? Y > **Q => Z” I wonder if the programmers are trying to safeguard their jobs by making things appear more complicated than they really are.

Anyway, has anyone ever tried to pass a conditional expression into a method using ABAP? I have a vague me

mory there is a standard class for such a thing. If you could then maybe I could simplify my “boundary condition” class that I created earlier in the blog.

And now, the end is near, and so I face, the final curtain

This is going to be the last blog I write for a year I imagine, as from now on I will have to devote all my spare time to writing that book for SAP Press. I hope what I have written above contributes to the ongoing “procedural vs OO” debate. Some people have even said this debate is a complete waste of time because the “future” is coming towards us at one hundred miles an hour and that will all be in languages like Javascript and “River” and what have you. Well, we shall see, but I am not 100% convinced that gigantic corporations are going to throw out all the years of custom ABAP development they have paid so much money for overnight….

This is the bush turkey that walks past our office in Brisbane each morning…

Cheersy Cheers

Paul

9 Comments