[Ada] Tagged record type and Class-wide operation dispatching

This example shows how to use tagged record type and class-wide operation dispatching to achieve run-time polymorphism.

Class Hierarchy

One root class Shape, and three subclasses Point, Circle and Rectangle. Each class has coordinator (x and y) and area function. Besides, Circle has additional radius and Rectangle has extended width and length.

Source Code

Shape

• shapes.ads

package shapes is
    type Shape is tagged private;

    function Area (S : in Shape) return Float;

private
    type Shape is tagged record
            X : Float ;
            Y : Float ;
    end record;
end shapes;

• shapes.adb

package body shapes is

    function Area (S : in Shape) return Float is
    begin
        return 0.0;
    end Area;
end shapes;

Point

• points.ads

with shapes; use shapes;

package points is
    type Point is new Shape with private;

    function Area (P : in Point) return Float;
end points;

• points.adb

package body points is

    function Area (P : in Point) return Float is
    begin
        return 0.0;
    end Area;
end points;

Circle

• circles.ads

with shapes; use shapes;

package circles is
    type Circle is new Shape with private;

    function Area (C : in Circle) return Float;
private
    type Circle is new Shape with record 
            Radius : Float ;
    end record;
end circles;

• circles.adb

package body circles is

    function Area (C : in Circle) return Float is
        pi : CONSTANT Float := 3.1415926;
    begin
        return 2.0 * pi * (C.Radius * C.Radius);
    end Area;

end circles;

Rectangle

• rectangles.ads

with shapes; use shapes;

package rectangles is
    type Rectangle is new Shape with private;

    function Area (R : in Rectangle) return Float;
private
    type Rectangle is new Shape with record 
            Length : Float ;
            Width : Float ;
    end record;
end rectangles;

• rectangles.adb

package body rectangles is

    function Area (R : in Rectangle) return Float is
    begin
        return R.Length * R.Width;
    end Area;

end rectangles;

Test

• test.adb

With shapes; use shapes;
With points; use points;
With circles; use circles;
With rectangles; use rectangles;

procedure test is
    p : Point;
    c : Circle;
    r : Rectangle;

    area_of_shape : Float := 0.0;

    function getArea (S: Shape'Class) return Float is
        temp : Float;
    begin
        temp := Area(S);
        return temp;
    end problem;

begin
    area_of_shape := getArea(p);
    area_of_shape := getArea(c);
    area_of_shape := getArea(r);
end test;

​

[Perl] signal handler

1. Use %SIG hash to trap control signal

You can set the values of the %SIG hash to be the functions you want to
handle the signal. After perl catches the signal, it looks in %SIG for a
key with the same name as the signal, then calls the subroutine value for
that key. The following is signal handler for INT signal [From perldoc -q SIG]

# as an anonymous subroutine
$SIG{INT} = sub { syswrite(STDERR, "ouch\n", 5 ) };

# or a reference to a function
$SIG{INT} = \&ouch;

# or the name of the function as a string
$SIG{INT} = "ouch";

sub ouch {
    die "Caught a signal: $!";
}

We can define handlers for other signals as well.

$SIG{TERM} = sub { print STDERR, "Going to terminate."; };
$SIG{__DIE__} = sub { die "Going to die:".shift; };
$SIG{__WARN__} = sub { die "Going to die:".shift; };

The key of %SIG hash can be INT, ‘INT’, and __INT__.

signal handler also can be defined with eval, such as

eval {
       local $SIG{ALRM} = sub { die "timeout\n" };
};

​

[Linux] system(3)

system(3) is a C library function and also can be used in perl.

SYNOPSIS in Perl

system LIST
system PROGRAM LIST

Description

• system will do a fork first and then the parent will wait fro the child process, where the command is running on, to exit.

• The return code from the command is got by wait(&ret) in parent process. An example of fork can be found by $man 2 wait.

  /**
   * wait(2)
   */
  #include <sys/wait.h>
  #include <stdlib.h>
  #include <unistd.h>
  #include <stdio.h>
  
  int main(int argc, char *argv[])
  {
      pid_t cpid, w;
      int status;
  
      cpid = fork();
      if (cpid == -1) { perror("fork"); exit(EXIT_FAILURE); }
  
      if (cpid == 0) {
          /* Code executed by child */
          printf("Child PID is %ld\n", (long) getpid());
          if (argc == 1)
              pause();                    /* Wait for signals */
          _exit(atoi(argv[1]));           /* exit code from child process */
      } else {
          /* Code executed by parent */
          do {    
              /* get exit code of child process in status */
              w = waitpid(cpid, &status, WUNTRACED | WCONTINUED); 
              if (w == -1) { perror("waitpid"); exit(EXIT_FAILURE); }
  
              if (WIFEXITED(status)) {
                  printf("exited, status=%d\n", WEXITSTATUS(status));
              } else if (WIFSIGNALED(status)) {
                  printf("killed by signal %d\n", WTERMSIG(status));
              } else if (WIFSTOPPED(status)) {
                  printf("stopped by signal %d\n", WSTOPSIG(status));
              } else if (WIFCONTINUED(status)) {
                  printf("continued\n");
              }
          } while (!WIFEXITED(status) && !WIFSIGNALED(status));
          exit(EXIT_SUCCESS);
      }
  }
      

• The return code of system is exactly the same as status in above example. It's a 16-bit value with high 8-bit for exit code and low 8-bit for signal id. WEXITSTATUS just extracts exit code from status and like status >> 8.

• use $man 3 system to get its reference in C and $perldoc -f system to get in perl.

• See this link for more information

  http://perldoc.perl.org/functions/system.html

[Perl] system command timeout implementation

An example

This example is from perldoc

• Reference: $perldoc -f alarm

# eval returns the value of last expression evaluated
# if no timeout, return value will be 'alarm 0;', which return 0
# otherwise, the last statement executed is 'sub { die "alarm\n" };'
# since die within eval will stuff error message into $@, the $@ will contain "alarm"

eval {
    local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
    # after $timeout seconds, it will issue SIGALRM signal to 
    # this process unless it is cancelled by a new alarm (like 
    # 'alarm 0;' below)
    alarm $timeout;
    $nread = sysread SOCKET, $buffer, $size;
    alarm 0;
};

# if $@ is 0, no timeout happen, otherwise, $@ contains error message "alarm"
if ($@) {
    # propagate unexpected errors (if it is not timeout, die)
    die unless $@ eq "alarm\n";   
    # timed out
}
else {
    # didn’t
}

[IDE] Source Code Syntax Highlight in Blogger

How to enable the source code syntax hightlighter for google blogger

SyntaxHighlighter

• Go to Blogger's template
• Click "Backup/Restore" in the upright of page to backup current template at first
• Then "Edit Template"
• Add the following lines just before the </head> line

Examples

js

<pre class="brush: js"> int function(int i) { return i; } </pre> <br />

int function(int i)
{
    return i;
}

C/C++

<pre class="brush: c"> int function(int i) { return i; } </pre> <br />

int function(int i)
{
    return i;
}