How can I check if a function param is undefined?
procedure Test(aValue: TObject);
begin
if aValue <> nil then
ShowMessage('param filled') <-- also when Test() is executed!
else
ShowMessage('no param filled') <-- not called, only when Test(nil) is called
end;
However when this function is called in pure JS without a param,
then aValue = undefined, but the <> nil check is converted to == null!
For example, when you have a JS function with a callback:
type
TObjectProcedure = procedure(aValue: TObject);
procedure FetchUrlAsync(aUrl: string; aCallback: TObjectProcedure )
begin
asm
$().load(#aUrl, #aCallback);
end;
end;
You can call this function with:
FetchUrlAsync('ajax/test.html', Test);
It is now depended on jQuery if "Test" is called with a param or not.
In the next version, you'll be able to use Defined() special function, it will make a strict check against undefined (it will return true for a null value).
if Defined(aValue) then
...
In the current version you can define a function to check that
function IsDefined(aValue : TObject);
begin
asm
#result = (#aValue!==undefined);
end;
end;
In the current version (1.0) you can use the function varIsValidRef() to check if a value is undefined. The function is a part of w3system.pas so it's always there. It looks like this:
function varIsValidRef(const aRef:Variant):Boolean;
begin
asm
if (#aRef == null) return false;
if (#aRef == undefined) return false;
return true;
end;
end;
This checks for both null and undefined so you can use it against object references (type THandle is variant) as well.
Related
I hope that you can advise me. I'm trying to use ADA 95's Object Oriented Features for the first time, and I want two derived classes, cyclicgroup and polyggroup, to call the put() method belonging to their base class,
abstractGroup. But instead of tracing up the class hierarchy as I expected, the compiler just tells me that I have a type mismatch in the call to put(). How do I tell the compiler to recognize the connection between the objects?
Here are the 5 files, with all the extraneous stuff removed, and the attempted compile:
grpdriver2.adb:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
with groupstuff2;
with subgrphandler2;
procedure grpdriver2 is
cycg: groupStuff2.cyclicgroup;
polyg: groupStuff2.polygonGroup;
begin
cycg := groupstuff2.createCyclicGroup( 10);
subgrphandler2.put(cycg); -- line 13
------------------------------------------------------------------------------------------------------------------
polyg := groupstuff2.createPolygonGroup( 10);
subgrphandler2.put(polyg); -- line 18
end grpdriver2;
.................................................................................................................
groupstuff2.ads:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
package groupstuff2 is
type abstractGroup is tagged record
x: integer;
end record;
type cyclicGroup is new abstractGroup with record
y: integer;
end record;
function createCyclicGroup( size: in integer) return cyclicGroup ;
----------------------------------------
type polygonGroup is new abstractGroup with record
null;
end record;
function createPolygonGroup( size: in integer) return polygonGroup ;
end groupstuff2;
.......................................................................................
groupstuff2.adb:
package body groupstuff2 is
procedure put( g: in abstractGroup) is
x: integer;
begin
x := 1;
end put;
function createCyclicGroup( size: in integer) return cyclicGroup is
cycg: cyclicGroup;
begin
cycg.x := size;
return cycg;
end createCyclicGroup;
function createPolygonGroup( size: in integer) return polygonGroup is
polyg: polygonGroup;
begin
polyg.x := size;
return polyg;
end createPolygonGroup;
end groupstuff2;
..............................................................................
subgrphandler2.ads:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
with groupstuff2;
package subgrphandler2 is
procedure put( g: in groupStuff2.abstractGroup);
end subgrphandler2;
...........................................................................................
subgrphandler2.adb:
package body subgrphandler2 is
procedure put( g: in groupStuff2.AbstractGroup) is
begin
put("THIS IS A PUT STATMENT");
end put;
end subgrphandler2;
COMPILE ATTEMPT:
C:\GNAT\2018\bin\ceblang>gnatmake grpdriver2
gcc -c grpdriver2.adb
grpdriver2.adb:13:36: expected type "abstractGroup" defined at groupstuff2.ads:7
grpdriver2.adb:13:36: found type "cyclicGroup" defined at groupstuff2.ads:16
grpdriver2.adb:18:36: expected type "abstractGroup" defined at groupstuff2.ads:7
grpdriver2.adb:18:36: found type "polygonGroup" defined at groupstuff2.ads:25
gnatmake: "grpdriver2.adb" compilation error
I cannot compile Ada95 code as I'm using GNAT CE 2018 (which only supports Ada 2012), but it seems that you need to add the Class attribute to the type of the argument of put in subgrphandler2 to make it accept a class wide type (i.e. groupStuff2.AbstractGroup, and all of its extensions (inherited types)).
You also might want to make groupStuff2.AbstractGroup actually abstract by adding the abstract keyword to its definition (see below).
This (reformatted code) compiles on GNAT CE 2018 in Ada 2012 mode:
group_driver_2.adb
with Group_Stuff_2;
with Sub_Group_Handler_2;
procedure Group_Driver_2 is
Cycg : Group_Stuff_2.Cyclic_Group;
Polyg : Group_Stuff_2.Polygon_Group;
begin
Cycg := Group_Stuff_2.Create_Cyclic_Group (10);
Sub_Group_Handler_2.Put (Cycg);
Polyg := Group_Stuff_2.Create_Polygon_Group (10);
Sub_Group_Handler_2.Put (Polyg);
end Group_Driver_2;
group_stuff_2.ads
package Group_Stuff_2 is
type Abstract_Group is abstract tagged
record
X: Integer;
end record;
-- Cyclic_Group
type Cyclic_Group is new Abstract_Group with
record
Y: Integer;
end record;
function Create_Cyclic_Group
(Size: in Integer) return Cyclic_Group;
-- Polygon_Group
type Polygon_Group is new Abstract_Group with null record;
function Create_Polygon_Group
(Size: in Integer) return Polygon_Group ;
end Group_Stuff_2;
group_stuff_2.adb
package body Group_Stuff_2 is
-------------------------
-- Create_Cyclic_Group --
-------------------------
function Create_Cyclic_Group
(Size : in Integer) return Cyclic_Group
is
Cycg : Cyclic_Group;
begin
Cycg.X := Size;
return Cycg;
end Create_Cyclic_Group;
--------------------------
-- Create_Polygon_Group --
--------------------------
function Create_Polygon_Group
(Size : in Integer) return Polygon_Group
is
Polyg: Polygon_Group;
begin
Polyg.X := Size;
return Polyg;
end Create_Polygon_Group;
end Group_Stuff_2;
sub_group_handler_2.ads
with Group_Stuff_2;
package Sub_Group_Handler_2 is
procedure Put (G : in Group_Stuff_2.Abstract_Group'Class);
end Sub_Group_Handler_2;
sub_group_handler_2.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Sub_Group_Handler_2 is
procedure Put (G: in Group_Stuff_2.Abstract_Group'Class) is
begin
Put_Line ("Value of X is" & Integer'Image (G.X));
end Put;
end Sub_Group_Handler_2;
i'm trying to CALL a very simple PLSQL function and i can't guess what i'm doing wrong:
CREATE OR REPLACE PACKAGE BODY KYC_OWN.KYCK_TEMP IS
FUNCTION PrintHelloWorld RETURN VARCHAR2 IS
BEGIN
RETURN 'Hello World';
END printHelloWorld;
END KYCK_TEMP;
Then i call the function like this:
call KYC_OWN.KYCK_TEMP.PrintHelloWorld() INTO :x;
I guess i need to declare the x variable somewhere, but how?
Thanks in advance
You can try this:
CREATE OR REPLACE PACKAGE BODY KYC_OWN.KYCK_TEMP IS
FUNCTION PrintHelloWorld RETURN VARCHAR2 IS
BEGIN
RETURN ('Hello World');
END printHelloWorld;
END KYCK_TEMP;
or create a variable like below and return g_helloworld
create or replace package constants as
g_helloworld constant varchar2(11) := 'Hello World';
function get_helloworld return varchar2;
end constants;
/
create or replace package body constants as
function get_helloworld return varchar2
is
begin
return g_helloworld;
end get_helloworld;
end constants;
/
If you're in SQL*Plus, you could create a variable and then use that to hold the function return variable, e.g.:
VARIABLE x varchar2(30)
call KYC_OWN.KYCK_TEMP.PrintHelloWorld() INTO :x;
print x
or you could simply use an anonymous block, along with dbms_output to display the number:
set serveroutput on -- assuming you're in SQL*Plus
declare
v_val varchar2(30);
begin
v_val := KYC_OWN.KYCK_TEMP.PrintHelloWorld;
dbms_output.put_line('return val = '||v_val);
end;
I'm trying to use generics to 'genericize' a var that instantiates network transports of different types. I'm not sure if the "generic=no RTTI" rule would invalidate the approach or not, as I'm not yet up to speed with generics.
I've read this post:
What is the correct way to structure this generic object creation , which states the following in the question:
One other thing I would like to do if possible, is to change two
creations:
LAdapter := TSQLiteNativeConnectionAdapter.Create(LFilename)
LAdapter := TFireDacConnectionAdapter.Create(FDatabaseLink.FConnection as TFDConnection, FDatabaseLink.OwnedComponent)
to use an abstract "GetAdapterClass" type function in the parent
TModelDatabaseConnection and just declare the class of adapter in the
child to do something like:
LAdapter := GetAdapterClass.Create...
This is exactly what I would like to do as well. So if you can picture this:
type
TTransport<T> = class(TComponent)
private
...
function GetTransport: TTransport;
procedure SetTransport(AValue: TTransport);
...
public
...
property Transport: TTransport read GetTransport write SetTransport;
...
end;
TTCPIPTransport = class(TTransport<T>)
private
function GetSocket(Index: Integer): String;
procedure SetSocket(Index: Integer; AValue: String);
public
property Socket[Index: Integer]: String read GetSocket write SetSocket;
end;
TServiceTransport = class(TTransport<T>)
private
function GetServiceName: String;
procedure SetServiceName(AValue: String);
public
property ServiceName: String read GetServiceName write SetServiceName;
end;
TISAPITransport = class(TServiceTransport<T>);
THTTPSysTransport = class(TServiceTransport<T>)
private
function GetURL(Index: Integer): String;
procedure SetURL(Index: Integer; AValue: String);
public
property URL[Index: Integer]: read GetURL write SetURL;
end;
etc.
The idea is to create a base class that has all fields/properties/methods that are common to all transports, then have intermediate classes that contain fields/methods/properties that are common only to a certain subset of transports, then have the final version of each transport be specific to the type.
So when I call:
var
trans: TTransport<T> // or TTransport<TTCPIPTransport> etc.
begin
trans := TTransport<TTCPIPTransport>.Create(AOwner,....);
trans.Transport.Socket[0] := '127.0.0.1:8523';
OR
trans := TTransport<TISAPITransport>.Create(AOwner,...);
trans.Transport.ServiceName = 'Foo';
...
etc.
end;
or perhaps even more generic then that, but have each instance of trans - without typecasting - have properties/fields/methods that are specific to the subclass automagically show up.
This way I can have a config screen that allows an administrator to select the type of transport say in a combo box, the have that variable value set the type inside the <> in code, and one set of code handles creation of the object by it's type.
Is this possible using generics?
Here is my first (feeble) attempt at a class factory, never done this before. It works partially (generates the correct class) but isn't accessible as a distinct subclass of the base class without typecasting, which defeats the purpose. Please see inline comments
TWSTransport = class(TComponent)
...
public
constructor Create(AOwner: TComponent); virtual;
....
end;
TWSTransportClass = Class of TWSTransport;
TWSTCPIPTransportClass = class of TWSTCPIPTransport;
TWSHTTPSysTransport = class(TWSServiceTransport);
TWSServiceTransport = class(TWSTransport);
TWSTransportStringConversion = class(TWSTransport);
TWSTransportStreamFormat = class(TWSTransportStringConversion);
TTransportFactory = class(TClassList)
private
function GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
public
procedure RegisterTransportClass(ATransportClass: TWSTransportClass);
property Transport[Index: TWSTransportClass; AOwner: TkbmMWServer]: TWSTransportClass read GetTransport;
end;
function TTransportFactory.GetTransport(Index: TWSTransportClass; AOwner: TkbmMWServer): TWSTransportClass;
begin
if IndexOf(Index) > -1 then
Result := TWSTransportClass(Items[IndexOf(Index)])
else
Result := TWSTransportClass(Index.Create(AOwner));
end;
procedure TTransportFactory.RegisterTransportClass(ATransportClass: TWSTransportClass);
var
index: Integer;
begin
// is the transport registered?
index := IndexOf(ATransportClass);
if index < 0 then
// the transport is not registered, add it to the list
Add(ATransportClass);
end;
initialization
factory := TTransportFactory.Create;
factory.RegisterTransportClass(TWSHTTPSysTransport);
factory.RegisterTransportClass(TWSISAPIRESTTransport);
factory.RegisterTransportClass(TWSTCPIPTransport);
finalization
FreeAndNil(factory);
end.
Here's how I tested it:
procedure TForm4.FormCreate(Sender: TObject);
var
//trans: TWSTCPIPTransport; // this doesn't work
trans: TWSTransport; // this works
begin
trans := factory.Transport[TWSTCPIPTransport,Self];
showmessage(trans.classname); // this shows the correct classname - TWSTCPIPTransport
trans.AddSocket('127.0.0.1:80'); // the compiler gives an error here because this call is specific to a subclass of TWSTransport, TWSTCPIPTransport.
end;
So I'm still missing something... anyone see the mistake?
I need a SQL/Oracle function that compares two numbers
if number are even like( 22,10,4,12,6..) true
if are odd number like(3,7,13,5...) false.
CREATE OR REPLACE FUNCTION is_even(num_in NUMBER) RETURN BOOLEAN IS
BEGIN
IF MOD(num_in, 2) = 0 THEN
RETURN TRUE;
END IF;
EXCEPTION
WHEN OTHERS THEN
RETURN FALSE;
END is_even;
/
CREATE OR REPLACE FUNCTION is_odd(num_in NUMBER) RETURN BOOLEAN IS
BEGIN
RETURN MOD(num_in, 2) = 1;
EXCEPTION
WHEN OTHERS THEN
RETURN FALSE;
END is_odd;
One point not addressed in the other answer, which I have already mentioned in the comments and you don't seem to have paid attention to is that Boolean values can only be used in PL/SQL code, not in Oracle SQL.
This restricts you from calling your function through the most common method - to use it in a sql statement. If you try running this query with your function, it would fail.
select is_even(10) FROM DUAL;
ORA-06552: PL/SQL: Statement ignored
ORA-06553: PLS-382: expression is
of wrong type
You may call this function to set a Boolean PL/SQL variable, but it isn't very useful in a general scenario.
DECLARE
v_even_odd BOOLEAN := is_even(3);
Alternatively, you could return a number or a string ( "TRUE" / "FALSE" ).
CREATE OR REPLACE FUNCTION is_even (num_in NUMBER)
RETURN VARCHAR2
IS
BEGIN
IF MOD (num_in, 2) = 0
THEN
RETURN 'TRUE';
ELSE
RETURN 'FALSE';
END IF;
END is_even;
/
Which works fine while calling from sql.
select is_even(10) FROM DUAL;
IS_EVEN(10)
----------------
TRUE
I ready don't understand what is the difficulty here, as you yourself have provided the code for two functions above...
Anyway here you go:
CREATE OR REPLACE FUNCTION is_even(num_in NUMBER) RETURN BOOLEAN IS
BEGIN
IF MOD(num_in, 2) = 0 THEN
RETURN TRUE;
else
RETURN FALSE;
END IF;
END is_even;
/
RemObjects PascalScript.
How to get the value of the variable after compilation?
var a,b,c: integer;
begin
a := 5;
b := 6;
c := a+b;
end;
cc := IntTostr(????c????);
You have two options:
You can register a function with
Sender.AddDelphiFunction('procedure MyOwnFunction(Data: string)');
and
Exec := TPSExec.Create; // Create an instance of the executer.
Exec.RegisterDelphiFunction(#MyOwnFunction, 'MYOWNFUNCTION', cdRegister);
and then call it from within your script.
Alternatively, you can define your script as a function and set the Result. Then you can retrieve it with
TestFunc := TTestFunction(Exec.GetProcAsMethodN('Test'));
Both methods are demonstrated in this example:
program sample8;
uses
uPSCompiler,
uPSRuntime,
uPSUtils,
Dialogs;
procedure MyOwnFunction(const Data: string);
begin
// Do something with Data
ShowMessage(Data);
end;
{$IFDEF UNICODE}
function ScriptOnExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: AnsiString): Boolean;
{$ELSE}
function ScriptOnExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: string): Boolean;
{$ENDIF}
{
The OnExportCheck callback function is called for each function in the script
(Also for the main proc, with '!MAIN' as a Proc^.Name). ProcDecl contains the
result type and parameter types of a function using this format:
ProcDecl: ResultType + ' ' + Parameter1 + ' ' + Parameter2 + ' '+Parameter3 + .....
Parameter: ParameterType+TypeName
ParameterType is # for a normal parameter and ! for a var parameter.
A result type of 0 means no result.
}
begin
if Proc.Name = 'TEST' then // Check if the proc is the Test proc we want.
begin
if not ExportCheck(Sender, Proc, {$IFDEF UNICODE}[btUnicodeString, btUnicodeString]{$ELSE}[btString, btString]{$ENDIF}, [pmIn]) then // Check if the proc has the correct params.
begin
{ Something is wrong, so cause an error. }
Sender.MakeError('', ecTypeMismatch, '');
Result := False;
Exit;
end;
Result := True;
end else Result := True;
end;
{$IFDEF UNICODE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: AnsiString): Boolean;
{$ELSE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: string): Boolean;
{$ENDIF}
{ the OnUses callback function is called for each "uses" in the script.
It's always called with the parameter 'SYSTEM' at the top of the script.
For example: uses ii1, ii2;
This will call this function 3 times. First with 'SYSTEM' then 'II1' and then 'II2'.
}
begin
if Name = 'SYSTEM' then
begin
Sender.AddDelphiFunction('procedure MyOwnFunction(Data: string)');
{ This will register the function to the script engine. Now it can be used from within the script. }
Result := True;
end else
Result := False;
end;
type
TTestFunction = function (const s: string): string of object;
// Header of the test function, added of object.
procedure ExecuteScript(const Script: string);
var
Compiler: TPSPascalCompiler;
{ TPSPascalCompiler is the compiler part of the scriptengine. This will
translate a Pascal script into a compiled form the executer understands. }
Exec: TPSExec;
{ TPSExec is the executer part of the scriptengine. It uses the output of
the compiler to run a script. }
{$IFDEF UNICODE}Data: AnsiString;{$ELSE}Data: string;{$ENDIF}
TestFunc: TTestFunction;
begin
Compiler := TPSPascalCompiler.Create; // create an instance of the compiler.
Compiler.OnUses := ScriptOnUses; // assign the OnUses event.
Compiler.OnExportCheck := ScriptOnExportCheck; // Assign the onExportCheck event.
Compiler.AllowNoBegin := True;
Compiler.AllowNoEnd := True; // AllowNoBegin and AllowNoEnd allows it that begin and end are not required in a script.
if not Compiler.Compile(Script) then // Compile the Pascal script into bytecode.
begin
Compiler.Free;
// You could raise an exception here.
Exit;
end;
Compiler.GetOutput(Data); // Save the output of the compiler in the string Data.
Compiler.Free; // After compiling the script, there is no need for the compiler anymore.
Exec := TPSExec.Create; // Create an instance of the executer.
Exec.RegisterDelphiFunction(#MyOwnFunction, 'MYOWNFUNCTION', cdRegister);
if not Exec.LoadData(Data) then // Load the data from the Data string.
begin
{ For some reason the script could not be loaded. This is usually the case when a
library that has been used at compile time isn't registered at runtime. }
Exec.Free;
// You could raise an exception here.
Exit;
end;
TestFunc := TTestFunction(Exec.GetProcAsMethodN('Test'));
if #TestFunc <> nil then
ShowMessage('Result from TestFunc(''test indata''): '+TestFunc('test indata'));
Exec.Free; // Free the executer.
end;
const
Script = 'function test(s: string): string; begin MyOwnFunction(''Test Called with param: ''+s); Result := ''Test Result: ''+s; end;';
begin
ExecuteScript(Script);
end.