tree (*functionHandler) (location_t, tree);
};
+struct GTY(()) builtin_macro_definition
+{
+ const char *name;
+ tree function_node;
+ tree return_node;
+};
+
static GTY (()) tree sizetype_endlink;
static GTY (()) tree unsigned_endlink;
static GTY (()) tree endlink;
static GTY (()) tree doubleptr_type_node;
static GTY (()) tree floatptr_type_node;
static GTY (()) tree builtin_ftype_int_var;
+static GTY (()) vec<builtin_macro_definition, va_gc> *builtin_macros;
/* Prototypes for locally defined functions. */
static tree DoBuiltinAlloca (location_t location, tree n);
if (strcmp (name, fe->name) == 0)
return true;
// return target_support_exists (fe);
-
+ int length = vec_safe_length (builtin_macros);
+ for (int idx = 0; idx < length; idx++)
+ if (strcmp ((*builtin_macros)[idx].name, name) == 0)
+ return true;
return false;
}
+/* lookup_builtin_function returns a builtin macro. */
-/* BuildBuiltinTree - returns a Tree containing the builtin function,
- name. */
+static
+tree
+lookup_builtin_macro (location_t location, char *name)
+{
+ int length = vec_safe_length (builtin_macros);
+ for (int idx = 0; idx < length; idx++)
+ if (strcmp ((*builtin_macros)[idx].name, name) == 0)
+ {
+ tree functype = TREE_TYPE ((*builtin_macros)[idx].function_node);
+ tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype),
+ (*builtin_macros)[idx].function_node);
+ tree call = m2treelib_DoCall (
+ location, (*builtin_macros)[idx].return_node,
+ funcptr, m2statement_GetParamList ());
+ m2statement_SetLastFunction (call);
+ m2statement_SetParamList (NULL_TREE);
+ if ((*builtin_macros)[idx].return_node == void_type_node)
+ m2statement_SetLastFunction (NULL_TREE);
+ return call;
+ }
+ return NULL_TREE;
+}
+
+/* lookup_builtin_function returns a builtin function. */
+static
tree
-m2builtins_BuildBuiltinTree (location_t location, char *name)
+lookup_builtin_function (location_t location, char *name)
{
struct builtin_function_entry *fe;
- tree call;
-
- m2statement_SetLastFunction (NULL_TREE);
for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
if ((strcmp (name, fe->name) == 0) && target_support_exists (fe))
tree functype = TREE_TYPE (fe->function_node);
tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype),
fe->function_node);
- call = m2treelib_DoCall (
+ tree call = m2treelib_DoCall (
location, fe->return_node, funcptr, m2statement_GetParamList ());
m2statement_SetLastFunction (call);
m2statement_SetParamList (NULL_TREE);
m2statement_SetLastFunction (NULL_TREE);
return call;
}
+ return NULL_TREE;
+}
+
+/* BuildBuiltinTree - returns a Tree containing the builtin function,
+ name. */
+
+tree
+m2builtins_BuildBuiltinTree (location_t location, char *name)
+{
+ tree call;
+ m2statement_SetLastFunction (NULL_TREE);
- m2statement_SetParamList (NULL_TREE);
- return m2statement_GetLastFunction ();
+ call = lookup_builtin_function (location, name);
+ if (call == NULL_TREE)
+ {
+ call = lookup_builtin_macro (location, name);
+ if (call == NULL_TREE)
+ {
+ m2statement_SetParamList (NULL_TREE);
+ return m2statement_GetLastFunction ();
+ }
+ }
+ return call;
}
static tree
}
/* Define a single builtin. */
+
static void
-define_builtin (enum built_in_function val, const char *name, tree type,
+define_builtin (enum built_in_function val, const char *name, tree prototype,
const char *libname, int flags)
{
tree decl;
+ builtin_macro_definition bmd;
decl = build_decl (BUILTINS_LOCATION, FUNCTION_DECL, get_identifier (name),
- type);
+ prototype);
DECL_EXTERNAL (decl) = 1;
TREE_PUBLIC (decl) = 1;
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (libname));
set_decl_built_in_class (decl, BUILT_IN_NORMAL);
set_decl_function_code (decl, val);
set_call_expr_flags (decl, flags);
-
set_builtin_decl (val, decl, true);
+ bmd.name = name;
+ bmd.function_node = decl;
+ bmd.return_node = TREE_TYPE (prototype);
+ vec_safe_push (builtin_macros, bmd);
+}
+
+/* Define a math type variant of the builtin function. */
+
+static
+void
+define_builtin_ext (enum built_in_function val, const char *name, tree type,
+ const char *libname, int flags, const char *ext)
+{
+ char *newname = (char *) xmalloc (strlen (name) + strlen (ext) + 1);
+ char *newlibname = (char *) xmalloc (strlen (libname) + strlen (ext) + 1);
+ strcpy (newname, name);
+ strcat (newname, ext);
+ strcpy (newlibname, libname);
+ strcat (newlibname, ext);
+ define_builtin (val, newname, type, newlibname, flags);
+}
+
+/* Define all support math type versions of this builtin. */
+
+static void
+define_builtin_math (enum built_in_function val, const char *name, tree type,
+ const char *libname, int flags)
+{
+ /* SHORTREAL version. */
+ define_builtin_ext (val, name, type, libname, flags, "f");
+ /* LONGREAL version. */
+ define_builtin_ext (val, name, type, libname, flags, "l");
+ /* REAL version. */
+ define_builtin (val, name, type, libname, flags);
+ /* Perhaps it should declare SYSTEM.def types size floating point
+ versions as well? */
}
void
define_builtin (BUILT_IN_TRAP, "__builtin_trap",
build_function_type_list (void_type_node, NULL_TREE),
"__builtin_trap", ECF_NOTHROW | ECF_LEAF | ECF_NORETURN);
- define_builtin (BUILT_IN_ISGREATER, "isgreater", builtin_ftype_int_var,
- "__builtin_isgreater", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISGREATEREQUAL, "isgreaterequal",
- builtin_ftype_int_var, "__builtin_isgreaterequal",
- ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISLESS, "isless", builtin_ftype_int_var,
- "__builtin_isless", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISLESSEQUAL, "islessequal", builtin_ftype_int_var,
- "__builtin_islessequal", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISLESSGREATER, "islessgreater",
- builtin_ftype_int_var, "__builtin_islessgreater",
- ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISUNORDERED, "isunordered", builtin_ftype_int_var,
- "__builtin_isunordered", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISGREATER, "isgreater", builtin_ftype_int_var,
+ "__builtin_isgreater", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISGREATEREQUAL, "isgreaterequal",
+ builtin_ftype_int_var, "__builtin_isgreaterequal",
+ ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISLESS, "isless", builtin_ftype_int_var,
+ "__builtin_isless", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISLESSEQUAL, "islessequal", builtin_ftype_int_var,
+ "__builtin_islessequal", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISLESSGREATER, "islessgreater",
+ builtin_ftype_int_var, "__builtin_islessgreater",
+ ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISUNORDERED, "isunordered", builtin_ftype_int_var,
+ "__builtin_isunordered", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISNORMAL, "isnormal", builtin_ftype_int_var,
+ "__builtin_isnormal", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISINF_SIGN, "isinf_sign", builtin_ftype_int_var,
+ "__builtin_isinf_sign", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
gm2_alloca_node = find_builtin_tree ("__builtin_alloca");
gm2_memcpy_node = find_builtin_tree ("__builtin_memcpy");
FROM SYSTEM IMPORT ADDRESS ;
-(* floating point intrinsic procedure functions *)
+(* Floating point intrinsic procedure functions. *)
PROCEDURE __BUILTIN__ isnanf (x: SHORTREAL) : INTEGER ;
PROCEDURE __BUILTIN__ isnan (x: REAL) : INTEGER ;
PROCEDURE __BUILTIN__ scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
PROCEDURE __BUILTIN__ scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
-(* complex arithmetic intrincic procedure functions *)
+PROCEDURE __BUILTIN__ isgreater (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isgreaterequal (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterequalf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterequall (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isless (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ islessequal (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessequalf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessequall (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ islessgreater (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessgreaterf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessgreaterl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isunordered (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isunorderedf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isunorderedl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ iseqsig (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ iseqsigf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ iseqsigl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isnormal (r: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isnormalf (s: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isnormall (l: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isinf_sign (r: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isinf_signf (s: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isinf_signl (l: LONGREAL) : INTEGER ;
+
+(* Complex arithmetic intrincic procedure functions. *)
PROCEDURE __BUILTIN__ cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
PROCEDURE __BUILTIN__ cabs (z: COMPLEX) : REAL ;
BEGIN
(* This routine will never be called as it allocates memory on
top of the current stack frame, which is automatically
- deallocated upon its return. *)
+ deallocated upon its return. *)
HALT ;
RETURN NIL
END alloca ;
(* this routine is only called if -fdebug-builtins is supplied
on the command line. The purpose of this routine is to allow
a developer to single step into this routine and inspect the
- value of, nBytes, and, returned.
- *)
+ value of nBytes and returned. *)
RETURN returned
END alloca_trace ;
-PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_memcpy)) memcpy (dest, src: ADDRESS; nbytes: CARDINAL) : ADDRESS ;
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_memcpy))
+ memcpy (dest, src: ADDRESS; nbytes: CARDINAL) : ADDRESS ;
BEGIN
- (* hopefully the compiler will choose to use the __builtin_memcpy function within GCC.
- This call is here just in case it cannot. Ie if the user sets a procedure variable to
- memcpy, then clearly the compiler cannot inline such a call and thus it will
- be forced into calling this function.
- *)
+ (* Hopefully the compiler will choose to use the __builtin_memcpy
+ function within GCC. This call is here just in case it cannot.
+ If the user sets a procedure variable to memcpy then the
+ code below could be run instead. *)
RETURN cbuiltin.memcpy (dest, src, nbytes)
END memcpy ;
RETURN -1.0
END huge_valf ;
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreater)) isgreater (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreater ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterf)) isgreaterf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterl)) isgreaterl (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterequal)) isgreaterequal (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterequal ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterequalf)) isgreaterequalf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterequalf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterequall)) isgreaterequall (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterequall ;
+
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isless)) isless (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isless ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessf)) islessf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessl)) islessl (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessequal)) islessequal (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessequal ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessequalf)) islessequalf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessequalf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessequall)) islessequall (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessequall ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessgreater)) islessgreater (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessgreater ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessgreaterf)) islessgreaterf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessgreaterf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessgreaterl)) islessgreaterl (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessgreaterl ;
+
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isunordered)) isunordered (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isunordered ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isunorderedf)) isunorderedf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isunorderedf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isunorderedl)) isunorderedl (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isunorderedl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_iseqsig)) iseqsig (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END iseqsig ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_iseqsigf)) iseqsigf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END iseqsigf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_iseqsigl)) iseqsigl (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END iseqsigl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnormal)) isnormal (r: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isnormal ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnormalf)) isnormalf (s: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isnormalf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnormall)) isnormall (l: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isnormall ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isinf)) isinf_sign (r: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isinf_sign ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isinf_signf)) isinf_signf (s: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isinf_signf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isinf)) isinf_signl (l: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isinf_signl ;
+
PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_longjmp)) longjmp (env: ADDRESS; val: INTEGER) ;
BEGIN
- (* empty, replaced internally by gcc *)
+ (* Empty, replaced internally by gcc. *)
END longjmp ;
PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_setjmp)) setjmp (env: ADDRESS) : INTEGER ;
BEGIN
- (* empty, replaced internally by gcc *)
- RETURN 0 (* keeps gm2 happy *)
+ (* Empty, replaced internally by gcc. *)
+ RETURN 0 (* Keep -Wreturn-type happy. *)
END setjmp ;
-
(*
frame_address - returns the address of the frame.
The current frame is obtained if level is 0,
--- /dev/null
+# Copyright (C) 2024 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaiusmod2@gmail.com)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/builtins/run/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-execute $testcase "" "pass"
+}
--- /dev/null
+MODULE testcomparisons ;
+
+
+FROM libc IMPORT printf, exit ;
+FROM Builtins IMPORT isgreater, isless, islessequal, isgreaterequal ;
+FROM SYSTEM IMPORT ADR ;
+
+
+(*
+ assert -
+*)
+
+PROCEDURE assert (value: BOOLEAN; message: ARRAY OF CHAR) ;
+BEGIN
+ IF NOT value
+ THEN
+ printf ("test failed: %s\n", ADR (message)) ;
+ code := 1
+ END
+END assert ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ result: INTEGER ;
+BEGIN
+ result := isgreater (2.0, 1.0) ;
+ printf ("isgreater (2.0, 1.0) = %d\n", result) ;
+ assert (result = 1, "isgreater (2.0, 1.0) # 1") ;
+
+ result := isless (1.0, 2.0) ;
+ printf ("isless (1.0, 2.0) = %d\n", result) ;
+ assert (result = 1, "isless (1.0, 2.0) # 1") ;
+
+ result := islessequal (1.0, 2.0) ;
+ printf ("islessequal (1.0, 2.0) = %d\n", result) ;
+ assert (result = 1, "islessequal (1.0, 2.0) # 1") ;
+
+ result := isgreaterequal (2.0, 1.0) ;
+ printf ("isgreaterequal (2.0, 1.0) = %d\n", result) ;
+ assert (result = 1, "isgreatereequal (2.0, 1.0) # 1") ;
+
+ result := isgreater (1.0, 2.0) ;
+ printf ("isgreater (1.0, 2.0) = %d\n", result) ;
+ assert (result = 0, "isgreater (1.0, 2.0) # 0") ;
+
+ result := isless (2.0, 1.0) ;
+ printf ("isless (2.0, 1.0) = %d\n", result) ;
+ assert (result = 0, "isless (2.0, 1.0) # 0") ;
+
+ result := islessequal (2.0, 1.0) ;
+ printf ("islessequal (2.0, 1.0) = %d\n", result) ;
+ assert (result = 0, "islessequal (2.0, 1.0) # 0") ;
+
+ result := isgreaterequal (1.0, 2.0) ;
+ printf ("isgreaterequal (1.0, 2.0) = %d\n", result) ;
+ assert (result = 0, "isgreatereequal (1.0, 2.0) # 1")
+END test ;
+
+
+VAR
+ code: INTEGER ;
+BEGIN
+ code := 0 ;
+ test ;
+ IF code = 0
+ THEN
+ printf ("all tests pass\n")
+ ELSE
+ printf ("some tests failed\n")
+ END ;
+ exit (code)
+END testcomparisons.
--- /dev/null
+MODULE testisnormal ;
+
+FROM libc IMPORT printf, exit ;
+FROM Builtins IMPORT isnormal ;
+FROM SYSTEM IMPORT ADR ;
+
+
+(*
+ assert -
+*)
+
+PROCEDURE assert (value: BOOLEAN; message: ARRAY OF CHAR) ;
+BEGIN
+ IF NOT value
+ THEN
+ printf ("test failed: %s\n", ADR (message)) ;
+ code := 1
+ END
+END assert ;
+
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ result: INTEGER ;
+BEGIN
+ result := isnormal (1.0) ;
+ printf ("isnormal (1.0) = %d\n", result) ;
+ assert (result = 1, "isnormal (1.0) # 1")
+END test ;
+
+
+VAR
+ code: INTEGER ;
+BEGIN
+ code := 0 ;
+ test ;
+ IF code = 0
+ THEN
+ printf ("all tests pass\n")
+ ELSE
+ printf ("some tests failed\n")
+ END ;
+ exit (code)
+END testisnormal.
--- /dev/null
+MODULE testchar ;
+
+FROM FIO IMPORT File, OpenToWrite, OpenToRead,
+ Close, WriteChar, ReadChar, IsNoError ;
+
+FROM libc IMPORT printf, exit ;
+
+
+(*
+ createFile -
+*)
+
+PROCEDURE createFile ;
+VAR
+ fo: File ;
+ ch: CHAR ;
+BEGIN
+ fo := OpenToWrite ("test.txt") ;
+ FOR ch := MIN (CHAR) TO MAX (CHAR) DO
+ WriteChar (fo, ch) ;
+ IF NOT IsNoError (fo)
+ THEN
+ printf ("failure to write: %c\n", ch);
+ exit (1)
+ END
+ END ;
+ Close (fo)
+END createFile ;
+
+
+(*
+ readFile -
+*)
+
+PROCEDURE readFile ;
+VAR
+ fi : File ;
+ ch, in: CHAR ;
+BEGIN
+ fi := OpenToRead ("test.txt") ;
+ FOR ch := MIN (CHAR) TO MAX (CHAR) DO
+ in := ReadChar (fi) ;
+ IF NOT IsNoError (fi)
+ THEN
+ printf ("failure to read: %c\n", ch);
+ exit (1)
+ END ;
+ IF ch # in
+ THEN
+ printf ("failure to verify: %c\n", ch);
+ exit (1)
+ END
+ END ;
+ Close (fi)
+END readFile ;
+
+
+(*
+ init -
+*)
+
+PROCEDURE init ;
+BEGIN
+ createFile ;
+ readFile
+END init ;
+
+
+BEGIN
+ init
+END testchar.
projects / thirdparty / gcc.git / commitdiff
