>From 5d53920602e234e4d99ae2d502e662ee3699978e 4 Oct 2024 12:01:22 -0400
From: "James K. Lowden" <jklow...@symas.com>
Date: Sat 15 Feb 2025 12:50:54 PM EST
Subject: [PATCH] 12 new 'cobol' FE files
gcc/cobol/ChangeLog
* posix/.gitignore: New file.
* posix/Makefile: New file.
* posix/README.md: New file.
* posix/headers: New file.
* posix/scrape.awk: New file.
* posix/udf-gen: New file.
* posix/c/posix_errno.c: New file.
* posix/udf/Makefile: New file.
* posix/udf/posix-errno.cbl: New file.
* posix/udf/posix-exit.cbl: New file.
* posix/udf/t/errno.cbl: New file.
* posix/udf/t/exit.cbl: New file.
---
gcc/cobol/posix/.gitignore | +++-
gcc/cobol/posix/Makefile | +++++++++++++-
gcc/cobol/posix/README.md |
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
gcc/cobol/posix/c/posix_errno.c | +++++-
gcc/cobol/posix/headers | +++++++++++++++++++++++++++++++++++++-
gcc/cobol/posix/scrape.awk | +++++++++++++++++++-
gcc/cobol/posix/udf-gen |
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
gcc/cobol/posix/udf/Makefile | +++++++++++++++++++++++++++-
gcc/cobol/posix/udf/posix-errno.cbl | ++++++++++++++++++-
gcc/cobol/posix/udf/posix-exit.cbl | ++++++++++++-
gcc/cobol/posix/udf/t/errno.cbl | ++++++++++++++++++++++++++-
gcc/cobol/posix/udf/t/exit.cbl | +++++++++++++++
12 files changed, 590 insertions(+), 12 deletions(-)
diff --git a/gcc/cobol/posix/.gitignore b/gcc/cobol/posix/.gitignore
new file mode 100644
index 00000000000..a65b24a10dc
--- /dev/null
+++ b/gcc/cobol/posix/.gitignore
@@ -0,0 +1,3 @@
+posix.txt
+prototypes.c
+prototypes.cpp
diff --git a/gcc/cobol/posix/Makefile b/gcc/cobol/posix/Makefile
new file mode 100644
index 00000000000..471769482b2
--- /dev/null
+++ b/gcc/cobol/posix/Makefile
@@ -0,0 +1,13 @@
+prototypes.c: headers prototypes.cpp
+ cat $^ > $@~
+ @mv $@~ $@
+
+prototypes.cpp: posix.txt
+ awk -F'[/.]' '{ print $$6 }' $^ | \
+ while read F; do echo "/* $$F */" && man 2 $$F | \
+ ./scrape.awk -v funcname=$$6; done > $@~
+ @mv $@~ $@
+
+posix.txt:
+ zgrep -l 'POSIX[.]' /usr/share/man/man2/*z > $@~
+ @mv $@~ $@
diff --git a/gcc/cobol/posix/README.md b/gcc/cobol/posix/README.md
new file mode 100644
index 00000000000..f126a8be990
--- /dev/null
+++ b/gcc/cobol/posix/README.md
@@ -0,0 +1,65 @@
+# GCC COBOL Posix Functions and Adapter
+
+## Purpose
+
+ISO COBOL does not specify any relationship to any particular
+operating system, and does not reference Posix. The raw capability is
+there, of course, via the `CALL` statement. But that's not very
+convenient, and offers no parameter validation.
+
+GCC COBOL as of this writing works *only* in a Posix environment. This
+directory exists to make using OS-provided functions a bit more convenient.
+
+## Contents
+
+The machine-shop tools are in this directory. Things directly usable
+by a COBOL program are in the `udf/` and `c/` directories.
+
+- `scrape.awk` extracts function prototypes from the SYNOPSIS of a man page.
+- `udf-gen` reads function declarations and, for each one, produces a
+ COBOL User Defined Function (UDF) that calls the function.
+- `Makefile` produces a list of function prototypes from Section 2 of
+ the manual.
+- `c/` contains helper functions in C that cannot be expressed in
+ COBOL. For example, the C `errno` "variable" may be a macro, and may
+ not be declared except by `errno.h`, which is not accessible to
+ COBOL.
+- `udf/Makefile` builds some infrastructure and examples:
+ - `udf/libposix-errno.so`, to get at the C `errno` variable and its
+ string representation.
+ - `udf/posix-mkdir.cbl` automatically from the manual, using `udf-gen`.
+ - `udf/t/errno` and
+ - `udf/t/exit` as examples of COBOL programs using these Posix UDFs.
+
+## Prerequisites
+
+`udf-gen` is a Python program that imports
+the [PLY pycparser module](http://www.dabeaz.com/ply/) module, which must be
installed.
+
+`udf-gen` is lightly documented, use `udf-gen --help`. It can be a
+little tedious to set up the first time, but if you want to use more a
+few functions, it will be faster than doing the work by hand.
+
+## Limitations
+
+`udf-gen` does not
+
+- generate a working UDF for function parameters of type `struct`,
+ such as is used by **stat**(2). This is because the information is
+ not available in a standardized way in the SYNOPSIS of a man page.
+- define helpful Level 88 values for "magic" numbers, such as
+ permission bits in **chmod**(2).
+
+None of this is particularly difficult; it's just a matter of time and
+need. The `scrape.awk` script finds 560 functions in the Ubuntu LTS
+22.04 manual. Which of those is important is for users to decide.
+
+## Other Options
+
+IBM and Microfocus both supply intrinsic functions to interface with
+the OS, each in their own way. GnuCOBOL implements some of those functions.
+
+## Portability
+
+The UDF produced by `udf-gen` is pure ISO COBOL. The code should be
+compilable by any ISO COBOL compiler.
diff --git a/gcc/cobol/posix/c/posix_errno.c b/gcc/cobol/posix/c/posix_errno.c
new file mode 100644
index 00000000000..f87e271ced4
--- /dev/null
+++ b/gcc/cobol/posix/c/posix_errno.c
@@ -0,0 +1,5 @@
+#include <errno.h>
+
+int posix_errno() {
+ return errno;
+}
diff --git a/gcc/cobol/posix/headers b/gcc/cobol/posix/headers
new file mode 100644
index 00000000000..b17c0f30cb3
--- /dev/null
+++ b/gcc/cobol/posix/headers
@@ -0,0 +1,37 @@
+#include <stddef.h>
+#include <stdio.h>
+#include <stddef.h>
+#include <unistd.h>
+#define loff_t ssize_t
+#define socklen_t size_t
+#define fd_set struct fd_set
+#define id_t unsigned int
+// typedef int mqd_t;
+#define mqd_t int
+// typedef unsigned long int nfds_t;
+#define nfds_t unsigned long int
+
+#if 0
+typedef struct
+{
+ unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))];
+} __sigset_t;
+define struct py_sigset_t \
+{ \
+ unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))]; \
+};
+#else
+#define kernel_sigset_t sigset_t
+#define old_kernel_sigset_t sigset_t
+#endif
+
+#if 0
+typedef enum
+{
+ P_ALL,
+ P_PID,
+ P_PGID
+} idtype_t;
+#else
+#define idtype_t int
+#endif
diff --git a/gcc/cobol/posix/scrape.awk b/gcc/cobol/posix/scrape.awk
new file mode 100755
index 00000000000..4d244d0ee3d
--- /dev/null
+++ b/gcc/cobol/posix/scrape.awk
@@ -0,0 +1,19 @@
+#! /usr/bin/awk -f
+
+/^UNIMPLEMENTED/ {
+ exit
+}
+
+/^DESCRIPTION/ {
+ exit
+}
+
+/struct sched_param {$/ {
+ exit
+}
+
+/SYNOPSIS/,/DESCRIPTION/ {
+ if( /([.][.]|[{},;]) *$/ ) {
+ print
+ }
+}
diff --git a/gcc/cobol/posix/udf-gen b/gcc/cobol/posix/udf-gen
new file mode 100755
index 00000000000..e6207085b1d
--- /dev/null
+++ b/gcc/cobol/posix/udf-gen
@@ -0,0 +1,350 @@
+#! /usr/bin/python3
+
+# Copyright (c) 2024 Symas Corporation
+#
+# 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 the Symas Corporation 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 THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "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 THE COPYRIGHT
+# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+# LIMITED TO, PROCUREMENT OF 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.
+
+import sys, os, getopt, re, copy
+from pycparser import c_parser, c_generator, c_ast, parse_file
+
+def starify(param):
+ stars = ""
+ while( isinstance(param, c_ast.PtrDecl) ):
+ q = ' '.join(param.quals)
+ stars = '*' + ' '.join((stars, q))
+ param = param.type
+ if( isinstance(param.type, c_ast.PtrDecl) ):
+ (stars, param) = starify(param.type)
+ if( isinstance(param, c_ast.TypeDecl) ):
+ return (stars, param)
+ return (stars, param.type)
+
+def linkage_str( i, name, param ) -> str:
+ if name == 'execve':
+ param.show()
+ if( isinstance(param, c_ast.EllipsisParam) ):
+ return (None, None, '...') # COBOL syntax error: no variadic UDF
+
+ is_array = False;
+ node = param
+
+ if( isinstance(node, c_ast.Decl) ):
+ node = node.type
+
+ if( isinstance(node, c_ast.ArrayDecl) ):
+ is_array = True;
+ node = node.type
+
+ (stars, node) = starify(node)
+
+ if( isinstance(node, c_ast.TypeDecl) ):
+ level = 1
+ item_name = ''
+ picture = ''
+ usage = ''
+ if node.declname:
+ item_name = 'Lk-' + node.declname
+
+ if is_array: # ignore level
+ if stars:
+ usage = 'Usage POINTER'
+ output = '01 FILLER.\n 02 %s %s %s OCCURS 100' \
+ % (item_name, picture, usage)
+ return (None, None, output)
+
+ if( isinstance(node.type, c_ast.Struct) ):
+ stars = None
+
+ if isinstance(node.type, c_ast.IdentifierType):
+ ctype = node.type.names[-1]
+ if ctype == 'void':
+ if not stars and not item_name:
+ return (None, None, None)
+ if ctype == 'char':
+ picture = 'X'
+ if stars[0] == '*':
+ picture = 'X ANY LENGTH'
+ if ctype == 'int' or \
+ ctype == 'long' or \
+ ctype == 'mode_t' or \
+ ctype == 'off_t' or \
+ ctype == 'size_t':
+ picture = '9(8)'
+ usage = 'Usage COMP'
+ stars = None
+
+ output = "%02d %s" % (level, ' '.join((item_name, 'PIC ' + picture,
usage)))
+ return (stars, item_name, output)
+
+ node.show()
+ return (None, None, '???')
+
+def using_str( i, name, param ) -> str:
+ item_name = ''
+ if( isinstance(param, c_ast.EllipsisParam) ):
+ return '...' # COBOL syntax error: no variadic UDF
+ node = param
+
+ if( isinstance(node, c_ast.Decl) ):
+ node = node.type
+
+ if( isinstance(node, c_ast.ArrayDecl) ):
+ node = node.type
+
+ (stars, node) = starify(node)
+
+ if( isinstance(node, c_ast.TypeDecl) ):
+ item_name = ''
+
+ if isinstance(node.type, c_ast.IdentifierType):
+ ctype = node.type.names[-1]
+ how = 'By Reference'
+ if ctype == 'int' or \
+ ctype == 'long' or \
+ ctype == 'mode_t' or \
+ ctype == 'off_t' or \
+ ctype == 'size_t':
+ how = 'By Value'
+ if node.declname:
+ item_name = '%s Lk-%s' % (how, node.declname)
+
+ return item_name
+
+def parameter_str( i, name, param ) -> str:
+ if( isinstance(param, c_ast.EllipsisParam) ):
+ return '...'
+
+ t = [0, 1, 2] # qual, type, name
+ is_array = False;
+ node = param
+
+ if( isinstance(node, c_ast.Decl) ):
+ node = node.type
+
+ if( isinstance(node, c_ast.ArrayDecl) ):
+ is_array = True;
+ node = node.type
+
+ (stars, node) = starify(node)
+
+ if( isinstance(node, c_ast.TypeDecl) ):
+ t[0] = ' '.join(node.quals)
+ item_name = ''
+ if node.declname:
+ item_name = 'Lk-' + node.declname
+ t[2] = ' '.join((stars, item_name))
+ if( node.declname == None ):
+ t[2] = ''
+ if( isinstance(node.type, c_ast.IdentifierType) ):
+ try:
+ t[1] = ' '.join(node.type.names)
+ except:
+ print("oops: node.type of %s is %s" % (name, str(node.type)))
+ return "could not parse %s arg[%d]" % (name, i)
+ if( isinstance(node.type, c_ast.Struct) ):
+ t[0] = ' '.join(node.quals)
+ t[1] = "struct " + node.type.name
+ if( isinstance(node, c_ast.ArrayDecl) ):
+ return parameter_str(i, name, node.type) + '[]'
+
+ try:
+ return ' '.join(t)
+ except:
+ print("oops: %s[%d]: {%s}" % (name, i, str(t)) )
+ param.show()
+
+class VisitPrototypes(c_ast.NodeVisitor):
+ def __init__(self):
+ self.done = set()
+
+ def type_of(self, node):
+ while( not isinstance(node.type, c_ast.TypeDecl) ):
+ node = node.type
+ return node.type.type.name
+
+ def visit_Decl(self, node):
+ name = node.name
+ if name in self.done:
+ return
+ self.done.add(name)
+
+ params = []
+ cbl_args = []
+ linkage_items = []
+ string_items = []
+ returns = '???'
+
+ if False and isinstance(node.type, c_ast.FuncDecl):
+ function_decl = node.type
+ print('Function: %s' % node.name)
+ if( node.type.args == None ):
+ print(' (no arguments)')
+ else:
+ for param_decl in node.type.args.params:
+ if( isinstance(param_decl, c_ast.EllipsisParam) ):
+ param_decl.show(offset=6)
+ continue
+ print(' Arg name: %s' % param_decl.name)
+ print(' Type:')
+ param_decl.type.show(offset=6)
+
+ if isinstance(node.type, c_ast.FuncDecl):
+ args = node.type.args
+ if isinstance(args, c_ast.ParamList):
+ #rint("params are %s (type %s)" % (str(args.params),
type(args.params)))
+ if( args == None ):
+ params.append('')
+ else:
+ for (i, param) in enumerate(args.params):
+ params.append(parameter_str(i, name, param))
+ cbl_args.append(using_str(i, name, param))
+ (stars, item, definition) = linkage_str(i, name, param)
+ if definition:
+ if stars:
+ string_items.append(item)
+ linkage_items.append(definition)
+
+ (stars, rets) = starify(node.type)
+
+ if isinstance(rets, c_ast.TypeDecl):
+ q = ' '.join(rets.quals)
+ if( isinstance(rets.type, c_ast.Struct) ):
+ t = "struct " + rets.type.name
+ else:
+ t = ' '.join(rets.type.names)
+ returns = ' '.join((q, t, stars))
+
+ if name == None:
+ return
+
+ # print the C version as a comment
+ cparams = [ x.replace('Lk-', '') for x in params ]
+ print( " * %s %s(%s)"
+ % (returns, name, ', '.join(cparams)) )
+
+ # print the UDF
+ print( ' Identification Division.')
+ sname = name
+ if( sname[0] == '_' ):
+ sname = sname[1:]
+ print( ' Function-ID. posix-%s.' % sname)
+
+ print( ' Data Division.')
+ print( ' Linkage Section.')
+ print( ' 77 Return-Value Binary-Long.')
+ for item in linkage_items:
+ print( ' %s.' % item.strip())
+ args = ',\n '.join(cbl_args)
+ args = 'using\n %s\n ' % args
+ print( ' Procedure Division %s Returning Return-Value.'
+ % args )
+ for item in string_items:
+ print( ' Inspect Backward %s ' % item +
+ 'Replacing Leading Space By Low-Value' )
+ using_args = ''
+ if args:
+ using_args = '%s' % args
+ print( ' Call "%s" %s Returning Return-Value.'
+ % (name, using_args) )
+ print( ' Goback.')
+ print( ' End Function posix-%s.' % sname)
+
+# Hard code a path to the fake includes
+# if not using cpp(1) environment variables.
+cpp_args = ['-I/home/jklowden/projects/3rd/pycparser/utils/fake_libc_include']
+
+for var in ('CPATH', 'C_INCLUDE_PATH'):
+ dir = os.getenv(var)
+ if dir:
+ cpp_args = ''
+
+def process(srcfile):
+ ast = parse_file(srcfile, use_cpp=True, cpp_args=cpp_args)
+ # print(c_generator.CGenerator().visit(ast))
+ v = VisitPrototypes()
+ v.visit(ast)
+
+__doc__ = """
+SYNOPSIS
+ udf-gen [-I include-path] [header-file ...]
+
+DESCRIPTION
+ For each C function declared in header-file,
+produce an ISO COBOL user-defined function definition to call it.
+If no filename is supplied, declarations are read from standard input.
+All output is written to standard output.
+
+ This Python script uses the PLY pycparser module,
+(http://www.dabeaz.com/ply/), which supplies a set of simplified "fake
+header files" to avoid parsing the (very complex) standard C header
+files. These alost suffice for parsing the Posix function
+declarations in Section 2 of the manual.
+
+ Use the -I option or the cpp(1) environment variables to direct
+the preprocessor to use the fake header files instead of the system
+header files.
+
+LIMITATIONS
+ udf-gen does not recognize C struct parameters, such as used by stat(2).
+
+ No attempt has been made to define "magic" values, such as would
+be needed for example by chmod(2).
+"""
+
+def main( argv=None ):
+ global cpp_args
+ if argv is None:
+ argv = sys.argv
+ # parse command line options
+ try:
+ opts, args = getopt.getopt(sys.argv[1:], "D:hI:m:", ["help"])
+ except getopt.error as msg:
+ print(msg)
+ print("for help use --help")
+ sys.exit(2)
+
+ # process options
+ astfile = None
+
+ for opt, arg in opts:
+ if opt in ("-h", "--help"):
+ print(__doc__)
+ sys.exit(0)
+ if opt == '-D':
+ cpp_args.append('-D%s ' % arg)
+ if opt == '-I':
+ cpp_args[0] = '-I' + arg
+
+ # process arguments
+ if not args:
+ args = ('/dev/stdin',)
+
+ for arg in args:
+ process(arg)
+
+if __name__ == "__main__":
+ sys.exit(main())
diff --git a/gcc/cobol/posix/udf/Makefile b/gcc/cobol/posix/udf/Makefile
new file mode 100644
index 00000000000..8321f2dde90
--- /dev/null
+++ b/gcc/cobol/posix/udf/Makefile
@@ -0,0 +1,27 @@
+LDFLAGS = -L $$(pwd) -Wl,-rpath -Wl,$$(pwd)
+
+all: t/exit t/errno
+
+t/exit: posix-exit.cbl t/exit.cbl
+ ../../built-gcobol $(FLAGS) -o $@ -I$$(pwd) $(lastword $^)
+
+t/errno: t/errno.cbl posix-mkdir.cbl | libposix-errno.so
+ ../../built-gcobol $(FLAGS) -o $@ -I$$(pwd) \
+ $(firstword $^) $(LDFLAGS) -lposix-errno
+
+libposix-errno.so: ../c/posix_errno.c posix-errno.o
+ gcc $(CFLAGS) -shared -o $@ $^
+
+posix-errno.o: posix-errno.cbl
+ ../../built-gcobol $(FLAGS) -fPIC -c -o $@ $^
+
+posix-mkdir.cbl:
+ man 2 mkdir | ../scrape.awk | \
+ ../udf-gen -D mode_t=unsigned\ long > $@~
+ @mv $@~ $@
+
+test: $(basename $(wildcard t/*.cbl))
+ t/errno
+
+clean:
+ rm -f *.o *.so $(basename $(wildcard t/*.cbl))
diff --git a/gcc/cobol/posix/udf/posix-errno.cbl
b/gcc/cobol/posix/udf/posix-errno.cbl
new file mode 100644
index 00000000000..9670637b3ba
--- /dev/null
+++ b/gcc/cobol/posix/udf/posix-errno.cbl
@@ -0,0 +1,18 @@
+ Identification Division.
+ Function-ID. posix-errno.
+
+ Data Division.
+ Linkage Section.
+ 77 Return-Value Binary-Long.
+ 01 Error-Msg PIC X ANY LENGTH.
+
+ Procedure Division
+ using Error-Msg
+ Returning Return-Value.
+ CALL "posix_errno"
+ returning Return-Value.
+ CALL "strerror"
+ using by value Return-Value
+ returning error-msg.
+ Goback.
+ END FUNCTION posix-errno.
diff --git a/gcc/cobol/posix/udf/posix-exit.cbl
b/gcc/cobol/posix/udf/posix-exit.cbl
new file mode 100644
index 00000000000..cd2ac1857e9
--- /dev/null
+++ b/gcc/cobol/posix/udf/posix-exit.cbl
@@ -0,0 +1,12 @@
+ Identification Division.
+ Function-ID. posix-exit.
+
+ Data Division.
+ Linkage Section.
+ 77 Return-Value Binary-Long.
+ 77 Exit-Status Binary-Long.
+
+ Procedure Division using Exit-Status Returning Return-Value.
+ CALL "_exit" using by value Exit-Status.
+ Goback.
+ END FUNCTION posix-exit.
\ No newline at end of file
diff --git a/gcc/cobol/posix/udf/t/errno.cbl b/gcc/cobol/posix/udf/t/errno.cbl
new file mode 100644
index 00000000000..22078ae3c31
--- /dev/null
+++ b/gcc/cobol/posix/udf/t/errno.cbl
@@ -0,0 +1,26 @@
+ COPY posix-mkdir.
+ COPY posix-errno.
+
+ Identification Division.
+ Program-ID. test-errno.
+ Data Division.
+ Working-Storage Section.
+ 77 Return-Value Binary-Long.
+ 77 Exit-Status Binary-Long Value 1.
+ 77 error-msg PIC X(100).
+ 77 errnum Binary-Long.
+ 77 Filename PIC X(100) Value '/'.
+
+ Procedure Division.
+ Display 'calling posix-mkdir with a foolish name ...'
+ Move Function posix-mkdir(Filename, 0) to Return-Value.
+ If Return-Value <> 0
+ Display 'calling posix-errno ...'
+ Move Function posix-errno(error-msg) to errnum
+ Display 'error: "' Filename '": ' error-msg ' (' errnum ')'
+ Goback with Error Status errnum
+ Else
+ Display 'Return-Value is ' Return-Value
+ End-If.
+
+ Goback.
diff --git a/gcc/cobol/posix/udf/t/exit.cbl b/gcc/cobol/posix/udf/t/exit.cbl
new file mode 100644
index 00000000000..4aed400b17a
--- /dev/null
+++ b/gcc/cobol/posix/udf/t/exit.cbl
@@ -0,0 +1,15 @@
+ COPY posix-exit.
+
+ Identification Division.
+ Program-ID. test-exit.
+ Data Division.
+ Working-Storage Section.
+ 77 Return-Value Binary-Long.
+ 77 Exit-Status Binary-Long Value 1.
+
+ Procedure Division.
+ Display 'calling posix-exit ...'
+ Move Function posix-exit(Exit-Status) to Return-Value.
+ * Does not return, Does not print
+ Display 'How did we get here?'
+ Goback.
