pax_global_header00006660000000000000000000000064147355320410014516gustar00rootroot0000000000000052 comment=e080d6922ff62ac07296a3f478735f93ec1fb253 libflorist-2025.1.0/000077500000000000000000000000001473553204100141165ustar00rootroot00000000000000libflorist-2025.1.0/.gitreview000066400000000000000000000001431473553204100161220ustar00rootroot00000000000000[gerrit] host = git.adacore-it.com project = florist defaultbranch = master defaultremote = origin libflorist-2025.1.0/COPYING000066400000000000000000000431061473553204100151550ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy 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 2 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 this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. libflorist-2025.1.0/INSTALL000066400000000000000000000021061473553204100151460ustar00rootroot00000000000000In order to install FLORIST, you should go through the following steps: 0. Make sure you have GNAT installed and in front of your PATH. 1. Configure FLORIST by typing "./configure". You may want to use the --prefix=/florist/install option to specify where to install FLORIST. By default, Florist will be installed under /usr/local. If you are using a special configuration with no support or non standard support for tasking/threads, you may consider using the --disable-threads option: ./configure --disable-threads Note that disabling thread support will remove support for the following packages that depend on threads: - POSIX.Asynchronous_IO - POSIX.Condition_Variables - POSIX.Message_Queues - POSIX.Mutexes - POSIX.Process_Primitives - POSIX.Process_Signals - POSIX.Timers 2. Build and compile FLORIST by typing "make" If you need to specify optional gprbuild flags, you may specify GPRBUILD="gprbuild-cmd-line", e.g: make GPRBUILD="gprbuild --RTS=sjlj" 3. Install FLORIST by typing "make install" libflorist-2025.1.0/Makefile.in000066400000000000000000000131501473553204100161630ustar00rootroot00000000000000# This builds the "Florist" implementation of POSIX.5b # # If you need to modify the "configure" file, you will need # autoconf version 2.12, or maybe a later version will also work. # .POSIX: VERSION=7.3.0w FLORIST_VERSION=$(VERSION) GNATPREPFLAGS = -c -r GCCFLAGS = -O2 TARGET=@host_alias@ ifneq ($(TARGET),) TARGET_OPTION=--target=$(TARGET) TARGET_PREFIX=$(TARGET)- endif ifeq ($(TARGET),powerpc-elinos-linux) TARGET_RUNNER=run-cross --target=ppc-elinos,5.1,qemu endif # How to invoke ranlib. RANLIB = ranlib # configure substitutions CC = @CC@ LIBS = @LIBS@ DEPS = @DEPS@ SIGNALS_GENERATED = @SIGNALS_GENERATED@ PREFIX = @prefix@ ENABLE_SHARED = @ENABLE_SHARED@ PROJECT_FLAGS = @BUILD_TYPE_OPTION@ @THREADS_OPTION@ @RTS_OPTION@ \ $(TARGET_OPTION) # Scenario variables and RTS selection must be passed consistently to # project-aware tools gprbuild, gprinstall, and gprclean. GNATPREP = $(TARGET_PREFIX)gnatprep GPRBUILD = gprbuild GPRBUILD_FLAGS = $(GCCFLAGS) $(PROJECT_FLAGS) GENDIR = gensrc GENDIR_ON_TARGET=$(GENDIR) # files generated by "configure" script CONFIG_GENERATED = \ confsrc/config.h\ confsrc/pconfig.h\ gnatprep.config\ pconfig.h.in CONFIG_HISTORY = \ config.cache\ config.log\ c-posix.log\ configure.log\ config.status\ stamp-h # files generated by "c-posix" program C-POSIX_GENERATED = \ $(GENDIR)/posix.ads\ $(GENDIR)/posix-limits.ads\ $(GENDIR)/posix-options.ads\ $(GENDIR)/posix-c.ads # files generated by "c-posix-signals" program (if present) ifneq "$(strip $(SIGNALS_GENERATED))" "" C-POSIX-SIGNALS_GENERATED = $(GENDIR)/$(SIGNALS_GENERATED) else C-POSIX-SIGNALS_GENERATED = endif GNATPREP_SOURCES = $(GENDIR)/posix-implementation.adb $(GENDIR)/threads/posix-timers-extensions.adb GENERATED = $(C-POSIX_GENERATED) $(C-POSIX-SIGNALS_GENERATED) $(GNATPREP_SOURCES) # all the executable programs EXECUTABLES = c-posix c-posix-signals # default target, get the gnat version and the system type and then # set up files and call make again (in uname) all: floristlib # # ------------------------------------ # configure-script # ------------------------------------ # # This first step should not need to be done during # normal installation # configure: configure.in aclocal.m4 autoconf # # ------------------------------------ # generation of OS dependent sources # ------------------------------------ # # Program c-posix generates some Ada package specs. # It is supposed to be a "portable" POSIX C program. # If it does not compile or does not link, # it might be fixable by hand-editing config.h or pconfig.h. # If you are unlucky, it will require fixes to c-posix.c. # c-posix: c-posix.c confsrc/config.h confsrc/pconfig.h $(CC) $(GCCFLAGS) -DVERSION="\"$(VERSION)\"" -DLIBS="\"$(LIBS)\"" -DGENDIR="\"$(GENDIR_ON_TARGET)\"" -o c-posix c-posix.c $(LIBS) # # Program c-posix-signals generates another Ada package spec. # c-posix-signals: c-posix-signals.c $(CC) $(GCCFLAGS) -DGENDIR="\"$(GENDIR_ON_TARGET)\"" -o c-posix-signals c-posix-signals.c $(LIBS) # # generate Ada source files using "c-posix" program # $(C-POSIX_GENERATED): c-posix mkdir -p $(GENDIR) && cd $(GENDIR) && rm -f posix.ads posix-limits.ads posix-options.ads posix-c.ads # See file "c-posix.log" for results of this step. $(TARGET_RUNNER) ./c-posix > c-posix.log 2>&1 # # generate Ada source files using "c-posix-signals" program # $(C-POSIX-SIGNALS_GENERATED): c-posix-signals mkdir -p $(GENDIR) && cd $(GENDIR) && rm -f posix-implementations-ok_signals.ads # See file "c-posix-signals.log" for results of this step. $(TARGET_RUNNER) ./c-posix-signals -nodefaults > c-posix-signals.log 2>&1 # # Some other Ada source files are tailored to the # particular OS using the "gnatprep" program. # The sources for these end in ".gpb" and ".gps". # .SUFFIXES: .gps .gpb .ads .adb .o .c $(GENDIR)/%.ads: libsrc/%.gps gnatprep.config mkdir -p `dirname $@` && $(GNATPREP) $< $@ gnatprep.config $(GNATPREPFLAGS) $(GENDIR)/%.adb: libsrc/%.gpb gnatprep.config mkdir -p `dirname $@` && $(GNATPREP) $< $@ gnatprep.config $(GNATPREPFLAGS) .c.o: $(CC) -c $(GCCFLAGS) $< # # ------------------------------------ # compilation of Florist packages # ------------------------------------ # force: # build both static and shared library when shared is enabled ifeq ($(ENABLE_SHARED), yes) floristlib: $(GENERATED) floristlib-static floristlib-relocatable install: install-static install-relocatable # ensure that the relocatable version is build first so the static library # will use the objects that are already built. floristlib-static: floristlib-relocatable # ensure that we don't have two instances of gprinstall trying to install at # the same time. install-relocatable: install-static else floristlib: $(GENERATED) floristlib-static install: install-static endif floristlib-%: force $(GPRBUILD) -p $(GPRBUILD_FLAGS) -XLIBRARY_TYPE=$* -Pflorist # ----------------------------------- # Maintenance targets # ----------------------------------- # # remove all c-posix and gnatprep generated files regen: rm -f $(GENERATED) # remove editor and compiler generated files clean: regen gprclean -Pflorist $(PROJECT_FLAGS) rm -rf obj lib rm -f *# *~ $(EXECUTABLES) b__* b~* # remove all generated files, including configuration history distclean: clean rm -f $(CONFIG_HISTORY) $(CONF_GENERATED) # install floristlib # make all files read-only to prevent recompilation install-%: gprinstall -Pflorist $(PROJECT_FLAGS) -XLIBRARY_TYPE=$* -a -p -f \ --prefix=$(PREFIX) --sources-subdir=floristlib \ --lib-subdir=floristlib --link-lib-subdir=floristlib \ --build-name=$* chmod a-w $(PREFIX)/floristlib/* .PHONY: all install clean distclean regen floristlib force libflorist-2025.1.0/README000066400000000000000000000026731473553204100150060ustar00rootroot00000000000000FLORIST: ======== This directory contains the components of FLORIST, an implementation of the IEEE Standards 1003.5: 1992, IEEE STD 1003.5b: 1996, and parts of IEEE STD 1003.5c: 1998, also known as the POSIX Ada Bindings. NORMAL INSTALLATION: ==================== Follow the steps described in the INSTALL file. COMPILING YOUR PROGRAMS WITH FLORIST: ===================================== The recommended approach for linking your application with Florist is to import Florist's project from your application's project file using GPRbuild's project management features, by adding the following "with" statement: with "florist.gpr". See section 2.3.1 of the GPRbuild and GPR Companion Tools User's Guide for more information on how to configure gprbuild to find Florist's project file, or where to install florist so as to allow gprbuild to find it automatically. The Florist library's project file, florist.gpr, that should be used to import the project is found at: /share/gpr/florist.gpr Alternatively, to use Florist without GPRbuild's project management features, you will need to tell the compiler the location where florist is installed, and also tell the linker to link with florist; for example: $ gnatmake -I//floristlib main -largs -lflorist Where is the path supplied as the --prefix command line argument to the configure command in the INSTALL procedure or /usr/local when omitted. libflorist-2025.1.0/aclocal.m4000066400000000000000000000163511473553204100157640ustar00rootroot00000000000000dnl auto-configuration macros for Florist dnl This version requires autoconf-2.10. dnl AC_POSIX_HEADER(HEADER-FILE, dnl [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]]) dnl side-effect: extend file "pconfig.h", dnl with includes for this header, if present. AC_DEFUN(AC_POSIX_HEADER, [dnl Do the transliteration at runtime so arg 1 can be a shell variable. ac_old_cflags=$CFLAGS # CFLAGS="$CFLAGS -Werror" ac_safe=`echo "$1" | tr './\055' '___'` AC_MSG_CHECKING([for $1]) AC_CACHE_VAL(ac_cv_header_$ac_safe, [AC_PREPROC_IFELSE([AC_LANG_SOURCE([[#include <$1>]])],[AC_COMPILE_IFELSE([AC_LANG_SOURCE([[#include "confsrc/pconfig.h" #include <$1>]])], eval "ac_cv_header_$ac_safe=yes", eval "ac_cv_header_$ac_safe=no")],[eval "ac_cv_header_$ac_safe=no"])])dnl if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then AC_MSG_RESULT(yes) echo "#include <$1>" >> confsrc/pconfig.h ifelse([$2], , :, [$2]) else AC_MSG_RESULT(no) ifelse([$3], , , [$3 ])dnl fi CFLAGS=$ac_old_cflags ])dnl dnl AC_POSIX_HEADERS(NAMES...) dnl side-effect: create file "pconfig.h" containing includes dnl for all the headers that are present. AC_DEFUN(AC_POSIX_HEADERS, [rm -f confsrc/pconfig.h cp pconfig.h.in confsrc/pconfig.h chmod 644 confsrc/pconfig.h if ( test ! -f confsrc/pconfig.h ) then AC_MSG_ERROR(missing confsrc/pconfig.h); fi for ac_hdr in $1 do AC_POSIX_HEADER($ac_hdr, [ac_tr_hdr=HAVE_$(echo $ac_hdr | tr 'abcdefghijklmnopqrstuvwxyz./\055' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ___') AC_DEFINE_UNQUOTED($ac_tr_hdr)])dnl done ])dnl dnl AC_POSIX5C_HEADERS(NAMES...) dnl side-effect: create file "pconfig.h" containing includes dnl for all the headers that are present. AC_DEFUN(AC_POSIX5C_HEADERS, [for ac_hdr in $1 do AC_POSIX_HEADER($ac_hdr, [ac_tr_hdr=HAVE_$(echo $ac_hdr | tr 'abcdefghijklmnopqrstuvwxyz./\055' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ___') AC_DEFINE_UNQUOTED($ac_tr_hdr)])dnl done AC_POSIX_HEADER(xti.h, AC_DEFINE_UNQUOTED(HAVE_XTI_H) [ echo "-- don't want TLI because we have xti.h TLI := False" >> gnatprep.config;], AC_POSIX_HEADER(tli.h, AC_DEFINE_UNQUOTED(HAVE_TLI_H) [ echo "-- using TLI because could not find xti.h TLI := True" >> gnatprep.config;], [ echo "-- could not find tli.h TLI := False" >> gnatprep.config;], )) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include "confsrc/pconfig.h"]], [[ struct msghdr hdr; hdr.msg_controllen = 0;]])],[echo "Socket interface looks like BSD 4.4"; # Put BSD flag in gnatprep.config if (grep BSD4_3 gnatprep.config >/dev/null 2>&1); then true; else (echo "-- set BSD4_3 to False if using 4.4 style socket msghdr"; echo "BSD4_3 := False") >> gnatprep.config; fi; if (grep _BSD4_4_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _BSD4_4_" >> confsrc/pconfig.h; fi;],[echo "Socket interface Looks like BSD 4.3"; if (grep BSD4_3 gnatprep.config >/dev/null 2>&1); then true; else (echo "-- set BSD4_3 to False if using 4.4 style socket msghdr"; echo "BSD4_3 := True") >> gnatprep.config; fi; if (grep _BSD4_3_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _BSD4_3_" >> confsrc/pconfig.h; fi;]) [if (grep xti.h confsrc/pconfig.h >/dev/null 2>&1); then if (grep _XTI_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _XTI_" >> confsrc/pconfig.h; fi ; else if [ -f /usr/include/sys/tiuser.h ]; then echo "Have only TLI, will use that in place of XTI"; if (grep _TLI_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _TLI_" >> confsrc/pconfig.h; echo "#include " >> confsrc/pconfig.h; fi; fi; fi] dnl For some reason the line below cannot be removed??? dnl AC_CHECK_FUNC(getaddrinfo, [], []) ])dnl dnl AC_POSIX_TYPE(TYPE-NAME) AC_DEFUN(AC_POSIX_TYPE, [AC_REQUIRE([AC_POSIX_HEADERS])dnl AC_MSG_CHECKING(for $1) AC_CACHE_VAL(ac_cv_type_$1, AC_EGREP_CPP($1[[[^0-9A-Za-z_]]],[#include "confsrc/pconfig.h"], eval "ac_cv_type_$1=yes", eval "ac_cv_type_$1=no")) if eval "test \"`echo '$ac_cv_type_'$1`\" = yes"; then AC_DEFINE_UNQUOTED(HAVE_$1) AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) fi ]) dnl AC_POSIX_TYPES(TYPE-NAME...) AC_DEFUN(AC_POSIX_TYPES, [for ac_typ in $1 do AC_POSIX_TYPE($ac_typ) done ]) dnl AC_POSIX_CONST(CONST) AC_DEFUN(AC_POSIX_CONST, [AC_REQUIRE([AC_POSIX_HEADERS])dnl AC_MSG_CHECKING(for $1) AC_CACHE_VAL(ac_cv_const_$1, [AC_EGREP_CPP($1, [#include "confsrc/pconfig.h"], eval "ac_cv_const_$1=yes", AC_EGREP_CPP(yes, [#include "confsrc/pconfig.h" #ifdef $1 yes #endif], eval "ac_cv_const_$1=yes", eval "ac_cv_const_$1=no"))])dnl if eval "test \"`echo '$ac_cv_const_'$1`\" = yes"; then AC_DEFINE_UNQUOTED(HAVE_$1) AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) fi ]) dnl AC_POSIX_CONSTS(CONST-NAME...) AC_DEFUN(AC_POSIX_CONSTS, [for ac_const in $1 do AC_POSIX_CONST($ac_const) done ]) dnl AC_POSIX_STRUCT(NAME, dnl [ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]]) AC_DEFUN(AC_POSIX_STRUCT, [AC_REQUIRE([AC_POSIX_HEADERS])dnl AC_MSG_CHECKING(for struct $1) AC_CACHE_VAL(ac_cv_struct_$1, [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include "confsrc/pconfig.h" struct $1 x;]], [[]])],[eval "ac_cv_struct_$1=yes"],[eval "ac_cv_struct_$1=no"])])dnl if eval "test \"`echo '$ac_cv_struct_'$1`\" = yes"; then AC_DEFINE_UNQUOTED(HAVE_struct_$1) AC_MSG_RESULT(yes) ifelse([$2], , :, [$2]) else AC_MSG_RESULT(no) ifelse([$3], , , [$3])dnl fi ]) dnl AC_POSIX_STRUCTS(NAME...) AC_DEFUN(AC_POSIX_STRUCTS, [for ac_struct in $1 do AC_POSIX_STRUCT($ac_struct) done ]) dnl AC_POSIX_FUNCS(FUNCTION... ) AC_DEFUN(AC_POSIX_FUNCS, [for ac_func in $1 do AC_CHECK_FUNC($ac_func, [AC_DEFINE_UNQUOTED(HAVE_$ac_func,1)], [AC_DEFINE_UNQUOTED(HAVE_$ac_func,0)])dnl done ]) dnl AC_POSIX_VAR(NAME) AC_DEFUN(AC_POSIX_VAR, [AC_REQUIRE([AC_POSIX_HEADERS])dnl AC_MSG_CHECKING(for global variable or macro $1) AC_CACHE_VAL(ac_cv_comp_$1, [AC_EGREP_CPP($1, [#include "confsrc/pconfig.h"], eval "ac_cv_comp_$1=yes", eval "ac_cv_comp_$1=no")])dnl if eval "test \"`echo '$ac_cv_comp_'$1`\" = yes"; then AC_DEFINE_UNQUOTED(HAVE_$1) AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) fi ]) dnl AC_POSIX_COMP(STRUCTNAME, COMPNAME) AC_DEFUN(AC_POSIX_COMP, [AC_REQUIRE([AC_POSIX_HEADERS])dnl AC_MSG_CHECKING(for struct $1 component $2) AC_CACHE_VAL(ac_cv_comp_$2, [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include "confsrc/pconfig.h" struct $1 x;]], [[x.$2 = x.$2;]])],[eval "ac_cv_comp_$2=yes"],[eval "ac_cv_comp_$2=no"])])dnl if eval "test \"`echo '$ac_cv_comp_'$2`\" = yes"; then AC_DEFINE_UNQUOTED(HAVE_component_$2) AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) fi ]) dnl AC_POSIX_COMP_OVERLAY(STRUCTNAME, COMPNAME1, COMPNAME2) dnl check for COMPNAME1 but only if it does not overlay in memory dnl layout with COMPNAME2; e.g. see overlaying of sigaction components dnl sa_handler and sa_sigaction AC_DEFUN(AC_POSIX_COMP_OVERLAY, [AC_REQUIRE([AC_POSIX_HEADERS])dnl AC_MSG_CHECKING(for struct $1 component $2 overlaying $3) AC_CACHE_VAL(ac_cv_comp_$2, AC_RUN_IFELSE([AC_LANG_SOURCE([#include "confsrc/pconfig.h" main() { struct $1 x; if (&x.$2 == &x.$3) { fprintf(stderr,"$2 overlays $3..."); exit (1); } else { exit (0); } }])], eval "ac_cv_comp_$2=yes", eval "ac_cv_comp_$2=no", eval "ac_cv_comp_$2=nu"))dnl if eval "test \"`echo '$ac_cv_comp_'$2`\" = yes"; then AC_DEFINE_UNQUOTED(HAVE_component_$2) AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) fi ]) libflorist-2025.1.0/addrinfo.h000066400000000000000000000035261473553204100160630ustar00rootroot00000000000000#if ! defined (__addrinfo_h) && ! defined (AI_PASSIVE) #define __addrinfo_h /* * Everything here really belongs in . * These defines are separate for now, to avoid having to modify the * system's header. * The test for AI_PASSIVE in the first line will prevent compilation * of this file on any system where these defines ARE included in * , e.g. Solaris 2.8 */ struct addrinfo { int ai_flags; /* AI_PASSIVE, AI_CANONNAME */ int ai_family; /* PF_xxx */ int ai_socktype; /* SOCK_xxx */ int ai_protocol; /* IPPROTO_xxx for IPv4 and IPv6 */ size_t ai_addrlen; /* length of ai_addr */ char *ai_canonname; /* canonical name for host */ struct sockaddr *ai_addr; /* binary address */ struct addrinfo *ai_next; /* next structure in linked list */ }; #define AI_PASSIVE 1 /* socket is intended for bind() + listen() */ #define AI_CANONNAME 2 /* return canonical name */ #define EAI_ADDRFAMILY 1 /* address family for host not supported */ #define EAI_AGAIN 2 /* temporary failure in name resolution */ #define EAI_BADFLAGS 3 /* invalid value for ai_flags */ #define EAI_FAIL 4 /* non-recoverable failure in name resolution */ #define EAI_FAMILY 5 /* ai_family not supported */ #define EAI_MEMORY 6 /* memory allocation failure */ #define EAI_NODATA 7 /* no address associated with host */ #define EAI_NONAME 8 /* host nor service provided, or not known */ #define EAI_SERVICE 9 /* service not supported for ai_socktype */ #define EAI_SOCKTYPE 10 /* ai_socktype not supported */ #define EAI_SYSTEM 11 /* system error returned in errno */ /* function prototypes */ int getaddrinfo(const char *, const char *, const struct addrinfo *, struct addrinfo **); void freeaddrinfo(struct addrinfo *); int getnameinfo(const struct sockaddr *, size_t, char *, size_t, char *, size_t); #endif /* __addrinfo_h */ libflorist-2025.1.0/c-posix-signals.c000066400000000000000000000455641473553204100173200ustar00rootroot00000000000000/*---------------------------------------------------------------------------- -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- -- -- C - P O S I X - S I G N A L S . C -- -- -- -- -- -- Copyright (C) 1998, Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ----------------------------------------------------------------------------*/ /* file: c-posix-signals.c ======================= [$Revision$] This program generates the file posix-implementation-ok_signals.ads, which is an Ada package specification that defines a list of signals that seem to work correctly with sigwait(). The test is to mask a given signal, then use kill () to send the signal to the current process, then call sigwait () to receive the signal. The observed behavior for some signals is that the process hangs on sigwait, notably for signals whose default action is to ignore the signal or stop the process. In order to allow testing of more than one signal, the program tries to recover if sigwait() hangs. The first attempt was to use alarm() to arrange for another signal to be delivered, if sigwait() did not receive the tested signal within one second. This seemed to have worked for SIGCHLD and SIGCONT, i.e. the signals whose default action is to ignore them. It did not seem to work for SIGSTOP, SITTSTP, SIGTTIN, SIGTTOU, whose default action is to stop the process. In order to recover for these cases, we moved the test of sigwait() into a child process, and arranged for the parent process to send SIGCONT to the child if it stops. This seems to solve the problem. When linking this test don't forget to use "-lpthread", or the appropriate thread library. */ #define _POSIX_C_SIGNALS_C #include "confsrc/pconfig.h" #define _POSIX_C_SOURCE 199506L #define _REENTRANT #include #include #include #include #include #include #include #include #include /* Uncomment the following only for debugging. */ /* #define DEBUG */ int sigs [] = { 0, #ifdef SIG32 SIG32, #endif #ifdef SIGABRT SIGABRT, #endif #ifdef SIGALRM SIGALRM, #endif #ifdef SIGBUS SIGBUS, #endif #ifdef SIGCANCEL SIGCANCEL, #endif #ifdef SIGCHLD SIGCHLD, #endif #ifdef SIGCLD SIGCLD, #endif #ifdef SIGCONT SIGCONT, #endif #ifdef SIGEMT SIGEMT, #endif #ifdef SIGFPE SIGFPE, #endif #ifdef SIGFREEZE SIGFREEZE, #endif #ifdef SIGHUP SIGHUP, #endif #ifdef SIGILL SIGILL, #endif #ifdef SIGINT SIGINT, #endif #ifdef SIGIO SIGIO, #endif #ifdef SIGIOT SIGIOT, #endif #ifdef SIGKILL SIGKILL, #endif #ifdef SIGLOST SIGLOST, #endif #ifdef SIGLWP SIGLWP, #endif #ifdef SIGPIPE SIGPIPE, #endif #ifdef SIGPOLL SIGPOLL, #endif #ifdef SIGPROF SIGPROF, #endif #ifdef SIGQUIT SIGQUIT, #endif #ifdef SIGSEGV SIGSEGV, #endif #ifdef SIGSTKFLT SIGSTKFLT, #endif #ifdef SIGSYS SIGSYS, #endif #ifdef SIGTERM SIGTERM, #endif #ifdef SIGUSR1 SIGUSR1, #endif #ifdef SIGUSR2 SIGUSR2, #endif #ifdef SIGTRAP SIGTRAP, #endif #ifdef SIGSTOP SIGSTOP, #endif #ifdef SIGTHAW SIGTHAW, #endif #ifdef SIGTSTP SIGTSTP, #endif #ifdef SIGTTIN SIGTTIN, #endif #ifdef SIGTTOU SIGTTOU, #endif #ifdef SIGPWR SIGPWR, #endif #ifdef SIGURG SIGURG, #endif #ifdef SIGUNUSED SIGUNUSED, #endif #ifdef SIGVTALRM SIGVTALRM, #endif #ifdef SIGWAITING SIGWAITING, #endif #ifdef SIGWINCH SIGWINCH, #endif #ifdef SIGXCPU SIGXCPU, #endif #ifdef SIGXFSZ SIGXFSZ, #endif 0}; char *signames [] = { "SIGNONE", #ifdef SIG32 "SIG32", #endif #ifdef SIGABRT "SIGABRT", #endif #ifdef SIGALRM "SIGALRM", #endif #ifdef SIGBUS "SIGBUS", #endif #ifdef SIGCANCEL "SIGCANCEL", #endif #ifdef SIGCHLD "SIGCHLD", #endif #ifdef SIGCLD "SIGCLD", #endif #ifdef SIGCONT "SIGCONT", #endif #ifdef SIGEMT "SIGEMT", #endif #ifdef SIGFPE "SIGFPE", #endif #ifdef SIGFREEZE "SIGFREEZE", #endif #ifdef SIGHUP "SIGHUP", #endif #ifdef SIGILL "SIGILL", #endif #ifdef SIGINT "SIGINT", #endif #ifdef SIGIO "SIGIO", #endif #ifdef SIGIOT "SIGIOT", #endif #ifdef SIGKILL "SIGKILL", #endif #ifdef SIGLOST "SIGLOST", #endif #ifdef SIGLWP "SIGLWP", #endif #ifdef SIGPIPE "SIGPIPE", #endif #ifdef SIGPOLL "SIGPOLL", #endif #ifdef SIGPROF "SIGPROF", #endif #ifdef SIGQUIT "SIGQUIT", #endif #ifdef SIGSEGV "SIGSEGV", #endif #ifdef SIGSTKFLT "SIGSTKFLT", #endif #ifdef SIGSYS "SIGSYS", #endif #ifdef SIGTERM "SIGTERM", #endif #ifdef SIGUSR1 "SIGUSR1", #endif #ifdef SIGUSR2 "SIGUSR2", #endif #ifdef SIGTRAP "SIGTRAP", #endif #ifdef SIGSTOP "SIGSTOP", #endif #ifdef SIGTHAW "SIGTHAW", #endif #ifdef SIGTSTP "SIGTSTP", #endif #ifdef SIGTTIN "SIGTTIN", #endif #ifdef SIGTTOU "SIGTTOU", #endif #ifdef SIGPWR "SIGPWR", #endif #ifdef SIGURG "SIGURG", #endif #ifdef SIGUNUSED "SIGUNUSED", #endif #ifdef SIGVTALRM "SIGVTALRM", #endif #ifdef SIGWAITING "SIGWAITING", #endif #ifdef SIGWINCH "SIGWINCH", #endif #ifdef SIGXCPU "SIGXCPU", #endif #ifdef SIGXFSZ "SIGXFSZ", #endif "SIGNONE"}; int namedsigs = sizeof (sigs) / sizeof (int); int nsigs; int *oksigs; int *oksigs_nodefault; int *oksigs_stop; void comment (char const *msg) { #ifdef DEBUG fprintf (stderr, "%s\n", msg); fflush (stderr); #endif } void handler (int sig) { if (sig == SIGALRM) { comment ("==> in handler for SIGALRM"); } else { comment ("==> in handler: unexpected signal"); exit (-1); } } void handler_parent (int sig) { if (sig == SIGALRM) { comment ("==> PARENT: in handler for SIGALRM"); } else { comment ("==> PARENT: in handler: unexpected signal"); kill (0, SIGKILL); exit (-1); } } void print_package (int *oksigs, int *oksigs_nodefault, int *oksigs_stop) { int sig; FILE *fp; fprintf (stderr,"creating package POSIX.Implementation.OK_Signals\n"); if (! (fp = fopen (GENDIR "/posix-implementation-ok_signals.ads", "w"))) { perror ("posix-implemenation-ok_signals.ads"); exit (-1); } fprintf (fp, "package POSIX.Implementation.OK_Signals is\n"); fprintf (fp, "\n"); fprintf (fp, " -- OK (Sig) = True iff we can use Sig" " with sigwait ().\n\n"); fprintf (fp, " OK : constant array (0 .. %d) of Boolean :=\n", nsigs - 1); fprintf (fp, " ("); for (sig = 0; sig < nsigs; sig++) { if (oksigs_nodefault[sig] == 1) fprintf (fp, " True"); else fprintf (fp, "False"); if (sig == nsigs - 1) fprintf (fp, ");\n"); else if (sig % 10 == 9) fprintf (fp, ",\n "); else fprintf (fp, ", "); } fprintf (fp, "\n"); fprintf (fp, " -- Default_Is_Ignore (Sig) = True iff we need to" " override the default\n"); fprintf (fp, " -- treatment of Sig with a do-nothing handler" " before we try to\n"); fprintf (fp, " -- use sigwait() with it.\n\n"); fprintf (fp, " Default_Is_Ignore : constant array" " (0 .. %d) of Boolean :=\n", nsigs - 1); fprintf (fp, " ("); for (sig = 0; sig < nsigs; sig++) { if ((oksigs[sig] != 1) && (oksigs_nodefault[sig] == 1)) fprintf (fp, " True"); else fprintf (fp, "False"); if (sig == nsigs - 1) fprintf (fp, ");\n"); else if (sig % 10 == 9) fprintf (fp, ",\n "); else fprintf (fp, ", "); } fprintf (fp, "\n -- Default_Is_Stop (Sig) = True iff the default" " action of Sig\n -- is to stop the process.\n\n"); fprintf (fp, " Default_Is_Stop : constant array (0 .. %d)" " of Boolean :=\n", nsigs - 1); fprintf (fp, " ("); for (sig = 0; sig < nsigs; sig++) { if (oksigs_stop[sig] == 1) fprintf (fp, " True"); else fprintf (fp, "False"); if (sig == nsigs - 1) fprintf (fp, ");\n"); else if (sig % 10 == 9) fprintf (fp, ",\n "); else fprintf (fp, ", "); } fprintf (fp, "\nend POSIX.Implementation.OK_Signals;\n"); fclose (fp); } int guess_nsigs () { /* Try to find out the range of valid signals. We have not yet discovered a portable C way of doing this. We assume the range starts at 0 and is continuous up to some limit. We need this becuase we want to represent sets of signals as Boolean arrays. We considered using sigset_t directly, and would have liked to do so, but had two problems: (1) sigset_t apparently allows the use of dynamically allocated memory (2) we could not figure out how to check for signal validity; in particular, we needed a way to check for whether a given signal is reserved by the Ada runtime system. */ #if defined(__APPLE__) # define BADSIG (0) #else # define BADSIG (-1) #endif sigset_t set; int sig; int result; int last_good = -1; int first_bad = -1; sigfillset (&set); for (sig = 0; sig < 1024; sig++) { result = sigismember (&set, sig); if (result == 1) { last_good = sig; } else if ((result == BADSIG) && (first_bad == -1)) { if (sig == 0) { fprintf (stderr, "WARNING: C library problem? " "sigfillset does not include zero\n"); } else first_bad = sig; } } if (last_good == 1023) fprintf (stderr, "WARNING: signal range estimate probably too small\n"); if (first_bad < last_good) { fprintf (stderr, "WARNING: signal range estimate may be invalid\n"); last_good = first_bad - 1; } #if defined(__APPLE__) /* On Darwin, the above mechanism fails to make a reasonable guess as to the number of available signals. In the test loop sigismember returns true for every value of sig, including zero, and no first_bad is ever set. For now, hard code a reasonable value. */ return 32; #else return last_good + 1; #endif } void parent_process(pid_t child, int *oksigs, int sig) { /* Monitor the child process until it terminates. If the child process stops, wake it up. If the child process dies via signal, restart it and tell it to skip the last signal it was trying. */ pid_t ret; int status; struct sigaction act; act.sa_flags = 0; act.sa_handler = handler_parent; if (sigaction (SIGALRM, &act, NULL)) perror ("sigaction (handler_parent)"); while (1) { alarm (30); comment (" PARENT: awaiting child status"); fflush (stderr); ret = waitpid ( (pid_t) -1, &status, WUNTRACED); fflush (stderr); if (ret == -1) { if (errno == EINTR) { comment (" PARENT: timed out, sending SIGCONT"); fflush (stderr); kill (child, SIGCONT); alarm (0); sleep (1); continue; } comment (" PARENT: waitpid failed"); kill (0, SIGKILL); exit (-1); } if (ret != child) { comment (" PARENT: unknown child"); kill (0, SIGKILL); exit (-1); } if (WIFSTOPPED (status)) { oksigs_stop [sig] = 1; comment (" PARENT: sending SIGCONT to stopped child"); kill (child, SIGCONT); alarm (0); sleep (1); continue; } if (WIFEXITED (status)) { if (WEXITSTATUS (status) != 1) comment (" PARENT: child exited abnormally"); else { oksigs [sig] = 1; comment (" PARENT: child exited normally"); } return; } if (WIFSIGNALED (status)) { comment(" PARENT: child killed by signal"); fprintf (stderr, "child process killed by signal %d\n", WTERMSIG (status)); return; } comment (" PARENT: invalid child status %x"); kill (0, SIGKILL); exit (-1); } } void test_signal (int nodefaults, int signal) { struct sigaction act; int sig; sigset_t set, oset; int ret; act.sa_flags = 0; act.sa_handler = handler; #ifdef LYNX_SIGTHREADKILL_HACK /* Attempting to test SIGTHREADKILL on LynxOS will kill both the child and the parent process: The call to sigaction fails and falls through to kill (0, SIGKILL). This code works around a problem specific to LynxOS, where signal 24 is reserved by the user space portion of the pthreads implementation. It should be replaced by a general mechanism for skipping problematic signals. */ if (signal == SIGTHREADKILL) { fprintf (stderr, "Reserved by C library.\n"); fflush (stderr); exit (-1); } #endif /* LYNX_SIGTHREADKILL_HACK */ if (sigaction (signal, &act, NULL)) { if (errno == EINVAL) { fprintf (stderr, "cannot be caught\n"); fflush (stderr); exit (-1); } else { fprintf (stderr, " *** sigaction: %s\n", strerror (errno)); fflush (stderr); kill (0, SIGKILL); exit (-1); } } if (! nodefaults) { act.sa_handler = SIG_IGN; if (sigaction (signal, &act, NULL)) { if (errno == EINVAL) { fprintf (stderr, "cannot be ignored\n"); fflush (stderr); exit (-1); } else { fprintf (stderr, " *** sigaction: %s\n", strerror (errno)); fflush (stderr); kill (0, SIGKILL); exit (-1); } } } if (! nodefaults) { act.sa_handler = SIG_DFL; if (sigaction (signal, &act, NULL)) { fprintf (stderr, " *** sigaction: %s\n", strerror (errno)); fflush (stderr); kill (0, SIGKILL); exit (-1); } } if (sigemptyset (&set)) perror ("sigemptyset"); if (sigaddset (&set, signal)) perror ("sigaddset"); if (sigaddset (&set, SIGALRM)) perror ("sigaddset"); comment (" masking signal"); if ((ret = pthread_sigmask (SIG_BLOCK, &set, NULL))) fprintf (stderr, " *** pthread_sigmask (SIG_BLOCK): %s\n", strerror (ret)); if ((ret = pthread_sigmask (SIG_BLOCK, &set, &oset))) fprintf (stderr, " *** pthread_sigmask (SIG_BLOCK 2): %s\n", strerror (ret)); if (sigismember (&oset, signal) == 0) { /* we are unable to mask this signal */ fprintf (stderr, "cannot be masked.\n"); exit (-1); } comment (" sending signal to self"); if (kill (getpid (), signal)) perror ("kill"); comment (" setting one second timeout"); alarm (1); comment (" doing sigwait"); #ifndef _CMA_OS_ if (ret = sigwait (&set, &sig)) { #else ret = sigwait (&set); if (ret == -1) ret = errno; else { sig = ret; ret = 0; } if (ret) { #endif fprintf (stderr, "*** sigwait: %s\n", strerror (ret)); } else if (sig == signal) { fprintf (stderr, "works OK.\n"); exit (1); /* signal is OK */ } else if (sig == SIGALRM) { fprintf (stderr, "*** timed out\n"); } else { fprintf (stderr, "*** wrong signal: %d\n", sig); } exit (-1); } void test_signals (int nodefaults, int *oksigs) { /* Test each signal, to see if it works with sigwait(). If nodefault != 0 then override the default treatment by installing a dummy handler. */ int i; int signal; pid_t child; if (nodefaults) fprintf (stderr, "testing signals without default treatments\n"); else fprintf (stderr, "testing signals with default treatments\n"); for (signal = 1; signal < nsigs; signal++) { for (i = 0; i < namedsigs; i++) if (sigs[i] == signal) break; if (i < namedsigs) fprintf (stderr, "testing signal: %2d %10s ...", signal, signames[i]); else fprintf (stderr, "testing signal: %2d ...", signal); fflush (stderr); if ((child = fork ())) parent_process (child, oksigs, signal); else { test_signal (nodefaults, signal); fprintf (stderr, "*** should never return ***"); exit (-1); } } } int main (int argc, char *argv[]){ int i; struct sigaction act; nsigs = guess_nsigs(); fprintf (stderr, "nsigs: %d\n", nsigs); oksigs = (int *) malloc (nsigs * sizeof (int)); oksigs_nodefault = (int *) malloc (nsigs * sizeof (int)); oksigs_stop = (int *) malloc (nsigs * sizeof (int)); for (i = 0; i < nsigs; i++) oksigs[i] = oksigs_nodefault[i] = oksigs_stop[i]= 0; act.sa_flags = 0; act.sa_handler = handler; if (sigaction (SIGALRM, &act, NULL)) perror ("sigaction (handler)"); #ifdef DEBUG comment ("sending 3 SIGALRM's, to test handler"); fflush (stderr); kill (getpid (), SIGALRM); kill (getpid (), SIGALRM); kill (getpid (), SIGALRM); #endif test_signals (0, oksigs); test_signals (1, oksigs_nodefault); print_package (oksigs, oksigs_nodefault, oksigs_stop); fprintf (stderr, "done.\n"); return 0; } libflorist-2025.1.0/c-posix.c000066400000000000000000005725571473553204100156710ustar00rootroot00000000000000/*---------------------------------------------------------------------------- -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- -- -- C - P O S I X . C -- -- -- -- -- -- Copyright (C) 1991-1994, Florida State University -- -- Copyright (C) 1995-2022, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ----------------------------------------------------------------------------*/ /* file: c-posix.c =============== This program generates the files: posix.ads, posix-limits.ads, posix-options.ads, posix-c.ads */ /* includes ======== Files pconfig.h and config.h are generated by the "configure" script, which in turn is generated by running "autoconf" on "configure.in". */ #include "confsrc/pconfig.h" #include #include #include #include #include #include "confsrc/config.h" #ifdef __hpux__ /* HP-UX headers define an obsolete (and wrong) OPEN_MAX when _XOPEN_SOURCE_EXTENDED is defined. Since we need this macro (_XOPEN.*) to get other POSIX definitions, we kludge here by undefining this unwanted symbol. */ #undef OPEN_MAX #endif int indent = 0; int ifprintf (FILE *stream, const char * format, ...) { va_list arg; int done; int i; va_start(arg, format); for (i = 0; i < indent; i++) fprintf(stream, " "); done = vfprintf(stream, format, arg); va_end(arg); return done; } /* Files pconfig.h and config.h are generated by the "configure" script, which in turn is generated by running "autoconf" on "configure.in". */ /* .... The following #define may belong in pconfig.h. Consider moving it there? */ /* TRY_MACRO_LINKNAMES activates a workaround for header files that define macros for certain POSIX function names, so that a substitute linkname is used. See macro GFUNC for more info. */ #define TRY_MACRO_LINKNAMES /* Macros ====== */ #define NON_SUPPORT_MESSAGE(NAME)\ ifprintf(fp," -- *** MISSING: %s *** --\n", NAME);\ warn("missing",NAME); /* universal constant declarations ------------------------------- In the original design, we did not account for the possibility of long integers coming out as negative with the "%d" format. We then added GUCST, but have only used it for known problem cases. By rights, we should go through all the POSIX symbols, find the ones that are used sa bit-masks, and make sure they all are put out using the unsigned format. */ #define GUCST(name, value) \ ifprintf(fp," %s : constant := %u;\n", name, value); #define GCST(name, value) \ ifprintf(fp," %s : constant := %d;\n", name, value); int max_GCST2; #define GCST2(name, name2, value) \ ifprintf(fp," %s,\n", name);\ ifprintf(fp," %s : constant := %d;\n", name2, value); \ if (value > max_GCST2) max_GCST2 = value; #define GDFLT(name, value) \ NON_SUPPORT_MESSAGE(name)\ ifprintf(fp," %s : constant := %d;\n", name, value); #define GUFLT(name, value) \ NON_SUPPORT_MESSAGE(name)\ ifprintf(fp," %s : constant := %u;\n", name, value); #define GDFLT2(name, name2) \ NON_SUPPORT_MESSAGE(name)\ GCST2(name, name2, -1); /* We use -1 for value above because this may be a missing errno value, for which 0 may mean no error. */ /* struct type definitions ----------------------- They are only to be used in the sequence GT1 (GT2 | GT2A | GT2V | GT2P)+ GT3. Do not interleave any other text or macros. */ /* GT1 --- start of code to generate a struct/record declaration C type name is struct TYPENAME Ada type name is struct_TYPENAME */ #define GT1(TYPENAME,WE_HAVE_IT)\ void g_struct_##TYPENAME(){\ int we_have_it = WE_HAVE_IT;\ struct TYPENAME DUMMY;\ char const typename [] = #TYPENAME;\ int typekind = STRUCT_TYPE;\ component_t comps [] = {\ /* GT1T ---- start of code to generate a struct/record declaration C type name is TYPENAME Ada type name is struct_TYPENAME */ #define GT1T(TYPENAME,WE_HAVE_IT)\ void g_##TYPENAME(){\ int we_have_it = WE_HAVE_IT;\ TYPENAME DUMMY;\ char const typename [] = #TYPENAME;\ int typekind = TYPEDEF_STRUCT_TYPE;\ component_t comps [] = {\ /* GT1R --- start of code to generate a struct/record declaration for structs that have a pointer to the struct type as a component. C type name is struct TYPENAME Ada type name is struct_TYPENAME */ #define GT1R(TYPENAME,WE_HAVE_IT)\ void g_struct_##TYPENAME(){\ int we_have_it = WE_HAVE_IT;\ struct TYPENAME DUMMY;\ char const typename [] = #TYPENAME;\ int typekind = RECURSIVE_STRUCT_TYPE;\ component_t comps [] = {\ /* GT2 --- component of struct/record type, non-aliased component name is COMPNAME component C type is CMPTYP function ada_type_name maps C type name to Ada */ #define GT2(COMPNAME,CMPTYP)\ #COMPNAME, #CMPTYP, sizeof(CMPTYP),\ ((char *)&DUMMY.COMPNAME - (char *)&DUMMY), 0, /* GT2_XPND_ARGS -------- As GT2, but expands any macros passed as arguments. */ #define GT2_XPND_ARGS(COMPNAME,CMPTYP)\ GT2(COMPNAME,CMPTYP) /* GT2A ---- variant of GT2, for component that is an array the component C type is CMPTYP which is an array with components of type CMPCMPTYP N is the number of components */ #define GT2A(COMPNAME,CMPTYP,CMPCMPTYP,N)\ #COMPNAME, #CMPTYP, sizeof(CMPCMPTYP)*N,\ ((char *)&DUMMY.COMPNAME - (char *)&DUMMY), 0, /* GT2V ---- variant of GT2, for component that is volatile */ #define GT2V(COMPNAME,CMPTYP)\ #COMPNAME, #CMPTYP, sizeof(CMPTYP),\ ((char *)&DUMMY.COMPNAME - (char *)&DUMMY), 1, /* GT2P ---- variant of GT2, for component that is a pointer to a function component name is COMPNAME component C type name is CMPTYP function ada_type_name maps C type name to Ada */ void (*DUMMYFPTR) (); #define GT2P(COMPNAME,CMPTYP)\ #COMPNAME, #CMPTYP, sizeof(DUMMYFPTR),\ ((char *)&DUMMY.COMPNAME - (char *)&DUMMY), 0, /* GT3 --- end of struct/record component list */ #define GT3\ 0, 0, 0, 0, 0};\ if (! we_have_it) {\ ifprintf(fp," -- *** MISSING: %s *** --\n", typename);\ warn("missing struct type",typename);}\ save_type(typename, sizeof(DUMMY), typekind, comps);\ print_type_declaration(typename,fp);} /* gen_unchckd_conv ---------------- generate an unchecked conversion FUNC from FROM to TO. */ #define gen_unchckd_conv(FUNC,FROM,TO)\ ifprintf(fp, " function %s is new Ada.Unchecked_Conversion (%s, %s);\n",\ FUNC, FROM, TO); /* gen_renaming ------------ generate a renaming ALIAS for ENT. */ #define gen_renaming(ALIAS,ENT)\ ifprintf(fp, " %s renames %s;\n", ALIAS, ENT); /* other macros ------------ */ #ifdef ENOSYS #else #define ENOSYS -1 #endif #define DEFAULTSIZE (sizeof(int)*bits_per_byte) /* the number of bits in the dummy type that is used to stand in for an unsupported type */ #define XTI_ERROR_FIRST 10000 #define XTI_ERROR_LAST 19999 #define EAI_ERROR_FIRST 20000 #define EAI_ERROR_LAST 29999 /* offsets applied to error codes from t_errno (T_xxxx) and codes from addrinfo (EAI_xxxxx). */ /* type declarations ================= */ /* We build a linked list structure to keep track of of information about POSIX types for which we might want to generate some output, either to the configuration files, or to an Ada package specification. */ typedef struct component { char * compname; /* name of component */ char * typename; /* definition of component type */ int size; /* sizeof (typename) */ int offset; /* offset of component, in bytes */ int is_volatile; /* 0 = nonvolatile, 1 = volatile */ } component_t; /* describes a record component */ /* type kinds */ #define SIGNED_INTEGER_TYPE 1 #define UNSIGNED_INTEGER_TYPE 2 #define STRUCT_TYPE 3 #define TYPEDEF_STRUCT_TYPE 4 #define OPAQUE_TYPE 5 #define CHAR_ARRAY_TYPE 6 #define RECURSIVE_STRUCT_TYPE 7 /* BLH */ /* .... may need to also define a case for union types .... may not need to distinquish struct from typedef */ typedef struct type { char *typename; int typesize; int typekind; int is_printed; component_t *comps; struct type *next; } type_t; /* describes a type */ type_t *all_type_list = NULL; type_t **all_type_tail = &all_type_list; /* subprograms =========== */ void warn(const char msg1[], const char msg2[]); void quit(const char msg1[], const char msg2[]); void save_type (char const name[], int typesize, int typekind, component_t *comps); void print_type_declaration(char const name[], FILE *fp); void gieeeheader(const char pkgname[]); void gspecheader(const char pkgname[]); void print_ada_type (char const typename[]); int wordsize(int n); void gbrg(char name[], char lb[], char ub[]); void gsitp(char name[], int size); void gdflsitp(char name[]); void guitp(char name[], int size); void gdfluitp(char name[]); void gptp(char name[], int size); void gptrtp(char const ptrname[], char const desname[]); void gdflptp(char name[]); void gfunc(char const name[], char const xname[], int have_it); void gfuncd(char const name[], char const xname[], int have_it); void gmaxi(char const name[], int lower_bound); void gmaxii(char const name[], int lower_bound); void gmaxn(char const name[], int lower_bound); void gmaxnn(char const name[], int lower_bound); void gpmaxn(char const name[], int value); void gpmaxr(char const name[], char const oname[]); void grename(char const name[], char const oname[]); void create_options(); void create_limits(); void create_posix(); void create_c(); /* variables ========= */ int bits_per_byte = 0; /* the number of bits in a byte, used for converting C "sizeof" return values to Ada 'size values */ char error_message[128]; /* a temporary buffer for building error messages It is global because we want to be able to return a pointer to it from inside a function. */ FILE *fp; /* current output file */ int network_byte_order; /* 1 means we have network order locally, and so don't need reordering */ /* Table of name to link name mappings ----------------------------------- The following table enumerates mappings to make from name to link name. */ char *name_to_linkname_table[] = { /* The following are variadic functions, so we call them via a wrapper in posix-macros.c. */ "open", "__gnat_florist_open", "sem_open", "__gnat_florist_sem_open", /* The following are implemented as macros on some platforms, so we call them via a wrapper in posix-macros.c. */ "stat", "__gnat_florist_stat", "fstat", "__gnat_florist_fstat", "lstat", "__gnat_florist_lstat", /* The following is implemented as an inline function on some platforms */ "uname", "__gnat_florist_uname", #if (_FILE_OFFSET_BITS == 64) && !defined(__LP64__) /* For a 32-bit system with large file support, force linking against 64-bit functions. */ "readdir", "readdir64", "readdir_r", "readdir64_r", "lseek", "lseek64", "ftruncate", "ftruncate64", /* Note: we already have C wrappers for stat/fstat/lstat so they do not need to be listed here. */ #elif __DARWIN_64_BIT_INO_T && !__DARWIN_ONLY_64_BIT_INO_T /* On Darwin some symbols are versioned to account for optional 64-bit inode numbers. */ "readdir", "readdir" __DARWIN_SUF_64_BIT_INO_T, "readdir_r", "readdir_r" __DARWIN_SUF_64_BIT_INO_T, #endif NULL }; /* Map a name to a linkname. */ const char *n2ln (const char *name) { char **i = name_to_linkname_table; while (*i) { if (strcmp (name, *i) == 0) return *(i + 1); i += 2; } return name; } /* declarations for C types ------------------------ If you make any changes here, also make changes where Ada types are put out, below. (***) */ /* the following are required by the C language standard */ void g_size_t(){ gsitp("size_t", sizeof(size_t)); gptrtp("size_t", "size_t"); } void g_time_t(){ gsitp("time_t", sizeof(time_t)); gptrtp("time_t", "time_t"); } void g_clock_t(){ guitp("clock_t", sizeof(clock_t)); gptrtp("clock_t", "clock_t"); } /* no sense configuring to do without the following types, since they are too basic */ void g_off_t(){gsitp("off_t", sizeof(off_t));} void g_pid_t(){gsitp("pid_t", sizeof(pid_t));} void g_gid_t(){guitp("gid_t", sizeof(gid_t));} void g_uid_t(){guitp("uid_t", sizeof(uid_t));} void g_mode_t(){guitp("mode_t", sizeof(mode_t));} void g_ssize_t(){gsitp("ssize_t", sizeof(ssize_t));} #ifdef HAVE_DIRENT_H void g_DIR(){DIR * x; gptp("DIR", sizeof(x));} #else void g_DIR(){gdflptp("DIR");} #endif #ifdef HAVE_ino_t void g_ino_t(){guitp("ino_t",sizeof(ino_t));} #else void g_ino_t(){gdfluitp("ino_t");} #endif #ifdef HAVE_dev_t void g_dev_t(){guitp("dev_t", sizeof(dev_t));} #else void g_dev_t(){gdfluitp("dev_t");} #endif #ifdef HAVE_nlink_t void g_nlink_t(){guitp("nlink_t", sizeof(nlink_t));} #else void g_nlink_t(){gdfluitp("nlink_t");} #endif #ifdef HAVE_blksize_t void g_blksize_t(){guitp("blksize_t", sizeof(blksize_t));} #else void g_blksize_t(){gdfluitp("blksize_t");} #endif #ifdef HAVE_blkcnt_t void g_blkcnt_t(){guitp("blkcnt_t", sizeof(blkcnt_t));} #else void g_blkcnt_t(){gdfluitp("blkcnt_t");} #endif #ifdef HAVE_cc_t void g_cc_t(){guitp("cc_t", sizeof(cc_t));} #else void g_cc_t(){gdfluitp("cc_t");} #endif #ifdef HAVE_tcflag_t void g_tcflag_t(){guitp("tcflag_t", sizeof(tcflag_t));} #else void g_tcflag_t(){gdfluitp("tcflag_t");} #endif #ifdef HAVE_clockid_t void g_clockid_t(){gsitp("clockid_t", sizeof(clockid_t));} #else void g_clockid_t(){gdflsitp("clockid_t");} #endif #ifdef HAVE_mqd_t void g_mqd_t(){gsitp("mqd_t", sizeof(mqd_t));} #else /* mqd_t must be signed, since the value -1 is used for error return */ void g_mqd_t(){gdflsitp("mqd_t");} #endif #ifdef HAVE_fd_set void g_fd_set(){gptp("fd_set", sizeof(fd_set));} #else void g_fd_set(){gdflptp("fd_set");} #endif #ifdef HAVE_pthread_attr_t void g_pthread_attr_t(){gptp("pthread_attr_t", sizeof(pthread_attr_t));} #else void g_pthread_attr_t(){gdflptp("pthread_attr_t");} #endif #ifdef HAVE_pthread_cond_t void g_pthread_cond_t(){gptp("pthread_cond_t", sizeof(pthread_cond_t));} #else void g_pthread_cond_t(){gdflptp("pthread_cond_t");} #endif #ifdef HAVE_pthread_condattr_t void g_pthread_condattr_t() {gptp("pthread_condattr_t", sizeof(pthread_condattr_t));} #else void g_pthread_condattr_t(){gdflptp("pthread_condattr_t");} #endif #ifdef HAVE_pthread_key_t void g_pthread_key_t(){gptp("pthread_key_t", sizeof(pthread_key_t));} #else void g_pthread_key_t(){gdflptp("pthread_key_t");} #endif #ifdef HAVE_pthread_mutex_t void g_pthread_mutex_t(){gptp("pthread_mutex_t", sizeof(pthread_mutex_t));} #else void g_pthread_mutex_t(){gdflptp("pthread_mutex_t");} #endif #ifdef HAVE_pthread_mutexattr_t void g_pthread_mutexattr_t() {gptp("pthread_mutexattr_t", sizeof(pthread_mutexattr_t));} #else void g_pthread_mutexattr_t(){gdflptp("pthread_mutexattr_t");} #endif #ifdef HAVE_pthread_once_t void g_pthread_once_t(){gptp("pthread_once_t", sizeof(pthread_once_t));} #else void g_pthread_once_t(){gdflptp("pthread_once_t");} #endif #ifdef HAVE_pthread_t void g_pthread_t(){gptp("pthread_t", sizeof(pthread_t));} #else void g_pthread_t(){gdflptp("pthread_t");} #endif #ifdef HAVE_sem_t void g_sem_t(){gptp("sem_t", sizeof(sem_t));} #else void g_sem_t(){gdflptp("sem_t");} #endif #ifdef HAVE_sigset_t void g_sigset_t(){gptp("sigset_t", sizeof(sigset_t));} #else void g_sigset_t(){gdflptp("sigset_t");} #endif #ifdef HAVE_speed_t void g_speed_t(){guitp("speed_t", sizeof(speed_t));} #else void g_speed_t(){gdfluitp("speed_t");} #endif #ifdef HAVE_socklen_t void g_socklen_t(){guitp("socklen_t", sizeof(socklen_t));} #else void g_socklen_t(){gdfluitp("socklen_t");} #endif #ifdef HAVE_timer_t void g_timer_t(){guitp("timer_t", sizeof(timer_t));} #else void g_timer_t(){gdfluitp("timer_t");} #endif /* sigval must precede siginfo_t and struct sigevent */ #ifdef HAVE_sigval #else union sigval { int sival_int; void *sival_ptr; }; #endif void g_sigval(){ #if defined(__hpux__) && defined(__ia64__) /* The definition of sigval on HP-UX for IA64 requires special treatment because the layout of the C type is unusual. */ ifprintf(fp," type Sigval_Int_Part is record\n"); ifprintf(fp," sival_int : int;\n"); ifprintf(fp," end record;\n"); ifprintf(fp," for Sigval_Int_Part use record\n"); ifprintf(fp," sival_int at 12 range 0 .. 31;\n"); ifprintf(fp," end record;\n"); ifprintf(fp," type Sigval_Ptr_Part is record\n"); ifprintf(fp," sival_ptr : System.Address;\n"); ifprintf(fp," end record;\n"); ifprintf(fp," for Sigval_Ptr_Part use record\n"); ifprintf(fp," sival_ptr at 8 range 0 .. 63;\n"); ifprintf(fp," end record;\n"); ifprintf(fp," type sigval (Dummy : Boolean := True) is record\n"); ifprintf(fp," case Dummy is\n"); ifprintf(fp," when True => Int_Part : Sigval_Int_Part;\n"); ifprintf(fp," when False => Ptr_Part : Sigval_Ptr_Part;\n"); ifprintf(fp," end case;\n"); ifprintf(fp," end record;\n"); ifprintf(fp," pragma Unchecked_Union (sigval);\n"); ifprintf(fp," null_sigval : constant sigval :=\n"); ifprintf(fp," (Dummy => False, Ptr_Part => (sival_ptr "); ifprintf(fp,"=> System.Null_Address));\n"); #else ifprintf(fp," type sigval (Dummy : Boolean := True) is record\n"); ifprintf(fp," case Dummy is\n"); ifprintf(fp," when True => sival_int : int;\n"); ifprintf(fp," when False => sival_ptr : System.Address;\n"); ifprintf(fp," end case;\n"); ifprintf(fp," end record;\n"); ifprintf(fp," pragma Unchecked_Union (sigval);\n"); ifprintf(fp," null_sigval : constant sigval :=\n"); ifprintf(fp," (Dummy => False, sival_ptr "); ifprintf(fp,"=> System.Null_Address);\n"); #endif ifprintf(fp," sigval_byte_size : constant := %d;\n", sizeof (union sigval)); ifprintf(fp," sigval_alignment : constant := ALIGNMENT;\n"); } /* siginfo_t must precede sigaction */ #ifdef HAVE_siginfo_t GT1T(siginfo_t, 1) #else typedef struct siginfo { int si_signo; int si_code; union sigval si_value; } siginfo_t; GT1T(siginfo_t, 0) #endif GT2(si_signo, int) GT2(si_code, int) GT2(si_value, union sigval) GT3 /* sigevent must precede aiocb */ #ifdef HAVE_struct_sigevent GT1(sigevent, 1) #else struct sigevent { int sigev_notify; int sigev_signo; union sigval sigev_value; /* void (*)(union sigval) sigev_notify_function; */ int sigev_notify_function; /* (pthread_attr_t *) sigev_notify_attributes; */ int sigev_notify_attributes; }; GT1(sigevent, 0) #endif GT2(sigev_notify,int) GT2(sigev_signo,int) GT2(sigev_value,union sigval) #ifdef HAVE_component_sigev_notify_function GT2(sigev_notify_function, void (*)(union sigval)) GT2(sigev_notify_attributes,pthread_attr_t *) #endif GT3 #ifdef HAVE_struct_aiocb GT1(aiocb, 1) #else struct aiocb { int aio_fildes; off_t aio_offset; volatile void * aio_buf; size_t aio_nbytes; int aio_reqprio; struct sigevent aio_sigevent; int aio_lio_opcode; }; GT1(aiocb, 0) #endif GT2(aio_fildes, int) GT2(aio_offset, off_t) GT2V(aio_buf, volatile void *) GT2(aio_nbytes, size_t) GT2(aio_reqprio, int) GT2(aio_sigevent, struct sigevent) GT2(aio_lio_opcode, int) GT3 #ifdef HAVE_struct_dirent GT1(dirent, 1) #else struct dirent { char d_name[1]; }; GT1(dirent, 0) #endif GT2A(d_name, POSIX_String (1 .. 1), char, 1) GT3 #ifdef HAVE_struct_flock GT1(flock, 1) #else struct flock { short l_type; short l_whence; off_t l_start; off_t l_len; pid_t l_pid; }; GT1(flock, 0) #endif GT2(l_type, short) GT2(l_whence, short) GT2(l_start, off_t) GT2(l_len, off_t) GT2(l_pid, pid_t) GT3 #ifdef HAVE_struct_group GT1(group, 1) #else struct group { char * gr_name; gid_t gr_gid; char ** gr_mem; }; GT1(group, 0) #endif GT2(gr_name, char *) GT2(gr_gid, gid_t) GT2(gr_mem, char **) GT3 #ifdef HAVE_struct_mq_attr GT1(mq_attr, 1) #else struct mq_attr { long mq_flags; long mq_maxmsg; long mq_msgsize; long mq_curmsgs; }; GT1(mq_attr, 0) #endif GT2(mq_flags, long) GT2(mq_maxmsg, long) GT2(mq_msgsize, long) GT2(mq_curmsgs, long) GT3 #ifdef HAVE_struct_passwd GT1(passwd, 1) #else struct passwd { char * pw_name; uid_t pw_uid; gid_t pw_gid; char * pw_dir; char * pw_shell; }; GT1(passwd, 0) #endif GT2(pw_name, char *) GT2(pw_uid, uid_t) GT2(pw_gid, gid_t) GT2(pw_dir, char *) GT2(pw_shell, char *) GT3 #if defined(HAVE_struct_sigaction) || defined(HAVE_struct_cma_sigaction) GT1(sigaction, 1) #else struct sigaction { void (*sa_handler)(); sigset_t sa_mask; int sa_flags; void (*sa_sigaction)(int,siginfo_t *, void *); }; GT1(sigaction, 0) #endif GT2P(sa_handler, System.Address) GT2(sa_mask, sigset_t) GT2(sa_flags, int) #ifdef HAVE_component_sa_sigaction GT2P(sa_sigaction, System.Address) #else #endif GT3 /* ....how to put message if a component, like sa_sigaction, if it is missing? consider putting a mark in the component descriptor. */ /* ....check P1003.1c to see what is the correct component name Provenzano uses "prio". We had "sched_priority". */ #ifdef HAVE_struct_sched_param GT1(sched_param, 1) #else struct sched_param { int sched_priority; }; GT1(sched_param, 0) #endif GT2(sched_priority, int) GT3 #ifdef HAVE_struct_stat GT1(stat, 1) #else struct stat { mode_t st_mode; ino_t st_ino; dev_t st_dev; nlink_t st_nlink; uid_t st_uid; gid_t st_gid; off_t st_size; blksize_t st_blksize; blkcnt_t st_blocks; time_t st_atime; time_t st_mtime; time_t st_ctime; }; GT1(stat, 0) #endif GT2(st_mode, mode_t) GT2(st_ino, ino_t) GT2(st_dev, dev_t) GT2(st_nlink, nlink_t) GT2(st_uid, uid_t) GT2(st_gid, gid_t) GT2(st_size, off_t) GT2(st_blksize, blksize_t) GT2(st_blocks, blkcnt_t) GT2(st_atime, time_t) GT2(st_mtime, time_t) GT2(st_ctime, time_t) GT3 #ifdef HAVE_struct_termios GT1(termios, 1) #else struct termios { tcflag_t c_iflag; tcflag_t c_oflag; tcflag_t c_cflag; tcflag_t c_lflag; cc_t c_cc[1]; }; GT1(termios, 0) #endif GT2(c_iflag, tcflag_t) GT2(c_oflag, tcflag_t) GT2(c_cflag, tcflag_t) GT2(c_lflag, tcflag_t) GT2A(c_cc, cc_t_array, cc_t, NCCS) GT3 #ifdef HAVE_suseconds_t #else #ifdef HAVE_struct_timeval struct timeval struct_timeval_temp; typedef __typeof__ (struct_timeval_temp.tv_usec) suseconds_t; #else typedef int suseconds_t; #endif #endif #ifdef HAVE_struct_timeval GT1(timeval, 1) #else struct timeval { time_t tv_sec; suseconds_t tv_usec; }; GT1(timeval, 0) #endif GT2(tv_sec, time_t) GT2(tv_usec, suseconds_t) GT3 struct timeval struct_timeval_dummy; void g_suseconds_t() {gsitp("suseconds_t", sizeof(struct_timeval_dummy.tv_usec));} #ifdef HAVE_struct_iovec GT1(iovec, 1) #else struct iovec { char * iov_base; size_t iov_len; }; GT1(iovec, 0) #endif GT2(iov_base, char *) GT2(iov_len, size_t) GT3 #ifdef HAVE_struct_timespec GT1(timespec, 1) #else struct timespec { time_t tv_sec; long tv_nsec; }; GT1(timespec, 0) #endif GT2(tv_sec,time_t) GT2(tv_nsec,long) GT3 #ifdef HAVE_struct_itimerspec GT1(itimerspec, 1) #else struct itimerspec { struct timespec it_interval; struct timespec it_value; }; GT1(itimerspec, 0) #endif GT2(it_interval, struct timespec) GT2(it_value, struct timespec) GT3 #ifdef HAVE_struct_tm GT1(tm, 1) #else struct tm { int tm_sec; int tm_min; int tm_hour; int tm_mday; int tm_mon; int tm_year; int tm_wday; int tm_yday; int tm_isdst; }; GT1(tm, 0) #endif GT2(tm_sec,int) GT2(tm_min,int) GT2(tm_hour,int) GT2(tm_mday,int) GT2(tm_mon,int) GT2(tm_year,int) GT2(tm_wday,int) GT2(tm_yday,int) GT2(tm_isdst,int) GT3 #ifdef HAVE_struct_tms GT1(tms, 1) #else struct tms { clock_t tms_utime; clock_t tms_stime; clock_t tms_cstime; clock_t tms_cutime; }; GT1(tms, 0) #endif GT2(tms_utime, clock_t) GT2(tms_stime, clock_t) GT2(tms_cutime, clock_t) GT2(tms_cstime, clock_t) GT3 #ifdef HAVE_struct_utimbuf GT1(utimbuf, 1) #else struct utimbuf { time_t modtime; time_t actime; }; GT1(utimbuf, 0) #endif GT2(modtime, time_t) GT2(actime, time_t) GT3 #ifdef HAVE_struct_utsname GT1(utsname, 1) #else struct utsname { char sysname [257]; char nodename [257]; char release [257]; char version [257]; char machine [257]; }; GT1(utsname, 0) #endif GT2A(sysname, utsname_sysname_string, char, sizeof(DUMMY.sysname)) GT2A(nodename, utsname_nodename_string, char, sizeof(DUMMY.nodename)) GT2A(release, utsname_release_string, char, sizeof(DUMMY.release)) GT2A(version, utsname_version_string, char, sizeof(DUMMY.version)) GT2A(machine, utsname_machine_string, char, sizeof(DUMMY.machine)) GT3 #ifdef HAVE_sa_family_t #else typedef unsigned short sa_family_t; #endif #ifdef HAVE_in_port_t #else typedef unsigned short in_port_t; #endif /* in_addr_t should be 4 bytes long It is likely to be defined as int or long, depending on the machine architecture. We use char[4] here if the system does not define an appropriate type. */ #ifdef HAVE_struct_in_addr #ifdef HAVE_in_addr_t #else typedef char in_addr_t[4]; #endif GT1(in_addr, 1) #else #ifdef HAVE_in_addr_t #else typedef char in_addr_t[4]; #endif struct in_addr { in_addr_t s_addr; }; GT1(in_addr, 0) #endif GT2(s_addr, in_addr_t) GT3 #ifdef HAVE_struct_sockaddr GT1(sockaddr, 1) #else struct sockaddr { sa_family_t sa_family; char sa_data [14]; }; GT1(sockaddr, 0) #endif GT2(sa_family, sa_family_t) GT2A(sa_data, POSIX_String (1 .. 14), char, sizeof (DUMMY.sa_data)) GT3 #ifdef HAVE_struct_sockaddr_un GT1(sockaddr_un, 1) #else struct sockaddr_un { sa_family_t sun_family; char sun_path [100]; }; GT1(sockaddr_un, 0) #endif GT2(sun_family, sa_family_t) GT2A(sun_path, sun_path_string, char, sizeof (DUMMY.sun_path)) GT3 #ifdef HAVE_struct_sockaddr_in GT1(sockaddr_in, 1) #else struct sockaddr_in { sa_family_t sin_family; in_port_t sin_port; struct in_addr sin_addr; char sin_zero [8]; }; GT1(sockaddr_in, 0) #endif GT2(sin_family, sa_family_t) GT2(sin_port, in_port_t) GT2(sin_addr, struct in_addr) GT2A(sin_zero, POSIX_String (1 .. 8), char, 8) GT3 #ifdef HAVE_struct_linger GT1(linger, 1) #else struct linger { int l_onoff; int l_linger; }; GT1(linger, 0) #endif GT2(l_onoff, int) GT2(l_linger, int) GT3 #ifdef HAVE_struct_msghdr GT1(msghdr, 1) #else struct msghdr { struct sockaddr * msg_name; size_t msg_namelen; struct iovec * msg_iov; size_t msg_iovlen; #ifdef _BSD4_3_ caddr_t msg_accrights; /* access rights sent/received */ int msg_accrightslen; #else char * msg_control; size_t msg_controllen; int msg_flags; #endif }; GT1(msghdr, 0) #endif GT2(msg_name, struct sockaddr *) GT2(msg_namelen, size_t) GT2(msg_iov, struct iovec *) GT2(msg_iovlen, size_t) #ifdef _BSD4_3_ GT2(msg_accrights,caddr_t) GT2(msg_accrightslen,int) #else #ifdef HAVE_component_msg_control GT2(msg_control, char *) #endif #ifdef HAVE_component_msg_controllen #if defined (__sparc__) && defined (__arch64__) GT2(msg_controllen, int) #else #ifdef HAVE_socklen_t GT2(msg_controllen, socklen_t) #else GT2(msg_controllen, size_t) #endif #endif #endif #ifdef HAVE_component_msg_flags GT2(msg_flags, int) #endif #endif GT3 #ifdef HAVE_struct_cmsghdr GT1(cmsghdr, 1) #else struct cmsghdr { int cmsg_level; int cmsg_type; size_t cmsg_len; }; GT1(cmsghdr, 0) #endif GT2(cmsg_level, int) GT2(cmsg_type, int) #if (defined (__sparc__) && defined (__arch64__)) GT2(cmsg_len, int) #elif HAVE_socklen_t GT2(cmsg_len, socklen_t) #else GT2(cmsg_len, size_t) #endif GT3 #ifdef HAVE_struct_ip_opts GT1(ip_opts, 1) #else struct ip_opts { struct in_addr ip_dst; char ip_opts[40]; }; GT1(ip_opts, 0) #endif GT2(ip_dst, struct in_addr) GT2A(ip_opts, POSIX.Octet_Array (1 .. 40), char, 40) GT3 #ifdef HAVE_struct_hostent GT1(hostent, 1) #else struct hostent { char * h_name; char ** h_aliases; int h_addrtype; int h_length; char ** h_addr_list; }; GT1(hostent, 0) #endif GT2(h_name, char *) GT2(h_aliases, char **) GT2(h_addrtype, int) GT2(h_length, int) GT2(h_addr_list, char **) GT3 #ifdef HAVE_struct_netent GT1(netent, 1) #else struct netent { char * n_name; char ** n_aliases; int n_addrtype; unsigned long n_net; }; GT1(netent, 0) #endif GT2(n_name, char *) GT2(n_aliases, char **) GT2(n_addrtype, int) GT2(n_net, in_addr_t) /* POSIX 1003.1g/D6.4 says n_net should be unsigned long, but it should be 4 bytes and unsigned long might be longer than that on some systems. Solaris 2.6 uses in_addr_t, which seems safer. */ GT3 #ifdef HAVE_struct_protoent GT1(protoent, 1) #else struct protoent { char * p_name; char ** p_aliases; int p_proto; }; GT1(protoent, 0) #endif GT2(p_name, char *) GT2(p_aliases, char **) GT2(p_proto, int) GT3 #ifdef HAVE_struct_servent GT1(servent, 1) #else struct servent { char * s_name; char ** s_aliases; int s_port; char * s_proto; }; GT1(servent, 0) #endif GT2(s_name, char *) GT2(s_aliases, char **) GT2(s_port, int) GT2(s_proto, char *) GT3 /* BLH : Changed GT1 to GT1R to handle addrinfo pointer */ #ifdef HAVE_struct_addrinfo GT1R(addrinfo, 1) #else struct addrinfo { int ai_flags; int ai_family; int ai_socktype; int ai_protocol; size_t ai_addrlen; struct sockaddr * ai_addr; char * ai_canonname; struct addrinfo * ai_next; }; GT1R(addrinfo, 0) #endif GT2(ai_flags, int) GT2(ai_family, int) GT2(ai_socktype, int) GT2(ai_protocol, int) /* Workaround layout issue on Sparc64 version 10. */ #if defined (__solaris10__) && defined (__arch64__) GT2(_ai_pad, int) GT2(ai_addrlen, int) #else GT2(ai_addrlen, size_t) #endif GT2(ai_addr, struct sockaddr *) GT2(ai_canonname, char *) GT2(ai_next, struct addrinfo *) GT3 /* XTI structs */ /* netbuf must precede all others */ #ifdef HAVE_struct_netbuf GT1(netbuf,1) #else struct netbuf { unsigned int maxlen; unsigned int len; char * buf; }; GT1(netbuf,0) #endif GT2(maxlen, unsigned int) GT2(len, unsigned int) GT2(buf, char *) GT3 /* t_info structure */ #ifndef XTI_TINFO_FTYPE #define XTI_TINFO_FTYPE long #endif #ifdef HAVE_struct_t_info GT1(t_info,1) #else struct t_info { XTI_TINFO_FTYPE addr; XTI_TINFO_FTYPE options; XTI_TINFO_FTYPE tsdu; XTI_TINFO_FTYPE etsdu; XTI_TINFO_FTYPE connect; XTI_TINFO_FTYPE discon; XTI_TINFO_FTYPE servtype; XTI_TINFO_FTYPE flags; }; GT1(t_info,0) #endif GT2_XPND_ARGS(addr, XTI_TINFO_FTYPE) GT2_XPND_ARGS(options, XTI_TINFO_FTYPE) GT2_XPND_ARGS(tsdu, XTI_TINFO_FTYPE) GT2_XPND_ARGS(etsdu, XTI_TINFO_FTYPE) GT2_XPND_ARGS(connect, XTI_TINFO_FTYPE) GT2_XPND_ARGS(discon, XTI_TINFO_FTYPE) GT2_XPND_ARGS(servtype, XTI_TINFO_FTYPE) #ifndef _TLI_ /* not xti compliant but usable */ GT2_XPND_ARGS(flags, XTI_TINFO_FTYPE) #endif GT3 /* t_opthdr structure */ #ifndef XTI_OPTHDR_FTYPE #define XTI_OPTHDR_FTYPE unsigned long #endif #ifdef HAVE_struct_t_opthdr GT1(t_opthdr,1) #else struct t_opthdr { XTI_OPTHDR_FTYPE len; XTI_OPTHDR_FTYPE level; XTI_OPTHDR_FTYPE name; XTI_OPTHDR_FTYPE status; }; GT1(t_opthdr,0) #endif GT2_XPND_ARGS(len, XTI_OPTHDR_FTYPE) GT2_XPND_ARGS(level, XTI_OPTHDR_FTYPE) GT2_XPND_ARGS(name, XTI_OPTHDR_FTYPE) GT2_XPND_ARGS(status, XTI_OPTHDR_FTYPE) GT3 /* t_bind structure */ #ifdef HAVE_struct_t_bind GT1(t_bind,1) #else struct t_bind { struct netbuf addr; unsigned qlen; }; GT1(t_bind,0) #endif GT2(addr, struct netbuf) GT2(qlen, unsigned) GT3 /* t_optmgmt structure */ #ifdef HAVE_struct_t_optmgmt GT1(t_optmgmt,1) #else struct t_optmgmt { struct netbuf opt; long flags; }; GT1(t_optmgmt,0) #endif GT2(opt, struct netbuf) GT2(flags, long) GT3 /* t_discon structure */ #ifdef HAVE_struct_t_discon GT1(t_discon,1) #else struct t_discon { struct netbuf udata; int reason; int sequence; }; GT1(t_discon,0) #endif GT2(udata, struct netbuf) GT2(reason, int) GT2(sequence, int) GT3 /* t_call structure */ #ifdef HAVE_struct_t_call GT1(t_call,1) #else struct t_call { struct netbuf addr; struct netbuf opt; struct netbuf udata; int sequence; }; GT1(t_call, 0) #endif GT2(addr, struct netbuf) GT2(opt, struct netbuf) GT2(udata, struct netbuf) GT2(sequence, int) GT3 /* t_unitdata structure */ #ifdef HAVE_struct_t_unitdata GT1(t_unitdata,1) #else struct t_unitdata { struct netbuf addr; struct netbuf opt; struct netbuf udata; }; GT1(t_unitdata,0) #endif GT2(addr, struct netbuf) GT2(opt, struct netbuf) GT2(udata, struct netbuf) GT3 /* t_uderr structure */ #ifdef HAVE_struct_t_uderr GT1(t_uderr,1) #else struct t_uderr { struct netbuf addr; struct netbuf opt; long error; }; GT1(t_uderr,0) #endif GT2(addr, struct netbuf) GT2(opt, struct netbuf) GT2(error, long) GT3 /* Sturcture used with linger option */ #ifndef XTI_LINGER_FTYPE #define XTI_LINGER_FTYPE long #endif #ifdef HAVE_struct_t_linger GT1(t_linger,1) #else struct t_linger { XTI_LINGER_FTYPE l_onoff; XTI_LINGER_FTYPE l_linger; }; GT1(t_linger,0) #endif GT2_XPND_ARGS(l_onoff, XTI_LINGER_FTYPE) GT2_XPND_ARGS(l_linger, XTI_LINGER_FTYPE) GT3 /* t_iovec structure */ #ifdef HAVE_struct_t_iovec GT1(t_iovec,1) #else struct t_iovec { char * iov_base; unsigned int iov_len; }; GT1(t_iovec,0) #endif GT2(iov_base, char *) GT2(iov_len, unsigned int) GT3 /* t_kpalive structure */ #ifndef XTI_KPALIVE_FTYPE #define XTI_KPALIVE_FTYPE long #endif #ifdef HAVE_struct_t_kpalive GT1(t_kpalive,1) #else struct t_kpalive { XTI_KPALIVE_FTYPE kp_onoff; XTI_KPALIVE_FTYPE kp_timeout; }; GT1(t_kpalive,0) #endif GT2_XPND_ARGS(kp_onoff, XTI_KPALIVE_FTYPE) GT2_XPND_ARGS(kp_timeout, XTI_KPALIVE_FTYPE) GT3 /* Poll/Select */ /* pollfd structure */ #ifdef HAVE_struct_pollfd GT1(pollfd,1) #else struct pollfd { int fd; short events; short revents; }; GT1(pollfd,0) #endif GT2(fd, int) GT2(events, short) GT2(revents, short) GT3 /* fd_set type ----------- POSIX.1G does not require fd_set to be a (visible) struct */ #ifdef HAVE_fd_set #else typedef struct fd_set { unsigned int fds_bits[32]; } fd_set; #endif /* warn ---- */ void warn(const char msg1[], const char msg2[]) { fprintf(stderr,"%s: %s\n",msg1,msg2); } /* quit ---- */ void quit(const char msg1[], const char msg2[]) { warn(msg1, msg2); exit(-1); } /* save_type --------- make a permanent copy of the information about a type with components, linked into a list on all_type_list, and return a pointer to the new node. */ void save_type (char const name[], int typesize, int typekind, component_t *comps) { type_t *tmp; int count; component_t *p; tmp = all_type_list; for (tmp=all_type_list; tmp && strcmp(tmp->typename,name); tmp=tmp->next); if (tmp) quit("DUPLICATE TYPE DEFINITION",name); tmp = malloc(sizeof(type_t)); tmp->typekind = typekind; tmp->is_printed = 0; count = strlen(name); tmp->typename = malloc(count+1); memcpy(tmp->typename,name,count+1); tmp->typesize = typesize; count = 0; if (comps) { for (p=comps;p->compname;p++) { /* Normalize component names by stripping out leading underscores. */ while (p -> compname [0] == '_') p -> compname++; count++; } tmp->comps = malloc((count+1)*sizeof(component_t)); memcpy(tmp->comps,comps,(count+1)*sizeof(component_t)); } tmp->next = NULL; *all_type_tail = tmp; all_type_tail = &tmp->next; } /* print_type_declaration ---------------------- print out Ada type declaration for C type with specified name */ void print_type_declaration(char const name[], FILE *fp) { type_t * type; component_t const * p; char extended_name[128]; type = all_type_list; for (type=all_type_list; type && strcmp(type->typename,name); type=type->next); if (type == NULL) { NON_SUPPORT_MESSAGE(name); return; } if (type->is_printed) ("TYPE ALREADY DECLARED",name); if (type->typekind == STRUCT_TYPE || type->typekind == RECURSIVE_STRUCT_TYPE) { if (strlen(type->typename)>=sizeof(extended_name)) { quit("type name too long",type->typename); } strcpy(extended_name,"struct_"); strcat(extended_name,type->typename); } else { if (strlen(type->typename)>=sizeof(extended_name)) { quit("type name too long",type->typename); } strcpy(extended_name,type->typename); } switch (type->typekind) { case SIGNED_INTEGER_TYPE: ifprintf(fp," type %s is range -2**%d .. (2**%d) - 1;\n", type->typename, type->typesize*bits_per_byte-1, type->typesize*bits_per_byte-1); ifprintf(fp," for %s'Size use %d;\n", extended_name, type->typesize*bits_per_byte); break; case UNSIGNED_INTEGER_TYPE: ifprintf(fp," type %s is mod 2**%d;\n", type->typename, type->typesize*bits_per_byte); ifprintf(fp," for %s'Size use %d;\n", extended_name, type->typesize*bits_per_byte); break; case STRUCT_TYPE: case TYPEDEF_STRUCT_TYPE: { component_t * p; int prev_offset = -1; ifprintf(fp," type %s is record\n", extended_name); for (p = type->comps; p && p->typename; p++) { ifprintf(fp," %s : ", p->compname); print_ada_type(p->typename); fprintf(fp,";\n"); if (p->is_volatile) ifprintf(fp," pragma Volatile (%s);\n", p->compname); } ifprintf(fp," end record;\n"); ifprintf(fp," for %s use record\n", extended_name); for (p = type->comps; p && p->compname; p++) { /* GNAT isn't able to handle overlapping components, so we add a simple minded test to prevent the most common cases */ if (p->offset == prev_offset) ifprintf(fp," -- *** OVERLAPPING component ***\n" " -- %s at %d range 0 .. %d;\n", p->compname, p->offset, p->size*bits_per_byte-1); else ifprintf(fp," %s at %d range 0 .. %d;\n", p->compname, p->offset, p->size*bits_per_byte-1); prev_offset = p->offset; } ifprintf(fp," end record;\n"); ifprintf(fp," pragma Convention (C_Pass_By_Copy, %s);\n", extended_name); ifprintf(fp," for %s'Alignment use ALIGNMENT;\n", extended_name); ifprintf(fp," pragma Warnings (Off);\n"); ifprintf(fp," -- There may be holes in the record, due to\n"); ifprintf(fp," -- components not defined by POSIX standard.\n"); ifprintf(fp," for %s'Size use %d;\n", extended_name, type->typesize*bits_per_byte); ifprintf(fp," pragma Warnings (On);\n"); gptrtp(type->typename, extended_name); break; } case RECURSIVE_STRUCT_TYPE: /* BLH */ { component_t * p; int prev_offset = -1; ifprintf(fp," type %s;\n", extended_name); gptrtp(type->typename, extended_name); ifprintf(fp," type %s is record\n", extended_name); for (p = type->comps; p && p->typename; p++) { ifprintf(fp," %s : ", p->compname); print_ada_type(p->typename); fprintf(fp,";\n"); if (p->is_volatile) ifprintf(fp," pragma Volatile (%s);\n", p->compname); } ifprintf(fp," end record;\n"); ifprintf(fp," for %s use record\n", extended_name); for (p = type->comps; p && p->compname; p++) { /* GNAT isn't able to handle overlapping components, so we add a simple minded test to prevent the most common cases */ if (p->offset == prev_offset) ifprintf(fp," -- *** OVERLAPPING component ***\n" " -- %s at %d range 0 .. %d;\n", p->compname, p->offset, p->size*bits_per_byte-1); else ifprintf(fp," %s at %d range 0 .. %d;\n", p->compname, p->offset, p->size*bits_per_byte-1); prev_offset = p->offset; } ifprintf(fp," end record;\n"); ifprintf(fp," pragma Convention (C_Pass_By_Copy, %s);\n", extended_name); ifprintf(fp," for %s'Alignment use ALIGNMENT;\n", extended_name); ifprintf(fp," pragma Warnings (Off);\n"); ifprintf(fp," -- There may be holes in the record, due to\n"); ifprintf(fp," -- components not defined by POSIX standard.\n"); ifprintf(fp," for %s'Size use %d;\n", extended_name, type->typesize*bits_per_byte); ifprintf(fp," pragma Warnings (On);\n"); break; } case CHAR_ARRAY_TYPE: ifprintf(fp," type %s is\n", extended_name); ifprintf(fp," array (1 .. %d) of char;\n", type->typesize); ifprintf(fp," for %s'Alignment use ALIGNMENT;\n", type->typename); gptrtp(type->typename,extended_name); break; case OPAQUE_TYPE: ifprintf(fp," type %s is\n", extended_name); ifprintf(fp," array (1 .. %d) of int;\n", wordsize(type->typesize)); ifprintf(fp," for %s'Alignment use ALIGNMENT;\n", type->typename); ifprintf(fp," for %s'Size use %d;\n", extended_name, type->typesize*bits_per_byte); gptrtp(type->typename,extended_name); break; default: break; } } #define IEEE_Header 1 #define FSU_Header 2 #define LMCo_Header 3 /* gheader ------- generate standard copyright header for automatically generated POSIX Ada binding package specification with name *pkgname */ void gheader(const char pkgname[], int header_kind) { int i; int namelen = strlen(pkgname); fprintf(fp,"-- DO NOT EDIT THIS FILE.\n"); fprintf(fp,"-- It is generated automatically, by program c-posix.c"); fprintf(fp,"\n"); fprintf(fp,"----------------------------------------"); fprintf(fp,"--------------------------------------\n"); fprintf(fp,"-- "); fprintf(fp," --\n"); if ((header_kind == FSU_Header || header_kind == LMCo_Header)) { fprintf(fp,"-- FLORIST (FSU Implementatio"); fprintf(fp,"n of POSIX.5) COMPONENTS --\n"); } else { fprintf(fp,"-- POSIX Ada95 Bindings for Protocol I"); fprintf(fp,"ndependent Interfaces (P1003.5c) --\n"); } fprintf(fp,"-- "); fprintf(fp," --\n"); fprintf(fp,"--"); for (i = 1; i<38-namelen; i++) fprintf(fp," "); for (i = 0; i= sizeof (int)) { save_type(name, size, OPAQUE_TYPE, NULL); } else { save_type(name, size, CHAR_ARRAY_TYPE, NULL); } print_type_declaration(name,fp); } /* gdflptp ------- generate default completion of private type declaration for C type not supported by the underlying OS */ void gdflptp(char name[]) { NON_SUPPORT_MESSAGE(name) gptp(name, DEFAULTSIZE/bits_per_byte); } /* GFUNC ------ macro wrapper for function gfunc, for cases where we are concerned that the function may have been renamed via a macro. This came up with DEC UNIX, for the pthread_-names. It also came up with HP-UX, for the pthread_-names. The extra layer of macro is to force expansion of name2 if it is a macro, even when we later quote it. */ #define GFUNC(name, have_it) GFUNCB(#name, name, have_it) #define GFUNCB(qname, qxname, have_it) gfunc(qname, #qxname, have_it) /* gfunc ----- generate constant for C name of function that notfies of errors by returning -1 with an error code in errno This lets us raise an exception for functions that are not available in the libraries. */ void gfunc(char const name[], char const xname[], int have_it) { if (have_it) { ifprintf (fp," HAVE_%s : constant Boolean := True;\n", name); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(name)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(name)); } else { #ifdef TRY_MACRO_LINKNAMES if (strcmp(name, xname)) { /* We have a macro masquerading as a function name. If this code results in problems, #undef TRY_MACRO_LINKNAMES and recompile c-posix.c. These functions will then simply be treated as not available. */ ifprintf(fp," -- We guessed %s is implemented as a macro that\n", name); ifprintf(fp," -- expands to the real function name." " This is risky...\n"); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(xname)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(xname)); } else #endif { ifprintf(fp," -- *** MISSING: function %s *** --\n", name); warn("missing function ", name); ifprintf (fp," HAVE_%s : constant Boolean := False;\n", name); ifprintf (fp," %s_LINKNAME : constant String := \"nosys_neg_one\";\n", name); } } } /* gfuncsol -------- variant of gfunc to work around feature of Solaris header files, which implement some POSIX functions by locally defined wrappers that call a real function whose name has the form __posix_XXX. */ void gfuncsol(char const name[], char const xname[]) { ifprintf(fp," -- We guessed %s is implemented as a wrapper\n", name); ifprintf(fp," -- that calls the real function. This is risky...\n"); ifprintf (fp," HAVE_%s : constant Boolean := True;\n", name); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(xname)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(xname)); } /* GFUNCNS ------_ like GFUNC, but generates ENOTSUP instead of ENOSYS if the function is not supported. */ #define GFUNCNS(name, have_it) GFUNCNSB(#name, name, have_it) #define GFUNCNSB(qname, qxname, have_it) gfuncns(qname, #qxname, have_it) /* gfuncns ------- like gfunc, except uses ENOTSUP instead of ENOSYS if not supported */ void gfuncns(char const name[], char const xname[], int have_it) { if (have_it) { ifprintf (fp," HAVE_%s : constant Boolean := True;\n", name); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(name)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(name)); } else { #ifdef TRY_MACRO_LINKNAMES if (strcmp(name, xname)) { /* We have a macro masquerading as a function name. If this code results in problems, #undef TRY_MACRO_LINKNAMES and recompile c-posix.c. These functions will then simply be treated as not available. */ ifprintf(fp," -- We guessed %s is implemented as a macro that\n", name); ifprintf(fp," -- expands to the real function name." " This is risky...\n"); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(xname)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(xname)); } else #endif { ifprintf(fp," -- *** MISSING: function %s *** --\n", name); warn("missing function ", name); ifprintf (fp," HAVE_%s : constant Boolean := False;\n", name); ifprintf (fp," %s_LINKNAME : constant String := \"notsup_neg_one\";\n", name); } } } /* GFUNCD ------ macro wrapper for function gfuncd, for cases where we are concerned that the function may have been renamed via a macro. This came up with DEC UNIX, for the pthread_-names. The extra layer of macro is to force expansion of name2 if it is a macro, even when we later quote it. */ #define GFUNCD(name, have_it) GFUNCDB(#name, name, have_it) #define GFUNCDB(qname, qxname, have_it) gfuncd(qname, #qxname, have_it) /* gfuncd ------ same as gfunc, except for function that notifies of errors by returning an error code directly. */ void gfuncd(char const name[], char const xname[], int have_it) { if (have_it) { if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(name)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(name)); } else { #ifdef TRY_MACRO_LINKNAMES if (strcmp(name, xname)) { /* We have a macro masquerading as a function name. If this results in problems, #undef TRY_MACRO_LINKNAMES and recompile c-posix.c. These functions will then simply be treated as not available. */ ifprintf(fp," -- Apparently this function is actually a macro.\n"); ifprintf(fp," -- We are guessing that" " the macro expands to a linkable name.\n"); ifprintf(fp," -- This is risky...\n"); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(xname)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(xname)); } else #endif { ifprintf(fp," -- *** MISSING: function %s *** --\n", name); warn("missing function ", name); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"nosys_direct\";\n", name); } else ifprintf (fp," %s_LINKNAME : constant String := \"nosys_direct\";\n", name); } } } /* GFUNCDNS -------- like GFUNCD, except that error code is ENOTSUP if not supported */ #define GFUNCDNS(name, have_it) GFUNCDNSB(#name, name, have_it) #define GFUNCDNSB(qname, qxname, have_it) gfuncdns(qname, #qxname, have_it) /* gfuncdns -------- same as gfuncd, except that error code for nonsupport is ENOTSUP */ void gfuncdns(char const name[], char const xname[], int have_it) { if (have_it) { if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(name)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(name)); } else { #ifdef TRY_MACRO_LINKNAMES if (strcmp(name, xname)) { /* We have a macro masquerading as a function name. If this results in problems, #undef TRY_MACRO_LINKNAMES and recompile c-posix.c. These functions will then simply be treated as not available. */ ifprintf(fp," -- Apparently this function is actually a macro.\n"); ifprintf(fp," -- We are guessing that" " the macro expands to a linkable name.\n"); ifprintf(fp," -- This is risky...\n"); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"%s\";\n", n2ln(xname)); } else ifprintf (fp," %s_LINKNAME : constant String := \"%s\";\n", name, n2ln(xname)); } else #endif { ifprintf(fp," -- *** MISSING: function %s *** --\n", name); warn("missing function ", name); if (strlen(name) > 20) { ifprintf(fp," %s_LINKNAME : constant String :=\n", name); ifprintf(fp," \"notsup_direct\";\n", name); } else ifprintf (fp," %s_LINKNAME : constant String := \"notsup_direct\";\n", name); } } } /* gmaxn ----- generate _Maxima subtype of Natural */ void gmaxn(char const name[], int lower_bound) { ifprintf(fp," subtype %s_Maxima is Natural range\n",name); ifprintf(fp," %d .. Natural'Last;\n",lower_bound); } /* gmaxnn ----- generate _Maxima subtype of Natural with tight bound */ void gmaxnn(char const name[], int bound) { ifprintf(fp," subtype %s_Maxima is Natural range\n",name); ifprintf(fp," %d .. %d;\n", bound, bound); } /* gmaxi ----- generate _Maxima subtype of IO_Count */ void gmaxi(char const name[], int lower_bound) { ifprintf(fp," subtype %s_Maxima is IO_Count range\n",name); ifprintf(fp," %d .. IO_Count'Last;\n",lower_bound); } /* gmaxi ----- generate _Maxima subtype of IO_Count with tight range */ void gmaxii(char const name[], int bound) { ifprintf(fp," subtype %s_Maxima is IO_Count range\n",name); ifprintf(fp," %d .. %d;\n", bound, bound); } /* gpmaxi ------ generate portable maximum constant of type IO_Count with specified value */ void gpmaxi(char const name[], int value) { ifprintf(fp," Portable_%s_Maximum :\n",name); ifprintf(fp," constant IO_Count := %d;\n",value); } /* gpmaxn ------ generate portable maximum constant of type Natural with specified value */ void gpmaxn(char const name[], int value) { ifprintf(fp," Portable_%s_Maximum :\n",name); ifprintf(fp," constant Natural := %d;\n",value); } /* gpmaxr ------ generate portable maximum constant of type Natural as renaming of constant in package POSIX */ void gpmaxr(char const name[], char const oname[]) { ifprintf(fp," Portable_%s_Maximum : Natural\n",name); ifprintf(fp," renames POSIX.Portable_%s_Maximum;\n",oname); } /* gpmaxrioc --------- generate portable maximum constant of type IO_Count as renaming of constant in package POSIX */ void gpmaxrioc(char const name[], char const oname[]) { ifprintf(fp," Portable_%s_Maximum : POSIX.IO_Count\n",name); ifprintf(fp," renames POSIX.Portable_%s_Maximum;\n",oname); } /* grename ------- */ void grename (char const name[], char const oname[]) { ifprintf(fp," subtype %s is\n",name); ifprintf(fp," POSIX.%s;\n",oname); } /* gmacrofunc ---------- */ void gmacrofunc (char const funcname[], char const parmtype[], char const parmname[]) { ifprintf(fp," function %s (%s : %s) return int;\n", funcname, parmname, parmtype); ifprintf(fp," pragma Import (C, %s, \"%s\");\n", funcname, funcname); } /* create_options -------------- create package POSIX.Options, in file posix-options.ads */ void create_options() { fprintf(stderr,"creating package POSIX_Options\n"); if (! (fp = fopen (GENDIR "/posix-options.ads", "w"))) { perror ("posix-options.ads"); quit("can't open file to write",""); } gheader("POSIX.Options", IEEE_Header); ifprintf(fp,"package POSIX.Options is\n"); #ifdef _POSIX_ASYNCHRONOUS_IO gbrg("Asynchronous_IO_Support", "True", "True"); #else #ifdef _POSIX_ASYNC_IO #if (_POSIX_ASYNC_IO == -1) gbrg("Asynchronous_IO_Support", "False", "False"); #else gbrg("Asynchronous_IO_Support", "True", "True"); #endif #else gbrg("Asynchronous_IO_Support", "False", "True"); #endif #endif grename("Change_Owner_Restriction","Change_Owner_Restriction"); grename("Filename_Truncation","Filename_Truncation"); #ifdef _POSIX_FSYNC gbrg("File_Synchronization_Support", "True", "True"); #else gbrg("File_Synchronization_Support", "False", "True"); #endif grename("Job_Control_Support","Job_Control_Support"); #ifdef _POSIX_MAPPED_FILES gbrg("Memory_Mapped_Files_Support", "True", "True"); #else gbrg("Memory_Mapped_Files_Support", "False", "True"); #endif #ifdef _POSIX_MEMLOCK gbrg("Memory_Locking_Support", "True", "True"); #else gbrg("Memory_Locking_Support", "False", "True"); #endif #ifdef _POSIX_MEMLOCK_RANGE gbrg("Memory_Range_Locking_Support", "True", "True"); #else gbrg("Memory_Range_Locking_Support", "False", "True"); #endif #ifdef _POSIX_MEMORY_PROTECTION gbrg("Memory_Protection_Support", "True", "True"); #else gbrg("Memory_Protection_Support", "False", "True"); #endif #ifdef _POSIX_MESSAGE_PASSING gbrg("Message_Queues_Support", "True", "True"); #else gbrg("Message_Queues_Support", "False", "True"); #endif grename("Saved_IDs_Support","Saved_IDs_Support"); gbrg("Mutexes_Support", "True", "True"); #ifdef _POSIX_PRIORITIZED_IO gbrg("Prioritized_IO_Support", "True", "True"); #else #ifdef _POSIX_PRIO_IO #if (_POSIX_PRIO_IO == -1) gbrg("Prioritized_IO_Support", "False", "False"); #else gbrg("Prioritized_IO_Support", "True", "True"); #endif #else gbrg("Prioritized_IO_Support", "False", "True"); #endif #endif #ifdef _POSIX_PRIORITY_SCHEDULING gbrg("Priority_Process_Scheduling_Support", "True", "True"); #ifdef _POSIX_THREADS gbrg("Priority_Task_Scheduling_Support", "True", "True"); #else gbrg("Priority_Task_Scheduling_Support", "False", "False"); #endif #else gbrg("Priority_Process_Scheduling_Support", "False", "True"); gbrg("Priority_Task_Scheduling_Support", "False", "False"); #endif #ifdef _POSIX_REALTIME_SIGNALS gbrg("Realtime_Signals_Support", "True", "True"); #else gbrg("Realtime_Signals_Support", "False", "True"); #endif #ifdef _POSIX_SEMAPHORES gbrg("Semaphores_Support", "True", "True"); #else gbrg("Semaphores_Support", "False", "True"); #endif #ifdef _POSIX_SHARED_MEMORY_OBJECTS gbrg("Shared_Memory_Objects_Support", "True", "True"); #else gbrg("Shared_Memory_Objects_Support", "False", "True"); #endif gbrg("Signal_Entries_Support", "True", "True"); #ifdef _POSIX_SYNCHRONIZED_IO gbrg("Synchronized_IO_Support", "True", "True"); #else #ifdef _POSIX_SYNC_IO #if (_POSIX_SYNC_IO == -1) gbrg("Synchronized_IO_Support", "False", "False"); #else gbrg("Synchronized_IO_Support", "True", "True"); #endif #else gbrg("Synchronized_IO_Support", "False", "True"); #endif #endif #ifdef _POSIX_THREAD_PRIO_PROTECT gbrg("Mutex_Priority_Ceiling_Support", "True", "True"); #else gbrg("Mutex_Priority_Ceiling_Support", "False", "True"); #endif #ifdef _POSIX_THREAD_PRIO_INHERIT gbrg("Mutex_Priority_Inheritance_Support", "True", "True"); #else gbrg("Mutex_Priority_Inheritance_Support", "False", "True"); #endif #ifdef _POSIX_THREAD_PROCESS_SHARED gbrg("Process_Shared_Support", "True", "True"); #else gbrg("Process_Shared_Support", "False", "True"); #endif #ifdef _POSIX_TIMERS gbrg("Timers_Support", "True", "True"); #else gbrg("Timers_Support", "False", "True"); #endif /* options from POSIX.5c [D2] */ /* What does _POSIX_PII map to in Ada? #ifdef _POSIX_PII gbrg("????_Support", "True", "True"); #else gbrg("????_Support", "False", "True"); #endif */ #ifdef _POSIX_PII_XTI gbrg("XTI_DNI_Support", "True", "True"); #else gbrg("XTI_DNI_Support", "False", "True"); #endif #ifdef _POSIX_PII_INTERNET_DGRAM gbrg("Internet_Datagram_Support", "True", "True"); #else gbrg("Internet_Datagram_Support", "False", "True"); #endif #ifdef _POSIX_PII_INTERNET gbrg("Internet_Protocol_Support", "True", "True"); #else gbrg("Internet_Protocol_Support", "False", "True"); #endif #ifdef _POSIX_PII_INTERNET_STREAM gbrg("Internet_Stream_Support", "True", "True"); #else gbrg("Internet_Stream_Support", "False", "True"); #endif #ifdef _POSIX_PII_OSI gbrg("ISO_OSI_Protocol_Support", "True", "True"); #else gbrg("ISO_OSI_Protocol_Support", "False", "True"); #endif #ifdef _POSIX_PII_OSI_M gbrg("OSI_Minimal_Support", "True", "True"); #else gbrg("OSI_Minimal_Support", "False", "True"); #endif #ifdef _POSIX_PII_OSI_COTS gbrg("OSI_Connection_Support", "True", "True"); #else gbrg("OSI_Connection_Support", "False", "True"); #endif #ifdef _POSIX_PII_OSI_CLTS gbrg("OSI_Connectionless_Support", "True", "True"); #else gbrg("OSI_Connectionless_Support", "False", "True"); #endif #ifdef _POSIX_POLL gbrg("Poll_Support", "True", "True"); #else gbrg("Poll_Support", "False", "True"); #endif #ifdef _POSIX_SELECT gbrg("Select_Support", "True", "True"); #else gbrg("Select_Support", "False", "True"); #endif #ifdef _POSIX_PII_SOCKET gbrg("Sockets_DNI_Support", "True", "True"); #else gbrg("Sockets_DNI_Support", "False", "True"); #endif #ifdef _POSIX_PII_NET_SUPPORT gbrg("Network_Management_Support", "True", "True"); #else gbrg("Network_Management_Support", "False", "True"); #endif ifprintf(fp,"end POSIX.Options;\n"); fclose (fp); fprintf(stderr,"done generating posix-options.ads\n"); } /* create_limits ------------- create package POSIX.Limits, in file posix-limits.ads */ void create_limits() { fprintf(stderr,"creating package POSIX_Limits\n"); if (! (fp = fopen (GENDIR "/posix-limits.ads", "w"))) { perror ("posix-limits.ads"); quit("can't open file to write",""); } gheader("POSIX.Limits", IEEE_Header); ifprintf(fp,"package POSIX.Limits is\n"); ghdrcmnt("Portable System Limits"); ifprintf(fp," -- .... Change P1003.5b?\n"); ifprintf(fp," -- to allow these constants\n"); ifprintf(fp," -- to be larger than the minimum values specified.\n\n"); gpmaxr("Argument_List","Argument_List"); ifprintf(fp," Portable_Asynchronous_IO_Maximum :\n"); ifprintf(fp," constant Natural := 1;\n"); gpmaxr("Child_Processes","Child_Processes"); ifprintf(fp," Portable_Clock_Resolution_Minimum :\n"); ifprintf(fp," constant := 20_000_000;\n"); /* notice that this is a MINIMUM, so we don't use gpmax */ gpmaxr("Filename","Filename_Limit"); gpmaxr("Groups","Groups"); gpmaxrioc("Input_Line","Input_Line_Limit"); gpmaxrioc("Input_Queue","Input_Queue_Limit"); gpmaxr("Links","Link_Limit"); #ifdef _POSIX_AIO_LISTIO_MAX gpmaxn("List_IO",_POSIX_AIO_LISTIO_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_AIO_LISTIO_MAX"); gpmaxn("List_IO", 2); #endif #ifdef _POSIX_MQ_PRIO_MAX gpmaxn("Message_Priority",_POSIX_MQ_PRIO_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_MQ_PRIO_MAX"); gpmaxn("Message_Priority", 32); #endif gpmaxr("Open_Files","Open_Files"); #ifdef _POSIX_MQ_OPEN_MAX gpmaxn("Open_Message_Queues",_POSIX_MQ_OPEN_MAX); #else gpmaxn("Open_Message_Queues",8); #endif gpmaxr("Pathname","Pathname_Limit"); gpmaxrioc("Pipe_Length","Pipe_Limit"); #ifdef _POSIX_SIGQUEUE_MAX gpmaxn("Queued_Signals",_POSIX_SIGQUEUE_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_SIGQUEUE_MAX"); gpmaxn("Queued_Signals", 32); #endif #ifdef _POSIX_RTSIG_MAX gpmaxn("Realtime_Signals",_POSIX_RTSIG_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_RTSIG_MAX"); gpmaxn("Realtime_Signals",8); #endif #ifdef _POSIX_SEM_NSEMS_MAX gpmaxn("Semaphores",_POSIX_SEM_NSEMS_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_SEM_NSEMS_MAX"); gpmaxn("Semaphores", 256); #endif #ifdef _POSIX_SEM_VALUE_MAX gpmaxn("Semaphores_Value",_POSIX_SEM_VALUE_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_SEM_VALUE_MAX"); gpmaxn("Semaphores_Value", 32767); #endif gpmaxr("Streams","Stream"); #ifdef _POSIX_DELAYTIMER_MAX gpmaxn("Timer_Overruns",_POSIX_DELAYTIMER_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_DELAYTIMER_MAX"); gpmaxn("Timer_Overruns", 32); #endif #ifdef _POSIX_TIMER_MAX gpmaxn("Timers",_POSIX_TIMER_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_NTIMER_MAX") gpmaxn("Timers", 32); #endif gpmaxr("Time_Zone_String","Time_Zone_String"); fprintf(fp,"\n"); ifprintf(fp," -- limits from POSIX.5c [D2]\n\n"); #ifdef _POSIX_FD_SETSIZE gpmaxn("File_Descriptor_Set", _POSIX_FD_SETSIZE); #else gpmaxr("File_Descriptor_Set", "Open_Files"); #endif #ifdef _POSIX_HIWAT gpmaxi("Socket_Buffer", _POSIX_HIWAT); #else gpmaxrioc("Socket_Buffer", "Pipe_Limit"); #endif #ifdef _POSIX_UIO_MAXIOV gpmaxn("Socket_IO_Vector", _POSIX_UIO_MAXIOV); #else gpmaxn("Socket_IO_Vector", 16); #endif #ifdef _POSIX_QLIMIT gpmaxn("Socket_Connection", _POSIX_QLIMIT); #else gpmaxn("Socket_Connection", 1); #endif #ifdef _POSIX_UIO_MAXIOV gpmaxn("XTI_IO_Vector", _POSIX_UIO_MAXIOV); #else gpmaxn("XTI_IO_Vector", 16); #endif ghdrcmnt("Configurable Limits"); grename("Argument_List_Maxima","Argument_List_Maxima"); #ifdef AIO_MAX gmaxnn("Asynchronous_IO",AIO_MAX); #else #ifdef _POSIX_AIO_MAX gmaxn("Asynchronous_IO",_POSIX_AIO_MAX); #else gmaxn("Asynchronous_IO", 1); #endif #endif #ifdef AIO_PRIO_DELTA_MAX gmaxnn("Asynchronous_IO_Priority_Delta",AIO_PRIO_DELTA_MAX); #else gmaxn("Asynchronous_IO_Priority_Delta", 0); #endif grename("Child_Processes_Maxima","Child_Processes_Maxima"); grename("Filename_Maxima","Filename_Limit_Maxima"); grename("Groups_Maxima","Groups_Maxima"); grename("Input_Line_Maxima","Input_Line_Limit_Maxima"); grename("Input_Queue_Maxima","Input_Queue_Limit_Maxima"); grename("Links_Maxima","Link_Limit_Maxima"); #ifdef AIO_LISTIO_MAX gmaxnn("List_IO",AIO_LISTIO_MAX); #else #ifdef _POSIX_AIO_LISTIO_MAX gmaxn("List_IO",_POSIX_AIO_LISTIO_MAX); #else gmaxn("List_IO", 2); #endif #endif #ifdef MQ_PRIO_MAX gmaxnn("Message_Priority",MQ_PRIO_MAX); #else #ifdef _POSIX_MQ_PRIO_MAX gmaxn("Message_Priority",_POSIX_MQ_PRIO_MAX); #else gmaxn("Message_Priority", 32); #endif #endif #ifdef MQ_OPEN_MAX gmaxnn("Open_Message_Queues",MQ_OPEN_MAX); #else #ifdef _POSIX_MQ_OPEN_MAX gmaxn("Open_Message_Queues",_POSIX_MQ_OPEN_MAX); #else gmaxn("Open_Message_Queues", 8); #endif #endif grename("Open_Files_Maxima","Open_Files_Maxima"); ifprintf(fp," subtype Page_Size_Range "); #ifdef PAGESIZE ifprintf(fp," is Natural range %d .. %d;\n", PAGESIZE, PAGESIZE); #else #ifdef _SC_PAGESIZE ifprintf(fp," is Natural range %d .. %d;\n", sysconf(_SC_PAGESIZE), sysconf(_SC_PAGESIZE)); #else ifprintf(fp," is Natural range 0 .. -1;\n"); #endif #endif grename("Pathname_Maxima","Pathname_Limit_Maxima"); grename("Pipe_Length_Maxima","Pipe_Limit_Maxima"); #ifdef SIGQUEUE_MAX gmaxnn("Queued_Signals",SIGQUEUE_MAX); #else #ifdef _POSIX_SIGQUEUE_MAX gmaxn("Queued_Signals",_POSIX_SIGQUEUE_MAX); #else gmaxn("Queued_Signals", 32); #endif #endif #ifdef RTSIG_MAX gmaxnn("Realtime_Signals",RTSIG_MAX); #else #ifdef _POSIX_RTSIG_MAX gmaxn("Realtime_Signals",_POSIX_RTSIG_MAX); #else gmaxn("Realtime_Signals",8); #endif #endif #ifdef SEM_NSEMS_MAX gmaxnn("Semaphores",SEM_NSEMS_MAX); #else #ifdef _POSIX_SEM_NSEMS_MAX gmaxn("Semaphores",_POSIX_SEM_NSEMS_MAX); #else gmaxn("Semaphores", 256); #endif #endif #ifdef SEM_VALUE_MAX /* Semaphores_Value bounds are declared as Natural, and thus cannot exceed INT_MAX. */ if (SEM_VALUE_MAX > INT_MAX) gmaxnn("Semaphores_Value",INT_MAX); else gmaxnn("Semaphores_Value",SEM_VALUE_MAX); #else #ifdef _POSIX_SEM_VALUE_MAX gmaxn("Semaphores_Value",_POSIX_SEM_VALUE_MAX); #else gmaxn("Semaphores_Value", 32767); #endif #endif grename("Streams_Maxima","Stream_Maxima"); #ifdef DELAYTIMER_MAX gmaxnn("Timer_Overruns",DELAYTIMER_MAX); #else #ifdef _POSIX_DELAYTIMER_MAX gmaxn("Timer_Overruns",_POSIX_DELAYTIMER_MAX); #else gmaxn("Timer_Overruns", 32); #endif #endif #ifdef TIMER_MAX gmaxnn("Timers",TIMER_MAX); #else #ifdef _POSIX_TIMER_MAX gmaxn("Timers",_POSIX_TIMER_MAX); #else gmaxn("Timers", 32); #endif #endif grename("Time_Zone_String_Maxima","Time_Zone_String_Maxima"); /* limits from POSIX.5c/D4 */ fprintf(fp,"\n"); fprintf(fp," -- limits from POSIX.5c [D2]\n\n"); #ifdef FD_SETSIZE gmaxnn("File_Descriptor_Set", FD_SETSIZE); #else #ifdef _POSIX_FD_SETSIZE gmaxn("File_Descriptor_Set", _POSIX_FD_SETSIZE); #else #ifdef _POSIX_PIPE_BUF gmaxn("File_Descriptor_Set", _POSIX_PIPE_BUF); #else gmaxn("File_Descriptor_Set", 8); #endif #endif #endif #ifdef SOCK_MAXBUF gmaxii("Socket_Buffer", SOCK_MAXBUF); #else #ifdef _POSIX_PIPE_BUF gmaxi("Socket_Buffer", _POSIX_PIPE_BUF); #else gmaxi("Socket_Buffer", 8); #endif #endif #ifdef UIO_MAXIOV gmaxnn ("Socket_IO_Vector", UIO_MAXIOV); #else #ifdef _POSIX_UIO_MAXIOV gmaxn ("Socket_IO_Vector", _POSIX_UIO_MAXIOV); #else gmaxn ("Socket_IO_Vector", 16); #endif #endif #ifdef _POSIX_QLIMIT gmaxn ("Socket_Connection", _POSIX_QLIMIT); #else gmaxn ("Socket_Connection", 1); #endif #ifdef T_IOV_MAX gmaxnn ("XTI_IO_Vector", T_IOV_MAX); #else #ifdef _POSIX_UIO_MAXIOV gmaxn("XTI_IO_Vector", _POSIX_UIO_MAXIOV); #else gmaxn("XTI_IO_Vector", 16); #endif #endif ifprintf(fp,"end POSIX.Limits;\n"); fclose (fp); fprintf(stderr,"done generating posix-limits.ads\n"); } /* create_posix ------------ create package POSIX, in file posix.ads */ void create_posix() { int max_posix_error; int XTI_Error_First; int XTI_Error_Last; int EAI_Error_First; int EAI_Error_Last; int count; /* The Makefile is responsible for defining LIBS correctly */ #ifdef LIBS char libs[] = LIBS, *s1, *s2; #endif fprintf(stderr,"creating package POSIX\n"); if (! (fp = fopen (GENDIR "/posix.ads", "w"))) { perror ("posix.ads"); quit("can't open file to write",""); } gheader("POSIX", IEEE_Header); ifprintf(fp,"with Ada.Streams;\n"); ifprintf(fp,"with Interfaces;\n"); ifprintf(fp,"package POSIX is\n\n"); #ifdef LIBS /* Generate one pragma Linker_Options per library */ for (s1 = libs; *s1; ) { for (s2 = s1; *s2 && *s2 != ' '; s2++); if (*s2) { *s2 = '\0'; ifprintf(fp," pragma Linker_Options (\"%s\");\n", s1); s1 = s2 + 1; } else s1 = s2; } #endif fprintf(fp,"\n"); ifprintf(fp," -- 2.4.1 Constants and Static Subtypes\n\n"); fprintf(fp," -- Version Identification\n\n"); #ifdef _POSIX_VERSION GCST("POSIX_Version", _POSIX_VERSION); #else GDFLT("POSIX_Version", 0); #endif ifprintf(fp," POSIX_Ada_Version : constant := 1995_00;\n\n"); ifprintf(fp," -- Optional Facilities (obsolescent, 0)\n"); ifprintf(fp," -- See package POSIX.Limits for preferred interfaces.\n\n"); #ifdef _POSIX_JOB_CONTROL gbrg("Job_Control_Support", "True", "True"); #else gbrg("Job_Control_Support", "False", "True"); #endif #ifdef _POSIX_SAVED_IDS gbrg("Saved_IDs_Support", "True", "True"); #else gbrg("Saved_IDs_Support", "False", "False"); #endif #ifdef _POSIX_CHOWN_RESTRICTED #if (_POSIX_CHOWN_RESTRICTED == -1) gbrg("Change_Owner_Restriction", "False", "False"); #else gbrg("Change_Owner_Restriction", "True", "True"); #endif #else gbrg("Change_Owner_Restriction", "False", "True"); #endif #ifdef _POSIX_NO_TRUNC #if (_POSIX_NO_TRUNC == -1) gbrg("Filename_Truncation", "False", "False"); #else gbrg("Filename_Truncation", "True", "True"); #endif #else gbrg("Filename_Truncation", "False", "True"); #endif ifprintf(fp," -- Bytes and I/O Counts\n\n"); ifprintf(fp," Byte_Size : constant := %d;\n\n",bits_per_byte); ifprintf(fp," type IO_Count is range -2**%d .. (2**%d) - 1;\n\n", sizeof(ssize_t)*bits_per_byte-1, sizeof(ssize_t)*bits_per_byte-1); ifprintf(fp," for IO_Count'Size use %d;\n", sizeof(ssize_t)*bits_per_byte); gmaxi("IO_Count", 32767); ifprintf(fp," -- System Limits (obsolescent)\n"); ifprintf(fp," -- See package POSIX.Limits for preferred interfaces.\n\n"); /* Run-Time Increasable Values These must be defined, but the actual limits, as reported by sysconf(), may be higher. */ #ifdef _POSIX_NGROUPS_MAX gpmaxn("Groups",_POSIX_NGROUPS_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_NGROUPS_MAX"); gpmaxn("Groups", 0); #endif #ifdef NGROUPS_MAX /* run-time increasable value */ gmaxn("Groups",NGROUPS_MAX); #else #ifdef _POSIX_NGROUPS_MAX gmaxn("Groups", _POSIX_NGROUPS_MAX); #else gmaxn("Groups", 0); #endif #endif /* Runtime Invariant Values These need not be defined. If defined, these are reliable static bounds, not to be exceeded by the sysconf() result. */ #ifdef _POSIX_ARG_MAX gpmaxn("Argument_List",_POSIX_ARG_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_ARG_MAX"); gpmaxn("Argument_List",4096); #endif #ifdef ARG_MAX gmaxnn("Argument_List", ARG_MAX); #else #ifdef _POSIX_ARG_MAX gmaxn("Argument_List", _POSIX_ARG_MAX); #else gmaxn("Argument_List",4096); #endif #endif #ifdef _POSIX_CHILD_MAX gpmaxn("Child_Processes",_POSIX_CHILD_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_CHILD_MAX"); gpmaxn("Child_Processes",6); #endif #ifdef CHILD_MAX gmaxnn("Child_Processes", CHILD_MAX); #else #ifdef _POSIX_CHILD_MAX gmaxn("Child_Processes", _POSIX_CHILD_MAX); #else gmaxn("Child_Processes",6); #endif #endif #ifdef _POSIX_OPEN_MAX gpmaxn("Open_Files",_POSIX_OPEN_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_OPEN_MAX"); gpmaxn("Open_Files", 16); #endif #ifdef OPEN_MAX gmaxnn("Open_Files", OPEN_MAX); #else #ifdef _POSIX_OPEN_MAX gmaxn("Open_Files", _POSIX_OPEN_MAX); #else gmaxn("Open_Files", 16); #endif #endif #ifdef _POSIX_STREAM_MAX gpmaxn("Stream",_POSIX_STREAM_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_STREAM_MAX"); gpmaxn("Stream",8); #endif #ifdef STREAM_MAX gmaxnn("Stream", STREAM_MAX); #else #ifdef _POSIX_STREAM_MAX gmaxn("Stream", _POSIX_STREAM_MAX); #else gmaxn("Stream",8); #endif #endif #ifdef _POSIX_TZNAME_MAX gpmaxn("Time_Zone_String",_POSIX_TZNAME_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_TZNAME_MAX"); gpmaxn("Time_Zone_String", 3); #endif #ifdef TZNAME_MAX gmaxnn("Time_Zone_String", TZNAME_MAX); #else #ifdef _POSIX_TZNAME_MAX gmaxn("Time_Zone_String", _POSIX_TZNAME_MAX); #else gmaxn("Time_Zone_String", 3); #endif #endif /* Pathname Variable Values These need not be defined. If defined, these are reliable static bounds, not to be exceeded by pathconf() result. */ ifprintf(fp," -- Pathname Variable Values (obsolescent)\n"); ifprintf(fp," -- See package POSIX.Limits for preferred" " interfaces.\n\n"); #ifdef _POSIX_LINK_MAX gpmaxn("Link_Limit",_POSIX_LINK_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_LINK_MAX"); gpmaxn("Link_Limit",8); #endif #ifdef LINK_MAX gmaxnn("Link_Limit", LINK_MAX); #else #ifdef _POSIX_LINK_MAX gmaxn("Link_Limit", _POSIX_LINK_MAX); #else gmaxn("Link_Limit",8); #endif #endif #ifdef _POSIX_MAX_INPUT gpmaxi("Input_Line_Limit",_POSIX_MAX_INPUT); #else NON_SUPPORT_MESSAGE("_POSIX_MAX_INPUT"); gpmaxi("Input_Line_Limit", 255); #endif #ifdef MAX_INPUT gmaxii("Input_Line_Limit",MAX_INPUT); #else #ifdef _POSIX_MAX_INPUT gmaxi("Input_Line_Limit", _POSIX_MAX_INPUT); #else gmaxi("Input_Line_Limit", 255); #endif #endif #ifdef _POSIX_MAX_CANON gpmaxi("Input_Queue_Limit",_POSIX_MAX_CANON); #else NON_SUPPORT_MESSAGE("_POSIX_MAX_CANON"); gpmaxi("Input_Queue_Limit", 255); #endif #ifdef MAX_CANON gmaxii("Input_Queue_Limit", MAX_CANON); #else #ifdef _POSIX_MAX_CANON gmaxi("Input_Queue_Limit", _POSIX_MAX_CANON); #else gmaxi("Input_Queue_Limit", 255); #endif #endif #ifdef _POSIX_NAME_MAX gpmaxn("Filename_Limit",_POSIX_NAME_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_NAME_MAX"); gpmaxn("Filename_Limit", 14); #endif #ifdef NAME_MAX gmaxnn("Filename_Limit", NAME_MAX); #else #ifdef _POSIX_NAME_MAX gmaxn("Filename_Limit", _POSIX_NAME_MAX); #else gmaxn("Filename_Limit", 14); #endif #endif #ifdef _POSIX_PATH_MAX gpmaxn("Pathname_Limit",_POSIX_PATH_MAX); #else NON_SUPPORT_MESSAGE("_POSIX_PATH_MAX"); gpmaxn("Pathname_Limit", 255); #endif #ifdef PATH_MAX gmaxnn("Pathname_Limit", PATH_MAX); #else #ifdef _POSIX_PATH_MAX gmaxn("Pathname_Limit", _POSIX_PATH_MAX); #else gmaxn("Pathname_Limit", 255); #endif #endif #ifdef _POSIX_PIPE_BUF gpmaxi("Pipe_Limit",_POSIX_PIPE_BUF); #else gpmaxi("Pipe_Limit", 512); #endif #ifdef PIPE_BUF gmaxii("Pipe_Limit", PIPE_BUF); #else #ifdef _POSIX_PIPE_BUF gmaxi("Pipe_Limit", _POSIX_PIPE_BUF); #else gmaxi("Pipe_Limit", 512); #endif #endif ifprintf(fp," -- Blocking Behavior Values\n"); ifprintf(fp," type Blocking_Behavior is (Tasks, Program, Special);\n"); ifprintf(fp," subtype Text_IO_Blocking_Behavior is Blocking_Behavior\n"); ifprintf(fp," range Tasks .. Tasks;\n"); ifprintf(fp," IO_Blocking_Behavior :"); ifprintf(fp," constant Blocking_Behavior\n"); ifprintf(fp," := Tasks;\n"); ifprintf(fp," File_Lock_Blocking_Behavior :"); ifprintf(fp," constant Blocking_Behavior\n"); ifprintf(fp," := Tasks;\n"); ifprintf(fp," Wait_For_Child_Blocking_Behavior :"); ifprintf(fp," constant Blocking_Behavior\n"); ifprintf(fp," := Tasks;\n"); ifprintf(fp," subtype Realtime_Blocking_Behavior is Blocking_Behavior\n"); ifprintf(fp," range Tasks .. Program;\n"); ifprintf(fp," -- Signal Masking\n"); ifprintf(fp," type Signal_Masking is "); ifprintf(fp,"(No_Signals, RTS_Signals, All_Signals);\n"); ifprintf(fp," -- Characters and Strings\n"); ifprintf(fp," subtype POSIX_Character is Standard.Character;\n"); ifprintf(fp," -- We rely here on the fact that the GNAT" " type Character\n"); ifprintf(fp," -- is the same as the GCC type char in C,\n"); ifprintf(fp," -- which in turn must be the same as POSIX_Character.\n\n"); ifprintf(fp," NUL : constant POSIX_Character := POSIX_Character (ASCII.NUL);\n"); ifprintf(fp," SOH : constant POSIX_Character := POSIX_Character (ASCII.SOH);\n"); ifprintf(fp," STX : constant POSIX_Character := POSIX_Character (ASCII.STX);\n"); ifprintf(fp," ETX : constant POSIX_Character := POSIX_Character (ASCII.ETX);\n"); ifprintf(fp," EOT : constant POSIX_Character := POSIX_Character (ASCII.EOT);\n"); ifprintf(fp," ENQ : constant POSIX_Character := POSIX_Character (ASCII.ENQ);\n"); ifprintf(fp," ACK : constant POSIX_Character := POSIX_Character (ASCII.ACK);\n"); ifprintf(fp," BEL : constant POSIX_Character := POSIX_Character (ASCII.BEL);\n"); ifprintf(fp," BS : constant POSIX_Character := POSIX_Character (ASCII.BS);\n"); ifprintf(fp," HT : constant POSIX_Character := POSIX_Character (ASCII.HT);\n"); ifprintf(fp," LF : constant POSIX_Character := POSIX_Character (ASCII.LF);\n"); ifprintf(fp," VT : constant POSIX_Character := POSIX_Character (ASCII.VT);\n"); ifprintf(fp," FF : constant POSIX_Character := POSIX_Character (ASCII.FF);\n"); ifprintf(fp," CR : constant POSIX_Character := POSIX_Character (ASCII.CR);\n"); ifprintf(fp," SO : constant POSIX_Character := POSIX_Character (ASCII.SO);\n"); ifprintf(fp," SI : constant POSIX_Character := POSIX_Character (ASCII.SI);\n"); ifprintf(fp," DLE : constant POSIX_Character := POSIX_Character (ASCII.DLE);\n"); ifprintf(fp," DC1 : constant POSIX_Character := POSIX_Character (ASCII.DC1);\n"); ifprintf(fp," DC2 : constant POSIX_Character := POSIX_Character (ASCII.DC2);\n"); ifprintf(fp," DC3 : constant POSIX_Character := POSIX_Character (ASCII.DC3);\n"); ifprintf(fp," DC4 : constant POSIX_Character := POSIX_Character (ASCII.DC4);\n"); ifprintf(fp," NAK : constant POSIX_Character := POSIX_Character (ASCII.NAK);\n"); ifprintf(fp," SYN : constant POSIX_Character := POSIX_Character (ASCII.SYN);\n"); ifprintf(fp," ETB : constant POSIX_Character := POSIX_Character (ASCII.ETB);\n"); ifprintf(fp," CAN : constant POSIX_Character := POSIX_Character (ASCII.CAN);\n"); ifprintf(fp," EM : constant POSIX_Character := POSIX_Character (ASCII.EM);\n"); ifprintf(fp," SUB : constant POSIX_Character := POSIX_Character (ASCII.SUB);\n"); ifprintf(fp," ESC : constant POSIX_Character := POSIX_Character (ASCII.ESC);\n"); ifprintf(fp," FS : constant POSIX_Character := POSIX_Character (ASCII.FS);\n"); ifprintf(fp," GS : constant POSIX_Character := POSIX_Character (ASCII.GS);\n"); ifprintf(fp," RS : constant POSIX_Character := POSIX_Character (ASCII.RS);\n"); ifprintf(fp," US : constant POSIX_Character := POSIX_Character (ASCII.US);\n\n"); ifprintf(fp," type POSIX_String is array (Positive range <>) "); ifprintf(fp,"of aliased POSIX_Character;\n"); ifprintf(fp," function To_POSIX_String (Str : String) "); ifprintf(fp,"return POSIX_String;\n"); ifprintf(fp," function To_POSIX_String (Str : Wide_String) "); ifprintf(fp,"return POSIX_String;\n"); ifprintf(fp," function To_String (Str : POSIX_String) return String;\n"); ifprintf(fp," function To_Wide_String (Str : POSIX_String) "); ifprintf(fp,"return Wide_String;\n"); ifprintf(fp," function To_Stream_Element_Array (Buffer : POSIX_String)\n"); ifprintf(fp," return Ada.Streams.Stream_Element_Array;\n"); ifprintf(fp," function To_POSIX_String (Buffer : "); ifprintf(fp,"Ada.Streams.Stream_Element_Array)\n"); ifprintf(fp," return POSIX_String;\n"); ifprintf(fp," subtype Filename is POSIX_String;\n"); ifprintf(fp," subtype Pathname is POSIX_String;\n"); ifprintf(fp," function Is_Filename (Str : POSIX_String)" " return Boolean;\n"); ifprintf(fp," function Is_Pathname (Str : POSIX_String)" " return Boolean;\n"); ifprintf(fp," function Is_Portable_Filename (Str : POSIX_String)"); ifprintf(fp," return Boolean;\n"); ifprintf(fp," function Is_Portable_Pathname (Str : POSIX_String)"); ifprintf(fp," return Boolean;\n"); ifprintf(fp," -- String Lists\n"); ifprintf(fp," type POSIX_String_List is limited private;\n"); ifprintf(fp," Empty_String_List : constant POSIX_String_List;\n"); ifprintf(fp," procedure Make_Empty (List : in out POSIX_String_List);\n"); ifprintf(fp," procedure Append (List : in out POSIX_String_List;\n"); ifprintf(fp," Str : POSIX_String);\n"); ifprintf(fp," generic\n"); ifprintf(fp," with procedure Action\n"); ifprintf(fp," (Item : POSIX_String;\n"); ifprintf(fp," Quit : in out Boolean);\n"); ifprintf(fp," procedure For_Every_Item (List : POSIX_String_List);\n"); ifprintf(fp," function Length (List : POSIX_String_List) "); ifprintf(fp,"return Natural;\n"); ifprintf(fp," function Value\n"); ifprintf(fp," (List : POSIX_String_List;\n"); ifprintf(fp," Index : Positive) return POSIX_String;\n"); ifprintf(fp," -- option sets\n"); ifprintf(fp," type Option_Set is private;\n"); ifprintf(fp," function Empty_Set return Option_Set;\n"); ifprintf(fp," function \"+\" (L, R : Option_Set) return Option_Set;\n"); ifprintf(fp," function \"-\" (L, R : Option_Set) return Option_Set;\n"); ifprintf(fp," function \"<\" (Left, Right : Option_Set)" " return Boolean;\n"); ifprintf(fp," function \"<=\"(Left, Right : Option_Set)" " return Boolean;\n"); ifprintf(fp," function \">\" (Left, Right : Option_Set)" " return Boolean;\n"); ifprintf(fp," function \">=\"(Left, Right : Option_Set)" " return Boolean;\n"); { int i; for (i =1; i<32; i++) { ifprintf(fp," Option_%d : constant Option_Set;\n", i); } } ifprintf(fp," -- Exceptions and error codes\n"); ifprintf(fp," POSIX_Error : exception;\n"); gsitp("Error_Code", sizeof(int)); ifprintf(fp," function Get_Error_Code return Error_Code;\n"); ifprintf(fp," procedure Set_Error_Code (Error : Error_Code);\n"); ifprintf(fp," function Is_POSIX_Error (Error : Error_Code) "); ifprintf(fp,"return Boolean;\n"); ifprintf(fp," function Image (Error : Error_Code) return String;\n"); ifprintf(fp," procedure Print_Error_Message;\n"); ifprintf(fp," No_Error : constant Error_Code := 0;\n"); ifprintf(fp," -- Error code constants with negative values "); ifprintf(fp,"correspond to\n"); ifprintf(fp," -- error codes that are not supported by the "); ifprintf(fp,"current system.\n"); ifprintf(fp," -- error codes\n"); max_GCST2 = 0; #ifdef E2BIG GCST2("E2BIG", "Argument_List_Too_Long", E2BIG); #else GDFLT2("E2BIG", "Argument_List_Too_Long"); #endif #ifdef EACCES GCST2("EACCES", "Permission_Denied", EACCES); #else GDFLT2("EACCES", "Permission_Denied"); #endif #ifdef EADDRINUSE GCST2("EADDRINUSE", "Address_In_Use", EADDRINUSE); #else GDFLT2("EADDRINUSE", "Address_In_Use"); #endif #ifdef EADDRNOTAVAIL GCST2("EADDRNOTAVAIL", "Address_Not_Available", EADDRNOTAVAIL); #else GDFLT2("EADDRNOTAVAIL", "Address_Not_Available"); #endif #ifdef EAFNOSUPPORT GCST2("EAFNOSUPPORT", "Inappropriate_Family", EAFNOSUPPORT); #else GDFLT2("EAFNOSUPPORT", "Inappropriate_Family"); #endif #ifdef EAGAIN GCST2("EAGAIN", "Resource_Temporarily_Unavailable", EAGAIN); #else GDFLT2("EAGAIN", "Resource_Temporarily_Unavailable"); #endif #ifdef EALREADY GCST2("EALREADY", "Already_Awaiting_Connection", EALREADY); #else GDFLT2("EALREADY", "Already_Awaiting_Connection"); #endif #ifdef EBADF GCST2("EBADF", "Bad_File_Descriptor", EBADF); #else GDFLT2("EBADF", "Bad_File_Descriptor"); #endif #ifdef EBADMSG GCST2("EBADMSG", "Bad_Message", EBADMSG); #else GDFLT2("EBADMSG", "Bad_Message"); #endif #ifdef EBUSY GCST2("EBUSY", "Resource_Busy", EBUSY); #else GDFLT2("EBUSY", "Resource_Busy"); #endif #ifdef ECANCELED GCST2("ECANCELED", "Operation_Canceled", ECANCELED); #else GDFLT2("ECANCELED", "Operation_Canceled"); #endif #ifdef ECHILD GCST2("ECHILD", "No_Child_Process", ECHILD); #else GDFLT2("ECHILD", "No_Child_Process"); #endif #ifdef ECONNABORTED GCST2("ECONNABORTED", "Connection_Aborted", ECONNABORTED); #else GDFLT2("ECONNABORTED", "Connection_Aborted"); #endif #ifdef ECONNREFUSED GCST2("ECONNREFUSED", "Connection_Refused", ECONNREFUSED); #else GDFLT2("ECONNREFUSED", "Connection_Refused"); #endif #ifdef ECONNRESET GCST2("ECONNRESET", "Connection_Reset", ECONNRESET); #else GDFLT2("ECONNRESET", "Connection_Reset"); #endif #ifdef EDEADLK GCST2("EDEADLK", "Resource_Deadlock_Avoided", EDEADLK); #else GDFLT2("EDEADLK", "Resource_Deadlock_Avoided"); #endif #ifdef EDOM GCST2("EDOM", "Domain_Error", EDOM); #else GDFLT2("EDOM", "Domain_Error"); #endif #ifdef EEXIST GCST2("EEXIST", "File_Exists", EEXIST); #else GDFLT2("EEXIST", "File_Exists"); #endif #ifdef EFAULT GCST2("EFAULT", "Bad_Address", EFAULT); #else GDFLT2("EFAULT", "Bad_Address"); #endif #ifdef EFBIG GCST2("EFBIG", "File_Too_Large", EFBIG); #else GDFLT2("EFBIG", "File_Too_Large"); #endif #ifdef EHOSTDOWN GCST2("EHOSTDOWN", "Host_Down", EHOSTDOWN); #else GDFLT2("EHOSTDOWN", "Host_Down"); #endif #ifdef EHOSTUNREACH GCST2("EHOSTUNREACH", "Host_Unreachable", EHOSTUNREACH); #else GDFLT2("EHOSTUNREACH", "Host_Unreachable"); #endif #ifdef EINPROGRESS GCST2("EINPROGRESS", "Operation_In_Progress", EINPROGRESS); #else GDFLT2("EINPROGRESS", "Operation_In_Progress"); #endif #ifdef EINTR GCST2("EINTR", "Interrupted_Operation", EINTR); #else GDFLT2("EINTR", "Interrupted_Operation"); #endif #ifdef EINVAL GCST2("EINVAL", "Invalid_Argument", EINVAL); #else GDFLT2("EINVAL", "Invalid_Argument"); #endif #ifdef EIO GCST2("EIO", "Input_Output_Error", EIO); #else GDFLT2("EIO", "Input_Output_Error"); #endif #ifdef EISCONN GCST2("EISCONN", "Is_Already_Connected", EISCONN); #else GDFLT2("EISCONN", "Is_Already_Connected"); #endif #ifdef EISDIR GCST2("EISDIR", "Is_A_Directory", EISDIR); #else GDFLT2("EISDIR", "Is_A_Directory"); #endif #ifdef EMFILE GCST2("EMFILE", "Too_Many_Open_Files", EMFILE); #else GDFLT2("EMFILE", "Too_Many_Open_Files"); #endif #ifdef EMLINK GCST2("EMLINK", "Too_Many_Links", EMLINK); #else GDFLT2("EMLINK", "Too_Many_Links"); #endif #ifdef EMSGSIZE GCST2("EMSGSIZE", "Message_Too_Long", EMSGSIZE); #else GDFLT2("EMSGSIZE", "Message_Too_Long"); #endif #ifdef ENAMETOOLONG GCST2("ENAMETOOLONG", "Filename_Too_Long", ENAMETOOLONG); #else GDFLT2("ENAMETOOLONG", "Filename_Too_Long"); #endif #ifdef ENETDOWN GCST2("ENETDOWN", "Network_Down", ENETDOWN); #else GDFLT2("ENETDOWN", "Network_Down"); #endif #ifdef ENETRESET GCST2("ENETRESET", "Network_Reset", ENETRESET); #else GDFLT2("ENETRESET", "Network_Reset"); #endif #ifdef ENETUNREACH GCST2("ENETUNREACH", "Network_Unreachable", ENETUNREACH); #else GDFLT2("ENETUNREACH", "Network_Unreachable"); #endif #ifdef ENFILE GCST2("ENFILE", "Too_Many_Open_Files_In_System", ENFILE); #else GDFLT2("ENFILE", "Too_Many_Open_Files_In_System"); #endif #ifdef ENOBUFS GCST2("ENOBUFS", "No_Buffer_Space", ENOBUFS); #else GDFLT2("ENOBUFS", "No_Buffer_Space"); #endif #ifdef ENODEV GCST2("ENODEV", "No_Such_Operation_On_Device", ENODEV); #else GDFLT2("ENODEV", "No_Such_Operation_On_Device"); #endif #ifdef ENOENT GCST2("ENOENT", "No_Such_File_Or_Directory", ENOENT); #else GDFLT2("ENOENT", "No_Such_File_Or_Directory"); #endif #ifdef ENOPROTOOPT GCST2("ENOPROTOOPT", "Unknown_Protocol_Option", ENOPROTOOPT); #else GDFLT2("ENOPROTOOPT", "Unknown_Protocol_Option"); #endif #ifdef ENOEXEC GCST2("ENOEXEC", "Exec_Format_Error", ENOEXEC); #else GDFLT2("ENOEXEC", "Exec_Format_Error"); #endif #ifdef ENOLCK GCST2("ENOLCK", "No_Locks_Available", ENOLCK); #else GDFLT2("ENOLCK", "No_Locks_Available"); #endif #ifdef ENOMEM GCST2("ENOMEM", "Not_Enough_Space", ENOMEM); #else GDFLT2("ENOMEM", "Not_Enough_Space"); #endif #ifdef ENOSPC GCST2("ENOSPC", "No_Space_Left_On_Device", ENOSPC); #else GDFLT2("ENOSPC", "No_Space_Left_On_Device"); #endif #ifdef ENOTCONN GCST2("ENOTCONN", "Not_Connected", ENOTCONN); #else GDFLT2("ENOTCONN", "Not_Connected"); #endif #ifdef ENOTSOCK GCST2("ENOTSOCK", "Not_A_Socket", ENOTSOCK); #else GDFLT2("ENOTSOCK", "Not_A_Socket"); #endif #ifdef ENOTSUP GCST2("ENOTSUP", "Operation_Not_Supported", ENOTSUP); #else NON_SUPPORT_MESSAGE("ENOTSUP"); GCST2("ENOTSUP", "Operation_Not_Supported", ENOSYS); #endif #ifdef ENOTDIR GCST2("ENOTDIR", "Not_A_Directory", ENOTDIR); #else GDFLT2("ENOTDIR", "Not_A_Directory"); #endif #ifdef ENOTEMPTY GCST2("ENOTEMPTY", "Directory_Not_Empty", ENOTEMPTY); #else GDFLT2("ENOTEMPTY", "Directory_Not_Empty"); #endif #ifdef ENOSYS GCST2("ENOSYS", "Operation_Not_Implemented", ENOSYS); #else GDFLT2("ENOSYS", "Operation_Not_Supported"); #endif #ifdef ENOTTY GCST2("ENOTTY", "Inappropriate_IO_Control_Operation", ENOTTY); #else GDFLT2("ENOTTY", "Inappropriate_IO_Control_Operation"); #endif #ifdef ENXIO GCST2("ENXIO", "No_Such_Device_Or_Address", ENXIO); #else GDFLT2("ENXIO", "No_Such_Device_Or_Address"); #endif #ifdef EOPNOTSUPP GCST2("EOPNOTSUPP", "Option_Not_Supported", EOPNOTSUPP); #else GDFLT2("EOPNOTSUPP", "Option_Not_Supported"); #endif #ifdef EPERM GCST2("EPERM", "Operation_Not_Permitted", EPERM); #else GDFLT2("EPERM", "Operation_Not_Permitted"); #endif #ifdef EPIPE GCST2("EPIPE", "Broken_Pipe", EPIPE); #else GDFLT2("EPIPE", "Broken_Pipe"); #endif #ifdef EPROTONOSUPPORT GCST2("EPROTONOSUPPORT", "Protocol_Not_Supported", EPROTONOSUPPORT); #else GDFLT2("EPROTONOSUPPORT", "Protocol_Not_Supported"); #endif #ifdef EPROTOTYPE GCST2("EPROTOTYPE", "Wrong_Protocol_Type", EPROTOTYPE); #else GDFLT2("EPROTOTYPE", "Wrong_Protocol_Type"); #endif /* .... what is ERANGE? .... */ #ifdef ERANGE GCST2("ERANGE", "TBD2", ERANGE); #else GDFLT2("ERANGE", "TBD2"); #endif #ifdef EROFS GCST2("EROFS", "Read_Only_File_System", EROFS); #else GDFLT2("EROFS", "Read_Only_File_System"); #endif #ifdef ESOCKTNOSUPPORT GCST2("ESOCKTNOSUPPORT", "Socket_Not_Supported", ESOCKTNOSUPPORT); #else GDFLT2("ESOCKTNOSUPPORT", "Socket_Not_Supported"); #endif #ifdef ESPIPE GCST2("ESPIPE", "Invalid_Seek", ESPIPE); #else GDFLT2("ESPIPE", "Invalid_Seek"); #endif #ifdef ESRCH GCST2("ESRCH", "No_Such_Process", ESRCH); #else GDFLT2("ESRCH", "No_Such_Process"); #endif #ifdef ETIMEDOUT GCST2("ETIMEDOUT", "Timed_Out", ETIMEDOUT); #else GDFLT2("ETIMEDOUT", "Timed_Out"); #endif #ifdef EWOULDBLOCK GCST2("EWOULDBLOCK", "Would_Block", EWOULDBLOCK); #else GDFLT2("EWOULDBLOCK", "Would_Block"); #endif #ifdef EXDEV GCST2("EXDEV", "Improper_Link", EXDEV); #else GDFLT2("EXDEV", "Improper_Link"); #endif #ifdef HOST_NOT_FOUND GCST("Host_Not_Found", HOST_NOT_FOUND); #else GDFLT("Host_Not_Found", -1); #endif #ifdef NO_DATA GCST2("NO_DATA", "No_Address_Available", NO_DATA); #else GDFLT2("NO_DATA", "No_Address_Available"); #endif #ifdef NO_RECOVERY GCST2("NO_RECOVERY", "Unrecoverable_Error", NO_RECOVERY); #else GDFLT2("NO_RECOVERY", "Unrecoverable_Error"); #endif max_posix_error = max_GCST2; EAI_Error_First = 10000; /* Start with a bias of 10000 */ while (1) { if (EAI_Error_First > max_posix_error) { break; } else { EAI_Error_First = EAI_Error_First * 10; } /* end if */ } /* end while */ max_GCST2 = EAI_Error_First; #ifdef EAI_ADDRFAMILY GCST2("EAI_ADDRFAMILY", "Unknown_Address_Type", EAI_ADDRFAMILY+EAI_Error_First); #else GDFLT2("EAI_ADDRFAMILY", "Unknown_Address_Type"); #endif #ifdef EAI_AGAIN GCST2("EAI_AGAIN", "Try_Again", EAI_AGAIN+EAI_Error_First); #else GDFLT2("EAI_AGAIN", "Try_Again"); #endif #ifdef EAI_BADFLAGS GCST2("EAI_BADFLAGS", "Invalid_Flags", EAI_BADFLAGS+EAI_Error_First); #else GDFLT2("EAI_BADFLAGS", "Invalid_Flags"); #endif #ifdef EAI_FAIL GCST2("EAI_FAIL", "Name_Failed", EAI_FAIL+EAI_Error_First); #else GDFLT2("EAI_FAIL", "Name_Failed"); #endif #ifdef EAI_FAMILY GCST2("EAI_FAMILY", "Unknown_Protocol_Family", EAI_FAMILY+EAI_Error_First); #else GDFLT2("EAI_FAMILY", "Unknown_Protocol_Family"); #endif #ifdef EAI_MEMORY GCST2("EAI_MEMORY", "Memory_Allocation_Failed", EAI_MEMORY+EAI_Error_First); #else GDFLT2("EAI_MEMORY", "Memory_Allocation_Failed"); #endif #ifdef EAI_NODATA GCST2("EAI_NODATA", "No_Address_For_Name", EAI_NODATA+EAI_Error_First); #else GDFLT2("EAI_NODATA", "No_Address_For_Name"); #endif #ifdef EAI_NONAME GCST2("EAI_NONAME", "Name_Not_Known", EAI_NONAME+EAI_Error_First); #else GDFLT2("EAI_NONAME", "Name_Not_Known"); #endif #ifdef EAI_SERVICE GCST2("EAI_SERVICE", "Service_Not_Supported", EAI_SERVICE+EAI_Error_First); #else GDFLT2("EAI_SERVICE", "Service_Not_Supported"); #endif #ifdef EAI_SOCKTYPE GCST2("EAI_SOCKTYPE", "Unknown_Socket_Type", EAI_SOCKTYPE+EAI_Error_First); #else GDFLT2("EAI_SOCKTYPE", "Unknown_Socket_Type"); #endif EAI_Error_Last = max_GCST2; XTI_Error_First = 100000; /* Start with a bias of 100000 */ while (1) { if (XTI_Error_First > max_posix_error) { break; } else { XTI_Error_First = XTI_Error_First * 10; } /* end if */ } /* end while */ ifprintf(fp," subtype Addrinfo_Error_Code is Error_Code\n"); ifprintf(fp," range %d .. %d;\n", EAI_Error_First, EAI_Error_Last); max_GCST2 = XTI_Error_First; #ifdef TACCES GCST2("TACCES", "Insufficient_Permission", TACCES+XTI_Error_First); #else GDFLT2("TACCES", "Insufficient_Permission"); #endif #ifdef TADDRBUSY GCST2("TADDRBUSY", "XTI_Address_In_Use", TADDRBUSY+XTI_Error_First); #else GDFLT2("TADDRBUSY", "XTI_Address_In_Use"); #endif #ifdef TBADADDR GCST2("TBADADDR", "Incorrect_Address_Format", TBADADDR+XTI_Error_First); #else GDFLT2("TBADADDR", "Incorrect_Address_Format"); #endif #ifdef TBADDATA GCST2("TBADDATA", "Illegal_Data_Range", TBADDATA+XTI_Error_First); #else GDFLT2("TBADDATA", "Illegal_Data_Range"); #endif #ifdef TBADF GCST2("TBADF", "Invalid_File_Descriptor", TBADF+XTI_Error_First); #else GDFLT2("TBADF", "Invalid_File_Descriptor"); #endif #ifdef TBADFLAG GCST2("TBADFLAG", "Invalid_Flag", TBADFLAG+XTI_Error_First); #else GDFLT2("TBADFLAG", "Invalid_Flag"); #endif #ifdef TBADNAME GCST2("TBADNAME", "Invalid_Communications_Provider", TBADNAME+XTI_Error_First); #else GDFLT2("TBADNAME", "Invalid_Communications_Provider"); #endif #ifdef TBADOPT GCST2("TBADOPT", "Incorrect_Or_Illegal_Option", TBADOPT+XTI_Error_First); #else GDFLT2("TBADOPT", "Incorrect_Or_Illegal_Option"); #endif #ifdef TBADQLEN GCST2("TBADQLEN", "Endpoint_Queue_Length_Is_Zero", TBADQLEN+XTI_Error_First); #else GDFLT2("TBADQLEN", "Endpoint_Queue_Length_Is_Zero"); #endif #ifdef TBADSEQ GCST2("TBADSEQ", "Invalid_Sequence_Number", TBADSEQ+XTI_Error_First); #else GDFLT2("TBADSEQ", "Invalid_Sequence_Number"); #endif #ifdef TBUFOVFLW GCST2("TBUFOVFLW", "Buffer_Not_Large_Enough", TBUFOVFLW+XTI_Error_First); #else GDFLT2("TBUFOVFLW", "Buffer_Not_Large_Enough"); #endif #ifdef TFLOW GCST2("TFLOW", "Flow_Control_Error", TFLOW+XTI_Error_First); #else GDFLT2("TFLOW", "Flow_Control_Error"); #endif #ifdef TINDOUT GCST2("TINDOUT", "Outstanding_Connection_Indications", TINDOUT+XTI_Error_First); #else GDFLT2("TINDOUT", "Outstanding_Connection_Indications"); #endif #ifdef TLOOK GCST2("TLOOK", "Event_Requires_Attention", TLOOK+XTI_Error_First); #else GDFLT2("TLOOK", "Event_Requires_Attention"); #endif #ifdef TNOADDR GCST2("TNOADDR", "Could_Not_Allocate_Address", TNOADDR+XTI_Error_First); #else GDFLT2("TNOADDR", "Could_Not_Allocate_Address"); #endif #ifdef TNODATA GCST2("TNODATA", "No_Data_Available", TNODATA+XTI_Error_First); #else GDFLT2("TNODATA", "No_Data_Available"); #endif #ifdef TNODIS GCST2("TNODIS", "No_Disconnect_Indication_On_Endpoint", TNODIS+XTI_Error_First); #else GDFLT2("TNODIS", "No_Disconnect_Indication_On_Endpoint"); #endif #ifdef TPROVMISMATCH GCST2("TPROVMISMATCH", "Communications_Provider_Mismatch", TPROVMISMATCH+XTI_Error_First); #else GDFLT2("TPROVMISMATCH", "Communications_Provider_Mismatch"); #endif #ifdef TNOREL GCST2("TNOREL", "No_Orderly_Release_Indication_On_Endpoint", TNOREL+XTI_Error_First); #else GDFLT2("TNOREL", "No_Orderly_Release_Indication_On_Endpoint"); #endif #ifdef TNOSTRUCTYPE GCST2("TNOSTRUCTYPE", "Unsupported_Object_Type_Requested", TNOSTRUCTYPE+XTI_Error_First); #else GDFLT2("TNOSTRUCTYPE", "Unsupported_Object_Type_Requested"); #endif #ifdef TNOTSUPPORT GCST2("TNOTSUPPORT", "Function_Not_Supported", TNOTSUPPORT+XTI_Error_First); #else GDFLT2("TNOTSUPPORT", "Function_Not_Supported"); #endif #ifdef TNOUDERR GCST2("TNOUDERR", "No_Unitdata_Error_On_Endpoint", TNOUDERR+XTI_Error_First); #else GDFLT2("TNOUDERR", "No_Unitdata_Error_On_Endpoint"); #endif #ifdef TOUTSTATE GCST2("TOUTSTATE", "Function_Not_Valid_For_State", TOUTSTATE+XTI_Error_First); #else GDFLT2("TOUTSTATE", "Function_Not_Valid_For_State"); #endif #ifdef TPROTO GCST2("TPROTO", "Protocol_Error", TPROTO+XTI_Error_First); #else GDFLT2("TPROTO", "Protocol_Error"); #endif #ifdef TQFULL GCST2("TQFULL", "Endpoint_Queue_Full", TQFULL+XTI_Error_First); #else GDFLT2("TQFULL", "Endpoint_Queue_Full"); #endif #ifdef TSTATECHNG GCST2("TSTATECHNG", "State_Change_In_Progress", TSTATECHNG+XTI_Error_First); #else GDFLT2("TSTATECHNG", "State_Change_In_Progress"); #endif #ifdef TRESADDR GCST2("TRESADDR", "Surrogate_File_Descriptor_Mismatch", TRESADDR+XTI_Error_First); #else GDFLT2("TRESADDR", "Surrogate_File_Descriptor_Mismatch"); #endif #ifdef TRESQLEN GCST2("TRESQLEN", "Incorrect_Surrogate_Queue_Length", TRESQLEN+XTI_Error_First); #else GDFLT2("TRESQLEN", "Incorrect_Surrogate_Queue_Length"); #endif XTI_Error_Last = max_GCST2; ifprintf(fp," subtype XTI_Error_Code is Error_Code\n"); ifprintf(fp," range %d .. %d;\n", XTI_Error_First, XTI_Error_Last); ifprintf(fp," -- System Identification\n"); ifprintf(fp," function System_Name return POSIX_String;\n"); ifprintf(fp," function Node_Name return POSIX_String;\n"); ifprintf(fp," function Release return POSIX_String;\n"); ifprintf(fp," function Version return POSIX_String;\n"); ifprintf(fp," function Machine return POSIX_String;\n"); ifprintf(fp," type Seconds is new Integer;\n"); ifprintf(fp," type Minutes is new Integer;\n"); ifprintf(fp," type Nanoseconds_Base is new Integer;\n"); ifprintf(fp," subtype Nanoseconds is "); ifprintf(fp,"Nanoseconds_Base range 0 .. (10**9) - 1;\n"); ifprintf(fp," type Timespec is private;\n"); ifprintf(fp," function Get_Seconds (Time : Timespec) return Seconds;\n"); ifprintf(fp," procedure Set_Seconds\n"); ifprintf(fp," (Time : in out Timespec;\n"); ifprintf(fp," S : Seconds);\n"); ifprintf(fp," function Get_Nanoseconds (Time : Timespec) "); ifprintf(fp,"return Nanoseconds;\n"); ifprintf(fp," procedure Set_Nanoseconds\n"); ifprintf(fp," (Time : in out Timespec;\n"); ifprintf(fp," NS : Nanoseconds);\n"); ifprintf(fp," procedure Split\n"); ifprintf(fp," (Time : Timespec;\n"); ifprintf(fp," S : out Seconds;\n"); ifprintf(fp," NS : out Nanoseconds);\n"); ifprintf(fp," function To_Timespec\n"); ifprintf(fp," (S : Seconds;\n"); ifprintf(fp," NS : Nanoseconds) return Timespec;\n"); ifprintf(fp," function \"+\" (Left, Right : Timespec) return Timespec;\n"); ifprintf(fp," function \"+\" (Left : Timespec; Right : Nanoseconds)\n"); ifprintf(fp," return Timespec;\n"); ifprintf(fp," function \"-\" (Right : Timespec) return Timespec;\n"); ifprintf(fp," function \"-\" (Left, Right : Timespec) return Timespec;\n"); ifprintf(fp," function \"-\" (Left : Timespec; Right : Nanoseconds)\n"); ifprintf(fp," return Timespec;\n"); ifprintf(fp," function \"*\" (Left : Timespec; Right : Integer)\n"); ifprintf(fp," return Timespec;\n"); ifprintf(fp," function \"*\" (Left : Integer; Right : Timespec)\n"); ifprintf(fp," return Timespec;\n"); ifprintf(fp," function \"/\" (Left : Timespec; Right : Integer)\n"); ifprintf(fp," return Timespec;\n"); ifprintf(fp," function \"/\" (Left, Right : Timespec) return Integer;\n"); ifprintf(fp," function \"<\" (Left, Right : Timespec) return Boolean;\n"); ifprintf(fp," function \"<=\" (Left, Right : Timespec) return Boolean;\n"); ifprintf(fp," function \">\" (Left, Right : Timespec) return Boolean;\n"); ifprintf(fp," function \">=\" (Left, Right : Timespec) return Boolean;\n"); ifprintf(fp," function To_Duration (Time : Timespec) return Duration;\n"); ifprintf(fp," -- pragma Inline (To_Duration);\n"); ifprintf(fp," function To_Timespec (D : Duration) return Timespec;\n"); ifprintf(fp," -- pragma Inline (To_Timespec);\n"); ghdrcmnt("Host-Network Byte Order Conversions"); /* we need 32-bit and a 16-bit unsigned integer types */ if (sizeof (unsigned int) == 4) { if (sizeof (unsigned short) == 2) { /* uint32_t -> unsigned int uint16_t -> unsigned int */ union { unsigned int l; unsigned char c[4]; } x; x.c[0] = 0; x.c[1] = 1; x.c[2] = 2; x.c[3] = 3; if (x.l == 0x00010203) { network_byte_order = 1; ifprintf(fp," Host_Byte_Order_Is_Net_Byte_Order" " : Boolean := True;\n\n"); } else { network_byte_order = 0; ifprintf(fp," Host_Byte_Order_Is_Net_Byte_Order" " : Boolean := False;\n\n"); } } else quit ("short is not 16-bit",""); } else quit ("int is not 32-bit",""); ifprintf(fp," function Host_To_Network_Byte_Order"); ifprintf(fp," (Host_32 : Interfaces.Unsigned_32)\n"); ifprintf(fp," return Interfaces.Unsigned_32;\n"); ifprintf(fp," function Host_To_Network_Byte_Order"); ifprintf(fp," (Host_16 : Interfaces.Unsigned_16)\n"); ifprintf(fp," return Interfaces.Unsigned_16;\n"); ifprintf(fp," function Network_To_Host_Byte_Order"); ifprintf(fp," (Host_32 : Interfaces.Unsigned_32)\n"); ifprintf(fp," return Interfaces.Unsigned_32;\n"); ifprintf(fp," function Network_To_Host_Byte_Order"); ifprintf(fp," (Host_16 : Interfaces.Unsigned_16)\n"); ifprintf(fp," return Interfaces.Unsigned_16;\n"); ifprintf(fp," XTI_Blocking_Behavior : constant Blocking_Behavior\n"); ifprintf(fp," := Tasks;\n"); ifprintf(fp," Sockets_Blocking_Behavior :" " constant Blocking_Behavior\n"); ifprintf(fp," := Tasks;\n"); ghdrcmnt("Octet declarations"); ifprintf(fp," type Octet is mod 2 ** 8;\n"); ifprintf(fp," type Octet_Array is\n"); ifprintf(fp," array (Integer range <>) of aliased Octet;\n"); ifprintf(fp," type Octet_Array_Pointer is access all Octet_Array;\n"); ifprintf(fp,"private\n"); #ifdef VERSION ifprintf(fp," Florist_Version : constant String := \""VERSION"\";\n\n"); #endif ifprintf(fp," type String_List;\n"); ifprintf(fp," -- See package body for comments on String_List.\n"); ifprintf(fp," type POSIX_String_List is access all String_List;\n"); ifprintf(fp," pragma No_Strict_Aliasing (POSIX_String_List);\n"); ifprintf(fp," Empty_String_List : constant POSIX_String_List" " := null;\n\n"); ifprintf(fp," type Timespec is record\n"); ifprintf(fp," Val : Duration := 0.0;\n"); ifprintf(fp," end record;\n"); ifprintf(fp," -- The value is of type Duration because we can do more\n"); ifprintf(fp," -- efficient arithmetic on that type "); ifprintf(fp,"than on a two-part C struct.\n"); ifprintf(fp," -- We rely that GNAT implements type "); ifprintf(fp,"Duration with enough\n"); ifprintf(fp," -- precision (64 bits) to hold a full C timespec value.\n"); ifprintf(fp," -- The enclosing record is to permit "); ifprintf(fp,"implicit initialization.\n"); guitp("Bits", sizeof(int)); ifprintf(fp," -- Bits and the C int type are always the same size.\n"); ifprintf(fp," -- We don't define int here," " since we want to be able to\n"); ifprintf(fp," -- use it in the visible parts of child packages.\n\n"); ifprintf(fp," type Option_Set is\n"); ifprintf(fp," record\n"); ifprintf(fp," Option : Bits := 0;\n"); ifprintf(fp," end record;\n"); { int i; for (i=1; i<32; i++) { ifprintf(fp," Option_%d : constant Option_Set" " := (Option => 2**%d);\n", i, i-1); } } ifprintf(fp,"end POSIX;\n"); fclose (fp); fprintf(stderr,"done generating posix.ads\n"); } /* create_c -------- create package POSIX.C, in file posix-c.ads */ void create_c() { fprintf(stderr,"creating package POSIX.C\n"); if (! (fp = fopen (GENDIR "/posix-c.ads", "w"))) { perror ("posix-c.ads"); quit("can't open file to write",""); } gheader("POSIX.C", FSU_Header); ifprintf(fp,"with System; use System;\n"); ifprintf(fp,"with Ada.Unchecked_Conversion;\n"); ifprintf(fp,"package POSIX.C is\n"); ifprintf(fp," pragma Elaborate_Body;\n"); ifprintf(fp," -- ========= --\n"); ifprintf(fp," -- WARNING --\n"); ifprintf(fp," -- ========= --\n\n"); ifprintf(fp," -- This package should NOT be used directly"); ifprintf(fp," by an application.\n"); ifprintf(fp," -- It is internal to the FLORIST implementation of the"); ifprintf(fp," POSIX.5 API,\n"); ifprintf(fp," -- and may be changed or replaced in future versions"); ifprintf(fp," of FLORIST.\n\n"); ifprintf(fp," ALIGNMENT : constant"); ifprintf(fp," := Natural'Min (Standard'Maximum_Alignment, 8);\n"); ifprintf(fp," -- worst-case alignment requirement\n"); /* numeric types ------------- */ ghdrcmnt("basic C types"); gsitp("short", sizeof(short)); gsitp("int", sizeof(int)); gptrtp("int","int"); guitp("unsigned", sizeof(unsigned)); gsitp("long", sizeof(long)); guitp("unsigned_long", sizeof(unsigned long)); guitp("unsigned_int", sizeof(unsigned int)); guitp("unsigned_short", sizeof(unsigned short)); guitp("caddr_t", sizeof(caddr_t)); g_size_t(); g_time_t(); g_clock_t(); gsitp("ptr_as_int", sizeof(char *)); /* char * and char ** ------------------ */ ifprintf(fp," subtype char is POSIX_Character;\n"); gptrtp("char","char"); gen_unchckd_conv("To_Ptr", "Address", "char_ptr"); gen_renaming("function To_char_ptr (Addr : Address) return char_ptr", "To_Ptr"); gen_unchckd_conv("To_Address", "char_ptr", "Address"); gptrtp("char_ptr","char_ptr"); gen_unchckd_conv("To_Ptr", "Address", "char_ptr_ptr"); gen_unchckd_conv("To_Address", "char_ptr_ptr", "Address"); ifprintf(fp," type char_ptr_array is\n"); ifprintf(fp," array (Positive range <>) of aliased char_ptr;\n"); ifprintf(fp," function malloc (size : size_t) return char_ptr;\n"); ifprintf(fp," function malloc (size : size_t) return char_ptr_ptr;\n"); ifprintf(fp," pragma Import (C, malloc, \"malloc\");\n"); ifprintf(fp," procedure free (object : char_ptr);\n"); ifprintf(fp," procedure free (object : char_ptr_ptr);\n"); ifprintf(fp," pragma Import (C, free, \"free\");\n"); ifprintf(fp," procedure Advance (Ptr : in out char_ptr);\n"); ifprintf(fp," procedure Advance (Ptr : in out char_ptr_ptr);\n"); ifprintf(fp," -- advance Ptr to next location\n"); ifprintf(fp," -- pragma Inline (Advance);\n"); ifprintf(fp," function Form_POSIX_String (Str : char_ptr)\n"); ifprintf(fp," return POSIX_String;\n"); ifprintf(fp," -- makes new copy of string, without null terminator\n"); /* constants --------- */ ghdrcmnt("constants"); #ifdef AIO_ALLDONE GCST("AIO_ALLDONE", AIO_ALLDONE); #else GDFLT("AIO_ALLDONE", 0); #endif #ifdef AIO_CANCELED GCST("AIO_CANCELED", AIO_CANCELED); #else GDFLT("AIO_CANCELED", 0); #endif #ifdef AIO_NOTCANCELED GCST("AIO_NOTCANCELED", AIO_NOTCANCELED); #else GDFLT("AIO_NOTCANCELED", 0); #endif #ifdef B0 GCST("B0", B0); #else GDFLT("B0", 0); #endif #ifdef B110 GCST("B110", B110); #else GDFLT("B110", 0); #endif #ifdef B115200 GCST("B115200", B115200); #else GDFLT("B115200", 0); #endif #ifdef B1200 GCST("B1200",B1200); #else GDFLT("B1200", 0); #endif #ifdef B134 GCST("B134", B134); #else GDFLT("B134", 0); #endif #ifdef B150 GCST("B150", B150); #else GDFLT("B150", 0); #endif #ifdef B1800 GCST("B1800", B1800); #else GDFLT("B1800", 0); #endif #ifdef B19200 GCST("B19200", B19200); #else GDFLT("B19200", 0); #endif #ifdef B200 GCST("B200", B200); #else GDFLT("B200", 0); #endif #ifdef B230400 GCST("B230400", B230400); #else GDFLT("B230400", 0); #endif #ifdef B2400 GCST("B2400", B2400); #else GDFLT("B2400", 0); #endif #ifdef B300 GCST("B300", B300); #else GDFLT("B300", 0); #endif #ifdef B38400 GCST("B38400", B38400); #else GDFLT("B38400", 0); #endif #ifdef B460800 GCST("B460800", B460800); #else GDFLT("B460800", 0); #endif #ifdef B4800 GCST("B4800", B4800); #else GDFLT("B4800", 0); #endif #ifdef B50 GCST("B50", B50); #else GDFLT("B50", 0); #endif #ifdef B57600 GCST("B57600", B57600); #else GDFLT("B57600", 0); #endif #ifdef B600 GCST("B600", B600); #else GDFLT("B600", 0); #endif #ifdef B75 GCST("B75", B75); #else GDFLT("B75", 0); #endif #ifdef B9600 GCST("B9600", B9600); #else GDFLT("B9600", 0); #endif #ifdef BRKINT GCST("BRKINT", BRKINT); #else GDFLT("BRKINT", 0); #endif #ifdef CLK_TCK GCST("CLK_TCK", CLK_TCK); #else GDFLT("CLK_TCK", 0); #endif #ifdef CLOCAL GCST("CLOCAL", CLOCAL); #else GDFLT("CLOCAL", 0); #endif #ifdef CLOCK_REALTIME /* Generate the value of CLOCK_REALTIME with a cast to int, as the GCST uses printf's %d to print it. Otherwise, if the CLOCK_REALTIME macro corresponds to a value whose type is larger than int (as is the case on ppc-aix, for instance), the printf might print the macro's value incorrectly. We allow ourselves to do that because it is unlikely that this macro be assigned a value that would overflow. */ GCST("CLOCK_REALTIME", (int) CLOCK_REALTIME); #else GDFLT("CLOCK_REALTIME", 1); #endif #ifdef CLOCK_SGI_FAST GCST("CLOCK_SGI_FAST", CLOCK_SGI_FAST); #endif #ifdef CREAD GCST("CREAD", CREAD); #else GDFLT("CREAD", 0); #endif #ifdef CSIZE GCST("CSIZE", CSIZE); #else GDFLT("CSIZE", 0); #endif #ifdef CSTOPB GCST("CSTOPB", CSTOPB); #else GDFLT("CSTOPB", 0); #endif #ifdef CS5 GCST("CS5", CS5); #else GDFLT("CS5", 0); #endif #ifdef CS6 GCST("CS6", CS6); #else GDFLT("CS6", 0); #endif #ifdef CS7 GCST("CS7", CS7); #else GDFLT("CS7", 0); #endif #ifdef CS8 GCST("CS8", CS8); #else GDFLT("CS8", 0); #endif ifprintf(fp," -- error code constants are in posix.ads\n"); #ifdef ECHO GCST("ECHO", ECHO); #else GDFLT("ECHO", 0); #endif #ifdef ECHOE GCST("ECHOE", ECHOE); #else GDFLT("ECHOE", 0); #endif #ifdef ECHOK GCST("ECHOK", ECHOK); #else GDFLT("ECHOK", 0); #endif #ifdef ECHONL GCST("ECHONL", ECHONL); #else GDFLT("ECHONL", 0); #endif #ifdef FD_CLOEXEC GCST("FD_CLOEXEC", FD_CLOEXEC); #else GDFLT("FD_CLOEXEC", 0); #endif #ifdef F_DUPFD GCST("F_DUPFD", F_DUPFD); #else GDFLT("F_DUPFD", 0); #endif #ifdef F_GETFD GCST("F_GETFD", F_GETFD); #else GDFLT("F_GETFD", 0); #endif #ifdef F_GETFL GCST("F_GETFL", F_GETFL); #else GDFLT("F_GETFL", 0); #endif #ifdef F_GETLK GCST("F_GETLK", F_GETLK); #else GDFLT("F_GETLK", 0); #endif #ifdef F_OK GCST("F_OK", F_OK); #else GDFLT("F_OK", 0); #endif #ifdef F_RDLCK GCST("F_RDLCK", F_RDLCK); #else GDFLT("F_RDLCK", 0); #endif #ifdef F_SETFD GCST("F_SETFD", F_SETFD); #else GDFLT("F_SETFD", 0); #endif #ifdef F_SETFL GCST("F_SETFL", F_SETFL); #else GDFLT("F_SETFL", 0); #endif #ifdef F_SETLK GCST("F_SETLK", F_SETLK); #else GDFLT("F_SETLK", 0); #endif #ifdef F_SETLKW GCST("F_SETLKW", F_SETLKW); #else GDFLT("F_SETLKW", 0); #endif #ifdef F_UNLCK GCST("F_UNLCK", F_UNLCK); #else GDFLT("F_UNLCK", 0); #endif #ifdef F_WRLCK GCST("F_WRLCK", F_WRLCK); #else GDFLT("F_WRLCK", 0); #endif #ifdef HUPCL GCST("HUPCL", HUPCL); #else GDFLT("HUPCL", 0); #endif #ifdef ICANON GCST("ICANON", ICANON); #else GDFLT("ICANON", 0); #endif #ifdef ICRNL GCST("ICRNL", ICRNL); #else GDFLT("ICRNL", 0); #endif #ifdef IEXTEN GUCST("IEXTEN", IEXTEN); #else GDFLT("IEXTEN", 0); #endif #ifdef IGNBRK GCST("IGNBRK", IGNBRK); #else GDFLT("IGNBRK", 0); #endif #ifdef IGNCR GCST("IGNCR", IGNCR); #else GDFLT("IGNCR", 0); #endif #ifdef IGNPAR GCST("IGNPAR", IGNPAR); #else GDFLT("IGNPAR", 0); #endif #ifdef INLCR GCST("INLCR", INLCR); #else GDFLT("INLCR", 0); #endif #ifdef INPCK GCST("INPCK", INPCK); #else GDFLT("INPCK", 0); #endif #ifdef ISIG GCST("ISIG", ISIG); #else GDFLT("ISIG", 0); #endif #ifdef ISTRIP GCST("ISTRIP", ISTRIP); #else GDFLT("ISTRIP", 0); #endif #ifdef IXOFF GCST("IXOFF", IXOFF); #else GDFLT("IXOFF", 0); #endif #ifdef IXON GCST("IXON", IXON); #else GDFLT("IXON", 0); #endif #ifdef L_ctermid GCST("L_ctermid", L_ctermid); #else GDFLT("L_ctermid", 10); #endif #ifdef LIO_NOP GCST("LIO_NOP", LIO_NOP); #else GDFLT("LIO_NOP", 0); #endif #ifdef LIO_NOWAIT GCST("LIO_NOWAIT", LIO_NOWAIT); #else GDFLT("LIO_NOWAIT", 0); #endif #ifdef LIO_READ GCST("LIO_READ", LIO_READ); #else GDFLT("LIO_READ", 0); #endif #ifdef LIO_WAIT GCST("LIO_WAIT", LIO_WAIT); #else GDFLT("LIO_WAIT", 0); #endif #ifdef LIO_WRITE GCST("LIO_WRITE", LIO_WRITE); #else GDFLT("LIO_WRITE", 0); #endif #ifdef MAP_FAILED GCST("MAP_FAILED", MAP_FAILED); #else GDFLT("MAP_FAILED",-1); #endif /* Linux wants MAP_FILE flag if we are memory-mapping a file. We define it to be zero for other systems. */ #ifdef MAP_FILE GCST("MAP_FILE", MAP_FILE); #else GDFLT("MAP_FILE", 0); #endif #ifdef MAP_FIXED GCST("MAP_FIXED", MAP_FIXED); #else GDFLT("MAP_FIXED", 0); #endif #ifdef MAP_VARIABLE GCST("MAP_VARIABLE", MAP_VARIABLE); #else GDFLT("MAP_VARIABLE", 0); #endif #ifdef MAP_PRIVATE GCST("MAP_PRIVATE", MAP_PRIVATE); #else GDFLT("MAP_PRIVATE", 0); #endif #ifdef MAP_SHARED GCST("MAP_SHARED", MAP_SHARED); #else GDFLT("MAP_SHARED", 0); #endif #ifdef MAX_CANON GCST("MAX_CANON", MAX_CANON); #else GDFLT("MAX_CANON", 0); #endif #ifdef MAX_INPUT GCST("MAX_INPUT", MAX_INPUT); #else GDFLT("MAX_INPUT", 0); #endif #ifdef MCL_CURRENT GCST("MCL_CURRENT", MCL_CURRENT); #else GDFLT("MCL_CURRENT", 0); #endif #ifdef MCL_FUTURE GCST("MCL_FUTURE", MCL_FUTURE); #else GDFLT("MCL_FUTURE", 0); #endif #ifdef MS_ASYNC GCST("MS_ASYNC", MS_ASYNC); #else GDFLT("MS_ASYNC", 0); #endif #ifdef MS_INVALIDATE GCST("MS_INVALIDATE", MS_INVALIDATE); #else GDFLT("MS_INVALIDATE", 0); #endif #ifdef MS_SYNC GCST("MS_SYNC", MS_SYNC); #else GDFLT("MS_SYNC", 0); #endif #ifdef MS_EINTR GCST("MS_EINTR", MS_EINTR); #else GDFLT("MS_EINTR", 0); #endif #ifdef NCCS GCST("NCCS", NCCS); #else GDFLT("NCCS", 0); #endif #ifdef NOFLSH GUCST("NOFLSH", NOFLSH); #else GDFLT("NOFLSH", 0); #endif #ifdef OPOST GCST("OPOST", OPOST); #else GDFLT("OPOST", 0); #endif #ifdef O_ACCMODE GCST("O_ACCMODE", O_ACCMODE); #else GDFLT("O_ACCMODE", 0); #endif #ifdef O_APPEND GCST("O_APPEND", O_APPEND); #else GDFLT("O_APPEND", 0); #endif #ifdef O_CREAT GCST("O_CREAT", O_CREAT); #else GDFLT("O_CREAT", 0); #endif #ifdef O_DSYNC GCST("O_DSYNC", O_DSYNC); #else GDFLT("O_DSYNC", 0); #endif #ifdef O_EXCL GCST("O_EXCL", O_EXCL); #else GDFLT("O_EXCL", 0); #endif #ifdef O_NOCTTY GCST("O_NOCTTY", O_NOCTTY); #else GDFLT("O_NOCTTY", 0); #endif #ifdef O_NONBLOCK GCST("O_NONBLOCK", O_NONBLOCK); #else GDFLT("O_NONBLOCK", 0); #endif #ifdef O_RDONLY GCST("O_RDONLY", O_RDONLY); #else GDFLT("O_RDONLY", 0); #endif #ifdef O_RDWR GCST("O_RDWR", O_RDWR); #else GDFLT("O_RDWR", 0); #endif #ifdef O_RSYNC GCST("O_RSYNC", O_RSYNC); #else GDFLT("O_RSYNC", 0); #endif #ifdef O_SYNC GCST("O_SYNC", O_SYNC); #else GDFLT("O_SYNC", 0); #endif #ifdef O_TRUNC GCST("O_TRUNC", O_TRUNC); #else GDFLT("O_TRUNC", 0); #endif #ifdef O_WRONLY GCST("O_WRONLY", O_WRONLY); #else GDFLT("O_WRONLY", 0); #endif #ifdef O_EXEC GCST("O_EXEC", O_EXEC); #else GDFLT("O_EXEC", 0); #endif #ifdef O_SEARCH GCST("O_SEARCH", O_SEARCH); #else GDFLT("O_SEARCH", 0); #endif #ifdef O_CLOEXEC GCST("O_CLOEXEC", O_CLOEXEC); #else GDFLT("O_CLOEXEC", 0); #endif #ifdef O_DIRECTORY GCST("O_DIRECTORY", O_DIRECTORY); #else GDFLT("O_DIRECTORY", 0); #endif #ifdef O_NOFOLLOW GCST("O_NOFOLLOW", O_NOFOLLOW); #else GDFLT("O_NOFOLLOW", 0); #endif #ifdef O_TTY_INIT GCST("O_TTY_INIT", O_TTY_INIT); #else GDFLT("O_TTY_INIT", 0); #endif #ifdef PAGESIZE GCST("PAGESIZE", PAGESIZE); #else #ifdef PAGE_SIZE GCST("PAGESIZE", PAGE_SIZE); #else GDFLT("PAGESIZE", 0); #endif #endif #ifdef PARENB GCST("PARENB", PARENB); #else GDFLT("PARENB", 0); #endif #ifdef PARMRK GCST("PARMRK", PARMRK); #else GDFLT("PARMRK", 0); #endif #ifdef PARODD GCST("PARODD", PARODD); #else GDFLT("PARODD", 0); #endif #ifdef PROT_EXEC GCST("PROT_EXEC", PROT_EXEC); #else GDFLT("PROT_EXEC", 0); #endif #ifdef PROT_NONE GCST("PROT_NONE", PROT_NONE); #else GDFLT("PROT_NONE", 0); #endif #ifdef PROT_READ GCST("PROT_READ", PROT_READ); #else GDFLT("PROT_READ", 0); #endif #ifdef PROT_WRITE GCST("PROT_WRITE", PROT_WRITE); #else GDFLT("PROT_WRITE", 0); #endif #ifdef PTHREAD_DESTRUCTOR_ITERATIONS GCST("PTHREAD_DESTRUCTOR_ITERATIONS", PTHREAD_DESTRUCTOR_ITERATIONS); #else GDFLT("PTHREAD_DESTRUCTOR_ITERATIONS", 0); #endif #ifdef PTHREAD_EXPLICIT_SCHED GCST("PTHREAD_EXPLICIT_SCHED", PTHREAD_EXPLICIT_SCHED); #else GDFLT("PTHREAD_EXPLICIT_SCHED", 0); #endif #ifdef PTHREAD_INHERIT_SCHED GCST("PTHREAD_INHERIT_SCHED", PTHREAD_INHERIT_SCHED); #else GDFLT("PTHREAD_INHERIT_SCHED", 0); #endif #ifdef PTHREAD_PRIO_INHERIT GCST("PTHREAD_PRIO_INHERIT", PTHREAD_PRIO_INHERIT); #else GDFLT("PTHREAD_PRIO_INHERIT", 0); #endif #ifdef PTHREAD_PRIO_NONE GCST("PTHREAD_PRIO_NONE", PTHREAD_PRIO_NONE); #else GDFLT("PTHREAD_PRIO_NONE", 0); #endif #ifdef PTHREAD_PRIO_PROTECT GCST("PTHREAD_PRIO_PROTECT", PTHREAD_PRIO_PROTECT); #else GDFLT("PTHREAD_PRIO_PROTECT", 0); #endif #ifdef PTHREAD_PROCESS_SHARED GCST("PTHREAD_PROCESS_SHARED", PTHREAD_PROCESS_SHARED); GCST("PTHREAD_PROCESS_PRIVATE", PTHREAD_PROCESS_PRIVATE); #else GDFLT("PTHREAD_PROCESS_SHARED", 1); GDFLT("PTHREAD_PROCESS_PRIVATE", 0); #endif #ifdef PTHREAD_SCOPE_PROCESS GCST("PTHREAD_SCOPE_PROCESS", PTHREAD_SCOPE_PROCESS); #else GDFLT("PTHREAD_SCOPE_PROCESS", 0); #endif #ifdef PTHREAD_SCOPE_SYSTEM GCST("PTHREAD_SCOPE_SYSTEM", PTHREAD_SCOPE_SYSTEM); #else GDFLT("PTHREAD_SCOPE_SYSTEM", 0); #endif #ifdef R_OK GCST("R_OK", R_OK); #else GDFLT("R_OK", 0); #endif #ifdef SA_NOCLDSTOP GCST("SA_NOCLDSTOP", SA_NOCLDSTOP); #else GDFLT("SA_NOCLDSTOP", 0); #endif #ifdef SA_SIGINFO GCST("SA_SIGINFO", SA_SIGINFO); #else GDFLT("SA_SIGINFO", 0); #endif #ifdef SCHED_FIFO GCST("SCHED_FIFO", SCHED_FIFO); #else GDFLT("SCHED_FIFO", 0); #endif #ifdef SCHED_OTHER GCST("SCHED_OTHER", SCHED_OTHER); #else GDFLT("SCHED_OTHER", 0); #endif #ifdef SCHED_RR GCST("SCHED_RR", SCHED_RR); #else GDFLT("SCHED_RR", 0); #endif #ifdef SEEK_CUR GCST("SEEK_CUR", SEEK_CUR); #else GDFLT("SEEK_CUR", 0); #endif #ifdef SEEK_END GCST("SEEK_END", SEEK_END); #else GDFLT("SEEK_END", 0); #endif #ifdef SEEK_SET GCST("SEEK_SET", SEEK_SET); #else GDFLT("SEEK_SET", 0); #endif #ifdef SIGABRT GCST("SIGABRT", SIGABRT); #else GDFLT("SIGABRT", 0); #endif #ifdef SIGALRM GCST("SIGALRM", SIGALRM); #else GDFLT("SIGALRM", 0); #endif #ifdef SIGBUS GCST("SIGBUS", SIGBUS); #else GDFLT("SIGBUS", 0); #endif #ifdef SIGCHLD GCST("SIGCHLD", SIGCHLD); #else GDFLT("SIGCHLD", 0); #endif #ifdef SIGCONT GCST("SIGCONT", SIGCONT); #else GDFLT("SIGCONT", 0); #endif #ifdef SIGEV_NONE GCST("SIGEV_NONE", SIGEV_NONE); #else GDFLT("SIGEV_NONE", 100); #endif #ifdef SIGEV_SIGNAL GCST("SIGEV_SIGNAL", SIGEV_SIGNAL); #else GDFLT("SIGEV_SIGNAL", 101); #endif #ifdef SIGEV_THREAD GCST("SIGEV_THREAD", SIGEV_THREAD); #else GDFLT("SIGEV_THREAD", 102); #endif #ifdef SIGFPE GCST("SIGFPE", SIGFPE); #else GDFLT("SIGFPE", 0); #endif #ifdef SIGHUP GCST("SIGHUP", SIGHUP); #else GDFLT("SIGHUP", 0); #endif #ifdef SIGILL GCST("SIGILL", SIGILL); #else GDFLT("SIGILL", 0); #endif #ifdef SIGINT GCST("SIGINT", SIGINT); #else GDFLT("SIGINT", 0); #endif #ifdef SIGIO GCST("SIGIO", SIGIO); #else GDFLT("SIGIO", 0); #endif #ifdef SIGKILL GCST("SIGKILL", SIGKILL); #else GDFLT("SIGKILL", 0); #endif #ifdef SIGPIPE GCST("SIGPIPE", SIGPIPE); #else GDFLT("SIGPIPE", 0); #endif #ifdef SIGQUIT GCST("SIGQUIT", SIGQUIT); #else GDFLT("SIGQUIT", 0); #endif /* Try to find out the range of valid signals. We have not yet discovered a portable C way of doing this. We assume the range starts at 0 and is continuous up to some limit. We need this becuase we want to represent sets of signals as Boolean arrays. We considered using sigset_t directly, and would have liked to do so, but had two problems: (1) sigset_t apparently allows the use of dynamically allocated memory (2) we could not figure out how to check for signal validity; in particular, we needed a way to check for whether a given signal is reserved by the Ada runtime system. */ #if defined(__APPLE__) # define BADSIG 0 #else # define BADSIG (-1) #endif {sigset_t set; int sig; int result; int last_good = -1; int first_bad = -1; sigfillset (&set); for (sig = 0; sig < 1024; sig++) { result = sigismember (&set, sig); if (result == 1) last_good = sig; else if ((result == BADSIG) && (first_bad = -1)) first_bad = sig; } if (last_good == 1023) printf("c-posix: WARNING: signal range estimate probably too small\n"); if (first_bad < last_good) { printf("c-posix: WARNING: signal range estimate may be invalid\n"); last_good = first_bad - 1; } #if defined(__APPLE__) /* On Darwin, the above mechanism fails to make a reasonable guess as to the number of available signals. In the test loop sigismember returns true for every value of sig, including zero, and no first_bad is ever set. For now, hard code a reasonable value. */ last_good = 31; #endif #ifdef SIGRTMAX #ifdef SIGRTMIN if ((SIGRTMAX >= 0) && (SIGRTMIN >= 0)) { if ((SIGRTMAX > last_good)) { GCST("SIGRTMAX", last_good); } else { GCST("SIGRTMAX", SIGRTMAX); } ifprintf(fp," function SIGRTMIN\n"); ifprintf(fp," return int;\n"); ifprintf(fp," pragma Import (C, SIGRTMIN, \"" "__gnat_florist_sigrtmin\");\n"); } else { GDFLT("SIGRTMAX", 0); GDFLT("SIGRTMIN", 1); } #else GDFLT("SIGRTMAX", 0); GDFLT("SIGRTMIN", 1); #endif #else GDFLT("SIGRTMAX", 0); GDFLT("SIGRTMIN", 1); #endif GCST("NSIGS", last_good); } #ifdef SIGSEGV GCST("SIGSEGV", SIGSEGV); #else GDFLT("SIGSEGV", 0); #endif #ifdef SIGSTOP GCST("SIGSTOP", SIGSTOP); #else GDFLT("SIGSTOP", 0); #endif #ifdef SIGTERM GCST("SIGTERM", SIGTERM); #else GDFLT("SIGTERM", 0); #endif #ifdef SIGTRAP GCST("SIGTRAP", SIGTRAP); #else GDFLT("SIGTRAP", 0); #endif #ifdef SIGTSTP GCST("SIGTSTP", SIGTSTP); #else GDFLT("SIGTSTP", 0); #endif #ifdef SIGTTIN GCST("SIGTTIN", SIGTTIN); #else GDFLT("SIGTTIN", 0); #endif #ifdef SIGTTOU GCST("SIGTTOU", SIGTTOU); #else GDFLT("SIGTTOU", 0); #endif #ifdef SIGURG GCST("SIGURG", SIGURG); #else GDFLT("SIGURG", 0); #endif #ifdef SIGUSR1 GCST("SIGUSR1", SIGUSR1); #else GDFLT("SIGUSR1", 0); #endif #ifdef SIGUSR2 GCST("SIGUSR2", SIGUSR2); #else GDFLT("SIGUSR2", 0); #endif #ifdef SIG_BLOCK GCST("SIG_BLOCK", SIG_BLOCK); #else GDFLT("SIG_BLOCK", 0); #endif /* .... hope that nobody is really using a pointer or a nontrivial macro for SIG_IGN or SIG_DFL */ #ifdef SIG_DFL GCST("SIG_DFL", (int) SIG_DFL); #else GDFLT("SIG_DFL", 0); #endif #ifdef SIG_IGN GCST("SIG_IGN", (int) SIG_IGN); #else GDFLT("SIG_IGN", 0); #endif #ifdef SIG_SETMASK GCST("SIG_SETMASK", SIG_SETMASK); #else GDFLT("SIG_SETMASK", 0); #endif #ifdef SIG_UNBLOCK GCST("SIG_UNBLOCK", SIG_UNBLOCK); #else GDFLT("SIG_UNBLOCK", 0); #endif #ifdef SI_ASYNCIO GCST("SI_ASYNCIO", SI_ASYNCIO); #else GDFLT("SI_ASYNCIO", 101); #endif #ifdef SI_MESGQ GCST("SI_MESGQ", SI_MESGQ); #else GDFLT("SI_MESGQ", 102); #endif #ifdef SI_QUEUE GCST("SI_QUEUE", SI_QUEUE); #else GDFLT("SI_QUEUE", 103); #endif #ifdef SI_TIMER GCST("SI_TIMER", SI_TIMER); #else GDFLT("SI_TIMER", 104); #endif #ifdef SI_USER GCST("SI_USER", SI_USER); #else GDFLT("SI_USER", 105); #endif #ifdef S_IFSOCK GCST("S_IFSOCK", S_IFSOCK); #else GDFLT("S_IFSOCK", 0); #endif #ifdef S_IRGRP GCST("S_IRGRP", S_IRGRP); #else GDFLT("S_IRGRP", 0); #endif #ifdef S_IROTH GCST("S_IROTH", S_IROTH); #else GDFLT("S_IROTH", 0); #endif #ifdef S_IRUSR GCST("S_IRUSR", S_IRUSR); #else GDFLT("S_IRUSR", 0); #endif #ifdef S_IRWXG GCST("S_IRWXG", S_IRWXG); #else GDFLT("S_IRWXG", 0); #endif #ifdef S_IRWXO GCST("S_IRWXO", S_IRWXO); #else GDFLT("S_IRWXO", 0); #endif #ifdef S_IRWXU GCST("S_IRWXU", S_IRWXU); #else GDFLT("S_IRWXU", 0); #endif #ifdef S_ISGID GCST("S_ISGID", S_ISGID); #else GDFLT("S_ISGID", 0); #endif #ifdef S_ISUID GCST("S_ISUID", S_ISUID); #else GDFLT("S_ISUID", 0); #endif #ifdef S_IWGRP GCST("S_IWGRP", S_IWGRP); #else GDFLT("S_IWGRP", 0); #endif #ifdef S_IWOTH GCST("S_IWOTH", S_IWOTH); #else GDFLT("S_IWOTH", 0); #endif #ifdef S_IWUSR GCST("S_IWUSR", S_IWUSR); #else GDFLT("S_IWUSR", 0); #endif #ifdef S_IXGRP GCST("S_IXGRP", S_IXGRP); #else GDFLT("S_IXGRP", 0); #endif #ifdef S_IXOTH GCST("S_IXOTH", S_IXOTH); #else GDFLT("S_IXOTH", 0); #endif #ifdef S_IXUSR GCST("S_IXUSR", S_IXUSR); #else GDFLT("S_IXUSR", 0); #endif #ifdef TCIFLUSH GCST("TCIFLUSH", TCIFLUSH); #else GDFLT("TCIFLUSH", 0); #endif #ifdef TCIOFF GCST("TCIOFF", TCIOFF); #else GDFLT("TCIOFF", 0); #endif #ifdef TCIOFLUSH GCST("TCIOFLUSH", TCIOFLUSH); #else GDFLT("TCIOFLUSH", 0); #endif #ifdef TCION GCST("TCION", TCION); #else GDFLT("TCION", 0); #endif #ifdef TCOFLUSH GCST("TCOFLUSH", TCOFLUSH); #else GDFLT("TCOFLUSH", 0); #endif #ifdef TCOOFF GCST("TCOOFF", TCOOFF); #else GDFLT("TCOOFF", 0); #endif #ifdef TCOON GCST("TCOON", TCOON); #else GDFLT("TCOON", 0); #endif #ifdef TCSADRAIN GCST("TCSADRAIN", TCSADRAIN); #else GDFLT("TCSADRAIN", 0); #endif #ifdef TCSAFLUSH GCST("TCSAFLUSH", TCSAFLUSH); #else GDFLT("TCSAFLUSH", 0); #endif #ifdef TCSANOW GCST("TCSANOW", TCSANOW); #else GDFLT("TCSANOW", 0); #endif #ifdef TIMER_ABSTIME GCST("TIMER_ABSTIME", TIMER_ABSTIME); #else GDFLT("TIMER_ABSTIME", 1); #endif /* TIMER_RELTIME is not defined by the POSIX.1b standard, but seems to be used by at least Solaris; letting the value default to 0 if undefined gives us the same effect as the POSIX.1c specification. */ #ifdef TIMER_RELTIME GCST("TIMER_RELTIME", TIMER_RELTIME); #else GDFLT("TIMER_RELTIME", 0); #endif #ifdef TOSTOP GCST("TOSTOP", TOSTOP); #else GDFLT("TOSTOP", 0); #endif #ifdef VEOF GCST("VEOF", VEOF); #else GDFLT("VEOF", 0); #endif #ifdef VEOL GCST("VEOL", VEOL); #else GDFLT("VEOL", 0); #endif #ifdef VERASE GCST("VERASE", VERASE); #else GDFLT("VERASE", 0); #endif #ifdef VINTR GCST("VINTR", VINTR); #else GDFLT("VINTR", 0); #endif #ifdef VKILL GCST("VKILL", VKILL); #else GDFLT("VKILL", 0); #endif #ifdef VMIN GCST("VMIN", VMIN); #else GDFLT("VMIN", 0); #endif #ifdef VQUIT GCST("VQUIT", VQUIT); #else GDFLT("VQUIT", 0); #endif #ifdef VSTART GCST("VSTART", VSTART); #else GDFLT("VSTART", 0); #endif #ifdef VSTOP GCST("VSTOP", VSTOP); #else GDFLT("VSTOP", 0); #endif #ifdef VSUSP GCST("VSUSP", VSUSP); #else GDFLT("VSUSP", 0); #endif #ifdef VTIME GCST("VTIME", VTIME); #else GDFLT("VTIME", 0); #endif #ifdef WNOHANG GCST("WNOHANG", WNOHANG); #else GDFLT("WNOHANG", 0); #endif #ifdef WUNTRACED GCST("WUNTRACED", WUNTRACED); #else GDFLT("WUNTRACED", 0); #endif #ifdef W_OK GCST("W_OK", W_OK); #else GDFLT("W_OK", 0); #endif #ifdef X_OK GCST("X_OK", X_OK); #else GDFLT("X_OK", 0); #endif #ifdef _PC_ASYNC_IO GCST("PC_ASYNC_IO", _PC_ASYNC_IO); #else GDFLT("PC_ASYNC_IO", 0); #endif #ifdef _PC_CHOWN_RESTRICTED GCST("PC_CHOWN_RESTRICTED", _PC_CHOWN_RESTRICTED); #else GDFLT("PC_CHOWN_RESTRICTED", 0); #endif #ifdef _PC_LINK_MAX GCST("PC_LINK_MAX", _PC_LINK_MAX); #else GDFLT("PC_LINK_MAX", 0); #endif #ifdef _PC_MAX_CANON GCST("PC_MAX_CANON", _PC_MAX_CANON); #else GDFLT("PC_MAX_CANON", 0); #endif #ifdef _PC_MAX_INPUT GCST("PC_MAX_INPUT", _PC_MAX_INPUT); #else GDFLT("PC_MAX_INPUT", 0); #endif #ifdef _PC_NAME_MAX GCST("PC_NAME_MAX", _PC_NAME_MAX); #else GDFLT("PC_NAME_MAX", 0); #endif #ifdef _PC_NO_TRUNC GCST("PC_NO_TRUNC", _PC_NO_TRUNC); #else GDFLT("PC_NO_TRUNC", 0); #endif #ifdef _PC_PATH_MAX GCST("PC_PATH_MAX", _PC_PATH_MAX); #else GDFLT("PC_PATH_MAX", 0); #endif #ifdef _PC_PIPE_BUF GCST("PC_PIPE_BUF", _PC_PIPE_BUF); #else GDFLT("PC_PIPE_BUF", 0); #endif #ifdef _PC_PRIO_IO GCST("PC_PRIO_IO", _PC_PRIO_IO); #else GDFLT("PC_PRIO_IO", 0); #endif #ifdef _PC_SYNC_IO GCST("PC_SYNC_IO", _PC_SYNC_IO); #else GDFLT("PC_SYNC_IO", 0); #endif #ifdef _PC_SOCK_MAXBUF GCST("PC_SOCK_MAXBUF", _PC_SOCK_MAXBUF); #else GDFLT("PC_SOCK_MAXBUF", 0); #endif #ifdef _SC_AIO_LISTIO_MAX GCST("SC_AIO_LISTIO_MAX", _SC_AIO_LISTIO_MAX); #else GDFLT("SC_AIO_LISTIO_MAX", 0); #endif #ifdef _SC_AIO_MAX GCST("SC_AIO_MAX", _SC_AIO_MAX); #else GDFLT("SC_AIO_MAX", 0); #endif #ifdef _SC_AIO_PRIO_DELTA_MAX GCST("SC_AIO_PRIO_DELTA_MAX", _SC_AIO_PRIO_DELTA_MAX); #else GDFLT("SC_AIO_PRIO_DELTA_MAX", 0); #endif #ifdef _SC_ARG_MAX GCST("SC_ARG_MAX", _SC_ARG_MAX); #else GDFLT("SC_ARG_MAX", 0); #endif #ifdef _SC_ASYNCHRONOUS_IO GCST("SC_ASYNCHRONOUS_IO", _SC_ASYNCHRONOUS_IO); #else GDFLT("SC_ASYNCHRONOUS_IO", 0); #endif #ifdef _SC_CHILD_MAX GCST("SC_CHILD_MAX", _SC_CHILD_MAX); #else GDFLT("SC_CHILD_MAX", 0); #endif #ifdef _SC_CLK_TCK GCST("SC_CLK_TCK", _SC_CLK_TCK); #else GDFLT("SC_CLK_TCK", 0); #endif #ifdef _SC_DELAYTIMER_MAX GCST("SC_DELAYTIMER_MAX", _SC_DELAYTIMER_MAX); #else GDFLT("SC_DELAYTIMER_MAX", 0); #endif #ifdef _SC_FSYNC GCST("SC_FSYNC", _SC_FSYNC); #else GDFLT("SC_FSYNC", 0); #endif #ifdef _SC_JOB_CONTROL GCST("SC_JOB_CONTROL", _SC_JOB_CONTROL); #else GDFLT("SC_JOB_CONTROL", 0); #endif #ifdef _SC_MAPPED_FILES GCST("SC_MAPPED_FILES", _SC_MAPPED_FILES); #else GDFLT("SC_MAPPED_FILES", 0); #endif #ifdef _SC_MEMLOCK GCST("SC_MEMLOCK", _SC_MEMLOCK); #else GDFLT("SC_MEMLOCK", 0); #endif #ifdef _SC_MEMLOCK_RANGE GCST("SC_MEMLOCK_RANGE", _SC_MEMLOCK_RANGE); #else GDFLT("SC_MEMLOCK_RANGE", 0); #endif #ifdef _SC_MEMORY_PROTECTION GCST("SC_MEMORY_PROTECTION", _SC_MEMORY_PROTECTION); #else GDFLT("SC_MEMORY_PROTECTION", 0); #endif #ifdef _SC_MESSAGE_PASSING GCST("SC_MESSAGE_PASSING", _SC_MESSAGE_PASSING); #else GDFLT("SC_MESSAGE_PASSING", 0); #endif #ifdef _SC_MQ_OPEN_MAX GCST("SC_MQ_OPEN_MAX", _SC_MQ_OPEN_MAX); #else GDFLT("SC_MQ_OPEN_MAX", 0); #endif #ifdef _SC_MQ_PRIO_MAX GCST("SC_MQ_PRIO_MAX", _SC_MQ_PRIO_MAX); #else GDFLT("SC_MQ_PRIO_MAX", 0); #endif #ifdef _SC_NGROUPS_MAX GCST("SC_NGROUPS_MAX", _SC_NGROUPS_MAX); #else GDFLT("SC_NGROUPS_MAX", 0); #endif #ifdef _SC_OPEN_MAX GCST("SC_OPEN_MAX", _SC_OPEN_MAX); #else GDFLT("SC_OPEN_MAX", 0); #endif #ifdef _SC_PAGESIZE GCST("SC_PAGESIZE", _SC_PAGESIZE); #else GDFLT("SC_PAGESIZE", 0); #endif #ifdef _SC_PII GCST("SC_PII", _SC_PII); #else GDFLT("SC_PII", 0); #endif #ifdef _SC_PII_XTI GCST("SC_PII_XTI", _SC_PII_XTI); #else GDFLT("SC_PII_XTI", 0); #endif #ifdef _SC_PII_SOCKET GCST("SC_PII_SOCKET", _SC_PII_SOCKET); #else GDFLT("SC_PII_SOCKET", 0); #endif #ifdef _SC_PII_INTERNET GCST("SC_PII_INTERNET", _SC_PII_INTERNET); #else GDFLT("SC_PII_INTERNET", 0); #endif #ifdef _SC_PII_INTERNET_STREAM GCST("SC_PII_INTERNET_STREAM", _SC_PII_INTERNET_STREAM); #else GDFLT("SC_PII_INTERNET_STREAM", 0); #endif #ifdef _SC_PII_INTERNET_DGRAM GCST("SC_PII_INTERNET_DGRAM", _SC_PII_INTERNET_DGRAM); #else GDFLT("SC_PII_INTERNET_DGRAM", 0); #endif #ifdef _SC_PII_OSI GCST("SC_PII_OSI", _SC_PII_OSI); #else GDFLT("SC_PII_OSI", 0); #endif #ifdef _SC_PII_OSI_M GCST("SC_PII_OSI_M", _SC_PII_OSI_M); #else GDFLT("SC_PII_OSI_M", 0); #endif #ifdef _SC_PII_OSI_COTS GCST("SC_PII_OSI_COTS", _SC_PII_OSI_COTS); #else GDFLT("SC_PII_OSI_COTS", 0); #endif #ifdef _SC_PII_OSI_CLTS GCST("SC_PII_OSI_CLTS", _SC_PII_OSI_CLTS); #else GDFLT("SC_PII_OSI_CLTS", 0); #endif #ifdef _SC_PII_NET_SUPPORT GCST("SC_PII_NET_SUPPORT", _SC_PII_NET_SUPPORT); #else GDFLT("SC_PII_NET_SUPPORT", 0); #endif #ifdef _SC_POLL GCST("SC_POLL", _SC_POLL); #else GDFLT("SC_POLL", 0); #endif #ifdef _SC_POSIX_PII_NET_SUPPORT GCST("SC_POSIX_PII_NET_SUPPORT", _SC_POSIX_PII_NET_SUPPORT); #else GDFLT("SC_POSIX_PII_NET_SUPPORT", 0); #endif #ifdef _SC_PRIORITIZED_IO GCST("SC_PRIORITIZED_IO", _SC_PRIORITIZED_IO); #else GDFLT("SC_PRIORITIZED_IO", 0); #endif #ifdef _SC_PRIORITY_SCHEDULING GCST("SC_PRIORITY_SCHEDULING", _SC_PRIORITY_SCHEDULING); #else GDFLT("SC_PRIORITY_SCHEDULING", 0); #endif #ifdef _SC_SELECT GCST("SC_SELECT", _SC_SELECT); #else GDFLT("SC_SELECT", 0); #endif #ifdef _SC_THREAD_PROCESS_SHARED GCST("SC_THREAD_PROCESS_SHARED", _SC_THREAD_PROCESS_SHARED); #else GDFLT("SC_THREAD_PROCESS_SHARED", 0); #endif #ifdef _SC_REALTIME_SIGNALS GCST("SC_REALTIME_SIGNALS", _SC_REALTIME_SIGNALS); #else GDFLT("SC_REALTIME_SIGNALS", 0); #endif #ifdef _SC_RTSIG_MAX GCST("SC_RTSIG_MAX", _SC_RTSIG_MAX); #else GDFLT("SC_RTSIG_MAX", 0); #endif #ifdef _SC_SAVED_IDS GCST("SC_SAVED_IDS", _SC_SAVED_IDS); #else GDFLT("SC_SAVED_IDS", 0); #endif #ifdef _SC_SEMAPHORES GCST("SC_SEMAPHORES", _SC_SEMAPHORES); #else GDFLT("SC_SEMAPHORES", 0); #endif #ifdef _SC_SEM_NSEMS_MAX GCST("SC_SEM_NSEMS_MAX", _SC_SEM_NSEMS_MAX); #else GDFLT("SC_SEM_NSEMS_MAX", 0); #endif #ifdef _SC_SEM_VALUE_MAX GCST("SC_SEM_VALUE_MAX", _SC_SEM_VALUE_MAX); #else GDFLT("SC_SEM_VALUE_MAX", 0); #endif #ifdef _SC_SHARED_MEMORY_OBJECTS GCST("SC_SHARED_MEMORY_OBJECTS", _SC_SHARED_MEMORY_OBJECTS); #else GDFLT("SC_SHARED_MEMORY_OBJECTS", 0); #endif #ifdef _SC_SIGQUEUE_MAX GCST("SC_SIGQUEUE_MAX", _SC_SIGQUEUE_MAX); #else GDFLT("SC_SIGQUEUE_MAX", 0); #endif #ifdef _SC_STREAM_MAX GCST("SC_STREAM_MAX", _SC_STREAM_MAX); #else GDFLT("SC_STREAM_MAX", 0); #endif #ifdef _SC_SYNCHRONIZED_IO GCST("SC_SYNCHRONIZED_IO", _SC_SYNCHRONIZED_IO); #else GDFLT("SC_SYNCHRONIZED_IO", 0); #endif #ifdef _SC_THREAD_PRIORITY_SCHEDULING GCST("SC_THREAD_PRIORITY_SCHEDULING", _SC_THREAD_PRIORITY_SCHEDULING); #else GDFLT("SC_THREAD_PRIORITY_SCHEDULING", 0); #endif #ifdef _SC_THREAD_PRIO_INHERIT GCST("SC_THREAD_PRIO_INHERIT", _SC_THREAD_PRIO_INHERIT); #else GDFLT("SC_THREAD_PRIO_INHERIT", 0); #endif #ifdef _SC_THREAD_PRIO_PROTECT GCST("SC_THREAD_PRIO_PROTECT", _SC_THREAD_PRIO_PROTECT); #else GDFLT("SC_THREAD_PRIO_PROTECT", 0); #endif #ifdef _SC_TIMERS GCST("SC_TIMERS", _SC_TIMERS); #else GDFLT("SC_TIMERS", 0); #endif #ifdef _SC_TIMER_MAX GCST("SC_TIMER_MAX", _SC_TIMER_MAX); #else GDFLT("SC_TIMER_MAX", 0); #endif #ifdef _SC_TZNAME_MAX GCST("SC_TZNAME_MAX", _SC_TZNAME_MAX); #else GDFLT("SC_TZNAME_MAX", 0); #endif #ifdef _SC_T_IOV_MAX GCST("SC_T_IOV_MAX", _SC_T_IOV_MAX); #else GDFLT("SC_T_IOV_MAX", 0); #endif #ifdef _SC_UIO_MAXIOV GCST("SC_UIO_MAXIOV", _SC_UIO_MAXIOV); #else GDFLT("SC_UIO_MAXIOV", 0); #endif #ifdef _SC_VERSION GCST("SC_VERSION", _SC_VERSION); #else GDFLT("SC_VERSION", 0); #endif /* type declarations ----------------- If you make any changes here, also make changes where procedures are declared, above. (***) */ ghdrcmnt("type definitions"); g_off_t(); g_pid_t(); g_gid_t(); g_uid_t(); g_mode_t(); g_suseconds_t(); g_ssize_t(); g_DIR(); g_ino_t(); g_dev_t(); g_cc_t(); g_nlink_t(); g_blksize_t(); g_blkcnt_t(); g_tcflag_t(); g_clockid_t(); g_mqd_t(); g_pthread_attr_t(); g_pthread_cond_t(); g_pthread_condattr_t(); g_pthread_key_t(); g_pthread_mutex_t(); g_pthread_mutexattr_t(); g_pthread_once_t(); g_pthread_t(); g_sem_t(); g_sigset_t(); g_speed_t(); g_socklen_t(); g_timer_t(); g_sigval(); /* must precede siginfo_t and struct_sigevent */ g_siginfo_t(); /* is typedef of a struct type */ ghdrcmnt("structure types"); g_struct_sigevent(); /* must precede aiocb */ g_struct_aiocb(); g_struct_dirent(); g_struct_flock(); g_struct_group(); g_struct_mq_attr(); g_struct_passwd(); g_struct_sigaction(); g_struct_sched_param(); ifprintf(fp," type cc_t_array is array (0 .. NCCS - 1) of cc_t;\n"); g_struct_stat(); gen_unchckd_conv ("To_Stat_Ptr", "Address", "stat_ptr"); g_struct_termios(); gcmnt("timeval structure"); g_struct_timeval(); g_struct_timespec(); g_struct_itimerspec(); g_struct_tm(); g_struct_tms(); g_struct_utimbuf(); { struct utsname DUMMY; ifprintf(fp," subtype utsname_sysname_string is\n" " POSIX_String (1 .. %d);\n", sizeof (DUMMY.sysname)); ifprintf(fp," subtype utsname_nodename_string is\n" " POSIX_String (1 .. %d);\n", sizeof (DUMMY.nodename)); ifprintf(fp," subtype utsname_release_string is\n" " POSIX_String (1 .. %d);\n", sizeof (DUMMY.release)); ifprintf(fp," subtype utsname_version_string is\n" " POSIX_String (1 .. %d);\n", sizeof (DUMMY.version)); ifprintf(fp," subtype utsname_machine_string is\n" " POSIX_String (1 .. %d);\n", sizeof (DUMMY.machine)); } g_struct_utsname(); /* ......need to figure what to do with functions, next..... */ ghdrcmnt("link names for C functions"); GFUNC(access,HAVE_access); GFUNC(aio_cancel,HAVE_aio_cancel); GFUNC(aio_error,HAVE_aio_error); GFUNC(aio_fsync,HAVE_aio_fsync); GFUNC(aio_read,HAVE_aio_read); GFUNC(aio_return,HAVE_aio_return); GFUNC(aio_suspend,HAVE_aio_suspend); GFUNC(aio_write,HAVE_aio_write); /* GFUNC(alarm,HAVE_alarm); */ /* GFUNC(asctime,HAVE_asctime); */ GFUNC(cfgetispeed,HAVE_cfgetispeed); GFUNC(cfgetospeed,HAVE_cfgetospeed); GFUNC(cfsetispeed,HAVE_cfsetispeed); GFUNC(cfsetospeed,HAVE_cfsetospeed); GFUNC(chdir,HAVE_chdir); GFUNC(chmod,HAVE_chmod); GFUNC(chown,HAVE_chown); GFUNC(clock_getres,HAVE_clock_getres); GFUNC(clock_gettime,HAVE_clock_gettime); GFUNC(clock_settime,HAVE_clock_settime); GFUNC(close,HAVE_close); GFUNC(closedir,HAVE_closedir); /* GFUNC(creat,HAVE_creat); */ GFUNC(ctermid,HAVE_ctermid); GFUNC(ctime,HAVE_ctime); #if defined(SOLARIS_HACK) if (HAVE___posix_ctime_r == 1) { gfuncsol("ctime_r","__posix_ctime_r"); } else { GFUNC(ctime_r,HAVE_ctime_r); } #else GFUNC(ctime_r,HAVE_ctime_r); #endif GFUNC(dup,HAVE_dup); GFUNC(dup2,HAVE_dup2); /* .... still need to check all the following functions, to verify how they return errors, and arrange for the correct kind of stub link-name to be generated if the function is not supported */ /* The execl* version of execl should not be used directly, since wrappers must be provided for all variadic functions. GFUNC(execl,HAVE_execl); GFUNC(execle,HAVE_execle); GFUNC(execlp,HAVE_execlp); */ GFUNC(execv,HAVE_execv); GFUNC(execve,HAVE_execve); GFUNC(execvp,HAVE_execvp); GFUNC(fchmod,HAVE_fchmod); GFUNC(fcntl,HAVE_fcntl); GFUNC(fdatasync,HAVE_fdatasync); /* GFUNC(fdopen,HAVE_fdopen); */ /* GFUNC(fileno,HAVE_fileno); */ /* GFUNC(flockfile,HAVE_flockfile); */ GFUNC(fork,HAVE_fork); GFUNC(fpathconf,HAVE_fpathconf); GFUNC(fstat,HAVE_fstat); GFUNC(fsync,HAVE_fsync); GFUNC(ftruncate,HAVE_ftruncate); /* GFUNC(funlockfile,HAVE_funlockfile); */ /* GFUNC(getc_unlocked,HAVE_getc_unlocked); */ /* GFUNC(getchar_unlocked,HAVE_getchar_unlocked); */ GFUNC(getcwd,HAVE_getcwd); GFUNC(getegid,HAVE_getegid); GFUNC(getenv,HAVE_getenv); GFUNC(geteuid,HAVE_geteuid); GFUNC(getgid,HAVE_getgid); GFUNC(getgrgid,HAVE_getgrgid); GFUNC(getgrnam,HAVE_getgrnam); GFUNC(getgroups,HAVE_getgroups); GFUNC(getlogin,HAVE_getlogin); GFUNC(getpgrp,HAVE_getpgrp); GFUNC(getpid,HAVE_getpid); GFUNC(getppid,HAVE_getppid); GFUNC(getpwnam,HAVE_getpwnam); GFUNC(getpwuid,HAVE_getpwuid); GFUNC(gettimeofday,HAVE_gettimeofday); GFUNC(getuid,HAVE_getuid); GFUNC(gmtime_r,HAVE_gmtime_r); GFUNC(isatty,HAVE_isatty); GFUNC(kill,HAVE_kill); GFUNC(link,HAVE_link); GFUNC(lio_listio,HAVE_lio_listio); GFUNC(lstat, HAVE_lstat); /* GFUNC(localtime_r,HAVE_localtime_r); */ GFUNC(lseek,HAVE_lseek); GFUNC(mkdir,HAVE_mkdir); GFUNC(mkfifo,HAVE_mkfifo); GFUNC(mlock,HAVE_mlock); GFUNC(mlockall,HAVE_mlockall); GFUNC(mmap,HAVE_mmap); GFUNC(mprotect,HAVE_mprotect); GFUNC(mq_close,HAVE_mq_close); GFUNC(mq_getattr,HAVE_mq_getattr); GFUNC(mq_notify,HAVE_mq_notify); GFUNC(mq_open,HAVE_mq_open); GFUNC(mq_receive,HAVE_mq_receive); GFUNC(mq_send,HAVE_mq_send); GFUNC(mq_setattr,HAVE_mq_setattr); GFUNC(mq_unlink,HAVE_mq_unlink); GFUNC(msync,HAVE_msync); GFUNC(munlock,HAVE_munlock); GFUNC(munlockall,HAVE_munlockall); GFUNC(munmap,HAVE_munmap); /* GFUNC(nanosleep,HAVE_nanosleep); */ GFUNC(open,HAVE_open); GFUNC(opendir,HAVE_opendir); GFUNC(pathconf,HAVE_pathconf); /* GFUNC(pause,HAVE_pause); */ /* GFUNC(perror,HAVE_perror); */ GFUNC(pipe,HAVE_pipe); /* GFUNCD(pthread_atfork,HAVE_pthread_atfork); */ /* GFUNCD(pthread_attr_destroy,HAVE_pthread_attr_destroy); */ /* GFUNCD(pthread_attr_getdetachstate,HAVE_pthread_attr_getdetachstate); */ /* GFUNCD(pthread_attr_getinheritsched,HAVE_pthread_attr_getinheritsched); */ /* GFUNCD(pthread_attr_getschedparam,HAVE_pthread_attr_getschedparam); */ /* GFUNCD(pthread_attr_getschedpolicy,HAVE_pthread_attr_getschedpolicy); */ /* GFUNCD(pthread_attr_getscope,HAVE_pthread_attr_getscope); */ /* GFUNCD(pthread_attr_getstackaddr,HAVE_pthread_attr_getstackaddr); */ /* GFUNCD(pthread_attr_getstacksize,HAVE_pthread_attr_getstacksize); */ /* GFUNCD(pthread_attr_init,HAVE_pthread_attr_init); */ /* GFUNCD(pthread_attr_setdetachstate,HAVE_pthread_attr_setdetachstate); */ /* GFUNCD(pthread_attr_setinheritsched,HAVE_pthread_attr_setinheritsched); */ /* GFUNCD(pthread_attr_setschedparam,HAVE_pthread_attr_setschedparam); */ /* GFUNCD(pthread_attr_setschedpolicy,HAVE_pthread_attr_setschedpolicy); */ /* GFUNCD(pthread_attr_setscope,HAVE_pthread_attr_setscope); */ /* GFUNCD(pthread_attr_setstackaddr,HAVE_pthread_attr_setstackaddr); */ /* GFUNCD(pthread_attr_setstacksize,HAVE_pthread_attr_setstacksize); */ /* GFUNCD(pthread_cancel,HAVE_pthread_cancel); */ /* GFUNCD(pthread_cleanup_pop,HAVE_pthread_cleanup_pop); */ /* GFUNCD(pthread_cleanup_push,HAVE_pthread_cleanup_push); */ GFUNCD(pthread_cond_broadcast,HAVE_pthread_cond_broadcast); GFUNCD(pthread_cond_destroy,HAVE_pthread_cond_destroy); GFUNCD(pthread_cond_init,HAVE_pthread_cond_init); GFUNCD(pthread_cond_signal,HAVE_pthread_cond_signal); GFUNCD(pthread_cond_timedwait,HAVE_pthread_cond_timedwait); GFUNCD(pthread_cond_wait,HAVE_pthread_cond_wait); GFUNCD(pthread_condattr_destroy,HAVE_pthread_condattr_destroy); GFUNCD(pthread_condattr_getpshared,HAVE_pthread_condattr_getpshared); GFUNCD(pthread_condattr_init,HAVE_pthread_condattr_init); GFUNCD(pthread_condattr_setpshared,HAVE_pthread_condattr_setpshared); /* GFUNCD(pthread_create,HAVE_pthread_create); */ /* GFUNCD(pthread_equal,HAVE_pthread_equal); */ /* GFUNCD(pthread_exit,HAVE_pthread_exit); */ /* GFUNCD(pthread_getschedparam,HAVE_pthread_getschedparam); */ /* GFUNCD(pthread_getspecific,HAVE_pthread_getspecific); */ /* GFUNCD(pthread_join,HAVE_pthread_join); */ /* GFUNCD(pthread_key_create,HAVE_pthread_key_create); */ /* GFUNCD(pthread_key_delete,HAVE_pthread_key_delete); */ /* GFUNCD(pthread_kill,HAVE_pthread_kill); */ GFUNCD(pthread_mutex_destroy,HAVE_pthread_mutex_destroy); GFUNCD(pthread_mutex_getprioceiling,HAVE_pthread_mutex_getprioceiling); GFUNCD(pthread_mutex_init,HAVE_pthread_mutex_init); GFUNCD(pthread_mutex_lock,HAVE_pthread_mutex_lock); GFUNCD(pthread_mutex_setprioceiling,HAVE_pthread_mutex_setprioceiling); GFUNCD(pthread_mutex_trylock,HAVE_pthread_mutex_trylock); GFUNCD(pthread_mutex_unlock,HAVE_pthread_mutex_unlock); GFUNCD(pthread_mutexattr_destroy,HAVE_pthread_mutexattr_destroy); GFUNCD(pthread_mutexattr_getprioceiling, HAVE_pthread_mutexattr_getprioceiling); GFUNCD(pthread_mutexattr_getprotocol,HAVE_pthread_mutexattr_getprotocol); GFUNCD(pthread_mutexattr_getpshared,HAVE_pthread_mutexattr_getpshared); GFUNCD(pthread_mutexattr_init,HAVE_pthread_mutexattr_init); GFUNCD(pthread_mutexattr_setprioceiling, HAVE_pthread_mutexattr_setprioceiling); GFUNCD(pthread_mutexattr_setprotocol,HAVE_pthread_mutexattr_setprotocol); /* if not supported, the error code is Operation_Not_Implemented, i.e., ENOSYS */ GFUNCD(pthread_mutexattr_setpshared,HAVE_pthread_mutexattr_setpshared); /* GFUNCD(pthread_once,HAVE_pthread_once); */ /* GFUNCD(pthread_self,HAVE_pthread_self); */ /* GFUNCD(pthread_setcancelstate,HAVE_pthread_setcancelstate); */ /* GFUNCD(pthread_setcanceltype,HAVE_pthread_setcanceltype); */ /* GFUNCD(pthread_setschedparam,HAVE_pthread_setschedparam); */ /* GFUNCD(pthread_setspecific,HAVE_pthread_setspecific); */ GFUNCD(pthread_sigmask,HAVE_pthread_sigmask); /* GFUNCD(pthread_testcancel,HAVE_pthread_testcancel); */ /* GFUNC(putc_unlocked,HAVE_putc_unlocked); */ /* GFUNC(putchar_unlocked,HAVE_putchar_unlocked); */ GFUNC(putenv,HAVE_putenv); /* GFUNC(rand_r,HAVE_rand_r); */ GFUNC(read,HAVE_read); GFUNC(readdir,HAVE_readdir); #if defined(SOLARIS_HACK) && (_FILE_OFFSET_BITS != 64) if (HAVE___posix_readdir_r == 1) { gfuncsol("readdir_r","__posix_readdir_r"); } else { GFUNC(readdir_r,HAVE_readdir_r); } #else GFUNC(readdir_r,HAVE_readdir_r); #endif GFUNC(rename,HAVE_rename); /* GFUNC(rewinddir,HAVE_rewinddir); */ /* GFUNC(rewinddir_r,HAVE_rewinddir_r); */ GFUNC(rmdir,HAVE_rmdir); GFUNC(sched_get_priority_max,HAVE_sched_get_priority_max); GFUNC(sched_get_priority_min,HAVE_sched_get_priority_min); GFUNC(sched_rr_get_interval,HAVE_sched_rr_get_interval); GFUNC(sched_getparam,HAVE_sched_getparam); GFUNC(sched_getscheduler,HAVE_sched_getscheduler); GFUNC(sched_setparam,HAVE_sched_setparam); GFUNC(sched_setscheduler,HAVE_sched_setscheduler); GFUNC(sched_yield,HAVE_sched_yield); GFUNC(sem_close,HAVE_sem_close); GFUNC(sem_destroy,HAVE_sem_destroy); GFUNC(sem_getvalue,HAVE_sem_getvalue); GFUNC(sem_init,HAVE_sem_init); GFUNC(sem_open,HAVE_sem_open); GFUNC(sem_post,HAVE_sem_post); GFUNC(sem_trywait,HAVE_sem_trywait); GFUNC(sem_unlink,HAVE_sem_unlink); GFUNC(sem_wait,HAVE_sem_wait); GFUNC(setenv,HAVE_setenv); GFUNC(setgid,HAVE_setgid); GFUNC(setpgid,HAVE_setpgid); GFUNC(setsid,HAVE_setsid); GFUNC(setuid,HAVE_setuid); GFUNC(shm_open,HAVE_shm_open); GFUNC(shm_unlink,HAVE_shm_unlink); GFUNC(sigaction,HAVE_sigaction); GFUNC(sigaddset,HAVE_sigaddset); GFUNC(sigdelset,HAVE_sigdelset); GFUNC(sigemptyset,HAVE_sigemptyset); GFUNC(sigfillset,HAVE_sigfillset); GFUNC(sigismember,HAVE_sigismember); #ifdef siglongjmp /* ifprintf(fp," -- *** WARNING: %s is a macro *** --\n", "siglongjmp"); */ #endif /* GFUNC(siglongjmp,HAVE_siglongjmp); */ GFUNC(sigpending,HAVE_sigpending); GFUNC(sigprocmask,HAVE_sigprocmask); GFUNC(sigqueue,HAVE_sigqueue); #ifdef sigsetjmp /* ifprintf(fp," -- *** WARNING: %s is a macro *** --\n", "sigsetjmp"); */ #endif /* GFUNC(sigsetjmp,HAVE_sigsetjmp); */ /* GFUNC(sigsuspend,HAVE_sigsuspend); */ GFUNC(sigtimedwait,HAVE_sigtimedwait); #if defined(SOLARIS_HACK) if (HAVE___posix_sigwait == 1) { gfuncsol("sigwait","__posix_sigwait"); } else { GFUNC(sigwait,HAVE_sigwait); } #else GFUNC(sigwait,HAVE_sigwait); #endif GFUNC(sigwaitinfo,HAVE_sigwaitinfo); /* GFUNC(sleep,HAVE_sleep); */ GFUNC(stat,HAVE_stat); /* GFUNC(strtok_r,HAVE_strtok_r); */ GFUNC(sysconf,HAVE_sysconf); GFUNC(tcdrain,HAVE_tcdrain); GFUNC(tcflow,HAVE_tcflow); GFUNC(tcflush,HAVE_tcflush); GFUNC(tcgetattr,HAVE_tcgetattr); GFUNC(tcgetpgrp,HAVE_tcgetpgrp); GFUNC(tcsendbreak,HAVE_tcsendbreak); GFUNC(tcsetattr,HAVE_tcsetattr); GFUNC(tcsetpgrp,HAVE_tcsetpgrp); GFUNC(time,HAVE_time); GFUNC(timer_create,HAVE_timer_create); /* POSIX.5b erroneously specifies OPERATION_NOT_SUPPORTED for Create/Delete_Timer. That is inconsistent with POSIX.1b. Therefore, we follow POSIX.1b instead. */ GFUNC(timer_delete,HAVE_timer_delete); GFUNC(timer_getoverrun,HAVE_timer_getoverrun); GFUNC(timer_gettime,HAVE_timer_gettime); GFUNC(timer_settime,HAVE_timer_settime); GFUNC(times,HAVE_times); GFUNC(ttyname,HAVE_ttyname); /* GFUNC(tzset,HAVE_tzset); */ GFUNC(umask,HAVE_umask); GFUNC(uname,HAVE_uname); GFUNC(unlink,HAVE_unlink); GFUNC(unsetenv,HAVE_unsetenv); GFUNC(utime,HAVE_utime); /* GFUNC(wait,HAVE_wait); */ GFUNC(waitpid,HAVE_waitpid); GFUNC(write,HAVE_write); ghdrcmnt("C functions for macros"); gmacrofunc("s_isdir","mode_t","mode"); gmacrofunc("s_ischr","mode_t","mode"); gmacrofunc("s_isblk","mode_t","mode"); gmacrofunc("s_islnk","mode_t","mode"); gmacrofunc("s_isreg","mode_t","mode"); gmacrofunc("s_isfifo","mode_t","mode"); gmacrofunc("s_ismsg","mode_t","mode"); gmacrofunc("s_issem","mode_t","mode"); gmacrofunc("s_isshm","mode_t","mode"); gmacrofunc("s_issock","mode_t","mode"); gmacrofunc("s_typeismq","stat_ptr","stat"); gmacrofunc("s_typeissem","stat_ptr","stat"); gmacrofunc("s_typeisshm","stat_ptr","stat"); gmacrofunc("wifexited","int","stat_val"); gmacrofunc("wifexitstatus","int","stat_val"); gmacrofunc("wifsignaled","int","stat_val"); gmacrofunc("wiftermsig","int","stat_val"); gmacrofunc("wifstopped","int","stat_val"); gmacrofunc("wifstopsig","int","stat_val"); /* c_sockets ---------------- */ indent++; ifprintf(fp,"package Sockets is\n"); ghdrcmnt("socket.h"); #ifdef HAVE_sa_family_t guitp("sa_family_t", sizeof(sa_family_t)); #else NON_SUPPORT_MESSAGE("sa_family_t") guitp("sa_family_t", sizeof(short)); #endif #ifdef HAVE_in_port_t guitp("in_port_t", sizeof(in_port_t)); #else NON_SUPPORT_MESSAGE("in_port_t") guitp("in_port_t", sizeof(in_port_t)); #endif ghdrcmnt("constants"); #ifdef HOST_NOT_FOUND GCST("HOST_NOT_FOUND", HOST_NOT_FOUND); #else GDFLT("HOST_NOT_FOUND", 0); #endif #ifdef NO_DATA GCST("NO_DATA", NO_DATA); #else GDFLT("NO_DATA", 0); #endif #ifdef NO_RECOVERY GCST("NO_RECOVERY", NO_RECOVERY); #else GDFLT("NO_RECOVERY", 0); #endif #ifdef TRY_AGAIN GCST("TRY_AGAIN", TRY_AGAIN); #else GDFLT("TRY_AGAIN", 0); #endif #ifdef MAX_SOCKADDR_EXT GCST("MAX_SOCKADDR_EXT", MAX_SOCKADDR_EXT); #else GDFLT("MAX_SOCKADDR_EXT", 108); #endif gcmnt("sockets protocol level"); #ifdef SOL_SOCKET GCST("SOL_SOCKET", SOL_SOCKET); #else GDFLT("SOL_SOCKET", 0); #endif gcmnt("socket types"); #ifdef SOCK_STREAM GCST("SOCK_STREAM", SOCK_STREAM); #else GDFLT("SOCK_STREAM", 0); #endif #ifdef SOCK_DGRAM GCST("SOCK_DGRAM", SOCK_DGRAM); #else GDFLT("SOCK_DGRAM", 0); #endif #ifdef SOCK_RAW GCST("SOCK_RAW", SOCK_RAW); #else GDFLT("SOCK_RAW", 0); #endif #ifdef SOCK_SEQPACKET GCST("SOCK_SEQPACKET", SOCK_SEQPACKET); #else GDFLT("SOCK_SEQPACKET", 0); #endif gcmnt("address families"); #ifdef AF_MAX GCST("AF_MAX", AF_MAX); #else GDFLT("AF_MAX", 0); #endif #ifdef AF_UNSPEC GCST("AF_UNSPEC", AF_UNSPEC); #else GDFLT("AF_UNSPEC", 0); #endif #ifdef AF_UNIX GCST("AF_UNIX", AF_UNIX); #else GDFLT("AF_UNIX", 0); #endif #ifdef AF_LOCAL GCST("AF_LOCAL", AF_LOCAL); #else #ifdef AF_UNIX GCST("AF_LOCAL", AF_UNIX); #else GDFLT("AF_LOCAL", 0); #endif #endif #ifdef AF_INET GCST("AF_INET", AF_INET); #else GDFLT("AF_INET", 0); #endif #ifdef AF_OSI GCST("AF_OSI", AF_OSI); #else GDFLT("AF_OSI", 0); #endif #ifdef AF_ISO GCST("AF_ISO", AF_ISO); #else GDFLT("AF_ISO", 0); #endif gcmnt("protocol families"); #ifdef PF_MAX GCST("PF_MAX", PF_MAX); #else GDFLT("PF_MAX", 0); #endif #ifdef PF_UNSPEC GCST("PF_UNSPEC", PF_UNSPEC); #else GDFLT("PF_UNSPEC", 0); #endif #ifdef PF_LOCAL GCST("PF_LOCAL", PF_LOCAL); #else #ifdef PF_UNIX GCST("PF_LOCAL", PF_UNIX); #else GDFLT("PF_LOCAL", 0); #endif #endif #ifdef PF_UNIX GCST("PF_UNIX", PF_UNIX); #else GDFLT("PF_UNIX", 0); #endif #ifdef PF_INET GCST("PF_INET", PF_INET); #else GDFLT("PF_INET", 0); #endif #ifdef PF_OSI GCST("PF_OSI", PF_OSI); #else GDFLT("PF_OSI", 0); #endif #ifdef PF_ISO GCST("PF_ISO", PF_ISO); #else GDFLT("PF_ISO", 0); #endif gcmnt("socket options"); #ifdef SO_BROADCAST GUCST("SO_BROADCAST", SO_BROADCAST); #else GDFLT("SO_BROADCAST", 0); #endif #ifdef SO_DEBUG GCST("SO_DEBUG", SO_DEBUG); #else GDFLT("SO_DEBUG", 0); #endif #ifdef SO_DONTROUTE GCST("SO_DONTROUTE", SO_DONTROUTE); #else GDFLT("SO_DONTROUTE", 0); #endif #ifdef SO_ERROR GCST("SO_ERROR", SO_ERROR); #else GDFLT("SO_ERROR", 0); #endif #ifdef SO_KEEPALIVE GCST("SO_KEEPALIVE", SO_KEEPALIVE); #else GDFLT("SO_KEEPALIVE", 0); #endif #ifdef SO_LINGER GCST("SO_LINGER", SO_LINGER); #else GDFLT("SO_LINGER", 0); #endif #ifdef SO_OOBINLINE GCST("SO_OOBINLINE", SO_OOBINLINE); #else GDFLT("SO_OOBINLINE", 0); #endif #ifdef SO_RCVBUF GCST("SO_RCVBUF", SO_RCVBUF); #else GDFLT("SO_RCVBUF", 0); #endif #ifdef SO_RCVLOWAT GCST("SO_RCVLOWAT", SO_RCVLOWAT); #else GDFLT("SO_RCVLOWAT", 0); #endif #ifdef SO_RCVTIMEO GCST("SO_RCVTIMEO", SO_RCVTIMEO); #else GDFLT("SO_RCVTIMEO", 0); #endif #ifdef SO_REUSEADDR GCST("SO_REUSEADDR", SO_REUSEADDR); #else GDFLT("SO_REUSEADDR", 0); #endif #ifdef SO_SNDBUF GCST("SO_SNDBUF", SO_SNDBUF); #else GDFLT("SO_SNDBUF", 0); #endif #ifdef SO_SNDLOWAT GCST("SO_SNDLOWAT", SO_SNDLOWAT); #else GDFLT("SO_SNDLOWAT", 0); #endif #ifdef SO_SNDTIMEO GCST("SO_SNDTIMEO", SO_SNDTIMEO); #else GDFLT("SO_SNDTIMEO", 0); #endif #ifdef SO_TYPE GCST("SO_TYPE", SO_TYPE); #else GDFLT("SO_TYPE", 0); #endif gcmnt("max queued connections"); #ifdef SOMAXCONN GCST("SOMAXCONN", SOMAXCONN); #else GDFLT("SOMAXCONN", 0); #endif gcmnt("send & receive option flag bits"); #ifdef MSG_OOB GCST("MSG_OOB", MSG_OOB); #else GDFLT("MSG_OOB", 0); #endif #ifdef MSG_PEEK GCST("MSG_PEEK", MSG_PEEK); #else GDFLT("MSG_PEEK", 0); #endif #ifdef MSG_DONTROUTE GCST("MSG_DONTROUTE", MSG_DONTROUTE); #else GDFLT("MSG_DONTROUTE", 0); #endif #ifdef MSG_EOR GCST("MSG_EOR", MSG_EOR); #else GDFLT("MSG_EOR", 0); #endif #ifdef MSG_TRUNC GCST("MSG_TRUNC", MSG_TRUNC); #else GDFLT("MSG_TRUNC", 0); #endif #ifdef MSG_CTRUNC GCST("MSG_CTRUNC", MSG_CTRUNC); #else GDFLT("MSG_CTRUNC", 0); #endif #ifdef MSG_WAITALL GCST("MSG_WAITALL", MSG_WAITALL); #else GDFLT("MSG_WAITALL", 0); #endif #ifdef MSG_MAXIOVLEN GCST("MSG_MAXIOVLEN", MSG_MAXIOVLEN); #else GDFLT("MSG_MAXIOVLEN", 0); #endif gcmnt("socket address information option flag bits"); #ifdef AI_PASSIVE GCST("AI_PASSIVE", AI_PASSIVE); #else GDFLT("AI_PASSIVE", 0); #endif #ifdef AI_CANONNAME GCST("AI_CANONNAME", AI_CANONNAME); #else GDFLT("AI_CANONNAME", 0); #endif gcmnt("scoket shutdown mode flag bits"); #ifdef SHUT_RD GCST("SHUT_RD", SHUT_RD); #else GDFLT("SHUT_RD", 0); #endif #ifdef SHUT_WR GCST("SHUT_WR", SHUT_WR); #else GDFLT("SHUT_WR", 1); #endif #ifdef SHUT_RDWR GCST("SHUT_RDWR", SHUT_RDWR); #else GDFLT("SHUT_RDWR", 2); #endif ghdrcmnt("structures"); /* can't follow alphabetic ordering; e.g. sockaddr needs to come early, to avoid forward references */ gcmnt("generic socket address"); g_struct_sockaddr(); gcmnt("struct addrinfo..."); g_struct_addrinfo(); gcmnt("message option header"); g_struct_cmsghdr(); gcmnt("host database entry"); g_struct_hostent(); gcmnt("internet address"); #ifdef HAVE_in_addr_t guitp("in_addr_t", sizeof(in_addr_t)); #else NON_SUPPORT_MESSAGE("in_addr_t") guitp("in_addr_t", sizeof(long)); #endif g_struct_in_addr(); gcmnt("linger option structure"); g_struct_linger(); gcmnt("I/O vector"); g_struct_iovec(); gcmnt("message header"); g_struct_msghdr(); gcmnt("local socket address"); { struct sockaddr_un DUMMY; ifprintf(fp," subtype sun_path_string is POSIX_String (1 .. %d);\n", sizeof (DUMMY.sun_path)); } g_struct_sockaddr_un(); gcmnt("internet socket address"); g_struct_sockaddr_in(); gcmnt("IP Level ip_opts structure"); g_struct_ip_opts(); ghdrcmnt("link names for functions"); GFUNC(accept, HAVE_accept); GFUNC(bind, HAVE_bind); GFUNC(connect, HAVE_connect); GFUNC(getsockname, HAVE_getsockname); GFUNC(getsockopt, HAVE_getsockopt); GFUNC(isfdtype, HAVE_isfdtype); GFUNC(listen, HAVE_listen); GFUNC(recv, HAVE_recv); GFUNC(recvfrom, HAVE_recvfrom); GFUNC(recvmsg, HAVE_recvmsg); GFUNC(send, HAVE_send); GFUNC(sendto, HAVE_sendto); GFUNC(sendmsg, HAVE_sendmsg); GFUNC(setsockopt, HAVE_setsockopt); GFUNC(shutdown, HAVE_shutdown); GFUNC(socket, HAVE_socket); GFUNC(sockatmark, HAVE_sockatmark); GFUNC(socketpair, HAVE_socketpair); fprintf(fp,"\n"); ifprintf(fp,"end Sockets;\n\n"); indent--; /* c_xti ---------------- */ indent++; ifprintf(fp,"package XTI is\n"); ghdrcmnt("XTI structures"); /* can't follow alphabetic ordering; e.g. */ gcmnt("netbuf structure"); g_struct_netbuf(); gcmnt("t_info structure"); g_struct_t_info(); gcmnt("t_opthdr structure"); g_struct_t_opthdr(); gcmnt("t_bind structure"); g_struct_t_bind(); gcmnt("t_optmgmt structure"); g_struct_t_optmgmt(); gcmnt("t_discon structure"); g_struct_t_discon(); gcmnt("t_call structure"); g_struct_t_call(); gcmnt("t_unitdata structure"); g_struct_t_unitdata(); gcmnt("t_uderr structure"); g_struct_t_uderr(); gcmnt("t_iovec structure"); g_struct_t_iovec(); gcmnt("t_kpalive structure"); g_struct_t_kpalive(); /* * The following are the events returned from t_look() */ gcmnt("The following are the events returned from t_look()"); #ifdef T_LISTEN GCST("T_LISTEN", T_LISTEN ); #else GDFLT("T_LISTEN", 0); #endif #ifdef T_CONNECT GCST("T_CONNECT", T_CONNECT ); #else GDFLT("T_CONNECT", 0); #endif #ifdef T_DATA GCST("T_DATA", T_DATA ); #else GDFLT("T_DATA", 0); #endif #ifdef T_EXDATA GCST("T_EXDATA", T_EXDATA ); #else GDFLT("T_EXDATA", 0); #endif #ifdef T_DISCONNECT GCST("T_DISCONNECT", T_DISCONNECT ); #else GDFLT("T_DISCONNECT", 0); #endif #ifdef T_UDERR GCST("T_UDERR", T_UDERR ); #else GDFLT("T_UDERR", 0); #endif #ifdef T_ORDREL GCST("T_ORDREL", T_ORDREL ); #else GDFLT("T_ORDREL", 0); #endif #ifdef T_GODATA GCST("T_GODATA", T_GODATA ); #else GDFLT("T_GODATA", 0); #endif #ifdef T_GOEXDATA GCST("T_GOEXDATA", T_GOEXDATA ); #else GDFLT("T_GOEXDATA", 0); #endif #ifdef T_EVENTS GCST("T_EVENTS", T_EVENTS ); #else GDFLT("T_EVENTS", 0); #endif /* * The following are the flag definitions needed by the * user level library routines. */ #ifdef T_MORE GCST("T_MORE", T_MORE ); #else GDFLT("T_MORE", 0); #endif #ifdef T_EXPEDITED GCST("T_EXPEDITED", T_EXPEDITED ); #else GDFLT("T_EXPEDITED", 0); #endif #ifdef T_PUSH GCST("T_PUSH", T_PUSH ); #else GDFLT("T_PUSH", 0); #endif #ifdef T_NEGOTIATE GCST("T_NEGOTIATE", T_NEGOTIATE ); #else GDFLT("T_NEGOTIATE", 0); #endif #ifdef T_CHECK GCST("T_CHECK", T_CHECK ); #else GDFLT("T_CHECK", 0); #endif #ifdef T_DEFAULT GCST("T_DEFAULT", T_DEFAULT ); #else GDFLT("T_DEFAULT", 0); #endif #ifdef T_SUCCESS GCST("T_SUCCESS", T_SUCCESS ); #else GDFLT("T_SUCCESS", 0); #endif #ifdef T_FAILURE GCST("T_FAILURE", T_FAILURE ); #else GDFLT("T_FAILURE", 0); #endif #ifdef T_CURRENT GCST("T_CURRENT", T_CURRENT ); #else GDFLT("T_CURRENT", 0); #endif #ifdef T_PARTSUCCESS GCST("T_PARTSUCCESS", T_PARTSUCCESS ); #else GDFLT("T_PARTSUCCESS", 0); #endif #ifdef T_READONLY GCST("T_READONLY", T_READONLY ); #else GDFLT("T_READONLY", 0); #endif #ifdef T_NOTSUPPORT GCST("T_NOTSUPPORT", T_NOTSUPPORT ); #else GDFLT("T_NOTSUPPORT", 0); #endif #ifdef T_RAW GCST("T_RAW", T_RAW ); #else GDFLT("T_RAW", 0); #endif /* * Service types defines */ gcmnt("Service types defines"); #ifdef T_COTS GCST("T_COTS", T_COTS ); #else GDFLT("T_COTS", 0); #endif #ifdef T_COTS_ORD GCST("T_COTS_ORD", T_COTS_ORD ); #else GDFLT("T_COTS_ORD", 0); #endif #ifdef T_CLTS GCST("T_CLTS", T_CLTS ); #else GDFLT("T_CLTS", 0); #endif /* * Flags defines (other info about the transport provider). */ #ifdef T_SENDZERO GCST("T_SENDZERO", T_SENDZERO ); #else GDFLT("T_SENDZERO", 0); #endif #ifdef SENDZERO GCST("SENDZERO", SENDZERO ); #else GDFLT("SENDZERO", 0); #endif #ifdef T_XPG4_1 GCST("T_XPG4_1", T_XPG4_1 ); #else GDFLT("T_XPG4_1", 0); #endif #ifdef XPG4_1 GCST("XPG4_1", XPG4_1 ); #else GDFLT("XPG4_1", 0); #endif /* * The following are structure types used when dynamically * allocating the above structure via alloc(). */ #ifdef T_BIND GCST("T_BIND", T_BIND ); #else GDFLT("T_BIND", 0); #endif #ifdef T_OPTMGMT GCST("T_OPTMGMT", T_OPTMGMT ); #else GDFLT("T_OPTMGMT", 0); #endif #ifdef T_CALL GCST("T_CALL", T_CALL ); #else GDFLT("T_CALL", 0); #endif #ifdef T_DIS GCST("T_DIS", T_DIS ); #else GDFLT("T_DIS", 0); #endif #ifdef T_UNITDATA GCST("T_UNITDATA", T_UNITDATA ); #else GDFLT("T_UNITDATA", 0); #endif #ifdef T_UDERROR GCST("T_UDERROR", T_UDERROR ); #else GDFLT("T_UDERROR", 0); #endif #ifdef T_INFO GCST("T_INFO", T_INFO ); #else GDFLT("T_INFO", 0); #endif #ifdef T_KUNITDATA GCST("T_KUNITDATA", T_KUNITDATA ); #else GDFLT("T_KUNITDATA", 0); #endif /* * The following bits specify which fields of the above * structures should be allocated by t_alloc(). */ #ifdef T_ADDR GCST("T_ADDR", T_ADDR ); #else GDFLT("T_ADDR", 0); #endif #ifdef T_OPT GCST("T_OPT", T_OPT ); #else GDFLT("T_OPT", 0); #endif #ifdef T_UDATA GCST("T_UDATA", T_UDATA ); #else GDFLT("T_UDATA", 0); #endif #ifdef T_ALL GCST("T_ALL", T_ALL ); #else GDFLT("T_ALL", 0); #endif /* * The following are the states for the user. */ #ifdef T_UNINIT GCST("T_UNINIT", T_UNINIT ); #else GDFLT("T_UNINIT", 0); #endif #ifdef T_UNBND GCST("T_UNBND", T_UNBND ); #else GDFLT("T_UNBND", 0); #endif #ifdef T_IDLE GCST("T_IDLE", T_IDLE ); #else GDFLT("T_IDLE", 0); #endif #ifdef T_OUTCON GCST("T_OUTCON", T_OUTCON ); #else GDFLT("T_OUTCON", 0); #endif #ifdef T_INCON GCST("T_INCON", T_INCON ); #else GDFLT("T_INCON", 0); #endif #ifdef T_DATAXFER GCST("T_DATAXFER", T_DATAXFER ); #else GDFLT("T_DATAXFER", 0); #endif #ifdef T_OUTREL GCST("T_OUTREL", T_OUTREL ); #else GDFLT("T_OUTREL", 0); #endif #ifdef T_INREL GCST("T_INREL", T_INREL ); #else GDFLT("T_INREL", 0); #endif /* General purpose defines */ #ifdef T_YES GCST("T_YES", T_YES ); #else # if defined(_TLI_) GCST("T_YES", 1); # else GDFLT("T_YES", 0); # endif #endif #ifdef T_NO GCST("T_NO", T_NO ); #else # if defined(_TLI_) GCST("T_NO", 0); # else GDFLT("T_NO", 0); # endif #endif #ifdef T_UNUSED GCST("T_UNUSED", T_UNUSED ); #else # if defined(_TLI_) GCST("T_UNUSED", -1); # else GDFLT("T_UNUSED", 0); # endif #endif #ifdef T_NULL GCST("T_NULL", T_NULL ); #else # if defined(_TLI_) GCST("T_NULL", 0); # else GDFLT("T_NULL", 0); # endif #endif #ifdef T_ABSREQ GCST("T_ABSREQ", T_ABSREQ ); #else # if defined(_TLI_) GCST("T_ABSREQ", 0x8000); # else GDFLT("T_ABSREQ", 0); # endif #endif #ifdef T_INFINITE GCST("T_INFINITE", T_INFINITE ); #else # if defined(_TLI_) GCST("T_INFINITE", -1); # else GDFLT("T_INFINITE", 0); # endif #endif #ifdef T_INVALID GCST("T_INVALID", T_INVALID ); #else # if defined(_TLI_) GCST("T_INVALID", -2); # else GDFLT("T_INVALID", 0); # endif #endif /* XTI-level Options */ gcmnt ("XTI-level Options"); #ifdef XTI_GENERIC GCST("XTI_GENERIC", XTI_GENERIC ); #else # if defined(_TLI_) GCST("XTI_GENERIC", 0xffff); # else GDFLT("XTI_GENERIC", 0); # endif #endif #ifdef XTI_DEBUG GCST("XTI_DEBUG", XTI_DEBUG ); #else # if defined(_TLI_) && defined(SO_DEBUG) GCST("XTI_DEBUG", SO_DEBUG); # else GDFLT("XTI_DEBUG", 0); # endif #endif #ifdef XTI_LINGER GCST("XTI_LINGER", XTI_LINGER ); #else # if defined(_TLI_) && defined(SO_LINGER) GCST("XTI_LINGER", SO_LINGER); # else GDFLT("XTI_LINGER", 0); # endif #endif #ifdef XTI_RCVBUF GCST("XTI_RCVBUF", XTI_RCVBUF ); #else # if defined(_TLI_) && defined(SO_RCVBUF) GCST("XTI_RCVBUF", SO_RCVBUF); # else GDFLT("XTI_RCVBUF", 0); # endif #endif #ifdef XTI_RCVLOWAT GCST("XTI_RCVLOWAT", XTI_RCVLOWAT ); #else # if defined(_TLI_) && defined(SO_RCVLOWAT) GCST("XTI_RCVLOWAT", SO_RCVLOWAT); # else GDFLT("XTI_RCVLOWAT", 0); # endif #endif #ifdef XTI_SNDBUF GCST("XTI_SNDBUF", XTI_SNDBUF ); #else # if defined(_TLI_) && defined(SO_SNDBUF) GCST("XTI_SNDBUF", SO_SNDBUF); # else GDFLT("XTI_SNDBUF", 0); # endif #endif #ifdef XTI_SNDLOWAT GCST("XTI_SNDLOWAT", XTI_SNDLOWAT ); #else # if defined(_TLI_) && defined(SO_SNDLOWAT) GCST("XTI_SNDLOWAT", SO_SNDLOWAT); # else GDFLT("XTI_SNDLOWAT", 0); # endif #endif gcmnt("t_linger structure"); g_struct_t_linger(); gcmnt("General definitions for option management"); #ifdef T_UNSPEC GCST("T_UNSPEC", T_UNSPEC ); #else # if defined(_TLI_) GCST("T_UNSPEC", (~0-2)); # else GDFLT("T_UNSPEC", 0); # endif #endif #ifdef T_ALLOPT GCST("T_ALLOPT", T_ALLOPT ); #else # if defined(_TLI_) GCST("T_ALLOPT", 0); # else GDFLT("T_ALLOPT", 0); # endif #endif gmacrofunc("c_T_ALIGN", "char_ptr", "p"); /* TCP Level and options */ gcmnt("TCP Level and Options"); #ifdef INET_TCP GCST("INET_TCP", INET_TCP); #else GDFLT("INET_TCP",0); #endif #ifdef TCP_NODELAY GCST("TCP_NODELAY", TCP_NODELAY); #else GDFLT("TCP_NODELAY",0); #endif #ifdef TCP_MAXSEG GCST("TCP_MAXSEG", TCP_MAXSEG); #else GDFLT("TCP_MAXSEG",0); #endif #ifdef TCP_KEEPALIVE GCST("TCP_KEEPALIVE", TCP_KEEPALIVE); #else # if defined(_TLI_) && defined (SO_KEEPALIVE) GCST("TCP_KEEPALIVE", SO_KEEPALIVE); # else GDFLT("TCP_KEEPALIVE",0); # endif #endif #ifdef T_GARBAGE GCST("T_GARBAGE", T_GARBAGE); #else # if defined(_TLI_) GCST("T_GARBAGE", 2); # else GDFLT("T_GARBAGE",0); # endif #endif /* UDP Level and options */ gcmnt("UDP Level and Options"); #ifdef INET_UDP GCST("INET_UDP", INET_UDP); #else GDFLT("INET_UDP",0); #endif #ifdef UDP_CHECKSUM GCST("UDP_CHECKSUM", UDP_CHECKSUM); #else GDFLT("UDP_CHECKSUM",0); #endif /* IP Level and Options */ gcmnt("IP Level and Options"); #ifdef INET_IP GCST("INET_IP", INET_IP); #else GDFLT("INET_IP",0); #endif #ifdef IP_OPTIONS GCST("IP_OPTIONS", IP_OPTIONS); #else GDFLT("IP_OPTIONS",0); #endif #ifdef IP_TOS GCST("IP_TOS", IP_TOS); #else GDFLT("IP_TOS",0); #endif #ifdef IP_TTL GCST("IP_TTL", IP_TTL); #else GDFLT("IP_TTL",0); #endif #ifdef IP_REUSEADDR GCST("IP_REUSEADDR", IP_REUSEADDR); #else # if defined(_TLI_) GCST("IP_REUSEADDR", SO_REUSEADDR); # else GDFLT("IP_REUSEADDR",0); # endif #endif #ifdef IP_DONTROUTE GCST("IP_DONTROUTE", IP_DONTROUTE); #else # if defined(_TLI_) GCST("IP_DONTROUTE", SO_DONTROUTE); # else GDFLT("IP_DONTROUTE",0); # endif #endif #ifdef IP_BROADCAST GCST("IP_BROADCAST", IP_BROADCAST); #else # if defined(_TLI_) GCST("IP_BROADCAST", SO_BROADCAST); # else GDFLT("IP_BROADCAST",0); # endif #endif gcmnt("IP_TOS precedence levels"); #ifdef T_ROUTINE GCST("T_ROUTINE", T_ROUTINE); #else GDFLT("T_ROUTINE",0); #endif #ifdef T_PRIORITY GCST("T_PRIORITY", T_PRIORITY); #else GDFLT("T_PRIORITY",0); #endif #ifdef T_IMMEDIATE GCST("T_IMMEDIATE", T_IMMEDIATE); #else GDFLT("T_IMMEDIATE",0); #endif #ifdef T_FLASH GCST("T_FLASH", T_FLASH); #else GDFLT("T_FLASH",0); #endif #ifdef T_OVERRIDEFLASH GCST("T_OVERRIDEFLASH", T_OVERRIDEFLASH); #else GDFLT("T_OVERRIDEFLASH",0); #endif #ifdef T_CRITIC_ECP GCST("T_CRITIC_ECP", T_CRITIC_ECP); #else GDFLT("T_CRITIC_ECP",0); #endif #ifdef T_INETCONTROL GCST("T_INETCONTROL", T_INETCONTROL); #else GDFLT("T_INETCONTROL",0); #endif #ifdef T_NETCONTROL GCST("T_NETCONTROL", T_NETCONTROL); #else GDFLT("T_NETCONTROL",0); #endif gcmnt("IP_TOS type of service"); #ifdef T_NOTOS GCST("T_NOTOS", T_NOTOS); #else GDFLT("T_NOTOS",0); #endif #ifdef T_LDELAY GCST("T_LDELAY", T_LDELAY); #else GDFLT("T_LDELAY",0); #endif #ifdef T_HITHRPT GCST("T_HITHRPT", T_HITHRPT); #else GDFLT("T_HITHRPT",0); #endif #ifdef T_HIREL GCST("T_HIREL", T_HIREL); #else GDFLT("T_HIREL",0); #endif ghdrcmnt("link names for functions"); GFUNC(t_accept, HAVE_t_accept); GFUNC(t_alloc, HAVE_t_accept); GFUNC(t_bind, HAVE_t_bind); GFUNC(t_blocking, HAVE_t_blocking); GFUNC(t_close, HAVE_t_close); GFUNC(t_connect, HAVE_t_connect); GFUNC(t_error, HAVE_t_error); GFUNC(t_free, HAVE_t_free); GFUNC(t_getinfo, HAVE_t_getinfo); GFUNC(t_getprotaddr, HAVE_t_getprotaddr); GFUNC(t_getstate, HAVE_t_getstate); GFUNC(t_listen, HAVE_t_listen); GFUNC(t_look, HAVE_t_look); GFUNC(t_nonblocking, HAVE_t_nonblocking); GFUNC(t_open, HAVE_t_open); GFUNC(t_optmgmt, HAVE_t_optmgmt); GFUNC(t_rcv, HAVE_t_rcv); GFUNC(t_rcvconnect, HAVE_t_rcvconnect); GFUNC(t_rcvdis, HAVE_t_rcvdis); GFUNC(t_rcvrel, HAVE_t_rcvrel); GFUNC(t_rcvreldata, HAVE_t_rcvreldata); GFUNC(t_rcvudata, HAVE_t_rcvudata); GFUNC(t_rcvuderr, HAVE_t_rcvuderr); GFUNC(t_rcvv, HAVE_t_rcvv); GFUNC(t_rcvvudata, HAVE_t_rcvvudata); GFUNC(t_snd, HAVE_t_snd); GFUNC(t_snddis, HAVE_t_snddis); GFUNC(t_sndudata, HAVE_t_sndudata); GFUNC(t_sndrel, HAVE_t_sndrel); GFUNC(t_sndreldata, HAVE_t_sndreldata); GFUNC(t_sndv, HAVE_t_sndv); GFUNC(t_sndvudata, HAVE_t_sndvudata); GFUNC(t_strerror, HAVE_t_strerror); GFUNC(t_sync, HAVE_t_sync); GFUNC(t_unbind, HAVE_t_unbind); GFUNC(strerror, HAVE_strerror); GFUNC(strerror_r, HAVE_strerror_r); GFUNC(perror, HAVE_perror); fprintf(fp,"\n"); ifprintf(fp,"end XTI;\n"); indent--; /* netinet/in.h ---------------- */ indent++; ifprintf(fp,"package Netinet is\n"); ghdrcmnt("From netinet/in.h"); #ifdef IPPROTO_IP GUCST("IPPROTO_IP", IPPROTO_IP); #else GDFLT("IPPROTO_IP", 0); #endif #ifdef IPPROTO_ICMP GUCST("IPPROTO_ICMP", IPPROTO_ICMP); #else GDFLT("IPPROTO_ICMP", 0); #endif #ifdef IPPROTO_TCP GUCST("IPPROTO_TCP", IPPROTO_TCP); #else GDFLT("IPPROTO_TCP", 0); #endif #ifdef IPPROTO_UDP GUCST("IPPROTO_UDP", IPPROTO_UDP); #else GDFLT("IPPROTO_UDP", 0); #endif #ifdef IPPROTO_RAW GUCST("IPPROTO_RAW", IPPROTO_RAW); #else GDFLT("IPPROTO_RAW", 0); #endif #ifdef IP_OPTIONS GUCST("IP_OPTIONS", IP_OPTIONS); #else GDFLT("IP_OPTIONS", 0); #endif #ifdef IP_HDRINCL GUCST("IP_HDRINCL", IP_HDRINCL); #else GDFLT("IP_HDRINCL", 0); #endif #ifdef IP_TOS GUCST("IP_TOS", IP_TOS); #else GDFLT("IP_TOS", 0); #endif #ifdef IP_TTL GUCST("IP_TTL", IP_TTL); #else GDFLT("IP_TTL", 0); #endif #ifdef IP_RECVDSTADDR GUCST("IP_RECVDSTADDR", IP_RECVDSTADDR); #else GDFLT("IP_RECVDSTADDR", 0); #endif #ifdef INADDR_NONE GUCST("INADDR_NONE", INADDR_NONE); #else GUFLT("INADDR_NONE", 0xffffffff); #endif #ifdef INADDR_ANY GUCST("INADDR_ANY",INADDR_ANY); #else GDFLT("INADDR_ANY",0); #endif #ifdef INADDR_BROADCAST GUCST("INADDR_BROADCAST",INADDR_BROADCAST); #else GDFLT("INADDR_BROADCAST",0); #endif #ifdef INADDR_LOOPBACK GUCST("INADDR_LOOPBACK",INADDR_LOOPBACK); #else GDFLT("INADDR_LOOPBACK",0); #endif #ifdef INADDR_UNSPEC_GROUP GUCST("INADDR_UNSPEC_GROUP",INADDR_UNSPEC_GROUP); #else GDFLT("INADDR_UNSPEC_GROUP",0); #endif #ifdef INADDR_ALLHOSTS_GROUP GUCST("INADDR_ALLHOSTS_GROUP",INADDR_ALLHOSTS_GROUP); #else GDFLT("INADDR_ALLHOSTS_GROUP",0); #endif #ifdef INADDR_MAX_LOCAL_GROUP GUCST("INADDR_MAX_LOCAL_GROUP",INADDR_MAX_LOCAL_GROUP); #else GDFLT("INADDR_MAX_LOCAL_GROUP",0); #endif GFUNC(inet_addr, HAVE_inet_addr); GFUNC(inet_makeaddr, HAVE_inet_makeaddr); GFUNC(inet_network, HAVE_inet_network); GFUNC(inet_lnaof, HAVE_inet_lnaof); GFUNC(inet_netof, HAVE_inet_netof); GFUNC(inet_ntoa, HAVE_inet_ntoa); ghdrcmnt("From netinet/tcp.h"); #ifdef TCP_NODELAY GCST("TCP_NODELAY", TCP_NODELAY); #else GDFLT("TCP_NODELAY",0); #endif #ifdef TCP_MAXSEG GCST("TCP_MAXSEG", TCP_MAXSEG); #else GDFLT("TCP_MAXSEG",0); #endif #ifdef TCP_KEEPALIVE GCST("TCP_KEEPALIVE", TCP_KEEPALIVE); #else GDFLT("TCP_KEEPALIVE",0); #endif #ifdef TCP_MAXRXT GCST("TCP_MAXRXT", TCP_MAXRXT); #else GDFLT("TCP_MAXRXT",0); #endif #ifdef TCP_STDURG GCST("TCP_STDURG", TCP_STDURG); #else GDFLT("TCP_STDURG",0); #endif ghdrcmnt("From netinet/ip.h"); #ifdef IPTOS_LOWDELAY GCST("IPTOS_LOWDELAY", IPTOS_LOWDELAY); #else GDFLT("IPTOS_LOWDELAY",0); #endif #ifdef IPTOS_THROUGHPUT GCST("IPTOS_THROUGHPUT", IPTOS_THROUGHPUT); #else GDFLT("IPTOS_THROUGHPUT",0); #endif #ifdef IPTOS_RELIABILITY GCST("IPTOS_RELIABILITY", IPTOS_RELIABILITY); #else GDFLT("IPTOS_RELIABILITY",0); #endif fprintf(fp,"\n"); ifprintf(fp,"end Netinet;\n"); indent--; /* netdb.h ---------------- */ indent++; ifprintf(fp,"package NetDB is\n"); ifprintf(fp," use Sockets;\n"); g_struct_netent(); gcmnt("protocol database entry"); g_struct_protoent(); gcmnt("local socket address"); GFUNC(endhostent, HAVE_endhostent); GFUNC(endnetent, HAVE_endnetent); GFUNC(endprotoent, HAVE_endprotoent); GFUNC(endservent, HAVE_endservent); /* Assume the following three are always there, since if getaddrinfo is not implemented we will provide our own freeware version. */ GFUNC(getaddrinfo, 1); GFUNC(freeaddrinfo, 1); GFUNC(getnameinfo, 1); GFUNC(gethostbyaddr, HAVE_gethostbyaddr); GFUNC(gethostbyaddr_r, HAVE_gethostbyaddr_r); GFUNC(gethostbyname, HAVE_gethostbyname); GFUNC(gethostbyname_r, HAVE_gethostbyname_r); GFUNC(gethostname, HAVE_gethostname); GFUNC(getnetbyaddr, HAVE_getnetbyaddr); GFUNC(getnetbyaddr_r, HAVE_getnetbyaddr_r); GFUNC(getnetbyname, HAVE_getnetbyname); GFUNC(getnetbyname_r, HAVE_getnetbyname_r); GFUNC(getpeername, HAVE_getpeername); GFUNC(getprotobyname, HAVE_getprotobyname); GFUNC(getprotobyname_r, HAVE_getprotobyname_r); GFUNC(getprotobynumber, HAVE_getprotobynumber); GFUNC(getprotobynumber_r, HAVE_getprotobynumber_r); GFUNC(getservbyname, HAVE_getservbyname); GFUNC(getservbyname_r, HAVE_getservbyname_r); GFUNC(getservbyport, HAVE_getservbyport); GFUNC(getservbyport_r, HAVE_getservbyport_r); GFUNC(sethostent, HAVE_sethostent); GFUNC(setnetent, HAVE_setnetent); GFUNC(setprotoent, HAVE_setprotoent); GFUNC(setservent, HAVE_setservent); fprintf(fp,"\n"); ifprintf(fp,"end NetDB;\n"); indent--; /* * Poll/Select */ gcmnt("pollfd structure"); g_struct_pollfd(); ifprintf(fp, " type fd_mask_array is array (Integer range <>) of unsigned_int;\n"); gcmnt("fd_set structure"); g_fd_set(); #ifdef FD_SETSIZE GCST("FD_SETSIZE", FD_SETSIZE); #else GDFLT("FD_SETSIZE",0); #endif #ifdef INFTIM GCST("INFTIM", INFTIM); #else GDFLT("INFTIM",0); #endif #ifdef POLLIN GCST("POLLIN", POLLIN); #else GDFLT("POLLIN",0); #endif #ifdef POLLRDNORM GCST("POLLRDNORM", POLLRDNORM); #else GDFLT("POLLRDNORM",0); #endif #ifdef POLLRDBAND GCST("POLLRDBAND", POLLRDBAND); #else GDFLT("POLLRDBAND",0); #endif #ifdef POLLPRI GCST("POLLPRI", POLLPRI); #else GDFLT("POLLPRI",0); #endif #ifdef POLLWRNORM GCST("POLLWRNORM", POLLWRNORM); #else GDFLT("POLLWRNORM",0); #endif #ifdef POLLWRBAND GCST("POLLWRBAND", POLLWRBAND); #else GDFLT("POLLWRBAND",0); #endif #ifdef POLLERR GCST("POLLERR", POLLERR); #else GDFLT("POLLERR",0); #endif #ifdef POLLNVAL GCST("POLLNVAL", POLLNVAL); #else GDFLT("POLLNVAL",0); #endif GFUNC(poll, HAVE_poll); GFUNC(select, HAVE_select); fprintf(fp,"\n"); ifprintf(fp,"end POSIX.C;\n"); fclose(fp); fprintf(stderr,"done generating posix-c.ads\n"); } /* end create_c */ /* main ---- */ int main() { /* Figure out the number of bits in a byte. */ { unsigned char b; bits_per_byte = 0; b = 1; while (b) { bits_per_byte++; b = b << 1; } } if (bits_per_byte != 8) { quit("byte-size is not equal to 8\n",""); } create_options(); create_limits(); create_posix(); create_c(); return 0; } libflorist-2025.1.0/configs/000077500000000000000000000000001473553204100155465ustar00rootroot00000000000000libflorist-2025.1.0/configs/pconfig.AIX4.1000066400000000000000000000017331473553204100177650ustar00rootroot00000000000000/* ??? On AiX, pthread.h must be included first */ #ifdef _POSIX_C_SIGNALS_C #ifndef _LONG_LONG #define _LONG_LONG #include #endif #endif #define _POSIX_C_SOURCE 199506L #define _POSIX_SOURCE #define _XOPEN_EXTENDED_SOURCE #define _SC_PAGE_SIZE 48 #define _SC_PAGESIZE _SC_PAGE_SIZE #define _REENTRANT #define pthread_sigmask sigthreadmask typedef unsigned char sa_family_t; #define aio_sigevent aio_event /* ??? There is an additional structure on AIX (struct liocb) to handle these fields. For now, fake them. */ #define aio_fildes aio_whence #define aio_lio_opcode aio_flag /* typedefs for BSD unsigned things ??? These are defined in when _ALL_SOURCE is defined, but that cause troubles in other parts of Florist */ typedef unsigned char u_char; typedef unsigned short u_short; typedef unsigned int u_int; typedef unsigned long u_long; typedef long long int64_t; typedef unsigned long long uint64_t; libflorist-2025.1.0/configs/pconfig.AIX5.x000066400000000000000000000002001473553204100200610ustar00rootroot00000000000000/* pthread.h must be included before errno.h to ensure the _THREAD_SAFE has been defined correctly. */ #include libflorist-2025.1.0/configs/pconfig.Darwin000066400000000000000000000001441473553204100203400ustar00rootroot00000000000000#define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 #define _REENTRANT #define _P1003_1B_VISIBLE libflorist-2025.1.0/configs/pconfig.Default000066400000000000000000000001521473553204100204770ustar00rootroot00000000000000#define _POSIX_C_SOURCE 199506L #define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 #define _REENTRANT libflorist-2025.1.0/configs/pconfig.FreeBSD000066400000000000000000000001441473553204100203260ustar00rootroot00000000000000#define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 #define _REENTRANT #define _P1003_1B_VISIBLE libflorist-2025.1.0/configs/pconfig.HP-UX10.x000066400000000000000000000004311473553204100203630ustar00rootroot00000000000000#define _XOPEN_SOURCE_EXTENDED #define _INCLUDE_HPUX_SOURCE #define _REENTRANT /* For HP-UX with DCE threads, we need pthread.h first, to get the desired effect, in the presence of #define sigaction cma_sigaction. */ #include #define pthread_sigmask sigprocmask libflorist-2025.1.0/configs/pconfig.HP-UX11.00000066400000000000000000000005621473553204100203410ustar00rootroot00000000000000#define _XOPEN_SOURCE_EXTENDED #define _INCLUDE_HPUX_SOURCE #define _REENTRANT /* Need those defines, but sys/semaphore.h will only define them if _KERNEL_BUILD is set */ #define NSDCHUNKS 16 #define SSDCHUNK 16 #ifdef __ia64__ #define XTI_TINFO_FTYPE int #define XTI_OPTHDR_FTYPE int #define XTI_LINGER_FTYPE int #define XTI_KPALIVE_FTYPE int #endif /* __ia64__ */ libflorist-2025.1.0/configs/pconfig.IRIX6.x000066400000000000000000000002351473553204100202240ustar00rootroot00000000000000#include #include #define _POSIX_C_SOURCE 199506L #define _REENTRANT #define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 libflorist-2025.1.0/configs/pconfig.Linux000066400000000000000000000003041473553204100202110ustar00rootroot00000000000000/* file: pconfig.h.in Linux version */ #define _POSIX_C_SOURCE 199506L #define _REENTRANT #define _POSIX_C_SIGNALS_C #define _BSD_SOURCE #define _FILE_OFFSET_BITS 64 #define _XOPEN_SOURCE 600 libflorist-2025.1.0/configs/pconfig.LynxOS000066400000000000000000000024551473553204100203170ustar00rootroot00000000000000/* Begin pconfig.LynxOS */ #define _POSIX_C_SOURCE 199506L #define _REENTRANT #define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 /* Work around header file problems: These should be addressed by the configure script, but for the time being the following directives explicitly include and tag undetected but available declarations. */ /* socket.h related. */ #include #define sa_family_t unsigned char #define HAVE_sa_family_t 1 /* Required for AF_UNIX domain sockets: The sockaddr_un structure is not defined in or included by socket.h. */ #include #define HAVE_sockaddr_un 1 /* signal.p4.h related */ #define HAVE_sigset_t 1 #define HAVE_sigval 1 #define HAVE_siginfo_t 1 /* types.h related. */ #define HAVE_fd_set 1 /* termio.h / termios.h related. */ #define HAVE_cc_t 1 #define HAVE_tcflag_t 1 #define HAVE_speed_t 1 /* The LynxOS BSD interfaces are closer to version 4.4 than to 4.3. */ #ifdef _BSD4_3_ #undef _BSD4_3_ #endif /* _BSD4_3_ */ #ifndef _BSD4_4_ #define _BSD4_4_ #endif /* _BSD4_4_ */ /* Work around for SIGTHREADKILL issues: LynxOS reserves signal 24 (aka SIGUDEF24) to the user space-portion of the pthreads implementation. */ #define LYNX_SIGTHREADKILL_HACK #define SIGTHREADKILL 24 /* End pconfig.LynxOS */ libflorist-2025.1.0/configs/pconfig.OSF1000066400000000000000000000002351473553204100176250ustar00rootroot00000000000000#define _POSIX_C_SOURCE 199506L #define _REENTRANT #define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 #define _OSF_SOURCE #define sigcontext _sigcontext libflorist-2025.1.0/configs/pconfig.OSF1-4.0b000066400000000000000000000002661473553204100202720ustar00rootroot00000000000000#define _POSIX_C_SOURCE 199506L #define _REENTRANT #define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 #define _OSF_SOURCE #define sigcontext _sigcontext #define _PTHREAD_ENV_CXX libflorist-2025.1.0/configs/pconfig.SunOS5.10000066400000000000000000000016661473553204100204410ustar00rootroot00000000000000#define _POSIX_C_SOURCE 199506L #define _XOPEN_SOURCE 500 #define _XOPEN_SOURCE_EXTENDED 1 #define __EXTENSIONS__ #define _REENTRANT #define _LARGEFILE_SOURCE #define _FILE_OFFSET_BITS 64 /* SOLARIS_HACK activates a workaround for a trick that appeared in the Solaris 2.6 header files, of defining local function bodies for certain POSIX function names, which are wrappers that in turn call a real library function whose name is of the form __posix_XXX. ....We need to fix the configuration process to auto-detect this! */ #define SOLARIS_HACK /* Need to include stdarg.h first to ensure that the GNU stdarg will be used. Defining _VA_LIST ensures that no further definition of va_list will be attempted. */ #include #define _VA_LIST #ifdef __arch64__ #define XTI_TINFO_FTYPE int #define XTI_OPTHDR_FTYPE int #define XTI_LINGER_FTYPE int #define XTI_KPALIVE_FTYPE int #endif /* __arch64__ */ #define __solaris10__ libflorist-2025.1.0/configs/pconfig.SunOS5.6000066400000000000000000000016371473553204100203640ustar00rootroot00000000000000#define _POSIX_C_SOURCE 199506L #define _XOPEN_SOURCE 500 #define _XOPEN_SOURCE_EXTENDED 1 #define __EXTENSIONS__ #define _REENTRANT #define _LARGEFILE_SOURCE #define _FILE_OFFSET_BITS 64 /* SOLARIS_HACK activates a workaround for a trick that appeared in the Solaris 2.6 header files, of defining local function bodies for certain POSIX function names, which are wrappers that in turn call a real library function whose name is of the form __posix_XXX. ....We need to fix the configuration process to auto-detect this! */ #define SOLARIS_HACK /* Need to include stdarg.h first to ensure that the GNU stdarg will be used. Defining _VA_LIST ensures that no further definition of va_list will be attempted. */ #include #define _VA_LIST #ifdef __arch64__ #define XTI_TINFO_FTYPE int #define XTI_OPTHDR_FTYPE int #define XTI_LINGER_FTYPE int #define XTI_KPALIVE_FTYPE int #endif /* __arch64__ */ libflorist-2025.1.0/configs/pconfig.UnixWare000066400000000000000000000002611473553204100206560ustar00rootroot00000000000000#define _POSIX_C_SOURCE 199506L #define _XOPEN_SOURCE #define _XOPEN_SOURCE_EXTENDED 1 #define _REENTRANT #define __VA_LIST #define si_value _data typedef unsigned long u_long; libflorist-2025.1.0/configure000077500000000000000000005532251473553204100160410ustar00rootroot00000000000000#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.72. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, # Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case e in #( e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Use a proper internal environment variable to ensure we don't fall # into an infinite loop, continuously re-executing ourselves. if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then _as_can_reexec=no; export _as_can_reexec; # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else case e in #( e) case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : else case e in #( e) exitcode=1; echo positional parameters were not saved. ;; esac fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) test x\"\$blah\" = xblah || exit 1 test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 test \$(( 1 + 1 )) = 2 || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes else case e in #( e) as_have_required=no ;; esac fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : else case e in #( e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$as_shell as_have_required=yes if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null then : break 2 fi fi done;; esac as_found=false done IFS=$as_save_IFS if $as_found then : else case e in #( e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes fi ;; esac fi if test "x$CONFIG_SHELL" != x then : export CONFIG_SHELL # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi if test x$as_have_required = xno then : printf "%s\n" "$0: This script requires a shell more modern than all" printf "%s\n" "$0: the shells that I found on your system." if test ${ZSH_VERSION+y} ; then printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." else printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system, $0: including any error possibly output before this $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 fi ;; esac fi fi SHELL=${CONFIG_SHELL-/bin/sh} export SHELL # Unset more variables known to interfere with behavior of common tools. CLICOLOR_FORCE= GREP_OPTIONS= unset CLICOLOR_FORCE GREP_OPTIONS ## --------------------- ## ## M4sh Shell Functions. ## ## --------------------- ## # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else case e in #( e) as_fn_append () { eval $1=\$$1\$2 } ;; esac fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else case e in #( e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } ;; esac fi # as_fn_arith # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_lineno_1=$LINENO as_lineno_1a=$LINENO as_lineno_2=$LINENO as_lineno_2a=$LINENO eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' t clear :clear s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # If we had to re-execute with $CONFIG_SHELL, we're ensured to have # already done that, so ensure we don't try to do so again and fall # in an infinite loop. This has already happened in practice. _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" as_tr_sh="eval sed '$as_sed_sh'" # deprecated test -n "$DJDIR" || exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='' PACKAGE_TARNAME='' PACKAGE_VERSION='' PACKAGE_STRING='' PACKAGE_BUGREPORT='' PACKAGE_URL='' ac_unique_file="libsrc/posix.adb" ac_subst_vars='LTLIBOBJS LIBOBJS CPP RTS_OPTION BUILD_TYPE_OPTION ENABLE_SHARED DEPS THREADS_OPTION SIGNALS_GENERATED OBJEXT EXEEXT ac_ct_CC CPPFLAGS LDFLAGS CFLAGS CC target_alias host_alias build_alias LIBS ECHO_T ECHO_N ECHO_C DEFS mandir localedir libdir psdir pdfdir dvidir htmldir infodir docdir oldincludedir includedir runstatedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir bindir program_transform_name prefix exec_prefix PACKAGE_URL PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR SHELL' ac_subst_files='' ac_user_opts=' enable_option_checking enable_threads enable_shared with_build_type with_rts ' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS LIBS CPPFLAGS CPP' # Initialize some variables set by options. ac_init_help= ac_init_version=false ac_unrecognized_opts= ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -runstatedir | --runstatedir | --runstatedi | --runstated \ | --runstate | --runstat | --runsta | --runst | --runs \ | --run | --ru | --r) ac_prev=runstatedir ;; -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ | --run=* | --ru=* | --r=*) runstatedir=$ac_optarg ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) as_fn_error $? "unrecognized option: '$ac_option' Try '$0 --help' for more information" ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) as_fn_error $? "invalid variable name: '$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; esac # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: '$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF 'configure' configures this package to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print 'checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for '--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or '..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, 'make install' will install all the files in '$ac_default_prefix/bin', '$ac_default_prefix/lib' etc. You can specify an installation prefix other than '$ac_default_prefix' using '--prefix', for instance '--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --disable-threads Do not try to build pthread support --enable-shared Enable build of shared libraries Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-build-type=X Set build type (Production/Debug) --with-rts=X Set RTS Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory LIBS libraries to pass to the linker, e.g. -l CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for configure.gnu first; this name is used for a wrapper for # Metaconfig's "Configure" on case-insensitive file systems. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF configure generated by GNU Autoconf 2.72 Copyright (C) 2023 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## # ac_fn_c_try_compile LINENO # -------------------------- # Try to compile conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext then : ac_retval=0 else case e in #( e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 ;; esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile # ac_fn_c_try_cpp LINENO # ---------------------- # Try to preprocess conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_cpp () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_cpp conftest.$ac_ext" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err } then : ac_retval=0 else case e in #( e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 ;; esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_link () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || test -x conftest$ac_exeext } then : ac_retval=0 else case e in #( e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 ;; esac fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link # ac_fn_c_check_func LINENO FUNC VAR # ---------------------------------- # Tests whether FUNC exists, setting the cache variable VAR accordingly ac_fn_c_check_func () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Define $2 to an innocuous variant, in case declares $2. For example, HP-UX 11i declares gettimeofday. */ #define $2 innocuous_$2 /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $2 (void); below. */ #include #undef $2 /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $2 (void); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$2 || defined __stub___$2 choke me #endif int main (void) { return $2 (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : eval "$3=yes" else case e in #( e) eval "$3=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext ;; esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_func ac_configure_args_raw= for ac_arg do case $ac_arg in *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac as_fn_append ac_configure_args_raw " '$ac_arg'" done case $ac_configure_args_raw in *$as_nl*) ac_safe_unquote= ;; *) ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. ac_unsafe_a="$ac_unsafe_z#~" ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; esac cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by $as_me, which was generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac printf "%s\n" "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done { ac_configure_args0=; unset ac_configure_args0;} { ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Sanitize IFS. IFS=" "" $as_nl" # Save into config.log some information that might help in debugging. { echo printf "%s\n" "## ---------------- ## ## Cache variables. ## ## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo printf "%s\n" "## ----------------- ## ## Output variables. ## ## ----------------- ##" echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then printf "%s\n" "## ------------------- ## ## File substitutions. ## ## ------------------- ##" echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then printf "%s\n" "## ----------- ## ## confdefs.h. ## ## ----------- ##" echo cat confdefs.h echo fi test "$ac_signal" != 0 && printf "%s\n" "$as_me: caught signal $ac_signal" printf "%s\n" "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h printf "%s\n" "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then ac_site_files="$CONFIG_SITE" elif test "x$prefix" != xNONE; then ac_site_files="$prefix/share/config.site $prefix/etc/config.site" else ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi for ac_site_file in $ac_site_files do case $ac_site_file in #( */*) : ;; #( *) : ac_site_file=./$ac_site_file ;; esac if test -f "$ac_site_file" && test -r "$ac_site_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file See 'config.log' for more details" "$LINENO" 5; } fi done # Test code for whether the C compiler supports C89 (global declarations) ac_c_conftest_c89_globals=' /* Does the compiler advertise C89 conformance? Do not test the value of __STDC__, because some compilers set it to 0 while being otherwise adequately conformant. */ #if !defined __STDC__ # error "Compiler does not advertise C89 conformance" #endif #include #include struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); static char *e (char **p, int i) { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* C89 style stringification. */ #define noexpand_stringify(a) #a const char *stringified = noexpand_stringify(arbitrary+token=sequence); /* C89 style token pasting. Exercises some of the corner cases that e.g. old MSVC gets wrong, but not very hard. */ #define noexpand_concat(a,b) a##b #define expand_concat(a,b) noexpand_concat(a,b) extern int vA; extern int vbee; #define aye A #define bee B int *pvA = &expand_concat(v,aye); int *pvbee = &noexpand_concat(v,bee); /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated as an "x". The following induces an error, until -std is added to get proper ANSI mode. Curiously \x00 != x always comes out true, for an array size at least. It is necessary to write \x00 == 0 to get something that is true only with -std. */ int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) '\''x'\'' int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), int, int);' # Test code for whether the C compiler supports C89 (body of main). ac_c_conftest_c89_main=' ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); ' # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' /* Does the compiler advertise C99 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif // See if C++-style comments work. #include extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); extern void free (void *); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare // FILE and stderr. #define debug(...) dprintf (2, __VA_ARGS__) #define showlist(...) puts (#__VA_ARGS__) #define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) static void test_varargs_macros (void) { int x = 1234; int y = 5678; debug ("Flag"); debug ("X = %d\n", x); showlist (The first, second, and third items.); report (x>y, "x is %d but y is %d", x, y); } // Check long long types. #define BIG64 18446744073709551615ull #define BIG32 4294967295ul #define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) #if !BIG_OK #error "your preprocessor is broken" #endif #if BIG_OK #else #error "your preprocessor is broken" #endif static long long int bignum = -9223372036854775807LL; static unsigned long long int ubignum = BIG64; struct incomplete_array { int datasize; double data[]; }; struct named_init { int number; const wchar_t *name; double average; }; typedef const char *ccp; static inline int test_restrict (ccp restrict text) { // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) continue; return 0; } // Check varargs and va_copy. static bool test_varargs (const char *format, ...) { va_list args; va_start (args, format); va_list args_copy; va_copy (args_copy, args); const char *str = ""; int number = 0; float fnumber = 0; while (*format) { switch (*format++) { case '\''s'\'': // string str = va_arg (args_copy, const char *); break; case '\''d'\'': // int number = va_arg (args_copy, int); break; case '\''f'\'': // float fnumber = va_arg (args_copy, double); break; default: break; } } va_end (args_copy); va_end (args); return *str && number && fnumber; } ' # Test code for whether the C compiler supports C99 (body of main). ac_c_conftest_c99_main=' // Check bool. _Bool success = false; success |= (argc != 0); // Check restrict. if (test_restrict ("String literal") == 0) success = true; char *restrict newvar = "Another string"; // Check varargs. success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); test_varargs_macros (); // Check flexible array members. struct incomplete_array *ia = malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; // Work around memory leak warnings. free (ia); // Check named initializers. struct named_init ni = { .number = 34, .name = L"Test wide string", .average = 543.34343, }; ni.number = 58; int dynamic_array[ni.number]; dynamic_array[0] = argv[0][0]; dynamic_array[ni.number - 1] = 543; // work around unused variable warnings ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' || dynamic_array[ni.number - 1] != 543); ' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' /* Does the compiler advertise C11 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif // Check _Alignas. char _Alignas (double) aligned_as_double; char _Alignas (0) no_special_alignment; extern char aligned_as_int; char _Alignas (0) _Alignas (int) aligned_as_int; // Check _Alignof. enum { int_alignment = _Alignof (int), int_array_alignment = _Alignof (int[100]), char_alignment = _Alignof (char) }; _Static_assert (0 < -_Alignof (int), "_Alignof is signed"); // Check _Noreturn. int _Noreturn does_not_return (void) { for (;;) continue; } // Check _Static_assert. struct test_static_assert { int x; _Static_assert (sizeof (int) <= sizeof (long int), "_Static_assert does not work in struct"); long int y; }; // Check UTF-8 literals. #define u8 syntax error! char const utf8_literal[] = u8"happens to be ASCII" "another string"; // Check duplicate typedefs. typedef long *long_ptr; typedef long int *long_ptr; typedef long_ptr long_ptr; // Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. struct anonymous { union { struct { int i; int j; }; struct { int k; long int l; } w; }; int m; } v1; ' # Test code for whether the C compiler supports C11 (body of main). ac_c_conftest_c11_main=' _Static_assert ((offsetof (struct anonymous, i) == offsetof (struct anonymous, w.k)), "Anonymous union alignment botch"); v1.i = 2; v1.w.k = 5; ok |= v1.i != 5; ' # Test code for whether the C compiler supports C11 (complete). ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} ${ac_c_conftest_c11_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} ${ac_c_conftest_c11_main} return ok; } " # Test code for whether the C compiler supports C99 (complete). ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} return ok; } " # Test code for whether the C compiler supports C89 (complete). ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} return ok; } " # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5 printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5 printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5 printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5 printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: '$ac_old_val'" >&5 printf "%s\n" "$as_me: former value: '$ac_old_val'" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: '$ac_new_val'" >&5 printf "%s\n" "$as_me: current value: '$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo See file "configure.log" for results of this step. # specifies some well-known file in the configured directory ac_config_headers="$ac_config_headers confsrc/config.h" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. set dummy ${ac_tool_prefix}clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "clang", so it can be a program name with args. set dummy clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi fi test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH See 'config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 set X $ac_compile ac_compiler=$2 for ac_option in --version -v -V -qversion -version; do { { ac_try="$ac_compiler $ac_option >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? if test -s conftest.err; then sed '10a\ ... rest of stderr output deleted ... 10q' conftest.err >conftest.er1 cat conftest.er1 >&5 fi rm -f conftest.er1 conftest.err printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 printf %s "checking whether the C compiler works... " >&6; } ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # The possible output files: ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { { ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link_default") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'. # So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an '-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else case e in #( e) ac_file='' ;; esac fi if test -z "$ac_file" then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables See 'config.log' for more details" "$LINENO" 5; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 printf "%s\n" "$ac_file" >&6; } ac_exeext=$ac_cv_exeext rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 printf %s "checking for suffix of executables... " >&6; } if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # If both 'conftest.exe' and 'conftest' are 'present' (well, observable) # catch 'conftest.exe'. For instance with Cygwin, 'ls conftest' will # work properly (i.e., refer to 'conftest.exe'), while it won't with # 'rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else case e in #( e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link See 'config.log' for more details" "$LINENO" 5; } ;; esac fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 printf "%s\n" "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int main (void) { FILE *f = fopen ("conftest.out", "w"); if (!f) return 1; return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF ac_clean_files="$ac_clean_files conftest.out" # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 printf %s "checking whether we are cross compiling... " >&6; } if test "$cross_compiling" != yes; then { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } if { ac_try='./conftest$ac_cv_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. If you meant to cross compile, use '--host'. See 'config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } rm -f conftest.$ac_ext conftest$ac_cv_exeext \ conftest.o conftest.obj conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else case e in #( e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile See 'config.log' for more details" "$LINENO" 5; } ;; esac fi rm -f conftest.$ac_cv_objext conftest.$ac_ext ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes else case e in #( e) ac_compiler_gnu=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } ac_compiler_gnu=$ac_cv_c_compiler_gnu if test $ac_compiler_gnu = yes; then GCC=yes else GCC= fi ac_test_CFLAGS=${CFLAGS+y} ac_save_CFLAGS=$CFLAGS { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes else case e in #( e) CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : else case e in #( e) ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } if test $ac_test_CFLAGS; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi ac_prog_cc_stdc=no if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c11_program _ACEOF for ac_arg in '' -std=gnu11 do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c11=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC ;; esac fi if test "x$ac_cv_prog_cc_c11" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else case e in #( e) if test "x$ac_cv_prog_cc_c11" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } CC="$CC $ac_cv_prog_cc_c11" ;; esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 ac_prog_cc_stdc=c11 ;; esac fi fi if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c99_program _ACEOF for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c99=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC ;; esac fi if test "x$ac_cv_prog_cc_c99" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else case e in #( e) if test "x$ac_cv_prog_cc_c99" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } CC="$CC $ac_cv_prog_cc_c99" ;; esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 ac_prog_cc_stdc=c99 ;; esac fi fi if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c89_program _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c89=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC ;; esac fi if test "x$ac_cv_prog_cc_c89" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else case e in #( e) if test "x$ac_cv_prog_cc_c89" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } CC="$CC $ac_cv_prog_cc_c89" ;; esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 ac_prog_cc_stdc=c89 ;; esac fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu rm -f pconfig.h # Check whether --enable-threads was given. if test ${enable_threads+y} then : enableval=$enable_threads; else case e in #( e) use_pthread=yes ;; esac fi if test "x$use_pthread" = "xyes" ; then DEPS=deps SIGNALS_GENERATED=posix-implementation-ok_signals.ads THREADS_BOOL=True else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: No pthread support." >&5 printf "%s\n" "$as_me: WARNING: No pthread support." >&2;} DEPS=deps_no_thread SIGNALS_GENERATED= THREADS_BOOL=False fi THREADS_OPTION=-XTHREADS=${THREADS_BOOL} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to build a shared library" >&5 printf %s "checking whether to build a shared library... " >&6; } # Check whether --enable-shared was given. if test ${enable_shared+y} then : enableval=$enable_shared; { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 printf "%s\n" "$enableval" >&6; } if test "$enableval" = "yes"; then ENABLE_SHARED="yes" fi else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking build type" >&5 printf %s "checking build type... " >&6; } # Check whether --with-build-type was given. if test ${with_build_type+y} then : withval=$with_build_type; case "x$with_build_type" in xyes|xno) as_fn_error $? "invalid build type" "$LINENO" 5 ;; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $with_build_type" >&5 printf "%s\n" "$with_build_type" >&6; } BUILD_TYPE_OPTION="-XBuild=$with_build_type" ;; esac else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: default" >&5 printf "%s\n" "default" >&6; } ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking RTS kind" >&5 printf %s "checking RTS kind... " >&6; } # Check whether --with-rts was given. if test ${with_rts+y} then : withval=$with_rts; case "x$with_rts" in xyes|xno) as_fn_error $? "invalid RTS" "$LINENO" 5 ;; *) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $with_rts" >&5 printf "%s\n" "$with_rts" >&6; } RTS_OPTION="--RTS=$with_rts" ;; esac else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: default" >&5 printf "%s\n" "default" >&6; } ;; esac fi # By default errno is preserved accross exceptions safe_errno=True echo $ac_n "checking for SGI IRIX timers... " $ac_c; if (grep "CLOCK_SGI_FAST" /usr/include/sys/ptimers.h >/dev/null 2>&1); then echo "yes" echo "HAVE_IRIX_Timers := True" >> gnatprep.config; else echo "no" echo "HAVE_IRIX_Timers := False" >> gnatprep.config; fi; UNAME_MACHINE=`(uname -m) 2>/dev/null` UNAME_RELEASE=`(uname -r) 2>/dev/null` UNAME_SYSTEM=`(uname -s) 2>/dev/null` UNAME_VERSION=`(uname -v) 2>/dev/null` echo ${UNAME_SYSTEM} ${UNAME_MACHINE} ${UNAME_RELEASE} ${UNAME_VERSION} echo "Using Configuration for" ${UNAME_SYSTEM} ${UNAME_RELEASE}; cp ./configs/pconfig.Linux ./pconfig.h.in; if test "x$safe_errno" = "xTrue" ; then safe_errno_msg="safe" else safe_errno_msg="not safe" fi echo "We will assume errno is $safe_errno_msg for exception propagation." echo "to override, hand-edit gnatprep.config" echo "HAVE_Safe_Errno := $safe_errno" >> gnatprep.config; # defines HAVE_NAME_H for each header "name.h" found # also checks for location of Pthread library # note that the order is rather touchy # for Solaris 2.5.1, utsname.h must precede limits.h # for Solaris 2.5.1, netinet/in.h must preceded arpa/inet.h # for Linux 2.0.x with Provenzano (MIT) threads, # pthread.h must follow sched.h, since # pthread.h redefines symbols in sched.h; # the effect is to detect the problem and drop pthread.h ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 printf %s "checking how to run the C preprocessor... " >&6; } # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then if test ${ac_cv_prog_CPP+y} then : printf %s "(cached) " >&6 else case e in #( e) # Double quotes because $CC needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp do ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO" then : else case e in #( e) # Broken: fails on valid input. continue ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue else case e in #( e) # Passes both tests. ac_preproc_ok=: break ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : break fi done ac_cv_prog_CPP=$CPP ;; esac fi CPP=$ac_cv_prog_CPP else ac_cv_prog_CPP=$CPP fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 printf "%s\n" "$CPP" >&6; } ac_preproc_ok=false for ac_c_preproc_warn_flag in '' yes do # Use a header file that comes with gcc, so configuring glibc # with a fresh cross-compiler works. # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. "Syntax error" is here to catch this case. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include Syntax error _ACEOF if ac_fn_c_try_cpp "$LINENO" then : else case e in #( e) # Broken: fails on valid input. continue ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue else case e in #( e) # Passes both tests. ac_preproc_ok=: break ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext done # Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : else case e in #( e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check See 'config.log' for more details" "$LINENO" 5; } ;; esac fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu rm -f confsrc/pconfig.h cp pconfig.h.in confsrc/pconfig.h chmod 644 confsrc/pconfig.h if ( test ! -f confsrc/pconfig.h ) then as_fn_error $? "missing confsrc/pconfig.h" "$LINENO" 5; fi for ac_hdr in \ aio.h\ dirent.h\ errno.h\ fcntl.h\ grp.h\ locale.h\ mqueue.h\ pwd.h\ sched.h\ pthread.h\ semaphore.h\ setjmp.h\ signal.h\ stdio.h\ sys/mman.h\ sys/stat.h\ sys/times.h\ sys/types.h\ sys/utsname.h\ limits.h\ sys/wait.h\ termios.h\ time.h\ sys/time.h\ unistd.h\ utime.h\ do ac_old_cflags=$CFLAGS # CFLAGS="$CFLAGS -Werror" ac_safe=`echo "$ac_hdr" | tr './\055' '___'` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_hdr" >&5 printf %s "checking for $ac_hdr... " >&6; } if eval test \${ac_cv_header_$ac_safe+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <$ac_hdr> _ACEOF if ac_fn_c_try_cpp "$LINENO" then : cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" #include <$ac_hdr> _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_header_$ac_safe=yes" else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } echo "#include <$ac_hdr>" >> confsrc/pconfig.h ac_tr_hdr=HAVE_$(echo $ac_hdr | tr 'abcdefghijklmnopqrstuvwxyz./\055' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ___') printf "%s\n" "#define $ac_tr_hdr 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi CFLAGS=$ac_old_cflags done # POSIX.5c headers are separated, because we want to do # some special processing to try to substitute for missing standard # header files. # Checks for xti.h and tli.h are built-in, as is check for whether we # need addrinfo.h. # We always call this after AC_POSIX_HEADERS, so that pconfig.h will # already have the other required POSIX headers in it, and in particular # will have any lines inherited from pconfig.h.in. for ac_hdr in netdb.h\ netinet/in.h\ netinet/in_systm.h\ netinet/ip.h\ netinet/tcp.h\ arpa/inet.h\ poll.h\ sys/select.h\ sys/socket.h\ sys/uio.h\ sys/un.h\ do ac_old_cflags=$CFLAGS # CFLAGS="$CFLAGS -Werror" ac_safe=`echo "$ac_hdr" | tr './\055' '___'` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_hdr" >&5 printf %s "checking for $ac_hdr... " >&6; } if eval test \${ac_cv_header_$ac_safe+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include <$ac_hdr> _ACEOF if ac_fn_c_try_cpp "$LINENO" then : cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" #include <$ac_hdr> _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_header_$ac_safe=yes" else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } echo "#include <$ac_hdr>" >> confsrc/pconfig.h ac_tr_hdr=HAVE_$(echo $ac_hdr | tr 'abcdefghijklmnopqrstuvwxyz./\055' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ___') printf "%s\n" "#define $ac_tr_hdr 1" >>confdefs.h else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi CFLAGS=$ac_old_cflags done ac_old_cflags=$CFLAGS # CFLAGS="$CFLAGS -Werror" ac_safe=`echo "xti.h" | tr './\055' '___'` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for xti.h" >&5 printf %s "checking for xti.h... " >&6; } if eval test \${ac_cv_header_$ac_safe+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if ac_fn_c_try_cpp "$LINENO" then : cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" #include _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_header_$ac_safe=yes" else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } echo "#include " >> confsrc/pconfig.h printf "%s\n" "#define HAVE_XTI_H 1" >>confdefs.h echo "-- don't want TLI because we have xti.h TLI := False" >> gnatprep.config; else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } ac_old_cflags=$CFLAGS # CFLAGS="$CFLAGS -Werror" ac_safe=`echo "tli.h" | tr './\055' '___'` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tli.h" >&5 printf %s "checking for tli.h... " >&6; } if eval test \${ac_cv_header_$ac_safe+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if ac_fn_c_try_cpp "$LINENO" then : cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" #include _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_header_$ac_safe=yes" else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext else case e in #( e) eval "ac_cv_header_$ac_safe=no" ;; esac fi rm -f conftest.err conftest.i conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } echo "#include " >> confsrc/pconfig.h printf "%s\n" "#define HAVE_TLI_H 1" >>confdefs.h echo "-- using TLI because could not find xti.h TLI := True" >> gnatprep.config; else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } echo "-- could not find tli.h TLI := False" >> gnatprep.config; fi CFLAGS=$ac_old_cflags fi CFLAGS=$ac_old_cflags cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" int main (void) { struct msghdr hdr; hdr.msg_controllen = 0; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : echo "Socket interface looks like BSD 4.4"; # Put BSD flag in gnatprep.config if (grep BSD4_3 gnatprep.config >/dev/null 2>&1); then true; else (echo "-- set BSD4_3 to False if using 4.4 style socket msghdr"; echo "BSD4_3 := False") >> gnatprep.config; fi; if (grep _BSD4_4_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _BSD4_4_" >> confsrc/pconfig.h; fi; else case e in #( e) echo "Socket interface Looks like BSD 4.3"; if (grep BSD4_3 gnatprep.config >/dev/null 2>&1); then true; else (echo "-- set BSD4_3 to False if using 4.4 style socket msghdr"; echo "BSD4_3 := True") >> gnatprep.config; fi; if (grep _BSD4_3_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _BSD4_3_" >> confsrc/pconfig.h; fi; ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext if (grep xti.h confsrc/pconfig.h >/dev/null 2>&1); then if (grep _XTI_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _XTI_" >> confsrc/pconfig.h; fi ; else if [ -f /usr/include/sys/tiuser.h ]; then echo "Have only TLI, will use that in place of XTI"; if (grep _TLI_ confsrc/pconfig.h >/dev/null 2>&1); then true; else echo "#define _TLI_" >> confsrc/pconfig.h; echo "#include " >> confsrc/pconfig.h; fi; fi; fi if test "x$use_pthread" = "xyes" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -lpthread" >&5 printf %s "checking for pthread_self in -lpthread... " >&6; } if test ${ac_cv_lib_pthread_pthread_self+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char pthread_self (void); int main (void) { return pthread_self (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthread_pthread_self=yes else case e in #( e) ac_cv_lib_pthread_pthread_self=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_self" >&5 printf "%s\n" "$ac_cv_lib_pthread_pthread_self" >&6; } if test "x$ac_cv_lib_pthread_pthread_self" = xyes then : printf "%s\n" "#define HAVE_LIBPTHREAD 1" >>confdefs.h LIBS="-lpthread $LIBS" else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __pthread_self in -lpthread" >&5 printf %s "checking for __pthread_self in -lpthread... " >&6; } if test ${ac_cv_lib_pthread___pthread_self+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char __pthread_self (void); int main (void) { return __pthread_self (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthread___pthread_self=yes else case e in #( e) ac_cv_lib_pthread___pthread_self=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_self" >&5 printf "%s\n" "$ac_cv_lib_pthread___pthread_self" >&6; } if test "x$ac_cv_lib_pthread___pthread_self" = xyes then : printf "%s\n" "#define HAVE_LIBPTHREAD 1" >>confdefs.h LIBS="-lpthread $LIBS" else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -lpthreads" >&5 printf %s "checking for pthread_self in -lpthreads... " >&6; } if test ${ac_cv_lib_pthreads_pthread_self+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-lpthreads $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char pthread_self (void); int main (void) { return pthread_self (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthreads_pthread_self=yes else case e in #( e) ac_cv_lib_pthreads_pthread_self=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_self" >&5 printf "%s\n" "$ac_cv_lib_pthreads_pthread_self" >&6; } if test "x$ac_cv_lib_pthreads_pthread_self" = xyes then : printf "%s\n" "#define HAVE_LIBPTHREADS 1" >>confdefs.h LIBS="-lpthreads $LIBS" else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -lcma" >&5 printf %s "checking for pthread_self in -lcma... " >&6; } if test ${ac_cv_lib_cma_pthread_self+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-lcma $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char pthread_self (void); int main (void) { return pthread_self (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_cma_pthread_self=yes else case e in #( e) ac_cv_lib_cma_pthread_self=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cma_pthread_self" >&5 printf "%s\n" "$ac_cv_lib_cma_pthread_self" >&6; } if test "x$ac_cv_lib_cma_pthread_self" = xyes then : printf "%s\n" "#define HAVE_LIBCMA 1" >>confdefs.h LIBS="-lcma $LIBS" else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -l:libcma.a" >&5 printf %s "checking for pthread_self in -l:libcma.a... " >&6; } if test ${ac_cv_lib__libcma_a_pthread_self+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-l:libcma.a $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char pthread_self (void); int main (void) { return pthread_self (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib__libcma_a_pthread_self=yes else case e in #( e) ac_cv_lib__libcma_a_pthread_self=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib__libcma_a_pthread_self" >&5 printf "%s\n" "$ac_cv_lib__libcma_a_pthread_self" >&6; } if test "x$ac_cv_lib__libcma_a_pthread_self" = xyes then : printf "%s\n" "#define HAVE_LIB_LIBCMA_A 1" >>confdefs.h LIBS="-l:libcma.a $LIBS" else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -lthread" >&5 printf %s "checking for pthread_self in -lthread... " >&6; } if test ${ac_cv_lib_thread_pthread_self+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-lthread $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char pthread_self (void); int main (void) { return pthread_self (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_thread_pthread_self=yes else case e in #( e) ac_cv_lib_thread_pthread_self=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_thread_pthread_self" >&5 printf "%s\n" "$ac_cv_lib_thread_pthread_self" >&6; } if test "x$ac_cv_lib_thread_pthread_self" = xyes then : printf "%s\n" "#define HAVE_LIBTHREAD 1" >>confdefs.h LIBS="-lthread $LIBS" else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -lc_r" >&5 printf %s "checking for pthread_self in -lc_r... " >&6; } if test ${ac_cv_lib_c_r_pthread_self+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-lc_r $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char pthread_self (void); int main (void) { return pthread_self (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_c_r_pthread_self=yes else case e in #( e) ac_cv_lib_c_r_pthread_self=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_self" >&5 printf "%s\n" "$ac_cv_lib_c_r_pthread_self" >&6; } if test "x$ac_cv_lib_c_r_pthread_self" = xyes then : printf "%s\n" "#define HAVE_LIBC_R 1" >>confdefs.h LIBS="-lc_r $LIBS" fi ;; esac fi ;; esac fi ;; esac fi ;; esac fi ;; esac fi ;; esac fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing aio_read" >&5 printf %s "checking for library containing aio_read... " >&6; } if test ${ac_cv_search_aio_read+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char aio_read (void); int main (void) { return aio_read (); ; return 0; } _ACEOF for ac_lib in '' aio do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_aio_read=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_aio_read+y} then : break fi done if test ${ac_cv_search_aio_read+y} then : else case e in #( e) ac_cv_search_aio_read=no ;; esac fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_aio_read" >&5 printf "%s\n" "$ac_cv_search_aio_read" >&6; } ac_res=$ac_cv_search_aio_read if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing shm_open" >&5 printf %s "checking for library containing shm_open... " >&6; } if test ${ac_cv_search_shm_open+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char shm_open (void); int main (void) { return shm_open (); ; return 0; } _ACEOF for ac_lib in '' rt do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_shm_open=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_shm_open+y} then : break fi done if test ${ac_cv_search_shm_open+y} then : else case e in #( e) ac_cv_search_shm_open=no ;; esac fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_shm_open" >&5 printf "%s\n" "$ac_cv_search_shm_open" >&6; } ac_res=$ac_cv_search_shm_open if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5 printf %s "checking for library containing clock_gettime... " >&6; } if test ${ac_cv_search_clock_gettime+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char clock_gettime (void); int main (void) { return clock_gettime (); ; return 0; } _ACEOF for ac_lib in '' posix4 rt do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_clock_gettime=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_clock_gettime+y} then : break fi done if test ${ac_cv_search_clock_gettime+y} then : else case e in #( e) ac_cv_search_clock_gettime=no ;; esac fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_clock_gettime" >&5 printf "%s\n" "$ac_cv_search_clock_gettime" >&6; } ac_res=$ac_cv_search_clock_gettime if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing gethostbyname" >&5 printf %s "checking for library containing gethostbyname... " >&6; } if test ${ac_cv_search_gethostbyname+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char gethostbyname (void); int main (void) { return gethostbyname (); ; return 0; } _ACEOF for ac_lib in '' nsl do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_gethostbyname=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_gethostbyname+y} then : break fi done if test ${ac_cv_search_gethostbyname+y} then : else case e in #( e) ac_cv_search_gethostbyname=no ;; esac fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_gethostbyname" >&5 printf "%s\n" "$ac_cv_search_gethostbyname" >&6; } ac_res=$ac_cv_search_gethostbyname if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing t_bind" >&5 printf %s "checking for library containing t_bind... " >&6; } if test ${ac_cv_search_t_bind+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char t_bind (void); int main (void) { return t_bind (); ; return 0; } _ACEOF for ac_lib in '' nsl nsl_s do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_t_bind=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_t_bind+y} then : break fi done if test ${ac_cv_search_t_bind+y} then : else case e in #( e) ac_cv_search_t_bind=no ;; esac fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_t_bind" >&5 printf "%s\n" "$ac_cv_search_t_bind" >&6; } ac_res=$ac_cv_search_t_bind if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing accept" >&5 printf %s "checking for library containing accept... " >&6; } if test ${ac_cv_search_accept+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char accept (void); int main (void) { return accept (); ; return 0; } _ACEOF for ac_lib in '' socket do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_accept=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_accept+y} then : break fi done if test ${ac_cv_search_accept+y} then : else case e in #( e) ac_cv_search_accept=no ;; esac fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_accept" >&5 printf "%s\n" "$ac_cv_search_accept" >&6; } ac_res=$ac_cv_search_accept if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for library containing h_errno" >&5 printf %s "checking for library containing h_errno... " >&6; } if test ${ac_cv_search_h_errno+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char h_errno (void); int main (void) { return h_errno (); ; return 0; } _ACEOF for ac_lib in '' resolv do if test -z "$ac_lib"; then ac_res="none required" else ac_res=-l$ac_lib LIBS="-l$ac_lib $ac_func_search_save_LIBS" fi if ac_fn_c_try_link "$LINENO" then : ac_cv_search_h_errno=$ac_res fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext if test ${ac_cv_search_h_errno+y} then : break fi done if test ${ac_cv_search_h_errno+y} then : else case e in #( e) ac_cv_search_h_errno=no ;; esac fi rm conftest.$ac_ext LIBS=$ac_func_search_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_h_errno" >&5 printf "%s\n" "$ac_cv_search_h_errno" >&6; } ac_res=$ac_cv_search_h_errno if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" fi echo "Using LIBS=${LIBS}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep -e" >&5 printf %s "checking for egrep -e... " >&6; } if test ${ac_cv_path_EGREP_TRADITIONAL+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -z "$EGREP_TRADITIONAL"; then ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_prog in grep ggrep do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue # Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. # Check for GNU $ac_path_EGREP_TRADITIONAL case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; #( *) ac_count=0 printf %s 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" "$ac_path_EGREP_TRADITIONAL" -E 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then : fi else ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi if test "$ac_cv_path_EGREP_TRADITIONAL" then : ac_cv_path_EGREP_TRADITIONAL="$ac_cv_path_EGREP_TRADITIONAL -E" else case e in #( e) if test -z "$EGREP_TRADITIONAL"; then ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_prog in egrep do for ac_exec_ext in '' $ac_executable_extensions; do ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue # Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. # Check for GNU $ac_path_EGREP_TRADITIONAL case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; #( *) ac_count=0 printf %s 0123456789 >"conftest.in" while : do cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" "$ac_path_EGREP_TRADITIONAL" 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break done rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi ;; esac fi ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP_TRADITIONAL" >&5 printf "%s\n" "$ac_cv_path_EGREP_TRADITIONAL" >&6; } EGREP_TRADITIONAL=$ac_cv_path_EGREP_TRADITIONAL { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for global variable or macro t_errno" >&5 printf %s "checking for global variable or macro t_errno... " >&6; } if test ${ac_cv_comp_t_errno+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP_TRADITIONAL "t_errno" >/dev/null 2>&1 then : eval "ac_cv_comp_t_errno=yes" else case e in #( e) eval "ac_cv_comp_t_errno=no" ;; esac fi rm -rf conftest* ;; esac fi if eval "test \"`echo '$ac_cv_comp_'t_errno`\" = yes"; then printf "%s\n" "#define HAVE_t_errno 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for global variable or macro t_nerr" >&5 printf %s "checking for global variable or macro t_nerr... " >&6; } if test ${ac_cv_comp_t_nerr+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP_TRADITIONAL "t_nerr" >/dev/null 2>&1 then : eval "ac_cv_comp_t_nerr=yes" else case e in #( e) eval "ac_cv_comp_t_nerr=no" ;; esac fi rm -rf conftest* ;; esac fi if eval "test \"`echo '$ac_cv_comp_'t_nerr`\" = yes"; then printf "%s\n" "#define HAVE_t_nerr 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct msghdr component msg_control" >&5 printf %s "checking for struct msghdr component msg_control... " >&6; } if test ${ac_cv_comp_msg_control+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" struct msghdr x; int main (void) { x.msg_control = x.msg_control; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_comp_msg_control=yes" else case e in #( e) eval "ac_cv_comp_msg_control=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_comp_'msg_control`\" = yes"; then printf "%s\n" "#define HAVE_component_msg_control 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct msghdr component msg_controllen" >&5 printf %s "checking for struct msghdr component msg_controllen... " >&6; } if test ${ac_cv_comp_msg_controllen+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" struct msghdr x; int main (void) { x.msg_controllen = x.msg_controllen; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_comp_msg_controllen=yes" else case e in #( e) eval "ac_cv_comp_msg_controllen=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_comp_'msg_controllen`\" = yes"; then printf "%s\n" "#define HAVE_component_msg_controllen 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct msghdr component msg_flags" >&5 printf %s "checking for struct msghdr component msg_flags... " >&6; } if test ${ac_cv_comp_msg_flags+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" struct msghdr x; int main (void) { x.msg_flags = x.msg_flags; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_comp_msg_flags=yes" else case e in #( e) eval "ac_cv_comp_msg_flags=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_comp_'msg_flags`\" = yes"; then printf "%s\n" "#define HAVE_component_msg_flags 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct sigevent component sigev_notify_function" >&5 printf %s "checking for struct sigevent component sigev_notify_function... " >&6; } if test ${ac_cv_comp_sigev_notify_function+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" struct sigevent x; int main (void) { x.sigev_notify_function = x.sigev_notify_function; ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_comp_sigev_notify_function=yes" else case e in #( e) eval "ac_cv_comp_sigev_notify_function=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_comp_'sigev_notify_function`\" = yes"; then printf "%s\n" "#define HAVE_component_sigev_notify_function 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct sigaction component sa_sigaction overlaying sa_handler" >&5 printf %s "checking for struct sigaction component sa_sigaction overlaying sa_handler... " >&6; } if test ${ac_cv_comp_sa_sigaction+y} then : printf %s "(cached) " >&6 else case e in #( e) if test "$cross_compiling" = yes then : eval "ac_cv_comp_sa_sigaction=nu" else case e in #( e) # ac_fn_c_try_run LINENO # ---------------------- # Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that # executables *can* be run. ac_fn_c_try_run () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; } then : ac_retval=0 else case e in #( e) printf "%s\n" "$as_me: program exited with status $ac_status" >&5 printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=$ac_status ;; esac fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" main() { struct sigaction x; if (&x.sa_sigaction == &x.sa_handler) { fprintf(stderr,"sa_sigaction overlays sa_handler..."); exit (1); } else { exit (0); } } _ACEOF if ac_fn_c_try_run "$LINENO" then : eval "ac_cv_comp_sa_sigaction=yes" else case e in #( e) eval "ac_cv_comp_sa_sigaction=no" ;; esac fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi ;; esac fi if eval "test \"`echo '$ac_cv_comp_'sa_sigaction`\" = yes"; then printf "%s\n" "#define HAVE_component_sa_sigaction 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi for ac_struct in \ addrinfo\ aiocb\ cmsghdr\ dirent\ flock\ group\ hostent\ iovec\ in_addr\ ip_opts\ linger\ msghdr\ mq_attr\ netbuf\ netent\ passwd\ pollfd\ protoent\ tm\ tms\ sched_param\ servent\ sigaction\ cma_sigaction\ sigevent\ sockaddr\ sockaddr_in\ sockaddr_un\ stat\ termios\ timespec\ timeval\ t_bind\ t_call\ t_discon\ t_info\ t_iovec\ t_kpalive\ t_linger\ t_opthdr\ t_optmgmt\ t_uderr\ t_unitdata\ itimerspec\ utimbuf\ utsname\ do { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for struct $ac_struct" >&5 printf %s "checking for struct $ac_struct... " >&6; } if eval test \${ac_cv_struct_$ac_struct+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" struct $ac_struct x; int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "ac_cv_struct_$ac_struct=yes" else case e in #( e) eval "ac_cv_struct_$ac_struct=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi if eval "test \"`echo '$ac_cv_struct_'$ac_struct`\" = yes"; then printf "%s\n" "#define HAVE_struct_$ac_struct 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } : else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi done for ac_typ in \ blkcnt_t\ blksize_t\ cc_t\ clockid_t\ clock_t\ dev_t\ fd_set\ ino_t\ in_addr_t\ in_port_t\ mqd_t\ nlink_t\ pthread_attr_t\ pthread_condattr_t\ pthread_cond_t\ pthread_key_t\ pthread_mutexattr_t\ pthread_mutex_t\ pthread_once_t\ pthread_t\ sa_family_t\ sem_t\ siginfo_t\ sigset_t\ sigval\ socklen_t\ speed_t\ suseconds_t\ tcflag_t\ timer_t\ do { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_typ" >&5 printf %s "checking for $ac_typ... " >&6; } if eval test \${ac_cv_type_$ac_typ+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include "confsrc/pconfig.h" _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | $EGREP_TRADITIONAL ".?$ac_typ[^0-9A-Za-z_]" >/dev/null 2>&1 then : eval "ac_cv_type_$ac_typ=yes" else case e in #( e) eval "ac_cv_type_$ac_typ=no" ;; esac fi rm -rf conftest* ;; esac fi if eval "test \"`echo '$ac_cv_type_'$ac_typ`\" = yes"; then printf "%s\n" "#define HAVE_$ac_typ 1" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi done for ac_func in \ accept\ access\ aio_cancel\ aio_error\ aio_fsync\ aio_read\ aio_return\ aio_suspend\ aio_write\ bind\ cfgetispeed\ cfgetospeed\ cfsetispeed\ cfsetospeed\ chdir\ chmod\ chown\ clock_getres\ clock_gettime\ clock_settime\ close\ closedir\ connect\ ctermid\ ctime\ ctime_r\ dup\ dup2\ endhostent\ endnetent\ endprotoent\ endservent\ execl\ execle\ execlp\ execv\ execve\ execvp\ fchmod\ fcntl\ fdatasync\ fork\ fpathconf\ fstat\ fsync\ ftruncate\ getaddrinfo\ getcwd\ getegid\ getenv\ geteuid\ getgid\ getgrgid\ getgrgid_r\ getgrnam\ getgrnam_r\ getgroups\ gethostbyaddr\ gethostbyaddr_r\ gethostbyname\ gethostbyname_r\ gethostname\ getlogin\ getlogin_r\ getpeername\ getpgrp\ getpid\ getppid\ getnetbyaddr\ getnetbyaddr_r\ getnetbyname\ getnetbyname_r\ getprotobyname\ getprotobyname_r\ getprotobynumber\ getprotobynumber_r\ getservbyname\ getservbyname_r\ getpwnam\ getpwnam_r\ getpwuid\ getpwuid_r\ getservbyport\ getservbyport_r\ getsockname\ getsockname_r\ getsockopt\ gettimeofday\ getuid\ gmtime_r\ inet_addr\ inet_lnaof\ inet_makeaddr\ inet_network\ inet_ntoa\ inet_netof\ isatty\ isfdtype\ kill\ link\ lio_listio\ listen\ lseek\ lstat\ mkdir\ mkfifo\ mlock\ mlockall\ mmap\ mprotect\ mq_close\ mq_getattr\ mq_notify\ mq_open\ mq_receive\ mq_send\ mq_setattr\ mq_unlink\ msync\ munlock\ munlockall\ munmap\ open\ opendir\ pathconf\ pipe\ poll\ pthread_condattr_destroy\ pthread_condattr_getpshared\ pthread_condattr_init\ pthread_condattr_setpshared\ pthread_cond_broadcast\ pthread_cond_destroy\ pthread_cond_init\ pthread_cond_signal\ pthread_cond_timedwait\ pthread_cond_wait\ pthread_mutexattr_destroy\ pthread_mutexattr_getprioceiling\ pthread_mutexattr_getprotocol\ pthread_mutexattr_getpshared\ pthread_mutexattr_init\ pthread_mutexattr_setprioceiling\ pthread_mutexattr_setprotocol\ pthread_mutexattr_setpshared\ pthread_mutex_destroy\ pthread_mutex_getprioceiling\ pthread_mutex_init\ pthread_mutex_lock\ pthread_mutex_setprioceiling\ pthread_mutex_trylock\ pthread_mutex_unlock\ pthread_sigmask\ putenv\ rcvmsg\ read\ readdir\ readdir_r\ recv\ recvfrom\ recvmsg\ rename\ rand_r\ rmdir\ sched_getparam\ sched_getscheduler\ sched_get_priority_max\ sched_get_priority_min\ sched_rr_get_interval\ sched_setparam\ sched_setscheduler\ sched_yield\ select\ sem_close\ sem_destroy\ sem_getvalue\ sem_init\ sem_open\ sem_post\ sem_trywait\ sem_unlink\ sem_wait\ send\ sendto\ sendmsg\ setgid\ setenv\ sethostent\ setnetent\ setpgid\ setprotoent\ setservent\ setsid\ setsockopt\ setuid\ shm_open\ shm_unlink\ shutdown\ sigaction\ sigaddset\ sigdelset\ sigemptyset\ sigfillset\ sigismember\ siglongjmp\ sigpending\ sigprocmask\ sigqueue\ sigsetjmp\ sigsuspend\ sigtimedwait\ sigwait\ sigwaitinfo\ socket\ sockatmark\ socketpair\ stat\ strtok_r\ sysconf\ tcdrain\ tcflow\ tcflush\ tcgetattr\ tcgetpgrp\ tcsendbreak\ tcsetattr\ tcsetpgrp\ time\ timer_create\ timer_delete\ timer_getoverrun\ timer_gettime\ timer_settime\ times\ ttyname\ ttyname_r\ t_accept\ t_alloc\ t_bind\ t_blocking\ t_close\ t_connect\ t_error\ t_free\ t_getinfo\ t_getprotaddr\ t_getstate\ t_listen\ t_look\ t_nonblocking\ t_open\ t_optmgmt\ t_rcv\ t_rcvconnect\ t_rcvdis\ t_rcvrel\ t_rcvudata\ t_snd\ t_snddis\ t_sndudata\ t_strerror\ t_sync\ t_unbind\ t_rcvreldata\ t_rcvuderr\ t_rcvv\ t_rcvvudata\ t_sndreldata\ t_sndrel\ t_sndv\ t_sndvudata\ strerror\ strerror_r\ perror\ umask\ uname\ unlink\ unsetenv\ utime\ waitpid\ write\ __posix_sigwait\ __posix_ctime_r\ __posix_readdir_r\ __posix_sigwait_r\ __posix_ttyname_r\ do as_ac_var=`printf "%s\n" "ac_cv_func_$ac_func" | sed "$as_sed_sh"` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" if eval test \"x\$"$as_ac_var"\" = x"yes" then : printf "%s\n" "#define HAVE_$ac_func 1" >>confdefs.h else case e in #( e) printf "%s\n" "#define HAVE_$ac_func 0" >>confdefs.h ;; esac fi done ac_config_files="$ac_config_files Makefile" ac_config_commands="$ac_config_commands default" test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} export SHELL _ASEOF cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case e in #( e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else case e in #( e) as_fn_append () { eval $1=\$$1\$2 } ;; esac fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else case e in #( e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } ;; esac fi # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" as_tr_sh="eval sed '$as_sed_sh'" # deprecated exec 6>&1 ## ----------------------------------- ## ## Main body of $CONFIG_STATUS script. ## ## ----------------------------------- ## _ASEOF test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by $as_me, which was generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF case $ac_config_files in *" "*) set x $ac_config_files; shift; ac_config_files=$*;; esac case $ac_config_headers in *" "*) set x $ac_config_headers; shift; ac_config_headers=$*;; esac cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" config_headers="$ac_config_headers" config_commands="$ac_config_commands" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ '$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit --config print configuration, then exit -q, --quiet, --silent do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Configuration commands: $config_commands Report bugs to the package provider." _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ config.status configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" Copyright (C) 2023 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; --*=) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg= ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) printf "%s\n" "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) printf "%s\n" "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; esac as_fn_append CONFIG_HEADERS " '$ac_optarg'" ac_need_defaults=false;; --he | --h) # Conflict between --help and --header as_fn_error $? "ambiguous option: '$1' Try '$0 --help' for more information.";; --help | --hel | -h ) printf "%s\n" "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error $? "unrecognized option: '$1' Try '$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX printf "%s\n" "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "confsrc/config.h") CONFIG_HEADERS="$CONFIG_HEADERS confsrc/config.h" ;; "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; "default") CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files test ${CONFIG_HEADERS+y} || CONFIG_HEADERS=$config_headers test ${CONFIG_COMMANDS+y} || CONFIG_COMMANDS=$config_commands fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to '$tmp'. $debug || { tmp= ac_tmp= trap 'exit_status=$? : "${ac_tmp:=$tmp}" { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. # This happens for instance with './config.status config.h'. if test -n "$CONFIG_FILES"; then ac_cr=`echo X | tr X '\015'` # On cygwin, bash can eat \r inside `` if the user requested igncr. # But we know of no other shell where ac_cr would be empty at this # point, so we can use a bashism as a fallback. if test "x$ac_cr" = x; then eval ac_cr=\$\'\\r\' fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF { echo "cat >conf$$subs.awk <<_ACEOF" && echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl t repl s/'"$ac_delim"'$// t delim :nl h s/\(.\{148\}\)..*/\1/ t more1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b repl :more1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\)..*/\1/ t more2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :more2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim ' >$CONFIG_STATUS || ac_write_fail=1 rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" } { line = $ 0 nfields = split(line, field, "@") substed = 0 len = length(field[1]) for (i = 2; i < nfields; i++) { key = field[i] keylen = length(key) if (S_is_set[key]) { value = S[key] line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) len += length(value) + length(field[++i]) substed = 1 } else len += 1 + keylen } print line } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF # VPATH may cause trouble with some makes, so we remove sole $(srcdir), # ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ h s/// s/^/:/ s/[ ]*$/:/ s/:\$(srcdir):/:/g s/:\${srcdir}:/:/g s/:@srcdir@:/:/g s/^:*// s/:*$// x s/\(=[ ]*\).*/\1/ G s/\n// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" # Set up the scripts for CONFIG_HEADERS section. # No need to generate them if there are no CONFIG_HEADERS. # This happens for instance with './config.status Makefile'. if test -n "$CONFIG_HEADERS"; then cat >"$ac_tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF # Transform confdefs.h into an awk script 'defines.awk', embedded as # here-document in config.status, that substitutes the proper values into # config.h.in to produce config.h. # Create a delimiter string that does not exist in confdefs.h, to ease # handling of long lines. ac_delim='%!_!# ' for ac_last_try in false false :; do ac_tt=`sed -n "/$ac_delim/p" confdefs.h` if test -z "$ac_tt"; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done # For the awk script, D is an array of macro values keyed by name, # likewise P contains macro parameters if any. Preserve backslash # newline sequences. ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* sed -n ' s/.\{148\}/&'"$ac_delim"'/g t rset :rset s/^[ ]*#[ ]*define[ ][ ]*/ / t def d :def s/\\$// t bsnl s/["\\]/\\&/g s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ D["\1"]=" \3"/p s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p d :bsnl s/["\\]/\\&/g s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ D["\1"]=" \3\\\\\\n"\\/p t cont s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p t cont d :cont n s/.\{148\}/&'"$ac_delim"'/g t clear :clear s/\\$// t bsnlc s/["\\]/\\&/g; s/^/"/; s/$/"/p d :bsnlc s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p b cont ' >$CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 for (key in D) D_is_set[key] = 1 FS = "" } /^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { line = \$ 0 split(line, arg, " ") if (arg[1] == "#") { defundef = arg[2] mac1 = arg[3] } else { defundef = substr(arg[1], 2) mac1 = arg[2] } split(mac1, mac2, "(") #) macro = mac2[1] prefix = substr(line, 1, index(line, defundef) - 1) if (D_is_set[macro]) { # Preserve the white space surrounding the "#". print prefix "define", macro P[macro] D[macro] next } else { # Replace #undef with comments. This is necessary, for example, # in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. if (defundef == "undef") { print "/*", prefix defundef, macro, "*/" next } } } { print } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 fi # test -n "$CONFIG_HEADERS" eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS" shift for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain ':'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is 'configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 printf "%s\n" "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`printf "%s\n" "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$ac_tmp/stdin" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= ac_sed_dataroot=' /datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when '$srcdir' = '.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_sed_extra="$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&5 printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" case $ac_file in -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; :H) # # CONFIG_HEADER # if test x"$ac_file" != x-; then { printf "%s\n" "/* $configure_input */" >&1 \ && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" } >"$ac_tmp/config.h" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 printf "%s\n" "$as_me: $ac_file is unchanged" >&6;} else rm -f "$ac_file" mv "$ac_tmp/config.h" "$ac_file" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 fi else printf "%s\n" "/* $configure_input */" >&1 \ && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ || as_fn_error $? "could not create -" "$LINENO" 5 fi ;; :C) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 printf "%s\n" "$as_me: executing $ac_file commands" >&6;} ;; esac case $ac_file$ac_mode in "default":C) test -z "$CONFIG_HEADERS" || date > stamp-h ;; esac done # for ac_tag as_fn_exit 0 _ACEOF ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi libflorist-2025.1.0/configure.ac000066400000000000000000000232771473553204100164170ustar00rootroot00000000000000# Configure template for Florist # Process this file with autoconf to produce a configure script. # When adding new names (header-files, types, functions, etc.) # to this file, don't forget to also add the corresponding line # for HAVE_... to config.h.in. define([AC_CACHE_LOAD], )dnl define([AC_CACHE_SAVE], )dnl AC_INIT AC_CONFIG_SRCDIR([libsrc/posix.adb]) [echo See file "configure.log" for results of this step.] # specifies some well-known file in the configured directory AC_CONFIG_HEADERS([confsrc/config.h]) AC_PROG_CC rm -f pconfig.h AC_ARG_ENABLE(threads, AS_HELP_STRING([--disable-threads], [Do not try to build pthread support]),, [use_pthread=yes]) if test "x$use_pthread" = "xyes" ; then DEPS=deps SIGNALS_GENERATED=posix-implementation-ok_signals.ads THREADS_BOOL=True else AC_MSG_WARN(No pthread support.) DEPS=deps_no_thread SIGNALS_GENERATED= THREADS_BOOL=False fi THREADS_OPTION=-XTHREADS=${THREADS_BOOL} AC_SUBST(SIGNALS_GENERATED) AC_SUBST(THREADS_OPTION) AC_SUBST(DEPS) AC_MSG_CHECKING([whether to build a shared library]) AC_ARG_ENABLE(shared, AS_HELP_STRING([--enable-shared], [Enable build of shared libraries]), [ AC_MSG_RESULT($enableval) if test "$enableval" = "yes"; then ENABLE_SHARED="yes" fi ], [AC_MSG_RESULT(no)]) AC_SUBST(ENABLE_SHARED) AC_MSG_CHECKING([build type]) AC_ARG_WITH(build-type, AS_HELP_STRING([--with-build-type=X], [Set build type (Production/Debug)]), [ case "x$with_build_type" in xyes|xno) AC_MSG_ERROR(invalid build type) ;; *) AC_MSG_RESULT($with_build_type) BUILD_TYPE_OPTION="-XBuild=$with_build_type" ;; esac ], [AC_MSG_RESULT(default)]) AC_SUBST(BUILD_TYPE_OPTION) AC_MSG_CHECKING([RTS kind]) AC_ARG_WITH(rts, AS_HELP_STRING([--with-rts=X], [Set RTS]), [ case "x$with_rts" in xyes|xno) AC_MSG_ERROR(invalid RTS) ;; *) AC_MSG_RESULT($with_rts) RTS_OPTION="--RTS=$with_rts" ;; esac ], [AC_MSG_RESULT(default)]) AC_SUBST(RTS_OPTION) [ # By default errno is preserved accross exceptions safe_errno=True echo $ac_n "checking for SGI IRIX timers... " $ac_c; if (grep "CLOCK_SGI_FAST" /usr/include/sys/ptimers.h >/dev/null 2>&1); then echo "yes" echo "HAVE_IRIX_Timers := True" >> gnatprep.config; else echo "no" echo "HAVE_IRIX_Timers := False" >> gnatprep.config; fi; UNAME_MACHINE=`(uname -m) 2>/dev/null` UNAME_RELEASE=`(uname -r) 2>/dev/null` UNAME_SYSTEM=`(uname -s) 2>/dev/null` UNAME_VERSION=`(uname -v) 2>/dev/null` echo ${UNAME_SYSTEM} ${UNAME_MACHINE} ${UNAME_RELEASE} ${UNAME_VERSION} echo "Using Configuration for" ${UNAME_SYSTEM} ${UNAME_RELEASE}; cp ./configs/pconfig.Linux ./pconfig.h.in; if test "x$safe_errno" = "xTrue" ; then safe_errno_msg="safe" else safe_errno_msg="not safe" fi echo "We will assume errno is $safe_errno_msg for exception propagation." echo "to override, hand-edit gnatprep.config" echo "HAVE_Safe_Errno := $safe_errno" >> gnatprep.config; ] # defines HAVE_NAME_H for each header "name.h" found # also checks for location of Pthread library # note that the order is rather touchy # for Solaris 2.5.1, utsname.h must precede limits.h # for Solaris 2.5.1, netinet/in.h must preceded arpa/inet.h # for Linux 2.0.x with Provenzano (MIT) threads, # pthread.h must follow sched.h, since # pthread.h redefines symbols in sched.h; # the effect is to detect the problem and drop pthread.h AC_POSIX_HEADERS(\ aio.h\ dirent.h\ errno.h\ fcntl.h\ grp.h\ locale.h\ mqueue.h\ pwd.h\ sched.h\ pthread.h\ semaphore.h\ setjmp.h\ signal.h\ stdio.h\ sys/mman.h\ sys/stat.h\ sys/times.h\ sys/types.h\ sys/utsname.h\ limits.h\ sys/wait.h\ termios.h\ time.h\ sys/time.h\ unistd.h\ utime.h\ ) # POSIX.5c headers are separated, because we want to do # some special processing to try to substitute for missing standard # header files. # Checks for xti.h and tli.h are built-in, as is check for whether we # need addrinfo.h. # We always call this after AC_POSIX_HEADERS, so that pconfig.h will # already have the other required POSIX headers in it, and in particular # will have any lines inherited from pconfig.h.in. AC_POSIX5C_HEADERS( netdb.h\ netinet/in.h\ netinet/in_systm.h\ netinet/ip.h\ netinet/tcp.h\ arpa/inet.h\ poll.h\ sys/select.h\ sys/socket.h\ sys/uio.h\ sys/un.h\ ) if test "x$use_pthread" = "xyes" ; then AC_CHECK_LIB(pthread, pthread_self,, [AC_CHECK_LIB(pthread, __pthread_self,, [AC_CHECK_LIB(pthreads, pthread_self,, [AC_CHECK_LIB(cma, pthread_self,, [AC_CHECK_LIB(:libcma.a, pthread_self,, [AC_CHECK_LIB(thread, pthread_self,, [AC_CHECK_LIB(c_r, pthread_self)])])])])])]) fi AC_SEARCH_LIBS(aio_read, aio) AC_SEARCH_LIBS(shm_open, rt) AC_SEARCH_LIBS(clock_gettime, [posix4 rt]) AC_SEARCH_LIBS(gethostbyname, nsl) AC_SEARCH_LIBS(t_bind, [nsl nsl_s]) AC_SEARCH_LIBS(accept, socket) AC_SEARCH_LIBS(h_errno, resolv) echo "Using LIBS=${LIBS}" AC_SUBST(LIBS) AC_POSIX_VAR(t_errno) AC_POSIX_VAR(t_nerr) AC_POSIX_COMP(msghdr, msg_control) AC_POSIX_COMP(msghdr, msg_controllen) AC_POSIX_COMP(msghdr, msg_flags) AC_POSIX_COMP(sigevent, sigev_notify_function) AC_POSIX_COMP_OVERLAY(sigaction, sa_sigaction, sa_handler) AC_POSIX_STRUCTS(\ addrinfo\ aiocb\ cmsghdr\ dirent\ flock\ group\ hostent\ iovec\ in_addr\ ip_opts\ linger\ msghdr\ mq_attr\ netbuf\ netent\ passwd\ pollfd\ protoent\ tm\ tms\ sched_param\ servent\ sigaction\ cma_sigaction\ sigevent\ sockaddr\ sockaddr_in\ sockaddr_un\ stat\ termios\ timespec\ timeval\ t_bind\ t_call\ t_discon\ t_info\ t_iovec\ t_kpalive\ t_linger\ t_opthdr\ t_optmgmt\ t_uderr\ t_unitdata\ itimerspec\ utimbuf\ utsname\ ) AC_POSIX_TYPES(\ blkcnt_t\ blksize_t\ cc_t\ clockid_t\ clock_t\ dev_t\ fd_set\ ino_t\ in_addr_t\ in_port_t\ mqd_t\ nlink_t\ pthread_attr_t\ pthread_condattr_t\ pthread_cond_t\ pthread_key_t\ pthread_mutexattr_t\ pthread_mutex_t\ pthread_once_t\ pthread_t\ sa_family_t\ sem_t\ siginfo_t\ sigset_t\ sigval\ socklen_t\ speed_t\ suseconds_t\ tcflag_t\ timer_t\ ) AC_POSIX_FUNCS(\ accept\ access\ aio_cancel\ aio_error\ aio_fsync\ aio_read\ aio_return\ aio_suspend\ aio_write\ bind\ cfgetispeed\ cfgetospeed\ cfsetispeed\ cfsetospeed\ chdir\ chmod\ chown\ clock_getres\ clock_gettime\ clock_settime\ close\ closedir\ connect\ ctermid\ ctime\ ctime_r\ dup\ dup2\ endhostent\ endnetent\ endprotoent\ endservent\ execl\ execle\ execlp\ execv\ execve\ execvp\ fchmod\ fcntl\ fdatasync\ fork\ fpathconf\ fstat\ fsync\ ftruncate\ getaddrinfo\ getcwd\ getegid\ getenv\ geteuid\ getgid\ getgrgid\ getgrgid_r\ getgrnam\ getgrnam_r\ getgroups\ gethostbyaddr\ gethostbyaddr_r\ gethostbyname\ gethostbyname_r\ gethostname\ getlogin\ getlogin_r\ getpeername\ getpgrp\ getpid\ getppid\ getnetbyaddr\ getnetbyaddr_r\ getnetbyname\ getnetbyname_r\ getprotobyname\ getprotobyname_r\ getprotobynumber\ getprotobynumber_r\ getservbyname\ getservbyname_r\ getpwnam\ getpwnam_r\ getpwuid\ getpwuid_r\ getservbyport\ getservbyport_r\ getsockname\ getsockname_r\ getsockopt\ gettimeofday\ getuid\ gmtime_r\ inet_addr\ inet_lnaof\ inet_makeaddr\ inet_network\ inet_ntoa\ inet_netof\ isatty\ isfdtype\ kill\ link\ lio_listio\ listen\ lseek\ lstat\ mkdir\ mkfifo\ mlock\ mlockall\ mmap\ mprotect\ mq_close\ mq_getattr\ mq_notify\ mq_open\ mq_receive\ mq_send\ mq_setattr\ mq_unlink\ msync\ munlock\ munlockall\ munmap\ open\ opendir\ pathconf\ pipe\ poll\ pthread_condattr_destroy\ pthread_condattr_getpshared\ pthread_condattr_init\ pthread_condattr_setpshared\ pthread_cond_broadcast\ pthread_cond_destroy\ pthread_cond_init\ pthread_cond_signal\ pthread_cond_timedwait\ pthread_cond_wait\ pthread_mutexattr_destroy\ pthread_mutexattr_getprioceiling\ pthread_mutexattr_getprotocol\ pthread_mutexattr_getpshared\ pthread_mutexattr_init\ pthread_mutexattr_setprioceiling\ pthread_mutexattr_setprotocol\ pthread_mutexattr_setpshared\ pthread_mutex_destroy\ pthread_mutex_getprioceiling\ pthread_mutex_init\ pthread_mutex_lock\ pthread_mutex_setprioceiling\ pthread_mutex_trylock\ pthread_mutex_unlock\ pthread_sigmask\ putenv\ rcvmsg\ read\ readdir\ readdir_r\ recv\ recvfrom\ recvmsg\ rename\ rand_r\ rmdir\ sched_getparam\ sched_getscheduler\ sched_get_priority_max\ sched_get_priority_min\ sched_rr_get_interval\ sched_setparam\ sched_setscheduler\ sched_yield\ select\ sem_close\ sem_destroy\ sem_getvalue\ sem_init\ sem_open\ sem_post\ sem_trywait\ sem_unlink\ sem_wait\ send\ sendto\ sendmsg\ setgid\ setenv\ sethostent\ setnetent\ setpgid\ setprotoent\ setservent\ setsid\ setsockopt\ setuid\ shm_open\ shm_unlink\ shutdown\ sigaction\ sigaddset\ sigdelset\ sigemptyset\ sigfillset\ sigismember\ siglongjmp\ sigpending\ sigprocmask\ sigqueue\ sigsetjmp\ sigsuspend\ sigtimedwait\ sigwait\ sigwaitinfo\ socket\ sockatmark\ socketpair\ stat\ strtok_r\ sysconf\ tcdrain\ tcflow\ tcflush\ tcgetattr\ tcgetpgrp\ tcsendbreak\ tcsetattr\ tcsetpgrp\ time\ timer_create\ timer_delete\ timer_getoverrun\ timer_gettime\ timer_settime\ times\ ttyname\ ttyname_r\ t_accept\ t_alloc\ t_bind\ t_blocking\ t_close\ t_connect\ t_error\ t_free\ t_getinfo\ t_getprotaddr\ t_getstate\ t_listen\ t_look\ t_nonblocking\ t_open\ t_optmgmt\ t_rcv\ t_rcvconnect\ t_rcvdis\ t_rcvrel\ t_rcvudata\ t_snd\ t_snddis\ t_sndudata\ t_strerror\ t_sync\ t_unbind\ t_rcvreldata\ t_rcvuderr\ t_rcvv\ t_rcvvudata\ t_sndreldata\ t_sndrel\ t_sndv\ t_sndvudata\ strerror\ strerror_r\ perror\ umask\ uname\ unlink\ unsetenv\ utime\ waitpid\ write\ __posix_sigwait\ __posix_ctime_r\ __posix_readdir_r\ __posix_sigwait_r\ __posix_ttyname_r\ ) AC_CONFIG_FILES([Makefile]) AC_CONFIG_COMMANDS([default],[test -z "$CONFIG_HEADERS" || date > stamp-h],[]) AC_OUTPUT libflorist-2025.1.0/configure.in000066400000000000000000000232031473553204100164270ustar00rootroot00000000000000# Configure template for Florist # Process this file with autoconf to produce a configure script. # When adding new names (header-files, types, functions, etc.) # to this file, don't forget to also add the corresponding line # for HAVE_... to config.h.in. define([AC_CACHE_LOAD], )dnl define([AC_CACHE_SAVE], )dnl AC_INIT(libsrc/posix.adb) [echo See file "configure.log" for results of this step.] # specifies some well-known file in the configured directory AC_CONFIG_HEADER(confsrc/config.h) AC_PROG_CC rm -f pconfig.h AC_ARG_ENABLE(threads, AS_HELP_STRING([--disable-threads], [Do not try to build pthread support]),, [use_pthread=yes]) if test "x$use_pthread" = "xyes" ; then DEPS=deps SIGNALS_GENERATED=posix-implementation-ok_signals.ads THREADS_BOOL=True else AC_MSG_WARN(No pthread support.) DEPS=deps_no_thread SIGNALS_GENERATED= THREADS_BOOL=False fi THREADS_OPTION=-XTHREADS=${THREADS_BOOL} AC_SUBST(SIGNALS_GENERATED) AC_SUBST(THREADS_OPTION) AC_SUBST(DEPS) AC_MSG_CHECKING([whether to build a shared library]) AC_ARG_ENABLE(shared, AS_HELP_STRING([--enable-shared], [Enable build of shared libraries]), [ AC_MSG_RESULT($enableval) if test "$enableval" = "yes"; then ENABLE_SHARED="yes" fi ], [AC_MSG_RESULT(no)]) AC_SUBST(ENABLE_SHARED) AC_MSG_CHECKING([build type]) AC_ARG_WITH(build-type, AS_HELP_STRING([--with-build-type=X], [Set build type (Production/Debug)]), [ case "x$with_build_type" in xyes|xno) AC_ERROR([invalid build type]) ;; *) AC_MSG_RESULT($with_build_type) BUILD_TYPE_OPTION="-XBuild=$with_build_type" ;; esac ], [AC_MSG_RESULT(default)]) AC_SUBST(BUILD_TYPE_OPTION) AC_MSG_CHECKING([RTS kind]) AC_ARG_WITH(rts, AS_HELP_STRING([--with-rts=X], [Set RTS]), [ case "x$with_rts" in xyes|xno) AC_ERROR([invalid RTS]) ;; *) AC_MSG_RESULT($with_rts) RTS_OPTION="--RTS=$with_rts" ;; esac ], [AC_MSG_RESULT(default)]) AC_SUBST(RTS_OPTION) [ # By default errno is preserved accross exceptions safe_errno=True echo $ac_n "checking for SGI IRIX timers... " $ac_c; if (grep "CLOCK_SGI_FAST" /usr/include/sys/ptimers.h >/dev/null 2>&1); then echo "yes" echo "HAVE_IRIX_Timers := True" >> gnatprep.config; else echo "no" echo "HAVE_IRIX_Timers := False" >> gnatprep.config; fi; UNAME_MACHINE=`(uname -m) 2>/dev/null` UNAME_RELEASE=`(uname -r) 2>/dev/null` UNAME_SYSTEM=`(uname -s) 2>/dev/null` UNAME_VERSION=`(uname -v) 2>/dev/null` echo ${UNAME_SYSTEM} ${UNAME_MACHINE} ${UNAME_RELEASE} ${UNAME_VERSION} echo "Using Configuration for" ${UNAME_SYSTEM} ${UNAME_RELEASE}; cp ./configs/pconfig.Linux ./pconfig.h.in; if test "x$safe_errno" = "xTrue" ; then safe_errno_msg="safe" else safe_errno_msg="not safe" fi echo "We will assume errno is $safe_errno_msg for exception propagation." echo "to override, hand-edit gnatprep.config" echo "HAVE_Safe_Errno := $safe_errno" >> gnatprep.config; ] # defines HAVE_NAME_H for each header "name.h" found # also checks for location of Pthread library # note that the order is rather touchy # for Solaris 2.5.1, utsname.h must precede limits.h # for Solaris 2.5.1, netinet/in.h must preceded arpa/inet.h # for Linux 2.0.x with Provenzano (MIT) threads, # pthread.h must follow sched.h, since # pthread.h redefines symbols in sched.h; # the effect is to detect the problem and drop pthread.h AC_POSIX_HEADERS(\ aio.h\ dirent.h\ errno.h\ fcntl.h\ grp.h\ locale.h\ mqueue.h\ pwd.h\ sched.h\ pthread.h\ semaphore.h\ setjmp.h\ signal.h\ stdio.h\ sys/mman.h\ sys/stat.h\ sys/times.h\ sys/types.h\ sys/utsname.h\ limits.h\ sys/wait.h\ termios.h\ time.h\ sys/time.h\ unistd.h\ utime.h\ ) # POSIX.5c headers are separated, because we want to do # some special processing to try to substitute for missing standard # header files. # Checks for xti.h and tli.h are built-in, as is check for whether we # need addrinfo.h. # We always call this after AC_POSIX_HEADERS, so that pconfig.h will # already have the other required POSIX headers in it, and in particular # will have any lines inherited from pconfig.h.in. AC_POSIX5C_HEADERS( netdb.h\ netinet/in.h\ netinet/in_systm.h\ netinet/ip.h\ netinet/tcp.h\ arpa/inet.h\ poll.h\ sys/select.h\ sys/socket.h\ sys/uio.h\ sys/un.h\ ) if test "x$use_pthread" = "xyes" ; then AC_CHECK_LIB(pthread, pthread_self,, [AC_CHECK_LIB(pthread, __pthread_self,, [AC_CHECK_LIB(pthreads, pthread_self,, [AC_CHECK_LIB(cma, pthread_self,, [AC_CHECK_LIB(:libcma.a, pthread_self,, [AC_CHECK_LIB(thread, pthread_self,, [AC_CHECK_LIB(c_r, pthread_self)])])])])])]) fi AC_CHECK_LIB(aio, aio_read) AC_CHECK_LIB(posix4, clock_gettime,, AC_CHECK_LIB(rt, clock_gettime)) AC_CHECK_LIB(nsl, gethostbyname) AC_CHECK_LIB(nsl, t_bind,, AC_CHECK_LIB(nsl_s, t_bind)) AC_CHECK_LIB(socket, accept) AC_CHECK_LIB(resolv, h_errno) echo "Using LIBS=${LIBS}" AC_SUBST(LIBS) AC_POSIX_VAR(t_errno) AC_POSIX_VAR(t_nerr) AC_POSIX_COMP(msghdr, msg_control) AC_POSIX_COMP(msghdr, msg_controllen) AC_POSIX_COMP(msghdr, msg_flags) AC_POSIX_COMP(sigevent, sigev_notify_function) AC_POSIX_COMP_OVERLAY(sigaction, sa_sigaction, sa_handler) AC_POSIX_STRUCTS(\ addrinfo\ aiocb\ cmsghdr\ dirent\ flock\ group\ hostent\ iovec\ in_addr\ ip_opts\ linger\ msghdr\ mq_attr\ netbuf\ netent\ passwd\ pollfd\ protoent\ tm\ tms\ sched_param\ servent\ sigaction\ cma_sigaction\ sigevent\ sockaddr\ sockaddr_in\ sockaddr_un\ stat\ termios\ timespec\ timeval\ t_bind\ t_call\ t_discon\ t_info\ t_iovec\ t_kpalive\ t_linger\ t_opthdr\ t_optmgmt\ t_uderr\ t_unitdata\ itimerspec\ utimbuf\ utsname\ ) AC_POSIX_TYPES(\ blkcnt_t\ blksize_t\ cc_t\ clockid_t\ clock_t\ dev_t\ fd_set\ ino_t\ in_addr_t\ in_port_t\ mqd_t\ nlink_t\ pthread_attr_t\ pthread_condattr_t\ pthread_cond_t\ pthread_key_t\ pthread_mutexattr_t\ pthread_mutex_t\ pthread_once_t\ pthread_t\ sa_family_t\ sem_t\ siginfo_t\ sigset_t\ sigval\ socklen_t \ speed_t\ suseconds_t\ tcflag_t\ timer_t\ ) AC_POSIX_FUNCS(\ accept\ access\ aio_cancel\ aio_error\ aio_fsync\ aio_read\ aio_return\ aio_suspend\ aio_write\ bind\ cfgetispeed\ cfgetospeed\ cfsetispeed\ cfsetospeed\ chdir\ chmod\ chown\ clock_getres\ clock_gettime\ clock_settime\ close\ closedir\ connect\ ctermid\ ctime\ ctime_r\ dup\ dup2\ endhostent\ endnetent\ endprotoent\ endservent\ execl\ execle\ execlp\ execv\ execve\ execvp\ fchmod\ fcntl\ fdatasync\ fork\ fpathconf\ fstat\ fsync\ ftruncate\ getaddrinfo\ getcwd\ getegid\ getenv\ geteuid\ getgid\ getgrgid\ getgrgid_r\ getgrnam\ getgrnam_r\ getgroups\ gethostbyaddr\ gethostbyaddr_r\ gethostbyname\ gethostbyname_r\ gethostname\ getlogin\ getlogin_r\ getpeername\ getpgrp\ getpid\ getppid\ getnetbyaddr\ getnetbyaddr_r\ getnetbyname\ getnetbyname_r\ getprotobyname\ getprotobyname_r\ getprotobynumber\ getprotobynumber_r\ getservbyname\ getservbyname_r\ getpwnam\ getpwnam_r\ getpwuid\ getpwuid_r\ getservbyport\ getservbyport_r\ getsockname\ getsockname_r\ getsockopt\ gettimeofday\ getuid\ gmtime_r\ inet_addr\ inet_lnaof\ inet_makeaddr\ inet_network\ inet_ntoa\ inet_netof\ isatty\ isfdtype\ kill\ link\ lio_listio\ listen\ lseek\ lstat\ mkdir\ mkfifo\ mlock\ mlockall\ mmap\ mprotect\ mq_close\ mq_getattr\ mq_notify\ mq_open\ mq_receive\ mq_send\ mq_setattr\ mq_unlink\ msync\ munlock\ munlockall\ munmap\ open\ opendir\ pathconf\ pipe\ poll\ pthread_condattr_destroy\ pthread_condattr_getpshared\ pthread_condattr_init\ pthread_condattr_setpshared\ pthread_cond_broadcast\ pthread_cond_destroy\ pthread_cond_init\ pthread_cond_signal\ pthread_cond_timedwait\ pthread_cond_wait\ pthread_mutexattr_destroy\ pthread_mutexattr_getprioceiling\ pthread_mutexattr_getprotocol\ pthread_mutexattr_getpshared\ pthread_mutexattr_init\ pthread_mutexattr_setprioceiling\ pthread_mutexattr_setprotocol\ pthread_mutexattr_setpshared\ pthread_mutex_destroy\ pthread_mutex_getprioceiling\ pthread_mutex_init\ pthread_mutex_lock\ pthread_mutex_setprioceiling\ pthread_mutex_trylock\ pthread_mutex_unlock\ pthread_sigmask\ putenv\ rcvmsg\ read\ readdir\ readdir_r\ recv\ recvfrom\ recvmsg\ rename\ rand_r\ rmdir\ sched_getparam\ sched_getscheduler\ sched_get_priority_max\ sched_get_priority_min\ sched_rr_get_interval\ sched_setparam\ sched_setscheduler\ sched_yield\ select\ sem_close\ sem_destroy\ sem_getvalue\ sem_init\ sem_open\ sem_post\ sem_trywait\ sem_unlink\ sem_wait\ send\ sendto\ sendmsg\ setgid\ setenv\ sethostent\ setnetent\ setpgid\ setprotoent\ setservent\ setsid\ setsockopt\ setuid\ shm_open\ shm_unlink\ shutdown\ sigaction\ sigaddset\ sigdelset\ sigemptyset\ sigfillset\ sigismember\ siglongjmp\ sigpending\ sigprocmask\ sigqueue\ sigsetjmp\ sigsuspend\ sigtimedwait\ sigwait\ sigwaitinfo\ socket\ sockatmark\ socketpair\ stat\ strtok_r\ sysconf\ tcdrain\ tcflow\ tcflush\ tcgetattr\ tcgetpgrp\ tcsendbreak\ tcsetattr\ tcsetpgrp\ time\ timer_create\ timer_delete\ timer_getoverrun\ timer_gettime\ timer_settime\ times\ ttyname\ ttyname_r\ t_accept\ t_alloc\ t_bind\ t_blocking\ t_close\ t_connect\ t_error\ t_free\ t_getinfo\ t_getprotaddr\ t_getstate\ t_listen\ t_look\ t_nonblocking\ t_open\ t_optmgmt\ t_rcv\ t_rcvconnect\ t_rcvdis\ t_rcvrel\ t_rcvudata\ t_snd\ t_snddis\ t_sndudata\ t_strerror\ t_sync\ t_unbind\ t_rcvreldata\ t_rcvuderr\ t_rcvv\ t_rcvvudata\ t_sndreldata\ t_sndrel\ t_sndv\ t_sndvudata\ strerror\ strerror_r\ perror\ umask\ uname\ unlink\ unsetenv\ utime\ waitpid\ write\ __posix_sigwait\ __posix_ctime_r\ __posix_readdir_r\ __posix_sigwait_r\ __posix_ttyname_r\ ) AC_OUTPUT(Makefile, [test -z "$CONFIG_HEADERS" || date > stamp-h]) libflorist-2025.1.0/confsrc/000077500000000000000000000000001473553204100155535ustar00rootroot00000000000000libflorist-2025.1.0/confsrc/config.h.in000066400000000000000000000231161473553204100176010ustar00rootroot00000000000000/* When adding new names (header-files, types, functions, etc.) to this file, don't forget to also add the corresponding names to configure.in. There are some non-POSIX names here, that we have learned by experience are defined on certain systems and may be used in place of the proper POSIX names. In particular, the names of the form __posix_XXX are not real POSIX names, but rather are stand-ins for the proper POSIX function XXX, specific to Solaris 2.6. I apologize for this ugly hack. Suggestions for a cleaner workaround would be welcome (see related comment on SOLARIS in the file README). */ /* header files */ #undef HAVE_DIRENT_H /* functions */ #undef HAVE_accept #undef HAVE_access #undef HAVE_aio_cancel #undef HAVE_aio_error #undef HAVE_aio_fsync #undef HAVE_aio_read #undef HAVE_aio_return #undef HAVE_aio_suspend #undef HAVE_aio_write #undef HAVE_bind #undef HAVE_cfgetispeed #undef HAVE_cfgetospeed #undef HAVE_cfsetispeed #undef HAVE_cfsetospeed #undef HAVE_chdir #undef HAVE_chmod #undef HAVE_chown #undef HAVE_clock_getres #undef HAVE_clock_gettime #undef HAVE_clock_settime #undef HAVE_close #undef HAVE_closedir #undef HAVE_connect #undef HAVE_ctermid #undef HAVE_ctime #undef HAVE_ctime_r #undef HAVE_dup #undef HAVE_dup2 /* not referenced: 1 */ #undef HAVE_endhostent #undef HAVE_endnetent #undef HAVE_endprotoent /* not referenced: 1 */ #undef HAVE_endservent #undef HAVE_execl #undef HAVE_execle #undef HAVE_execlp #undef HAVE_execv #undef HAVE_execve #undef HAVE_execvp #undef HAVE_fchmod #undef HAVE_fcntl #undef HAVE_fdatasync #undef HAVE_fork #undef HAVE_fpathconf #undef HAVE_fstat #undef HAVE_fsync #undef HAVE_ftruncate #undef HAVE_getaddrinfo #undef HAVE_getcwd #undef HAVE_getegid #undef HAVE_getenv #undef HAVE_geteuid #undef HAVE_getgid /* not referenced: 2 */ #undef HAVE_getgrgid #undef HAVE_getgrgid_r /* not referenced: 2 */ #undef HAVE_getgrnam #undef HAVE_getgrnam_r #undef HAVE_getgroups /* not referenced: 5 */ #undef HAVE_gethostbyaddr #undef HAVE_gethostbyaddr_r #undef HAVE_gethostbyname #undef HAVE_gethostbyname_r #undef HAVE_gethostname #undef HAVE_getlogin #undef HAVE_getlogin_r #undef HAVE_getnetbyaddr_r #undef HAVE_getnetbyname_r /* not referenced: 2 */ #undef HAVE_getnetbyaddr #undef HAVE_getnetbyname #undef HAVE_getpeername #undef HAVE_getpgrp #undef HAVE_getpid #undef HAVE_getppid #undef HAVE_getprotobyname_r #undef HAVE_getprotobynumber_r /* not referenced: 2 */ #undef HAVE_getprotobyname #undef HAVE_getprotobynumber #undef HAVE_getpwnam #undef HAVE_getpwnam_r #undef HAVE_getpwuid /* unreferenced: 4 */ #undef HAVE_getservbyname #undef HAVE_getservbyname_r #undef HAVE_getservbyport #undef HAVE_getservbyport_r #undef HAVE_getsockname #undef HAVE_getsockopt #undef HAVE_gettimeofday #undef HAVE_getuid /* unreferenced: 1 */ #undef HAVE_gmtime_r /* not referenced: 5 */ #undef HAVE_inet_addr #undef HAVE_inet_lnaof #undef HAVE_inet_makeaddr #undef HAVE_inet_netof #undef HAVE_inet_network #undef HAVE_inet_ntoa #undef HAVE_isatty /* not referenced: 1 */ #undef HAVE_isfdtype #undef HAVE_kill #undef HAVE_link #undef HAVE_lio_listio #undef HAVE_listen #undef HAVE_lseek #undef HAVE_lstat #undef HAVE_mkdir #undef HAVE_mkfifo #undef HAVE_mlock #undef HAVE_mlockall #undef HAVE_mmap #undef HAVE_mprotect #undef HAVE_mq_close #undef HAVE_mq_getattr #undef HAVE_mq_notify #undef HAVE_mq_open #undef HAVE_mq_receive #undef HAVE_mq_send #undef HAVE_mq_setattr #undef HAVE_mq_unlink #undef HAVE_msync #undef HAVE_munlock #undef HAVE_munlockall #undef HAVE_munmap #undef HAVE_open #undef HAVE_opendir #undef HAVE_pathconf #undef HAVE_pipe #undef HAVE_poll #undef HAVE_pthread_cond_broadcast #undef HAVE_pthread_cond_destroy #undef HAVE_pthread_cond_init #undef HAVE_pthread_cond_signal #undef HAVE_pthread_cond_timedwait #undef HAVE_pthread_cond_wait #undef HAVE_pthread_condattr_destroy #undef HAVE_pthread_condattr_getpshared #undef HAVE_pthread_condattr_init #undef HAVE_pthread_condattr_setpshared #undef HAVE_pthread_mutex_destroy #undef HAVE_pthread_mutex_getprioceiling #undef HAVE_pthread_mutex_init #undef HAVE_pthread_mutex_lock #undef HAVE_pthread_mutex_setprioceiling #undef HAVE_pthread_mutex_trylock #undef HAVE_pthread_mutex_unlock #undef HAVE_pthread_mutexattr_destroy #undef HAVE_pthread_mutexattr_getprioceiling #undef HAVE_pthread_mutexattr_getprotocol #undef HAVE_pthread_mutexattr_getpshared #undef HAVE_pthread_mutexattr_init #undef HAVE_pthread_mutexattr_setprioceiling #undef HAVE_pthread_mutexattr_setprotocol #undef HAVE_pthread_mutexattr_setpshared #undef HAVE_pthread_sigmask #undef HAVE_putenv #undef HAVE_read #undef HAVE_readdir /* not referenced: 1 */ #undef HAVE_readdir_r #undef HAVE_recv #undef HAVE_recvfrom #undef HAVE_recvmsg #undef HAVE_rename #undef HAVE_rmdir #undef HAVE_sched_get_priority_max #undef HAVE_sched_get_priority_min #undef HAVE_sched_getparam #undef HAVE_sched_getscheduler #undef HAVE_sched_rr_get_interval #undef HAVE_sched_setparam #undef HAVE_sched_setscheduler #undef HAVE_sched_yield #undef HAVE_select #undef HAVE_sem_close #undef HAVE_sem_destroy #undef HAVE_sem_getvalue #undef HAVE_sem_init #undef HAVE_sem_open #undef HAVE_sem_post #undef HAVE_sem_trywait #undef HAVE_sem_unlink #undef HAVE_sem_wait #undef HAVE_send #undef HAVE_sendmsg #undef HAVE_sendto #undef HAVE_setenv #undef HAVE_setgid /* not referenced: 1 */ #undef HAVE_sethostent #undef HAVE_setnetent #undef HAVE_setpgid #undef HAVE_setprotoent /* not referenced: 1 */ #undef HAVE_setservent #undef HAVE_setsid #undef HAVE_setsockopt #undef HAVE_setuid #undef HAVE_shm_open #undef HAVE_shm_unlink #undef HAVE_shutdown #undef HAVE_sigaction #undef HAVE_sigaddset #undef HAVE_sigdelset #undef HAVE_sigemptyset #undef HAVE_sigfillset #undef HAVE_sigismember #undef HAVE_sigpending #undef HAVE_sigprocmask #undef HAVE_sigqueue #undef HAVE_sigtimedwait #undef HAVE_sigwait #undef HAVE_sigwaitinfo #undef HAVE_sockatmark #undef HAVE_socket #undef HAVE_socketpair #undef HAVE_stat #undef HAVE_sysconf #undef HAVE_t_accept /* not referenced: 1 */ #undef HAVE_t_alloc #undef HAVE_t_bind /* not referenced: 1 */ #undef HAVE_t_blocking #undef HAVE_t_close #undef HAVE_t_connect #undef HAVE_t_error #undef HAVE_t_free #undef HAVE_t_getinfo #undef HAVE_t_getprotaddr #undef HAVE_t_getstate #undef HAVE_t_listen #undef HAVE_t_look /* not referenced: 1 */ #undef HAVE_t_nonblocking #undef HAVE_t_open #undef HAVE_t_optmgmt #undef HAVE_t_rcv #undef HAVE_t_rcvconnect #undef HAVE_t_rcvdis #undef HAVE_t_rcvrel #undef HAVE_t_rcvreldata #undef HAVE_t_rcvudata #undef HAVE_t_rcvuderr #undef HAVE_t_rcvv #undef HAVE_t_rcvvudata #undef HAVE_t_snd #undef HAVE_t_snddis #undef HAVE_t_sndrel #undef HAVE_t_sndreldata #undef HAVE_t_sndudata #undef HAVE_t_sndv #undef HAVE_t_sndvudata #undef HAVE_t_strerror #undef HAVE_t_sync #undef HAVE_t_unbind #undef HAVE_strerror #undef HAVE_strerror_r #undef HAVE_perror #undef HAVE_tcdrain #undef HAVE_tcflow #undef HAVE_tcflush #undef HAVE_tcgetattr #undef HAVE_tcgetpgrp #undef HAVE_tcsendbreak #undef HAVE_tcsetattr #undef HAVE_tcsetpgrp #undef HAVE_time #undef HAVE_timer_create #undef HAVE_timer_delete #undef HAVE_timer_getoverrun #undef HAVE_timer_gettime #undef HAVE_timer_settime #undef HAVE_times #undef HAVE_ttyname /* not referenced: 1 */ #undef HAVE_ttyname_r #undef HAVE_umask #undef HAVE_uname #undef HAVE_unlink #undef HAVE_unsetenv #undef HAVE_utime #undef HAVE_waitpid #undef HAVE_write /* SOLARIS hacks */ #undef HAVE___posix_ctime_r #undef HAVE___posix_readdir_r #undef HAVE___posix_sigwait #undef HAVE___posix_ttyname_r /* types */ #undef HAVE_cc_t #undef HAVE_clockid_t #undef HAVE_clock_t #undef HAVE_dev_t #undef HAVE_fd_set #undef HAVE_in_addr_t #undef HAVE_in_port_t #undef HAVE_inet_netof #undef HAVE_ino_t #undef HAVE_mqd_t #undef HAVE_nlink_t #undef HAVE_pthread_attr_t #undef HAVE_pthread_cond_t #undef HAVE_pthread_condattr_t #undef HAVE_pthread_key_t #undef HAVE_pthread_mutex_t #undef HAVE_pthread_mutexattr_t #undef HAVE_pthread_once_t #undef HAVE_pthread_t #undef HAVE_sa_family_t #undef HAVE_sem_t #undef HAVE_siginfo_t #undef HAVE_sigset_t #undef HAVE_sigval #undef HAVE_socklen_t #undef HAVE_speed_t #undef HAVE_suseconds_t #undef HAVE_tcflag_t #undef HAVE_timer_t /* error return macros or variables */ #undef HAVE_t_errno #undef HAVE_t_nerr /* struct types */ #undef HAVE_struct_addrinfo #undef HAVE_struct_aiocb #undef HAVE_struct_cmsghdr #undef HAVE_struct_dirent #undef HAVE_struct_flock #undef HAVE_struct_group #undef HAVE_struct_hostent #undef HAVE_struct_itimerspec #undef HAVE_struct_in_addr #undef HAVE_struct_ip_opts #undef HAVE_struct_iovec #undef HAVE_struct_linger #undef HAVE_struct_msghdr #undef HAVE_struct_mq_attr #undef HAVE_struct_netbuf #undef HAVE_struct_netent #undef HAVE_struct_passwd #undef HAVE_struct_pollfd #undef HAVE_struct_protoent #undef HAVE_struct_sched_param #undef HAVE_struct_servent #undef HAVE_struct_sigaction #undef HAVE_struct_cma_sigaction #undef HAVE_struct_sigevent #undef HAVE_struct_sockaddr #undef HAVE_struct_sockaddr_in #undef HAVE_struct_sockaddr_un #undef HAVE_struct_stat #undef HAVE_struct_termios #undef HAVE_struct_timespec #undef HAVE_struct_timeval #undef HAVE_struct_tm #undef HAVE_struct_tms #undef HAVE_struct_t_bind #undef HAVE_struct_t_call #undef HAVE_struct_t_discon #undef HAVE_struct_t_info #undef HAVE_struct_t_iovec #undef HAVE_struct_t_kpalive #undef HAVE_struct_t_linger #undef HAVE_struct_t_opthdr #undef HAVE_struct_t_optmgmt #undef HAVE_struct_t_uderr #undef HAVE_struct_t_unitdata #undef HAVE_struct_utimbuf #undef HAVE_struct_utsname #undef HAVE_component_sa_sigaction #undef HAVE_component_sigev_notify_function #undef HAVE_component_msg_control #undef HAVE_component_msg_controllen #undef HAVE_component_msg_flags libflorist-2025.1.0/florist.gpr000066400000000000000000000031621473553204100163140ustar00rootroot00000000000000library project Florist is for Library_Name use "florist"; for Languages use ("C", "Ada"); type Boolean is ("False", "True"); Threads : Boolean := external ("THREADS", "True"); Common_Source_Dirs := ("libsrc", "gensrc", "confsrc"); Threads_Source_Dirs := ("libsrc/threads", "gensrc/threads"); case Threads is when "False" => for Source_Dirs use Common_Source_Dirs; when "True" => for Source_Dirs use Common_Source_Dirs & Threads_Source_Dirs; end case; for Object_Dir use "obj"; for Library_Dir use "lib"; Version := "1"; for Library_version use "libflorist.so." & Version; type Library_Type_Type is ("relocatable", "static"); Library_Type : Library_Type_Type := external ("LIBRARY_TYPE", "static"); for Library_Kind use Library_Type; type Build_Type is ("Debug", "Production"); Build : Build_Type := External ("Build", "Production"); package Compiler is Ada_Flags := ("-O2", "-gnatp", "-gnat95"); GNAT_Flags := Ada_Flags & ("-gnatg"); case Build is when "Production" => -- Use above defaults when "Debug" => Ada_Flags := ("-g", "-O2", "-gnatwae", "-gnatyg", "-gnatw.Z"); GNAT_Flags := ("-g", "-O2", "-gnatpg"); end case; for Switches ("posix-signals.adb") use GNAT_Flags; for Switches ("posix-implementation.adb") use GNAT_Flags; for Switches ("posix-supplement_to_ada_io.adb") use GNAT_Flags; for Switches ("posix-unsafe_process_primitives.adb") use GNAT_Flags; for Default_Switches ("Ada") use Ada_Flags; end Compiler; end Florist; libflorist-2025.1.0/gnatsocks/000077500000000000000000000000001473553204100161125ustar00rootroot00000000000000libflorist-2025.1.0/gnatsocks/Makefile000066400000000000000000000014641473553204100175570ustar00rootroot00000000000000# makefile for Gnatsocks tests # LIBS = -lsocket -lnsl -largs FLORISTDIR = /part9/baker/florist-3.10p GNATMAKEFLAGS1 = -g -A$(FLORISTDIR)/floristlib -aO$(FLORISTDIR)/floristlib GNATMAKEFLAGS2 = -cargs -gnatg -largs $(LIBS) -lflorist TESTS = test_sockets sockettest echoserver multiecho multidb test_unix_sockets SOURCES = sockettest.adb sockets-internet.ads sockets-internet.adb\ sockets.ads sockets.adb sockets-unix.ads sockets-unix.adb\ echoserver.adb \ test_sockets.adb multiecho.adb test_pkg.ads test_pkg.adb\ table.adb table.ads multidb.adb\ test_unix_sockets.adb\ Makefile READ.ME all : $(TESTS) $(TESTS): %: %.adb \ $(FLORISTDIR)/floristlib/libflorist.a test_parameters.ads test_parameters.adb gnatmake $(GNATMAKEFLAGS1) $@ $(GNATMAKEFLAGS2) clean: -rm -f *~ *# *.o *.ali b_*.c $(TESTS) libflorist-2025.1.0/gnatsocks/READ.ME000066400000000000000000000035531473553204100170560ustar00rootroot00000000000000GNATSOCKS This directory contains the code of GNATSOCKS, a simple object-oriented Ada interface for doing socket I/O. This is a personal project of mine, which I wrote originally for use by the students in my "Software Engineering with Ada" course, so that they could see how Ada 95 tagged types and imported subprograms work, and so that they would not have to waste time fiddling with the details of the UNIX C-language socket interfaces. The interfaces were inspired by the Java socket I/O classes. I'm making this code available to the general public in hope that it may be of some use, but anyone who uses it should beware that I do not consider it complete, nor have I tested it beyond the few simple test programs that are in this directory. The original Gnatsocks used hand-coded interfaces to the C-language socket I/O interfaces of the Solaris 2.6 operating system. The present version has been recoded in the form of an add-on to Florist (the FSU implementation of the POSIX Ada bindings). However, Gnatsocks does not depend on all of Florist -- just on the configuration mechanism and the a few packages (POSIX, POSIX.C, POSIX.C.Sockets). --Ted Baker (12 May 1998) READ.ME this file Makefile type "make" to compile everything sockets.ads socket ADT sockets.adb implementation sockets-internet.ads extension for internet sockets sockets-internet.adb implementation sockets-unix.ads extension for UNIX sockets sockets-unix.adb implementation sockettest.adb test program, reads one line from port 12 echoserver.adb test program, echos input from port 8189 test_socketsadb test program, calls and checks various interfaces os_interface.ads low-level interface to Solaris socket libraries os_interface.adb implementation errno_c.c low-level interface to C errno values Comments, suggestions, and bug-fixes are welcome. --Ted Baker (16 March 1997) libflorist-2025.1.0/gnatsocks/bug.adb000066400000000000000000000051211473553204100173360ustar00rootroot00000000000000----------------------------------------------------------------- -- file: bug.adb [$Revision$] ----------------------------------------------------------------- -- Demonstrates incorrect implementation of record assignment. -- The bug appears at least in GNAT 3.10p, -- and the version of 3.11w we are using here (FSU). -- This problem seems to depend on: -- the alignment clause -- the representation clause -- the aliased component -- On Solaris 2.6 SuperSPARC (Sparcstation 20 HS14) the test -- fails, and prints: -- dad% ERROR: record assignment does not copy C.s_addr correctly. -- Addr.C.s_addr= 1 -- Tmp_Addr.in_addr.sin_addr.s_addr= 0 -- Assignment works OK at leaf component level. -- Tmp_Addr.in_addr.sin_addr.s_addr= 1 -- This bug came up in the Florist POSIX sockets interface. -- --Ted Baker (baker@cs.fsu.edu) with Ada.Text_IO; procedure bug is ALIGNMENT : constant := 8; type int16 is range -2**15 .. 2**15 - 1; type in_addr_t is mod 2**32; type struct_in_addr is record s_addr : in_addr_t; end record; for struct_in_addr'Alignment use ALIGNMENT; type Internet_Address is record C : struct_in_addr; end record; type struct_sockaddr_in is record sin_family : int16; sin_port : int16; sin_addr : struct_in_addr; sin_zero : String (1 .. 8); end record; for struct_sockaddr_in use record sin_family at 0 range 0 .. 15; sin_port at 2 range 0 .. 15; sin_addr at 4 range 0 .. 31; sin_zero at 8 range 0 .. 63; end record; type Internet_Socket_Address is record in_addr : aliased struct_sockaddr_in; end record; Addr : Internet_Address; Tmp_Addr : Internet_Socket_Address; begin Addr.C.s_addr := 1; Tmp_Addr.in_addr.sin_addr := Addr.C; if Tmp_Addr.in_addr.sin_addr.s_addr /= Addr.C.s_addr then Ada.Text_IO.Put_Line ("ERROR: record assignment does not copy C.s_addr correctly."); Ada.Text_IO.Put_Line ("Addr.C.s_addr=" & in_addr_t'Image (Addr.C.s_addr)); Ada.Text_IO.Put_Line ("Tmp_Addr.in_addr.sin_addr.s_addr=" & in_addr_t'Image (Tmp_Addr.in_addr.sin_addr.s_addr)); Tmp_Addr.in_addr.sin_addr.s_addr := Addr.C.s_addr; if Tmp_Addr.in_addr.sin_addr.s_addr = Addr.C.s_addr then Ada.Text_IO.Put_Line ("Assignment works OK at leaf component level."); Ada.Text_IO.Put_Line ("Tmp_Addr.in_addr.sin_addr.s_addr=" & in_addr_t'Image (Tmp_Addr.in_addr.sin_addr.s_addr)); end if; else Ada.Text_IO.Put_Line ("Assignment works OK."); end if; end bug; libflorist-2025.1.0/gnatsocks/echoserver.adb000066400000000000000000000042241473553204100207310ustar00rootroot00000000000000-------------------------------------------------------------------------- -- file : echoserver.adb [$Revision$] -------------------------------------------------------------------------- -- This is a direct translation into GNAT Ada -- of the Java example in file "echoserver.java". -- waits for a client to attach to port 8189, then -- reads input from the client, a line at a time, and echos it. -- To run this program, type "java EchoServer", then put the job in -- the background or switch to another window and type -- "telnet 8189", replacing by the name of -- the host on which you are running the echo-server. -- This will connect you to the server. with ada.characters.latin_1; with ada.exceptions; with ada.text_io; with sockets; with sockets.internet; procedure echoserver is s : sockets.server_socket; connection : sockets.stream_socket; ins : sockets.input_stream_ptr; outs : sockets.output_stream_ptr; peer : sockets.internet.internet_socket_address; lf : constant character := ada.characters.latin_1.lf; -- line-feed cr : constant character := ada.characters.latin_1.cr; -- carriage-return procedure writeln (s : string) is begin string'write (outs, s); character'write (outs, cr); character'write (outs, lf); end writeln; function readln return string is buf : string (1 .. 1024); i : integer := 1; begin loop character'read (ins, buf (i)); exit when buf (i) = lf; i := i + 1; end loop; return buf (1 .. i-2); end readln; begin sockets.open (s, sockets.internet.new_address (8189, "dad.cs.fsu.edu")); sockets.accept_connection (s, connection, peer); ins := sockets.get_input_stream (connection); outs := sockets.get_output_stream (connection); writeln ("Hello! Enter BYE to exit."); loop declare str : string := readln; begin exit when str (1..3) = "BYE"; writeln ("Echo: """ & str & '"'); end; end loop; exception when e : others => ada.text_io.put_line (ada.exceptions.exception_name (e) & ": " & ada.exceptions.exception_message (e)); end echoserver; libflorist-2025.1.0/gnatsocks/gnatsocks.ads000066400000000000000000000171601473553204100206040ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- GNATSOCKS -- -- -- -- S o c k e t s -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of GNATSOCKS, an Ada interfaces to socket I/O -- -- services, for use with the GNAT Ada compiler. -- -- -- -- GNATSOCKS is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package is intended to provide convenient access to socket I/O. -- It still needs design, documentation, and implementation work -- to specify what happens if an error occurs, -- for each of the operations. with Ada.Finalization, Ada.Streams, Ada.Tags, POSIX.C, POSIX.C.Sockets; package Sockets is -------------------------------------- type Socket_Address is abstract tagged private; -------------------------------------- type Socket is abstract tagged limited private; procedure Close (Obj : in out Socket'Class); -- closes the socket function Get_Address (Obj : in Socket'Class) return Socket_Address is abstract; -- gets address of socket -------------------------------------- type Input_Stream is new Ada.Streams.Root_Stream_Type with private; type Input_Stream_Ptr is access all Input_Stream; type Output_Stream is new Ada.Streams.Root_Stream_Type with private; type Output_Stream_Ptr is access all Output_Stream; -------------------------------------- type Stream_Socket is new Socket with private; procedure Open (Sock : in out Stream_Socket; Addr : Socket_Address'Class); -- creates a stream socket and connects it to the specified address function Get_Input_Stream (Obj : Stream_Socket) return Input_Stream_Ptr; function Get_Output_Stream (Obj : Stream_Socket) return Output_Stream_Ptr; -------------------------------------- type Server_Socket is new Socket with private; procedure Open (Sock : in out Server_Socket; Addr : Socket_Address'Class; Count : Natural := 0); -- creates a server socket on the specified port -- with the specified backlog count procedure Accept_Connection (Server : Server_Socket; Stream : in out Stream_Socket'Class; Peer : in out Socket_Address'Class); -- accept connection addressed to Server socket, and -- open Stream socket to handle the connection. -------------------------------------- type Datagram_Socket is new Socket with private; procedure Open (Sock : in out Datagram_Socket; Addr : Socket_Address'Class); -- creates a datagram socket on the specified port -- with the specified local address -- This part is "in progress". We will add support for datagram sockets, -- including send and receive operations. -- Issues to address include whether to use type to distinguish connected -- from non-connected datagram sockets (so as to tell whether to use send/recv -- or sendto/recfrom), and whether to allow bind for sending. -- Note that INADDR_ANY can be used for bind, to let system choose -- the local IP address, for bind private function Address (Obj : Socket_Address) return POSIX.C.Sockets.struct_sockaddr_ptr is abstract; function Length (Obj : Socket_Address) return Interfaces.C.int is abstract; function Valid (Obj : Socket_Address) return Boolean is abstract; function Protocol_Family (Obj : Socket_Address) return Interfaces.C.int is abstract; type Socket_Address is abstract tagged null record; ----------------------------------- type Socket is new Ada.Finalization.Limited_Controlled with record fd : Interfaces.C.int := 0; -- file descriptor of an open socket, of nonzero tag : Ada.Tags.Tag; -- tag of the socket address type used to open the socket, of fd /= 0 -- This is used to check that other operations use only addresses -- that are in the same family. end record; procedure Finalize (Obj : in out Socket); ----------------------------------- type Stream_Socket_Ptr is access all Stream_Socket; type Input_Stream is new Ada.Streams.Root_Stream_Type with record sock : Stream_Socket_Ptr; end record; type Output_Stream is new Ada.Streams.Root_Stream_Type with record sock : Stream_Socket_Ptr; end record; type Stream_Socket is new Socket with record in_stream : aliased Input_Stream; out_stream : aliased Output_Stream; in_ptr : Input_Stream_Ptr; -- points to in_stream out_ptr : Output_Stream_Ptr; -- points to out_stream -- These pointers are needed to implement -- functions Get_InputStream and Get_OutputStream. end record; procedure Read (Stream : in out Input_Stream; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); procedure Write (Stream : in out Input_Stream; Item : in Ada.Streams.Stream_Element_Array); procedure Read (Stream : in out Output_Stream; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); procedure Write (Stream : in out Output_Stream; Item : in Ada.Streams.Stream_Element_Array); ----------------------------------- type Server_Socket is new Socket with null record; ----------------------------------- type Datagram_Socket is new Socket with null record; end Sockets; libflorist-2025.1.0/gnatsocks/multidb.adb000066400000000000000000000140211473553204100202200ustar00rootroot00000000000000-------------------------------------------------------------------------- -- file : multidb.adb [$Revision$] -------------------------------------------------------------------------- -- This is a modification of "multiecho.adb", to implement instead -- a simple database. It illustrates the use of Ada direct I/O. -- The present version has at least one flaw. The socket input '!' -- is supposed to shut down the server, by aborting the main task. -- This is not working correctly, probably due to a bad interaction -- between the "accept" operation and the task abort. I need to look -- into this more, but you should not need this capability for your -- projects. -- Ted Baker with ada.characters.latin_1; with ada.exceptions; with ada.task_identification; with ada.text_io; with ada.direct_io; with sockets; with sockets.internet; with table; procedure multidb is use table; type connection_id is range 1..4; connections : array (connection_id) of sockets.stream_socket; procedure shut_down (e : ada.exceptions.exception_occurrence); main_task : ada.task_identification.task_id := ada.task_identification.current_task; -- used to shut down the entire program task type server_task; servers : array (connections'range) of server_task; lf : constant character := ada.characters.latin_1.lf; -- line-feed cr : constant character := ada.characters.latin_1.cr; -- carriage-return protected server_pool is entry await_turn; procedure next_turn; private turn : boolean := false; end server_pool; protected body server_pool is entry await_turn when turn is begin turn := false; end await_turn; procedure next_turn is begin turn := true; end next_turn; end server_pool; procedure writeln (outs : sockets.output_stream_ptr; s : string) is begin string'write (outs, s); character'write (outs, cr); character'write (outs, lf); end writeln; is_letter : array (character) of boolean := ('a'..'z' | 'A'..'Z' => true, others => false); procedure skipln (ins : sockets.input_stream_ptr) is c : character := ' '; begin while c /= lf loop character'read (ins, c); end loop; end skipln; procedure get_string (ins : sockets.input_stream_ptr; outs : sockets.output_stream_ptr; s : out string) is i : integer := s'first -1; c : character; begin string'write (outs, "enter a string of up to" & integer'image (s'length) & " letters: "); while i < s'last loop character'read (ins, c); exit when not is_letter (c); i := i + 1; s (i) := c; end loop; while i < s'last loop i := i + 1; s (i) := ' '; end loop; skipln (ins); end get_string; peer : sockets.internet.internet_socket_address; s : sockets.server_socket; task db_task is entry store (key : key_string; value : value_string); entry fetch (key : key_string; value : out value_string); end db_task; task body server_task is connection : sockets.stream_socket; ins : sockets.input_stream_ptr; outs : sockets.output_stream_ptr; ch : character; key : key_string; value : value_string; begin loop begin server_pool.await_turn; sockets.accept_connection (s, connection, peer); server_pool.next_turn; ins := sockets.get_input_stream (connection); outs := sockets.get_output_stream (connection); writeln (outs, "Hello!"); loop string'write (outs, "enter +, ?, ., or ! "); character'read (ins, ch); skipln (ins); case ch is when '+' => get_string (ins, outs, key); get_string (ins, outs, value); db_task.store (key, value); writeln (outs, "ok."); when '?' => get_string (ins, outs, key); db_task.fetch (key, value); writeln (outs, "value = " & value & '.'); when '.' => writeln (outs, "bye."); exit; when '!' => writeln (outs, "bye."); sockets.close (connection); sockets.close (s); abort db_task; ada.task_identification.abort_task (main_task); when others => null; end case; end loop; exception when others => null; end; sockets.close(connection); end loop; exception when e : others => shut_down (e); end server_task; task body db_task is begin loop begin select accept store (key : key_string; value : value_string) do set_value (key, value); end store; or accept fetch (key : key_string; value : out value_string) do value := table.value (key); end fetch; or terminate; end select; exception when others => null; end; end loop; end db_task; procedure shut_down (e : ada.exceptions.exception_occurrence) is begin ada.text_io.put_line ("main: " & ada.exceptions.exception_name (e) & ": " & ada.exceptions.exception_message (e)); sockets.close (s); abort db_task; ada.task_identification.abort_task (main_task); end shut_down; begin sockets.open (s, sockets.internet.new_address (sockets.internet.any_port, sockets.internet.all_local_addresses)); ada.text_io.put_line ("serving at: " & sockets.internet.get_addressstring ( sockets.internet.get_internet_address ( sockets.internet.get_address (s))) & " port " & sockets.internet.port_number'image ( sockets.internet.get_port ( sockets.internet.get_address (s)))); server_pool.next_turn; exception when e : others => shut_down (e); end multidb; libflorist-2025.1.0/gnatsocks/multiecho.adb000066400000000000000000000102421473553204100205520ustar00rootroot00000000000000-------------------------------------------------------------------------- -- file : multiecho.adb [$Revision$] -------------------------------------------------------------------------- -- This is a modification of "echoserver.adb", to allow multiple -- connections, using Ada tasks. -- waits for a client to attach to port 8189, then -- reads input from the client, a line at a time, and echos it. -- To run this program, type "java EchoServer", -- then put the job in the background -- or switch to another window, and type -- "telnet ", -- replacing by the name of -- the host on which you are running the echo-server -- and by the port number that the server printed -- out when it started up. -- This will connect you to the server. -- The server should be able to handle up to 4 concurrent connections. -- Use control-C to kill the server. with ada.characters.latin_1; with ada.exceptions; with ada.task_identification; with ada.text_io; with sockets; with sockets.internet; procedure multiecho is type connection_id is range 1..4; connections : array (connection_id) of sockets.stream_socket; procedure shut_down (e : ada.exceptions.exception_occurrence); main_task : ada.task_identification.task_id := ada.task_identification.current_task; -- used to shut down the entire program task type server_task; servers : array (connections'range) of server_task; lf : constant character := ada.characters.latin_1.lf; -- line-feed cr : constant character := ada.characters.latin_1.cr; -- carriage-return protected server_pool is entry await_turn; procedure next_turn; private turn : boolean := false; end server_pool; protected body server_pool is entry await_turn when turn is begin turn := false; end await_turn; procedure next_turn is begin turn := true; end next_turn; end server_pool; procedure writeln (outs : sockets.output_stream_ptr; s : string) is begin string'write (outs, s); character'write (outs, cr); character'write (outs, lf); end writeln; function readln (ins : sockets.input_stream_ptr) return string is buf : string (1 .. 1024); i : integer := 1; begin loop character'read (ins, buf (i)); exit when buf (i) = lf; i := i + 1; end loop; return buf (1 .. i-2); end readln; peer : sockets.internet.internet_socket_address; s : sockets.server_socket; task body server_task is connection : sockets.stream_socket; ins : sockets.input_stream_ptr; outs : sockets.output_stream_ptr; begin loop server_pool.await_turn; sockets.accept_connection (s, connection, peer); server_pool.next_turn; ins := sockets.get_input_stream (connection); outs := sockets.get_output_stream (connection); writeln (outs, "Hello! Enter BYE to exit."); loop declare str : string := readln (ins); begin exit when str (1..3) = "BYE"; writeln (outs, "Echo: """ & str & '"'); end; end loop; sockets.close(connection); end loop; exception when e : others => shut_down (e); end server_task; procedure shut_down (e : ada.exceptions.exception_occurrence) is begin ada.text_io.put_line ("main: " & ada.exceptions.exception_name (e) & ": " & ada.exceptions.exception_message (e)); sockets.close (s); ada.task_identification.abort_task (main_task); end shut_down; begin sockets.open (s, sockets.internet.new_address (sockets.internet.any_port, sockets.internet.all_local_addresses)); ada.text_io.put_line ("serving at: " & sockets.internet.get_addressstring ( -- & sockets.internet.get_hostbyaddr ( sockets.internet.get_internet_address ( sockets.internet.get_address (s))) & " port " & sockets.internet.port_number'image ( sockets.internet.get_port ( sockets.internet.get_address (s)))); server_pool.next_turn; exception when e : others => shut_down (e); end multiecho; libflorist-2025.1.0/gnatsocks/posix_report.adb000066400000000000000000000713611473553204100213270ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P O S I X _ R E P O R T -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Command_Line, Ada.Text_IO, POSIX_Configurable_System_Limits, POSIX_Options, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Signals; pragma Elaborate_All (POSIX_Process_Identification); package body POSIX_Report is use Ada.Command_Line, Ada.Exceptions, Ada.Text_IO, POSIX, POSIX_Configurable_System_Limits, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Options, POSIX_Signals; subtype Exit_Status is POSIX_Process_Primitives.Exit_Status; ------------------------- -- Local Subprograms -- ------------------------- function Option_Name (Option : POSIX_Option) return String; function Option_Name (Option : POSIX_Option) return String is begin case Option is when Asynchronous_IO_Option => return "Asynchronous IO"; when Change_Owner_Restriction_Option => return "Change Owner Restriction"; when Filename_Truncation_Option => return "Filename Truncation"; when File_Synchronization_Option => return "File Synchronization"; when Memory_Mapped_Files_Option => return "Memory Mapped Files"; when Memory_Locking_Option => return "Memory Locking"; when Memory_Range_Locking_Option => return "Memory Range Locking"; when Memory_Protection_Option => return "Memory Protection"; when Message_Queues_Option => return "Message Queues"; when Mutex_Priority_Ceiling_Option => return "Mutex Priority Ceiling"; when Mutex_Priority_Inheritance_Option => return "Mutex Priority Inheritance"; when Mutex_Option => return "Mutexes"; when Prioritized_IO_Option => return "Prioritized IO"; when Priority_Process_Scheduling_Option => return "Priority Process Scheduling"; when Priority_Task_Scheduling_Option => return "Priority Task Scheduling"; when Process_Shared_Option => return "Process Shared"; when Realtime_Signals_Option => return "Realtime Signals"; when Saved_IDs_Option => return "Saved IDs"; when Job_Control_Option => return "Job Control"; when Semaphores_Option => return "Semaphores"; when Shared_Memory_Objects_Option => return "Shared Memory"; when Signal_Entries_Option => return "Signal Entries"; when Synchronized_IO_Option => return "Synchronized IO"; when Timers_Option => return "Timers"; end case; end Option_Name; function int_to_uid (Id : Integer) return POSIX_Process_Identification.User_ID; function int_to_uid (Id : Integer) return POSIX_Process_Identification.User_ID is begin return Value (Integer'Image (Id)); end int_to_uid; ----------------------- -- Local Variables -- ----------------------- Super_User_ID : User_ID := int_to_uid (0); procedure Header (Label : String; Root_OK : Boolean := False) is Saved_Verbose : Boolean := Verbose; Empty_String : String := ""; begin Put_Line (",.,. " & Label & " " & Test_Identifier); if Get_Real_User_ID = Super_User_ID and then not Root_OK then Fail ("For safety reasons, the test program should not be " & "run as root"); Done; Exit_Process (Exit_Status'Last); end if; Program_Name_Length := Label'Length; if Program_Name_Length > Program_Name'Length then Program_Name_Length := Program_Name'Length; end if; Program_Name (1 .. Program_Name_Length) := Label (Program_Name'First .. Program_Name'First + Program_Name_Length - 1); exception when E : others => Fatal_Exception (E, "in Header"); end Header; procedure Test (Label : String) is Empty_String : String := ""; begin if not Terse then Put_Line ("---- *-Subtest: " & Label); Flush; end if; Test_Label_Length := Label'Length; if Test_Label_Length > Test_Label'Length then Test_Label_Length := Test_Label'Length; end if; Test_Label (1 .. Test_Label_Length) := Label (Label'First .. Label'First + Test_Label_Length - 1); end Test; procedure Fail (Message : String) is begin Put_Line (" !!TEST FAILED: " & Message); Flush; Error_Count := Error_Count + 1; end Fail; procedure Fail (E : Exception_Occurrence; Message : String) is begin Put (" !!TEST FAILED: " & Exception_Name (E)); if Message = "" then if Exception_Message (E) = "" then New_Line; else Put_Line (": " & Exception_Message (E)); end if; elsif Exception_Message (E) = "" then Put_Line (": " & Message); else Put_Line (": " & Exception_Message (E) & ": " & Message); end if; Error_Count := Error_Count + 1; end Fail; procedure Assert (Condition : Boolean; Message : String) is begin if not Condition then if Message = "" then Fail ("assert"); else Fail ("assert [" & Message & "]"); end if; end if; end Assert; procedure Expect_Exception (Message : String) is begin Fail ("exception not raised [" & Message & "]"); end Expect_Exception; procedure Unexpected_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin Fail ("exception " & Exception_Name (E) & " [" & Message & "]"); if Exception_Message (E) /= "" and then Verbose then Put_Line (" -- Exception message = " & Exception_Message (E)); Flush; end if; end Unexpected_Exception; procedure Check_Error_Code (EC : POSIX.Error_Code; Message : String) is E : POSIX.Error_Code := POSIX.Get_Error_Code; begin if E /= EC then Fail ("incorrect error code: " & POSIX.Image (E)); Comment ("Expected error code: " & POSIX.Image (EC)); Flush; end if; end Check_Error_Code; procedure Check_Error_Code (EC : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is EEC : POSIX.Error_Code := POSIX.Get_Error_Code; begin if Exception_Identity (E) /= POSIX_Error'Identity then Fail (E, Message); elsif EEC /= EC then if Message = "" then Fail ("incorrect error code " & POSIX.Image (EEC) & " [expected " & POSIX.Image (EC) & "]"); else Fail ("incorrect error code " & POSIX.Image (EEC) & " [expected " & POSIX.Image (EC) & "]" & ": " & Message); end if; elsif Exception_Message (E) /= "" and then Exception_Message (E) /= POSIX.Image (EC) then if Message = "" then Fail ("incorrect Exception_Message: " & Exception_Message (E)); else Fail ("incorrect Exception_Message: " & Exception_Message (E) & ": " & Message); end if; end if; end Check_Error_Code; procedure Check_Message (E : Ada.Exceptions.Exception_Occurrence; Expected_Message : String; Message : String) is begin if Exception_Message (E) /= Expected_Message then Fail (Message & ": message is not " & Expected_Message); end if; end Check_Message; procedure Comment (Msg : String) is begin if Verbose then Put_Line (" -- " & Msg); Flush; end if; end Comment; function Image (T : POSIX.Timespec) return String is S : Seconds; NS : Nanoseconds; Z : constant Integer := Character'Pos ('0'); begin Split (T, S, NS); declare SBuff : String (1 .. 9) := "000000000"; I : Integer := SBuff'Last; begin while NS > 0 loop SBuff (I) := Character'Val (Z + Integer (NS rem 10)); NS := NS / 10; I := I - 1; end loop; return Seconds'Image (S) & "." & SBuff & "s"; end; end Image; procedure Comment (Msg : String; T : POSIX.Timespec) is begin Comment (Msg & " = " & Image (T)); end Comment; function Is_Supported (Option : POSIX_Option) return Boolean is use POSIX_Configurable_System_Limits; begin case Option is when Asynchronous_IO_Option => if True in Asynchronous_IO_Support then if False in Asynchronous_IO_Support then return Asynchronous_IO_Is_Supported; end if; else return False; end if; when Change_Owner_Restriction_Option => raise Constraint_Error; when Filename_Truncation_Option => raise Constraint_Error; when File_Synchronization_Option => if True in File_Synchronization_Support then if False in File_Synchronization_Support then return File_Synchronization_Is_Supported; end if; else return False; end if; when Memory_Mapped_Files_Option => if True in Memory_Mapped_Files_Support then if False in Memory_Mapped_Files_Support then return Memory_Mapped_Files_Are_Supported; end if; else return False; end if; when Memory_Locking_Option => if True in Memory_Locking_Support then if False in Memory_Locking_Support then return Memory_Locking_Is_Supported; end if; else return False; end if; when Memory_Range_Locking_Option => if True in Memory_Range_Locking_Support then if False in Memory_Range_Locking_Support then return Memory_Range_Locking_Is_Supported; end if; else return False; end if; when Memory_Protection_Option => if True in Memory_Protection_Support then if False in Memory_Protection_Support then return Memory_Protection_Is_Supported; end if; else return False; end if; when Message_Queues_Option => if True in Message_Queues_Support then if False in Message_Queues_Support then return Message_Queues_Are_Supported; end if; else return False; end if; when Mutex_Priority_Ceiling_Option => if True in Mutex_Priority_Ceiling_Support then if False in Mutex_Priority_Ceiling_Support then return Mutex_Priority_Ceiling_Is_Supported; end if; else return False; end if; when Mutex_Priority_Inheritance_Option => if True in Mutex_Priority_Inheritance_Support then if False in Mutex_Priority_Inheritance_Support then return Mutex_Priority_Inheritance_Is_Supported; end if; else return False; end if; when Mutex_Option => if True in Mutexes_Support then if False in Mutexes_Support then return Mutexes_Are_Supported; end if; else return False; end if; when Prioritized_IO_Option => if True in Prioritized_IO_Support then if False in Prioritized_IO_Support then return Prioritized_IO_Is_Supported; end if; else return False; end if; when Priority_Process_Scheduling_Option => if True in Priority_Process_Scheduling_Support then if False in Priority_Process_Scheduling_Support then return Priority_Process_Scheduling_Is_Supported; end if; else return False; end if; when Priority_Task_Scheduling_Option => if True in Priority_Task_Scheduling_Support then if False in Priority_Task_Scheduling_Support then return Priority_Task_Scheduling_Is_Supported; end if; else return False; end if; when Process_Shared_Option => if True in Process_Shared_Support then if False in Process_Shared_Support then return Process_Shared_Is_Supported; end if; else return False; end if; when Realtime_Signals_Option => if True in Realtime_Signals_Support then if False in Realtime_Signals_Support then return Realtime_Signals_Are_Supported; end if; else return False; end if; when Job_Control_Option => if True in POSIX.Job_Control_Support then if False in POSIX.Job_Control_Support then return Job_Control_Is_Supported; end if; else return False; end if; when Saved_IDs_Option => if True in POSIX.Saved_IDs_Support then if False in POSIX.Saved_IDs_Support then return Saved_IDs_Are_Supported; end if; else return False; end if; when Semaphores_Option => if True in Semaphores_Support then if False in Semaphores_Support then return Semaphores_Are_Supported; end if; else return False; end if; when Shared_Memory_Objects_Option => if True in Shared_Memory_Objects_Support then if False in Shared_Memory_Objects_Support then return Shared_Memory_Objects_Are_Supported; end if; else return False; end if; when Signal_Entries_Option => if True in Signal_Entries_Support then if False in Signal_Entries_Support then return True; end if; else return False; end if; when Synchronized_IO_Option => if True in Synchronized_IO_Support then if False in Synchronized_IO_Support then return Synchronized_IO_Is_Supported; end if; else return False; end if; when Timers_Option => if True in Timers_Support then if False in Timers_Support then return Timers_Are_Supported; end if; else return False; end if; end case; return True; end Is_Supported; procedure Optional (Option : POSIX_Option; Message : String) is begin if not Is_Supported (Option) then if Message /= "" then Comment (POSIX_Option'Image (Option) & " required: " & Message); else Comment (POSIX_Option'Image (Option) & " required"); end if; Nonsupport (Option) := True; for I in Nonsupport'Range loop if Nonsupport (I) then Put ("**** Nonsupport of "&POSIX_Option'Image (I)&" detected."); New_Line; end if; end loop; Put_Line ("==== Test Not Applicable."); Exit_Process (Normal_Exit); end if; end Optional; procedure Optional (Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if Is_Supported (Option) or else POSIX.Get_Error_Code /= Expected then Fail (E, Message); elsif Message = "" then Comment (POSIX_Option'Image (Option) & " not supported"); Nonsupport (Option) := True; else Comment (POSIX_Option'Image (Option) & " not supported [" & Message & "]"); Nonsupport (Option) := True; end if; exception when E1 : others => Fail (E1, "checking for support of " & POSIX_Option'Image (Option)); end Optional; procedure Optional (Option_1 : POSIX_Option; Option_2 : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if (Is_Supported (Option_1) and then Is_Supported (Option_2)) or else POSIX.Get_Error_Code /= Expected then Fail (E, Message); else if not Is_Supported (Option_1) then if Message = "" then Comment (POSIX_Option'Image (Option_1) & " not supported"); Nonsupport (Option_1) := True; else Comment (POSIX_Option'Image (Option_1) & " not supported [" & Message & "]"); Nonsupport (Option_1) := True; end if; end if; if not Is_Supported (Option_2) then if Message = "" then Comment (POSIX_Option'Image (Option_2) & " not supported"); Nonsupport (Option_2) := True; else Comment (POSIX_Option'Image (Option_2) & " not supported [" & Message & "]"); Nonsupport (Option_2) := True; end if; end if; end if; exception when E1 : others => Fail (E1, "checking for support of options"); end Optional; procedure Optional (Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if Is_Supported (Option) then if POSIX.Get_Error_Code /= Expected_If_Supported then Fail (E, Message); end if; elsif POSIX.Get_Error_Code /= Expected_If_Not_Supported then Fail (E, Message); else if Message = "" then Comment (POSIX_Option'Image (Option) & " not supported"); Nonsupport (Option) := True; else Comment (POSIX_Option'Image (Option) & " not supported [" & Message & "]"); Nonsupport (Option) := True; end if; end if; exception when E1 : others => Fail (E1, "checking for support of options"); end Optional; function Uid_To_Integer (Uid : POSIX_Process_Identification.User_ID) return Integer; -- .... not portable; needs configurable mechanism function Uid_To_Integer (Uid : POSIX_Process_Identification.User_ID) return Integer is begin return Integer'Value (POSIX_Process_Identification.Image (Uid)); end Uid_To_Integer; procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is Error : constant POSIX.Error_Code := POSIX.Get_Error_Code; begin if Error = Operation_Not_Permitted then Fail (E, Message & " - insufficient privilege"); Privilege_Failure := True; return; end if; if Is_Supported (Option) or else Error /= Expected then Fail (E, Message); elsif Message = "" then Comment (POSIX_Option'Image (Option) & " not supported"); Nonsupport (Option) := True; else Comment (POSIX_Option'Image (Option) & " not supported [" & Message & "]"); Nonsupport (Option) := True; end if; exception when E1 : others => Fail (E1, "checking for support of " & POSIX_Option'Image (Option)); end Privileged; procedure Privileged (Privilege : POSIX_Privilege; Message : String) is Error : constant POSIX.Error_Code := POSIX.Get_Error_Code; begin if Error = Operation_Not_Permitted then -- .... This is temporary. -- For the longer term, there should be a locally configurable -- mechanism for determining whether we have appropriate -- privilege for various operations. For now, we assume that -- appropriate privilege is equivalent to having root user-id. if (Uid_To_Integer (POSIX_Process_Identification.Get_Effective_User_ID) = 0) then Fail ("should have appropriate privilege"); end if; end if; end Privileged; procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is Error : constant POSIX.Error_Code := POSIX.Get_Error_Code; begin if Error = Operation_Not_Permitted then Fail (E, Message & " - insufficient privilege"); Privilege_Failure := True; return; end if; Optional (Option, Expected_If_Not_Supported, Expected_If_Supported, E, Message); end Privileged; procedure Increment_Error_Count (Number : Integer) is begin Error_Count := Error_Count + 1; end Increment_Error_Count; function Get_Error_Count return Integer is begin return Error_Count; end Get_Error_Count; procedure Done is begin if Error_Count = 0 and not Privilege_Failure then if Child /= 0 then Comment ("child process completed successfully"); else Put_Line ("==== Test Completed Successfully."); end if; else if Privilege_Failure then if Child /= 0 then Put_Line ("**** Child failed due to insufficient privilege"); else Put_Line ("**** Failed some parts due to insufficient privilege"); end if; end if; if Error_Count > 0 and Child = 0 then Put ("==== Failed"); Put (Natural'Image (Error_Count)); Put (" test"); if Error_Count /= 1 then Put ("s."); end if; New_Line; end if; end if; for I in Nonsupport'Range loop if Nonsupport (I) then Put ("**** Nonsupport of "&POSIX_Option'Image (I)&" detected."); New_Line; end if; end loop; Flush; if Child /= 0 then -- Report number of errors back to parent process. if Error_Count >= Natural (Failed_Creation_Exit) then Put ("==== Child error count overflowed"); Error_Count := Natural (Failed_Creation_Exit) - 1; end if; Exit_Process (Exit_Status (Error_Count)); end if; end Done; procedure Fatal (Msg : String) is begin Fail ("fatal error: [" & Msg & "]"); Done; Exit_Process (Normal_Exit); end Fatal; procedure Fatal_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if Message /= "" then Fail ("[" & Message & "] fatal exception " & Exception_Name (E)); else Fail ("fatal exception " & Exception_Name (E)); end if; Done; Exit_Process (Normal_Exit); end Fatal_Exception; procedure Pass_Through_Verbosity (Args : in out POSIX.POSIX_String_List) is begin if Verbose then Append (Args, "-v"); elsif Terse then Append (Args, "-t"); end if; end Pass_Through_Verbosity; procedure Check_Child_Status (Status : Termination_Status; Child_ID : Process_ID; Expected : Exit_Status; Message : String) is E : Exit_Status; begin Assert (Child_ID /= Null_Process_ID, Message & ": null child id"); if not Status_Available (Status) then -- Fail when status not available Fail (Message & ": no status available"); return; end if; Assert (Process_ID_Of (Status) = Child_ID, Message & ": wrong child"); if Termination_Cause_Of (Status) /= Exited then -- Fail when did not exit Assert (False, Message & ": did not exit"); return; end if; E := Exit_Status_Of (Status); if E > 0 and E < Failed_Creation_Exit then -- child process reports errors via exit status Increment_Error_Count (Integer (E)); elsif E /= Expected then Assert (False, Message & ": exit status =" & Exit_Status'Image (E)); end if; declare Sig : Signal; begin Sig := Stopping_Signal_Of (Status); -- Stopping_Signal_Of invalid status Expect_Exception (Message); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, Message); when E : others => Fail (E, Message); end; declare Sig : Signal; begin Sig := Termination_Signal_Of (Status); -- Termination_Signal_Of invalid status Expect_Exception (Message); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, Message); when E : others => Fail (E, Message); end; exception when E : others => Unexpected_Exception (E, Message); end Check_Child_Status; begin for I in 1 .. Argument_Count loop if Argument (I) = "-v" then Verbose := True; elsif Argument (I) = "-t" then Terse := True; elsif Argument (I)'Length >= 6 and then Argument (I)(Argument (I)'First .. Argument (I)'First + 5) = "-child" then -- Treat this argument as value of Child. -- Default value is 1. declare Arg : constant String := Argument (I); J : Integer := Arg'First + 6; Tmp : Integer := 0; begin while J <= Arg'Last and then Arg (J) = ' ' loop J := J + 1; end loop; while J <= Arg'Last and then Arg (J) in '0' .. '9' loop Tmp := Tmp * 10 + Character'Pos (Arg (J)) - Character'Pos ('0'); J := J + 1; end loop; while J <= Arg'Last and then Arg (J) = ' ' loop J := J + 1; end loop; if J /= Arg'Last + 1 or Tmp = 0 then Child := 1; else Child := Tmp; end if; exception when others => Fail ("bad command-line argument"); end; end if; end loop; end POSIX_Report; libflorist-2025.1.0/gnatsocks/posix_report.ads000066400000000000000000000275331473553204100213520ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P O S I X _ R E P O R T -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Exceptions, POSIX, POSIX_Process_Identification, POSIX_Process_Primitives; package POSIX_Report is -- This package contains utility routines which are useful for -- running tests. Verbose : Boolean := False; -- set to True if "-v" is on command line. Terse : Boolean := False; -- set to True if "-t" is on command line. Child : Natural := 0; -- set to 1 if "-child" is on command line -- set to NNN if "-child NNN" is on command line, where NNN is a number Test_Identifier : String := "POSIX Ada Validation Tests, Version 1.2a"; -- Call this once for each test program, at the beginning. -- It prints a message indicating that a test is about to be -- performed, regardless of whether verbose is turned on. -- User Root_OK = True if the test is one that makes sense to -- run as root. procedure Header (Label : String; Root_OK : Boolean := False); -- Call this once for each section of the test program. -- It prints a message indicating that a test is about to be -- performed, if verbose is turned on. -- The label should be unique so that if the test fails it is -- possible to find the code for the test by grepping through -- the source. procedure Test (Label : String); -- .... -- Fail is obsolescent. Use the more specific procedures. -- Call this to record the fact that a test failed. procedure Fail (Message : String); -- Call this from an exception handler for "others", to catch -- completion of test casem by an unhandled exception. procedure Fail (E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this to check a condition that should be true. -- The test fails if the argument is false. procedure Assert (Condition : Boolean; Message : String); type POSIX_Option is (Asynchronous_IO_Option, Change_Owner_Restriction_Option, Filename_Truncation_Option, File_Synchronization_Option, Memory_Mapped_Files_Option, Memory_Locking_Option, Memory_Range_Locking_Option, Memory_Protection_Option, Message_Queues_Option, Mutex_Priority_Ceiling_Option, Mutex_Priority_Inheritance_Option, Mutex_Option, Prioritized_IO_Option, Priority_Process_Scheduling_Option, Priority_Task_Scheduling_Option, Process_Shared_Option, Realtime_Signals_Option, Job_Control_Option, Saved_IDs_Option, Semaphores_Option, Shared_Memory_Objects_Option, Signal_Entries_Option, Synchronized_IO_Option, Timers_Option); function Is_Supported (Option : POSIX_Option) return Boolean; -- Call this near the beginning of a test program -- that entirely depends on an option. It will end the test -- if the required option is not supported. procedure Optional (Option : POSIX_Option; Message : String); -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where the feature depends on one option. procedure Optional (Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where the feature depends on two options. procedure Optional (Option_1 : POSIX_Option; Option_2 : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where POSIX_Error should be raised -- with a different error code if the option is supported. procedure Optional (Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); type POSIX_Privilege is (Memory_Locking_Privilege, Semaphore_Initialization_Privilege, Set_Time_Privilege); -- add more of these values as we discover more privileges -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where the feature depends on one option -- and also depends on having appropriate privilege. procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); procedure Privileged (Privilege : POSIX_Privilege; Message : String); -- Call this if the test is supposed to raise an exception, -- other than for nonsupport or lack of privilege. procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this at a point where control should not reach -- because an exception should have been raised. procedure Expect_Exception (Message : String); -- Call this inside an exception handler for an unexpected -- exception. procedure Unexpected_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for POSIX_Error, -- to validate that the expected error code is set. procedure Check_Error_Code (EC : POSIX.Error_Code; Message : String); -- Call this inside an exception handler for POSIX_Error, -- to validate that the expected error code is set. procedure Check_Error_Code (EC : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for any exception -- to check that the exception message is correct. procedure Check_Message (E : Ada.Exceptions.Exception_Occurrence; Expected_Message : String; Message : String); -- Call this from an exception handler for "others", to catch -- completion of test program by an unhandled exception. procedure Fatal_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this to print out a an informational message, -- iff Verbose = True. -- It does not imply that anything went wrong. procedure Comment (Msg : String); -- Call this to get a printable string for a Timepsec value. function Image (T : POSIX.Timespec) return String; -- This is equivalent to Comment (Msg & " = " & Image (T)); procedure Comment (Msg : String; T : POSIX.Timespec); -- Call this to add to this package's internal error count. procedure Increment_Error_Count (Number : Integer); -- Call this to get this package's internal error count. function Get_Error_Count return Integer; -- Call this once, before exiting, when the testing is complete, -- for normal completion of a main program. procedure Done; -- Call this to terminate a test immediately. procedure Fatal (Msg : String); -- Add to the given argument list the necessary values to pass -- through the verbose/normal/terse state of the parent process. procedure Pass_Through_Verbosity (Args : in out POSIX.POSIX_String_List); -- Check Termination_Status value of child process, to verify -- that the child exited and exited with the anticipated status. -- Add the error count of the child process to that of the parent. procedure Check_Child_Status (Status : POSIX_Process_Primitives.Termination_Status; Child_ID : POSIX_Process_Identification.Process_ID; Expected : POSIX_Process_Primitives.Exit_Status; Message : String); private -- name of the executable file for this program Program_Name : String (1 .. 128) := (others => ' '); Program_Name_Length : Integer := 0; -- label from the last Test subprogram call Test_Label : String (1 .. 128) := (others => ' '); Test_Label_Length : Integer := 0; -- an option has been found to be unsupported Nonsupport : array (POSIX_Option) of Boolean := (others => False); pragma Atomic_Components (Nonsupport); -- an operation has failed due to insufficient privilege Privilege_Failure : Boolean := False; pragma Atomic (Privilege_Failure); -- number of errors so far Error_Count : Natural := 0; pragma Atomic (Error_Count); end POSIX_Report; libflorist-2025.1.0/gnatsocks/sockets-internet.adb000066400000000000000000000311371473553204100220700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- GNATSOCKS -- -- -- -- S o c k e t s . I n t e r n e t -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of GNATSOCKS, an Ada interfaces to socket I/O -- -- services, for use with the GNAT Ada compiler. -- -- -- -- GNATSOCKS is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Streams, Ada.Unchecked_Conversion, POSIX, POSIX.C, POSIX.Implementation, System; package body Sockets.Internet is use POSIX, POSIX.C, POSIX.C.NetDB, POSIX.C.Netinet, POSIX.C.Sockets, POSIX.Implementation; Local_Hostname : String (1 .. 256) := (others => Character'Val (0)); function inet_addr (cp : char_var_ptr) return unsigned_long; pragma Import (C, inet_addr, inet_addr_LINKNAME); function inet_network (cp : char_var_ptr) return unsigned_long; pragma Import (C, inet_network, inet_network_LINKNAME); function inet_makeaddr (net, lna : int) return struct_in_addr; pragma Import (C, inet_makeaddr, inet_makeaddr_LINKNAME); function inet_lnaof (addr : struct_in_addr) return int; pragma Import (C, inet_lnaof, inet_lnaof_LINKNAME); function inet_netof (addr : struct_in_addr) return int; pragma Import (C, inet_netof, inet_netof_LINKNAME); function inet_ntoa (addr : struct_in_addr) return char_ptr; pragma Import (C, inet_ntoa, inet_ntoa_LINKNAME); function gethostbyname_r (name : char_ptr; result : hostent_var_ptr; buffer : char_var_ptr; buflen : int; errnop : access int) return hostent_ptr; pragma Import (C, gethostbyname_r, gethostbyname_r_LINKNAME); function gethostbyaddr_r (addr : char_ptr; length : int; addr_type : int; result : hostent_var_ptr; buffer : char_var_ptr; buflen : int; errnop : access int) return hostent_ptr; pragma Import (C, gethostbyaddr_r, gethostbyaddr_r_LINKNAME); function htonl (hostlong : unsigned_long) return unsigned_long; pragma Import (C, htonl, "c_htonl"); function ntohl (netlong : unsigned_long) return unsigned_long; pragma Import (C, ntohl, "c_ntohl"); function htons (hostshort : unsigned_short) return unsigned_short; pragma Import (C, htons, "c_htons"); function ntohs (netshort : unsigned_short) return unsigned_short; pragma Import (C, ntohs, "c_ntohs"); function gethostname (name : char_var_ptr; namelen : int) return int; pragma Import (C, gethostname, gethostname_LINKNAME); function read (fildes : int; buf : char_var_ptr; nbyte : size_t) return ssize_t; pragma Import (C, read, read_LINKNAME); function write (fildes : int; buf : char_ptr; nbyte : size_t) return ssize_t; pragma Import (C, write, write_LINKNAME); function open (path : char_ptr; oflag : int; mode : mode_t := 0) return int; pragma Import (C, open, open_LINKNAME); function close (fd : int) return int; pragma Import (C, close, close_LINKNAME); -- close a file descriptor (or socket) function unlink (path : char_ptr) return int; pragma Import (C, unlink, unlink_LINKNAME); function link (existing : char_ptr; new_name : char_ptr) return int; pragma Import (C, link, link_LINKNAME); function fsync (fildes : int) return int; pragma Import (C, fsync, fsync_LINKNAME); function stat (path : char_ptr; buf : stat_ptr) return int; pragma Import (C, stat, stat_LINKNAME); function Get_AddressString (Addr : Internet_Address) return String is begin return Form_String (inet_ntoa (Addr.C)); end Get_AddressString; function Hash_Code (Addr : Internet_Address) return Integer is begin return Integer (Addr.C.s_addr mod 2**(Integer'Size - 1)); end Hash_Code; function "=" (Left, Right : Internet_Address) return Boolean is begin return Left.C.s_addr = Right.C.s_addr; end "="; function cptr_to_sia is new Ada.Unchecked_Conversion (char_ptr, in_addr_ptr); function Get_AddrByName (Host : String) return Internet_Address is name : constant POSIX_String := To_POSIX_String (Host) & NUL; hostent : aliased struct_hostent; buffer : POSIX_String (1 .. 1024); error_code : aliased int; p : hostent_ptr; begin p := gethostbyname_r (name => name (name'First)'Unchecked_Access, result => hostent'Unchecked_Access, buffer => buffer (buffer'First)'Unchecked_Access, buflen => buffer'Length, errnop => error_code'Unchecked_Access); if p = null then Raise_POSIX_Error; end if; return (C => cptr_to_sia (p.h_addr_list.all).all); end Get_AddrByName; function Get_HostByAddr (Addr : Internet_Address) return String is hostent : aliased struct_hostent; buffer : POSIX_String (1 .. 1024); error_code : aliased int; p : hostent_ptr; function "+" is new Ada.Unchecked_Conversion (in_addr_ptr, char_ptr); begin p := gethostbyaddr_r (addr => +Addr.C'Unchecked_Access, length => Addr.C'Size / char'Size, addr_type => AF_INET, result => hostent'Unchecked_Access, buffer => buffer (buffer'First)'Unchecked_Access, buflen => buffer'Length, errnop => error_code'Unchecked_Access); if p = null then Raise_POSIX_Error; end if; return Form_String (p.h_name); end Get_HostByAddr; function Local_Host return Internet_Address is function "+" is new Ada.Unchecked_Conversion (System.Address, char_var_ptr); begin if Local_Hostname (Local_Hostname'First) = Character'Val (0) then Check (gethostname (+Local_Hostname (Local_Hostname'First)'Address, Local_Hostname'Length)); end if; return Get_AddrByName (Local_Hostname); end Local_Host; -------------------------------------- function Get_AllByName (Host : String) return Internet_Address_Array is name : constant POSIX_String := To_POSIX_String (Host) & NUL; hostent : aliased struct_hostent; buffer : POSIX_String (1 .. 1024); error_code : aliased int; p : hostent_ptr; q : char_ptr_ptr; len : integer := 0; begin p := gethostbyname_r (name => name (name'First)'Unchecked_Access, result => hostent'Unchecked_Access, buffer => buffer (buffer'First)'Unchecked_Access, buflen => buffer'Length, errnop => error_code'Unchecked_Access); if p = null then Raise_POSIX_Error; end if; q := hostent.h_addr_list; while q.all /= null loop len := len + 1; Advance (q); end loop; declare result : Internet_Address_Array (1 .. len); begin q := hostent.h_addr_list; for I in result'Range loop result (I) := (C => cptr_to_sia (q.all).all); Advance (q); end loop; return result; end; end Get_AllByName; -------------------------------------- function getsockname (socket_fd : int; name : struct_sockaddr_var_ptr; namelen : access int) return int; pragma Import (C, getsockname, getsockname_LINKNAME); -- returns the current name for a socket function Get_Address (Sock : in Socket'Class) return Internet_Socket_Address is addr : aliased struct_sockaddr_in; addrlen : aliased int := addr'Size / char'Size; function "+" is new Ada.Unchecked_Conversion (sockaddr_in_var_ptr, sockaddr_var_ptr); begin Check (getsockname (Sock.fd, +addr'Unchecked_Access, addrlen'Unchecked_Access)); if addrlen /= addr'Size / char'Size then raise Constraint_Error; end if; return (Socket_Address with in_addr => addr); end Get_Address; function New_Address (Port : Port_Number; Addr : Internet_Address := Local_Host) return Internet_Socket_Address is begin return (Socket_Address with in_addr => (sin_family => AF_INET, sin_port => in_port_t (htons (unsigned_short (Port))), sin_addr => Addr.C, sin_zero => (others => NUL))); end New_Address; function New_Address (Port : Port_Number; Host : String) return Internet_Socket_Address is begin return New_Address (Port, Get_AddrByName (Host)); end New_Address; function Get_Internet_Address (Addr : Internet_Socket_Address) return Internet_Address is begin return (C => Addr.in_addr.sin_addr); end Get_Internet_Address; function Get_Port (Addr : Internet_Socket_Address) return Port_Number is begin return Port_Number (Addr.in_addr.sin_port); end Get_Port; ---------------------------------------- function getpeername (socket_fd : int; name : access struct_sockaddr; namelen : access int) return int; pragma Import (C, getpeername, getpeername_LINKNAME); -- returns the name of the peer connected to a socket function Get_PeerAddress (Sock : Stream_Socket) return Internet_Socket_Address is addr : aliased struct_sockaddr_in; addrlen : aliased int := addr'Size / char'Size; function "+" is new Ada.Unchecked_Conversion (sockaddr_in_var_ptr, sockaddr_var_ptr); begin Check (getpeername (Sock.fd, +addr'Unchecked_Access, addrlen'Unchecked_Access)); if addrlen /= addr'Size / char'Size then raise Constraint_Error; end if; return (Socket_Address with in_addr => addr); end Get_PeerAddress; ---------------------------------------- function Address (Addr : Internet_Socket_Address) return sockaddr_ptr is function "+" is new Ada.Unchecked_Conversion (sockaddr_in_ptr, sockaddr_ptr); begin return +Addr.in_addr'Unchecked_Access; end Address; function Length (Addr : Internet_Socket_Address) return POSIX.C.int is begin return Addr.in_addr'Size / char'Size; end Length; function Valid (Addr : Internet_Socket_Address) return Boolean is -- This is only the most basic validity check. -- ???? Consider doing more? begin return Addr.in_addr.sin_family = AF_INET; end Valid; function Protocol_Family (Addr : Internet_Socket_Address) return POSIX.C.int is begin return PF_INET; end Protocol_Family; end Sockets.Internet; libflorist-2025.1.0/gnatsocks/sockets-internet.ads000066400000000000000000000134101473553204100221030ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- GNATSOCKS -- -- -- -- S o c k e t s . I n t e r n e t -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of GNATSOCKS, an Ada interfaces to socket I/O -- -- services, for use with the GNAT Ada compiler. -- -- -- -- GNATSOCKS is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] package Sockets.Internet is type Port_Number is new POSIX.C.unsigned_short; Any_Port : constant Port_Number; -- specifies to Open for a server socket -- that it may assign any free port number type Internet_Address is private; All_Local_Addresses : constant Internet_Address; -- may be used with Open on a server socket to -- allow accepting connections for any local Internet address function Get_AddressString (Addr : Internet_Address) return String; -- returns dot-separated numeric internet address as string, -- e.g. "128.186.121.10". function Hash_Code (Addr : Internet_Address) return Integer; -- returns value suitable for use in a hash-table lookup function "=" (Left, Right : Internet_Address) return Boolean; -- returns true iff both have the same numeric address, -- not necessarily if both designate the same host function Get_AddrByName (Host : String) return Internet_Address; -- returns the address of the named host function Get_HostByAddr (Addr : Internet_Address) return String; -- returns the name of the host with given address function Local_Host return Internet_Address; -------------------------------------- type Internet_Address_Array is array (Positive range <>) of Internet_Address; function Get_AllByName (Host : String) return Internet_Address_Array; -- returns all the addresses of the named host -------------------------------------- type Internet_Socket_Address is new Socket_Address with private; function Get_Address (Addr : in Socket'Class) return Internet_Socket_Address; function New_Address (Port : Port_Number; Addr : Internet_Address := Local_Host) return Internet_Socket_Address; -- specifies the host address and port number of the socket address function New_Address (Port : Port_Number; Host : String) return Internet_Socket_Address; -- specifies the host name and port number of the socket address function Get_Internet_Address (Addr : Internet_Socket_Address) return Internet_Address; function Get_Port (Addr : Internet_Socket_Address) return Port_Number; -------------------------------------------------------- function Get_PeerAddress (Sock : Stream_Socket) return Internet_Socket_Address; -- return socket address of peer connected to open stream socket private type Internet_Address is record C : aliased POSIX.C.Sockets.struct_in_addr; end record; Any_Port : constant Port_Number := 0; All_Local_Addresses : constant Internet_Address := (C => (s_addr => POSIX.C.Netinet.INADDR_ANY)); function Address (Addr : Internet_Socket_Address) return POSIX.C.Sockets.sockaddr_ptr; function Length (Addr : Internet_Socket_Address) return POSIX.C.int; function Valid (Addr : Internet_Socket_Address) return Boolean; function Protocol_Family (Addr : Internet_Socket_Address) return POSIX.C.int; ----------------------------------- type Internet_Socket_Address is new Socket_Address with record in_addr : aliased POSIX.C.Sockets.struct_sockaddr_in; end record; end Sockets.Internet; libflorist-2025.1.0/gnatsocks/sockets-unix.adb000066400000000000000000000124111473553204100212150ustar00rootroot00000000000000----------------------------------------------------------------------------- -- -- -- GNATSOCKS -- -- -- -- S o c k e t s . U n i x -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of GNATSOCKS, an Ada interfaces to socket I/O -- -- services, for use with the GNAT Ada compiler. -- -- -- -- GNATSOCKS is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Finalization, Ada.Streams, Ada.Unchecked_Conversion, POSIX.C, POSIX.Implementation, System; package body Sockets.Unix is use POSIX, POSIX.C, POSIX.C.Sockets, POSIX.Implementation; function getsockname (socket_fd : int; name : sockaddr_var_ptr; namelen : access int) return int; pragma Import (C, getsockname, getsockname_LINKNAME); -- returns the current name for a socket function "+" is new Ada.Unchecked_Conversion (sockaddr_un_ptr, sockaddr_var_ptr); function "+" is new Ada.Unchecked_Conversion (sockaddr_un_ptr, sockaddr_ptr); function Get_Address (Sock : in Socket'Class) return Unix_Socket_Address is addr : aliased struct_sockaddr_un; addrlen : aliased int := addr'Size / char'Size; begin Check (getsockname (Sock.fd, +addr'Unchecked_Access, addrlen'Unchecked_Access)); if addrlen /= addr'Size / char'Size then raise Constraint_Error; end if; return (Socket_Address with un_addr => addr); end Get_Address; type String_Ptr is access all String; function New_Address (Path : String) return Unix_Socket_Address is addr : struct_sockaddr_un; function sptr_to_psptr is new Ada.Unchecked_Conversion (String_Ptr, POSIX_String_Ptr); begin if Path'Length > addr.sun_path'Length - 1 then raise Constraint_Error; end if; addr.sun_family := AF_UNIX; Nulterminate (addr.sun_path, Path); return (Socket_Address with un_addr => addr); end New_Address; function Get_Path (Addr : Unix_Socket_Address) return String is begin if Valid (Addr) then raise Constraint_Error; end if; return Form_String (Addr.un_addr.sun_path (1)'Unchecked_Access); end Get_Path; ---------------------------------------- function Address (Addr : Unix_Socket_Address) return sockaddr_ptr is begin return +Addr.un_addr'Unchecked_Access; end Address; function Length (Addr : Unix_Socket_Address) return POSIX.C.int is begin return Addr.un_addr'Size / char'Size; end Length; function Valid (Addr : Unix_Socket_Address) return Boolean is -- only the most basic validity check -- ... consider doing more? begin for I in Addr.un_addr.sun_path'Range loop if Addr.un_addr.sun_path (I) = NUL then return Addr.un_addr.sun_family = AF_UNIX; end if; end loop; return False; end Valid; function Protocol_Family (Addr : Unix_Socket_Address) return POSIX.C.int is begin return PF_UNIX; end Protocol_Family; end Sockets.Unix; libflorist-2025.1.0/gnatsocks/sockets-unix.ads000066400000000000000000000067271473553204100212530ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- GNATSOCKS -- -- -- -- S o c k e t s . U n i x -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of GNATSOCKS, an Ada interfaces to socket I/O -- -- services, for use with the GNAT Ada compiler. -- -- -- -- GNATSOCKS is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with POSIX.C; package Sockets.Unix is type Unix_Socket_Address is new Socket_Address with private; function Get_Address (Sock : in Socket'Class) return Unix_Socket_Address; function New_Address (Path : String) return Unix_Socket_Address; -- specifies the pathname of the socket function Get_Path (Addr : Unix_Socket_Address) return String; private type Unix_Socket_Address is new Socket_Address with record un_addr : aliased POSIX.C.Sockets.struct_sockaddr_un; end record; function Address (Addr : Unix_Socket_Address) return POSIX.C.Sockets.sockaddr_ptr; function Length (Addr : Unix_Socket_Address) return POSIX.C.int; function Valid (Addr : Unix_Socket_Address) return Boolean; function Protocol_Family (Addr : Unix_Socket_Address) return POSIX.C.int; end Sockets.Unix; libflorist-2025.1.0/gnatsocks/sockets.adb000066400000000000000000000313771473553204100202500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- GNATSOCKS -- -- -- -- S o c k e t s -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of GNATSOCKS, an Ada interfaces to socket I/O -- -- services, for use with the GNAT Ada compiler. -- -- -- -- GNATSOCKS is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Text_IO, Ada.Streams, Ada.Unchecked_Conversion, POSIX, POSIX.C, POSIX.Implementation, System; package body Sockets is use Ada.Text_IO, POSIX, POSIX.C, POSIX.C.Sockets, POSIX.Implementation; function close (fildes : int) return int; pragma Import (C, close, close_LINKNAME); procedure Close (Sock : in out Socket'Class) is begin if Sock.fd /= 0 then Check (close (Sock.fd)); end if; Sock.fd := 0; end Close; procedure Finalize (Sock : in out Socket) is begin Close (Sock); end Finalize; -------------------------------------- function connect (socket_fd : int; name : sockaddr_ptr; namelen : int) return int; pragma Import (C, connect, connect_LINKNAME); -- attempts to make a connection to a named socket. function make_socket (domain : int; socket_type : int; protocol : int) return int; pragma Import (C, make_socket, socket_LINKNAME); procedure Open (Sock : in out Stream_Socket; Addr : Socket_Address'Class) is begin if not Valid (Addr) then raise Constraint_Error; end if; if Sock.fd /= 0 then raise Constraint_Error; end if; Sock.fd := Check (make_socket (PF_INET, SOCK_STREAM, 0)); Check (connect (Sock.fd, Address (Addr), Length (Addr))); Sock.in_stream.sock := Sock'Unchecked_Access; Sock.in_ptr := Sock.in_stream'Unchecked_Access; Sock.out_stream.sock := Sock'Unchecked_Access; Sock.out_ptr := Sock.out_stream'Unchecked_Access; Sock.tag := Addr'Tag; end Open; function Get_Input_Stream (Sock : Stream_Socket) return Input_Stream_Ptr is begin if Sock.fd = 0 then raise Constraint_Error; end if; return Sock.in_ptr; end Get_Input_Stream; function Get_Output_Stream (Sock : Stream_Socket) return Output_Stream_Ptr is begin if Sock.fd = 0 then raise Constraint_Error; end if; return Sock.out_ptr; end Get_Output_Stream; ----------------------------------------- function listen (socket_fd : int; backlog : int) return int; pragma Import (C, listen, listen_LINKNAME); -- specifies that we want to listen on the argument socket ID. -- backlog is the number of backlogged connections that are allowed. -- To accept connections, a socket is first crated with socked(), -- a backlog for incoming connections is specified with listen(), -- and then the connections are accepted with accept(). function bind (socket_fd : int; name : sockaddr_ptr; namelen : int) return int; pragma Import (C, bind, bind_LINKNAME); -- assigns a name to an unnamed socket. -- A socket is first created with socket(). -- Binding a socket in the UNIX (not Internet) domain -- causes creation of a socket in the file system, that must -- be deleted later when it is no longer needed, using unlink() procedure Open (Sock : in out Server_Socket; Addr : Socket_Address'Class; Count : Natural := 0) is begin if not Valid (Addr) then raise Constraint_Error; end if; if Sock.fd /= 0 then raise Constraint_Error; end if; Sock.fd := Check (make_socket (Protocol_Family (Addr), SOCK_STREAM, 0)); Check (bind (Sock.fd, Address (Addr), Length (Addr))); Check (listen (Sock.fd, int (Count))); Sock.tag := Addr'Tag; end Open; function accept_connection (socket_fd : int; addr : sockaddr_ptr; addrlen : access int) return int; pragma Import (C, accept_connection, accept_LINKNAME); -- returns a socket ID for a new connection that has been -- requested via the socket whose ID is given as argument. -- The argument must be an existing socket that is bound to an address -- and is listeninf for connections. -- addr received the address of the connecting entity. procedure Accept_Connection (Server : Server_Socket; Stream : in out Stream_Socket'Class; Peer : in out Socket_Address'Class) is addrlen : aliased int := Length (Peer); use type Ada.Tags.Tag; begin if Server.fd = 0 then raise Constraint_Error; end if; if Stream.fd /= 0 then raise Constraint_Error; end if; if Server.tag /= Peer'Tag then raise Constraint_Error; end if; -- require that the Peer and Server object be of the same type as the -- socket address used to create the Server Stream.fd := Check (accept_connection (Server.fd, Address (Peer), addrlen'Unchecked_Access)); Stream.in_stream.sock := Stream'Unchecked_Access; Stream.in_ptr := Stream.in_stream'Unchecked_Access; Stream.out_stream.sock := Stream'Unchecked_Access; Stream.out_ptr := Stream.out_stream'Unchecked_Access; Stream.tag := Server.tag; if addrlen /= Length (Peer) then raise Constraint_Error; end if; end Accept_Connection; ----------------------------------------- procedure Open (Sock : in out Datagram_Socket; Addr : Socket_Address'Class) is begin if not Valid (Addr) then raise Constraint_Error; end if; if Sock.fd /= 0 then raise Constraint_Error; end if; Sock.fd := Check (make_socket (Protocol_Family (Addr), SOCK_DGRAM, 0)); Check (bind (Sock.fd, Address (Addr), Length (Addr))); Sock.tag := Addr'Tag; end Open; ----------------------------------------- function read (fildes : int; buf : System.Address; nbyte : size_t) return ssize_t; pragma Import (C, read, read_LINKNAME); function write (fildes : int; buf : char_ptr; nbyte : size_t) return ssize_t; pragma Import (C, write, write_LINKNAME); procedure Read (Stream : in out Input_Stream; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset) is use type Ada.Streams.Stream_Element_Offset; Tmp : ssize_t; function "+" is new Ada.Unchecked_Conversion (System.Address, char_ptr); begin Tmp := read (Stream.sock.fd, Item'Address, size_t (Item'Length)); Check (int (Tmp)); Last := Item'First + Ada.Streams.Stream_Element_Offset (Tmp); end Read; procedure Write (Stream : in out Input_Stream; Item : in Ada.Streams.Stream_Element_Array) is begin Raise_POSIX_Error (Operation_Not_Implemented); end Write; procedure Read (Stream : in out Output_Stream; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset) is begin Raise_POSIX_Error (Operation_Not_Implemented); end Read; procedure Write (Stream : in out Output_Stream; Item : in Ada.Streams.Stream_Element_Array) is function "+" is new Ada.Unchecked_Conversion (System.Address, char_ptr); begin Check (int (write (Stream.sock.fd, +Item'Address, size_t (Item'Length)))); end Write; ---------------------------------------------------- function sendto (socket_fd : int; buf : char_ptr; len : int; flags : int; from : sockaddr_ptr; fromlen : int_ptr) return int; pragma Import (C, sendto, sendto_LINKNAME); procedure Send (Sock : in Datagram_Socket; Addr : in Socket_Address'Class; Data : in String) is Data_With_NUL : POSIX_String; begin if not Valid (Addr) then raise Constraint_Error; end if; if Sock.fd /= 0 then raise Constraint_Error; end if; if Sock.tag /= Addr'Tag then raise Constraint_Error; end if; Check (sendto (socket_fd => Sock.fd, buf => +Data (Data'First)'Address, len => Data'Length, flags => 0, from => Address (Addr), fromlen => Length (Addr))); end Send; function recvfrom (socket_fd : int; buf : char_ptr; len : int; flags : int; from : sockaddr_ptr; -- may be null fromlen : int_ptr) return int; pragma Import (C, recvfrom, recvfrom_LINKNAME); procedure Receive (Sock : in Datagram_Socket; Addr : out Socket_Address'Class; Buff : in out String; Last : out Natural) is begin if not Valid (Addr) then raise Constraint_Error; end if; if Sock.fd /= 0 then raise Constraint_Error; end if; if Sock.tag /= Addr'Tag then raise Constraint_Error; end if; Check (recvfrom (socket_fd => Sock.fd, buf => +Buff (Buff'First)'Address, len => Buff'Length, flags => 0, from => Address (Buff), fromlen => Length (Addr))); end Receive; ---------------------------------------------------- -- Stuff that may be bound-to in future extensions? -- function getsockopt -- (socket_fd : int; -- level : int; -- optname : int; -- optval : char_ptr; -- optlen : int_ptr) -- return int; -- pragma Import (C, getsockopt, getsockopt_LINKNAME); -- -- get options associated with a socket -- function setsockopt -- (socket_fd : int; -- level : int; -- optname : int; -- optval : char_ptr; -- optlen : int) -- return int; -- pragma Import (C, setsockopt, setsockopt_LINKNAME); -- -- set options associated with a socket -- function recv -- (socket_fd : int; -- buf : char_ptr; -- len : int; -- flags : int) -- return int; -- pragma Import (C, recv, recv_LINKNAME); -- -- requires socket must be connected -- function send -- (socket_fd : int; -- buf : char_ptr; -- len : int; -- flags : int) -- return int; -- pragma Import (C, send, send_LINKNAME); -- -- requires socket must be connected -- function sendmsg -- (socket_fd : int; -- msg : struct_msghdr_ptr; -- flags : int) -- return int; -- pragma Import (C, recvmsg, recvmsg_LINKNAME); -- function recvmsg -- (socket_fd : int; -- msg : struct_msghdr_ptr; -- flags : int) -- return int; -- pragma Import (C, recvmsg, recvmsg_LINKNAME); -- other functions we may need? -- ioctl -- fcntl -- socketpair -- shutdown end Sockets; libflorist-2025.1.0/gnatsocks/sockets.ads000066400000000000000000000174151473553204100202660ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- GNATSOCKS -- -- -- -- S o c k e t s -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of GNATSOCKS, an Ada interfaces to socket I/O -- -- services, for use with the GNAT Ada compiler. -- -- -- -- GNATSOCKS is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] ------------------------------------------------------------------------ -- This package is intended to provide convenient access to socket I/O. -- It still needs design, documentation, and implementation work. -- For example, there is no specification what happens if an error occurs -- for each of the operations. with Ada.Finalization, Ada.Streams, Ada.Tags, POSIX, POSIX.C; package Sockets is -------------------------------------- type Socket_Address is abstract tagged private; -------------------------------------- type Socket is abstract tagged limited private; procedure Close (Sock : in out Socket'Class); -- closes the socket function Get_Address (cock : in Socket'Class) return Socket_Address is abstract; -- gets address of socket -------------------------------------- type Input_Stream is new Ada.Streams.Root_Stream_Type with private; type Input_Stream_Ptr is access all Input_Stream; type Output_Stream is new Ada.Streams.Root_Stream_Type with private; type Output_Stream_Ptr is access all Output_Stream; -------------------------------------- type Stream_Socket is new Socket with private; procedure Open (Sock : in out Stream_Socket; Addr : Socket_Address'Class); -- creates a stream socket and connects it to the specified address function Get_Input_Stream (Sock : Stream_Socket) return Input_Stream_Ptr; function Get_Output_Stream (Sock : Stream_Socket) return Output_Stream_Ptr; -------------------------------------- type Server_Socket is new Socket with private; procedure Open (Sock : in out Server_Socket; Addr : Socket_Address'Class; Count : Natural := 0); -- creates a server socket on the specified port -- with the specified backlog count procedure Accept_Connection (Server : Server_Socket; Stream : in out Stream_Socket'Class; Peer : in out Socket_Address'Class); -- accept connection addressed to Server socket, and -- open Stream socket to handle the connection. -------------------------------------- -- This part is "in progress". type Datagram_Socket is new Socket with private; -- connectionless procedure Open (Sock : in out Datagram_Socket; Addr : in Socket_Address'Class); -- creates a datagram socket on the specified port -- with the specified local address procedure Send (Sock : in Datagram_Socket; Addr : in Socket_Address'Class; Data : in String); -- sends Data to the specified address Addr procedure Receive (Sock : in Datagram_Socket; Addr : out Socket_Address'Class; Buff : in out String; Last : out Natural); -- receives data into Buff -- Last is the index of the last position in Buff that is used. -- Addr receives the sender's address. private function Address (Addr : Socket_Address) return POSIX.C.Sockets.sockaddr_ptr is abstract; function Length (Addr : Socket_Address) return POSIX.C.int is abstract; function Valid (Addr : Socket_Address) return Boolean is abstract; function Protocol_Family (Addr : Socket_Address) return POSIX.C.int is abstract; type Socket_Address is abstract tagged null record; ----------------------------------- type Socket is new Ada.Finalization.Limited_Controlled with record fd : POSIX.C.int := 0; -- file descriptor of an open socket, of nonzero tag : Ada.Tags.Tag; -- tag of the socket address type used to open the socket, of fd /= 0 -- This is used to check that other operations use only addresses -- that are in the same family. end record; procedure Finalize (Sock : in out Socket); ----------------------------------- type Stream_Socket_Ptr is access all Stream_Socket; type Input_Stream is new Ada.Streams.Root_Stream_Type with record sock : Stream_Socket_Ptr; end record; type Output_Stream is new Ada.Streams.Root_Stream_Type with record sock : Stream_Socket_Ptr; end record; type Stream_Socket is new Socket with record in_stream : aliased Input_Stream; out_stream : aliased Output_Stream; in_ptr : Input_Stream_Ptr; -- points to in_stream out_ptr : Output_Stream_Ptr; -- points to out_stream -- These pointers are needed to implement -- functions Get_InputStream and Get_OutputStream. end record; procedure Read (Stream : in out Input_Stream; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); procedure Write (Stream : in out Input_Stream; Item : in Ada.Streams.Stream_Element_Array); procedure Read (Stream : in out Output_Stream; Item : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset); procedure Write (Stream : in out Output_Stream; Item : in Ada.Streams.Stream_Element_Array); ----------------------------------- type Server_Socket is new Socket with null record; ----------------------------------- type Datagram_Socket is new Socket with null record; end Sockets; libflorist-2025.1.0/gnatsocks/sockettest.adb000066400000000000000000000015501473553204100207530ustar00rootroot00000000000000----------------------------------------------------------------------------- -- file : socketest.adb [$Revision$] ----------------------------------------------------------------------------- -- This is an indirect translation into GNAT Ada -- of the Java example in file "socketest.java". with ada.exceptions; with ada.text_io; with sockets; with sockets.internet; procedure sockettest is t : sockets.stream_socket; ins : sockets.input_stream_ptr; lf : constant character := character'val (10); ch : character := ' '; begin sockets.open (t, sockets.internet.new_address (12, "www.cs.fsu.edu")); ins := sockets.get_input_stream (t); while ch /= lf loop character'read (ins,ch); ada.text_io.put (ch); end loop; exception when e : others => ada.text_io.put_line ("error " & ada.exceptions.exception_name (e)); end sockettest; libflorist-2025.1.0/gnatsocks/table.adb000066400000000000000000000040451473553204100176540ustar00rootroot00000000000000-- file : table.adb [$Revision$] -- See package body (file tables.adb) for header comments. -- This implementation of the package uses a fixed-size array -- representation. What about other representations? -- Ted Baker, 13 January 1997 PACKAGE BODY TABLE IS Table_Size : constant := 100; Last_Entry : Natural := 0; type Pair is record Key : Key_String; Value : Value_String; end record; type Table_Type is array (1..Table_Size) of Pair; The_Table: Table_Type; procedure Set_Value (Key : in Key_String; Value : in Value_String) is begin for I in The_Table'First .. Last_Entry loop if The_Table(I).Key = Key then The_Table(I).Value := Value; return; end if; end loop; if Last_Entry = Table_Size then raise Overflow; end if; Last_Entry := Last_Entry + 1; The_Table(Last_Entry) := (Key=> Key, Value=> Value); end Set_Value; function Has_Value (Key : in Key_String) return Boolean is begin for I in The_Table'First .. Last_Entry loop if The_Table(I).Key = Key then return True; end if; end loop; return False; end Has_Value; function Value (Key : in Key_String) return Value_String is begin for I in The_Table'First .. Last_Entry loop if The_Table(I).Key = Key then return The_Table(I).Value; end if; end loop; raise Not_Found; end Value; -- generic -- with procedure Action (Key : in Key_String; Value : in Value_String); procedure Enumerate is begin for I in The_Table'First .. Last_Entry loop Action (The_Table(I).Key, The_Table(I).Value); end loop; end Enumerate; END TABLE; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1997/02/26 15:29:22; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- New changes after this line. Each line starts with: "-- " -- This version is just to check how the "checkin" and "checkout" scripts -- are working. libflorist-2025.1.0/gnatsocks/table.ads000066400000000000000000000032131473553204100176710ustar00rootroot00000000000000----------------------------------------------------------------------- -- file : table.ads [$Revision$] ----------------------------------------------------------------------- -- See file READ.ME for explanation of this and the other examples. -- Uppercase characters are used for emphasis of new features -- in this example, as compared with the other examples. package table is subtype key_string is string (1..10); subtype value_string is string (1..16); procedure set_value (key : in key_string; value : in value_string); function has_value (key : in key_string) return boolean; function value (key : in key_string) return value_string; generic with procedure action (key : in key_string; value : in value_string); procedure enumerate; not_found : exception; overflow : exception; end table; -- Table is an abstract data object that provides the -- ability to define a mapping from a finite set of strings -- of a given fixed length to strings of another fixed length. -- Set_Value attempts to modify Table, so that Key is mapped to Value. -- It raises Overflow if there is not enough space left in Table. -- Has_Value returns True iff Table contains a mapping for Key. -- It does not raise any exceptions. -- Value returns the value to which Key is mapped by Table, if -- Table contains a mapping for Key. -- Otherwise, Value raises Not_Found. -- Generic procedure Enumerate must be instantiated with a specific -- Action procedure to create a callable subprogram. The instantiation -- is a procedure that takes no argument, and calls the -- Action procedure for each (Key, Value) pair in Table. libflorist-2025.1.0/gnatsocks/test_sockets.adb000066400000000000000000000042151473553204100212760ustar00rootroot00000000000000------------------------------------------------------------------------ -- file : test_sockets.adb [$Revision$] ------------------------------------------------------------------------ -- The bare bones of a test for packages Sockets and Sockets.Internet. with Ada.Characters.Latin_1, POSIX_Report, Sockets, Sockets.Internet; procedure Test_Sockets is use POSIX_Report, Sockets, Sockets.Internet; Stream_Sock : Sockets.Stream_Socket; Server_Sock : Sockets.Server_Socket; In_Stream : Input_Stream_Ptr; Out_Strem : Output_Stream_Ptr; Lf : constant Character := Ada.Characters.Latin_1.Lf; Cr : constant Character := Ada.Characters.Latin_1.Cr; Localhost : Internet_Address; Telnet_Port : constant Port_Number := 23; Sockaddr : Internet_Socket_Address; begin Header ("Test_Sockets"); Test ("package Sockets"); declare Addr : Internet_Address; begin Test ("Local_Host"); Localhost := Local_Host; Test ("Get_Hostname"); declare Address : constant String := Get_AddressString (Localhost); begin Comment ("address = " & Address); declare Hostname : constant String := Get_HostByAddr (Localhost); begin Comment ("hostname = " & Hostname); Test ("Get_AddrByName"); Addr := Get_AddrByName (Hostname); Assert (Localhost = Addr, "A000: Get_AddrByName, Get_HostName"); end; end; Comment ("name of All_Local_Addresses = " & Get_HostByAddr (All_Local_Addresses)); exception when E : others => Fail (E, "A001"); end; declare Ch : Character; begin Test ("open stream socket to telnet port of local host"); Sockets.Open (Stream_Sock, Sockets.Internet.New_Address (Telnet_Port, Localhost)); In_Stream := Sockets.Get_Input_Stream (Stream_Sock); Test ("close"); Close (Stream_Sock); exception when E : others => Fail (E, "A002"); end; begin null; exception when E : others => Fail (E, "A003"); end; Done; exception when E : others => Fatal_Exception (E, "A004"); end Test_Sockets; libflorist-2025.1.0/gnatsocks/test_unix_sockets.adb000066400000000000000000000003471473553204100223430ustar00rootroot00000000000000-- The package Sockets.Unix has not been tested at all. -- This dummy test program just forces compilation, to check for -- syntax errors. with Sockets.Unix; procedure Text_Unix_Sockets is begin null; end Test_Unix_Sockets; libflorist-2025.1.0/libsrc/000077500000000000000000000000001473553204100153745ustar00rootroot00000000000000libflorist-2025.1.0/libsrc/ada_streams.ads000066400000000000000000000061051473553204100203520ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- A D A _ S T R E A M S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996, 1997 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- Copyright (C) 2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Streams; package Ada_Streams renames Ada.Streams; libflorist-2025.1.0/libsrc/posix-c.adb000066400000000000000000000076011473553204100174320ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with System.Storage_Elements; package body POSIX.C is use System.Storage_Elements; --------------- -- Advance -- --------------- procedure Advance (Ptr : in out char_ptr) is begin Ptr := To_Ptr (To_Address (Ptr) + char'Size / System.Storage_Unit); end Advance; procedure Advance (Ptr : in out char_ptr_ptr) is begin Ptr := To_Ptr (To_Address (Ptr) + char_ptr'Size / System.Storage_Unit); end Advance; ------------------------- -- Form_POSIX_String -- ------------------------- function strlen (str : char_ptr) return size_t; pragma Import (C, strlen, "strlen"); function Form_POSIX_String (Str : char_ptr) return POSIX.POSIX_String is begin if Str = null then return ""; end if; declare Result : constant POSIX.POSIX_String (1 .. Integer (strlen (Str))); for Result'Address use Str.all'Address; pragma Import (Ada, Result); begin return Result; end; end Form_POSIX_String; end POSIX.C; libflorist-2025.1.0/libsrc/posix-calendar.adb000066400000000000000000000167671473553204100207760ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C A L E N D A R -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- Copyright (C) 1998-2012, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- Note: we used to call c_time in order to keep some compatibility with -- POSIX.Files.Set_File_Times, but this seems obsolete now with modern -- file systems, and having a fine grain precision is more important anyway. with Ada.Unchecked_Conversion; package body POSIX.Calendar is package AC renames Ada.Calendar; use Ada.Calendar; POSIX_Epoch : constant Duration := AC.Time_Of (Year => 2150, Month => 1, Day => 1) - AC.Time_Of (Year => 1970, Month => 1, Day => 1); -- Time difference between POSIX and GNAT notion of time, measured as a -- duration since the Ada mid point pragma Warnings (Off); -- Disable warning that the representation of Time values may -- change between GNAT versions. function Duration_To_POSIX_Time is new Ada.Unchecked_Conversion (Duration, POSIX_Time); function POSIX_Time_To_Duration is new Ada.Unchecked_Conversion (POSIX_Time, Duration); pragma Warnings (On); ------------- -- Clock -- ------------- function Clock return POSIX_Time is begin return To_POSIX_Time (AC.Clock); end Clock; --------------- -- To_Time -- --------------- function To_Time (Date : POSIX_Time) return AC.Time is begin return AC.Time (Date) - POSIX_Epoch; end To_Time; --------------------- -- To_POSIX_Time -- --------------------- function To_POSIX_Time (Date : AC.Time) return POSIX_Time is begin return POSIX_Time (Date + POSIX_Epoch); end To_POSIX_Time; ------------ -- Year -- ------------ function Year (Date : POSIX_Time) return Year_Number is begin return Year_Number (AC.Year (To_Time (Date))); end Year; ------------- -- Month -- ------------- function Month (Date : POSIX_Time) return Month_Number is begin return AC.Month (To_Time (Date)); end Month; ----------- -- Day -- ----------- function Day (Date : POSIX_Time) return Day_Number is begin return AC.Day (To_Time (Date)); end Day; --------------- -- Seconds -- --------------- function Seconds (Date : POSIX_Time) return Day_Duration is begin return AC.Seconds (To_Time (Date)); end Seconds; ------------- -- Split -- ------------- procedure Split (Date : POSIX_Time; Year : out Year_Number; Month : out Month_Number; Day : out Day_Number; Seconds : out Day_Duration) is begin AC.Split (To_Time (Date), Year, Month, Day, Seconds); end Split; --------------- -- Time_Of -- --------------- function Time_Of (Year : Year_Number; Month : Month_Number; Day : Day_Number; Seconds : Day_Duration := 0.0) return POSIX_Time is begin return To_POSIX_Time (AC.Time_Of (Year, Month, Day, Seconds)); end Time_Of; ----------- -- "+" -- ----------- function "+" (L : POSIX_Time; R : Duration) return POSIX_Time is begin return To_POSIX_Time (To_Time (L) + R); end "+"; ----------- -- "+" -- ----------- function "+" (L : Duration; R : POSIX_Time) return POSIX_Time is begin return To_POSIX_Time (L + To_Time (R)); end "+"; ----------- -- "-" -- ----------- function "-" (L : POSIX_Time; R : Duration) return POSIX_Time is begin return To_POSIX_Time (To_Time (L) - R); end "-"; ----------- -- "-" -- ----------- function "-" (L : POSIX_Time; R : POSIX_Time) return Duration is begin return To_Time (L) - To_Time (R); end "-"; ----------- -- "<" -- ----------- function "<" (L, R : POSIX_Time) return Boolean is begin return To_Time (L) < To_Time (R); end "<"; ------------ -- "<=" -- ------------ function "<=" (L, R : POSIX_Time) return Boolean is begin return To_Time (L) <= To_Time (R); end "<="; ----------- -- ">" -- ----------- function ">" (L, R : POSIX_Time) return Boolean is begin return To_Time (L) > To_Time (R); end ">"; ------------ -- ">=" -- ------------ function ">=" (L, R : POSIX_Time) return Boolean is begin return To_Time (L) >= To_Time (R); end ">="; --------------------- -- To_POSIX_Time -- --------------------- function To_POSIX_Time (Date : POSIX.Timespec) return POSIX_Time is begin return Duration_To_POSIX_Time (POSIX.To_Duration (Date)); end To_POSIX_Time; ------------------- -- To_Timespec -- ------------------- function To_Timespec (Date : POSIX_Time) return POSIX.Timespec is begin return POSIX.To_Timespec (POSIX_Time_To_Duration (Date)); end To_Timespec; end POSIX.Calendar; libflorist-2025.1.0/libsrc/posix-calendar.ads000066400000000000000000000110051473553204100207730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C A L E N D A R -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with Ada.Calendar; package POSIX.Calendar is -- Time information type POSIX_Time is private; function Clock return POSIX_Time; function To_Time (Date : POSIX_Time) return Ada.Calendar.Time; function To_POSIX_Time (Date : Ada.Calendar.Time) return POSIX_Time; -- operations on POSIX_Time subtype Year_Number is Ada.Calendar.Year_Number; subtype Month_Number is Ada.Calendar.Month_Number; subtype Day_Number is Ada.Calendar.Day_Number; subtype Day_Duration is Ada.Calendar.Day_Duration; function Year (Date : POSIX_Time) return Year_Number; function Month (Date : POSIX_Time) return Month_Number; function Day (Date : POSIX_Time) return Day_Number; function Seconds (Date : POSIX_Time) return Day_Duration; procedure Split (Date : POSIX_Time; Year : out Year_Number; Month : out Month_Number; Day : out Day_Number; Seconds : out Day_Duration); function Time_Of (Year : Year_Number; Month : Month_Number; Day : Day_Number; Seconds : Day_Duration := 0.0) return POSIX_Time; function "+" (L : POSIX_Time; R : Duration) return POSIX_Time; function "+" (L : Duration; R : POSIX_Time) return POSIX_Time; function "-" (L : POSIX_Time; R : Duration) return POSIX_Time; function "-" (L : POSIX_Time; R : POSIX_Time) return Duration; function "<" (L, R : POSIX_Time) return Boolean; function "<=" (L, R : POSIX_Time) return Boolean; function ">" (L, R : POSIX_Time) return Boolean; function ">=" (L, R : POSIX_Time) return Boolean; Time_Error : exception renames Ada.Calendar.Time_Error; function To_POSIX_Time (Date : POSIX.Timespec) return POSIX_Time; function To_Timespec (Date : POSIX_Time) return POSIX.Timespec; private type POSIX_Time is new Ada.Calendar.Time; end POSIX.Calendar; libflorist-2025.1.0/libsrc/posix-configurable_file_limits.adb000066400000000000000000000355251473553204100242360ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C O N F I G U R A B L E _ F I L E _ L I M I T S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Implementation; package body POSIX.Configurable_File_Limits is use POSIX.C; use POSIX.Implementation; ------------------------- -- Local Subprograms -- ------------------------- function pathconf (path : char_ptr; name : int) return long; pragma Import (C, pathconf, pathconf_LINKNAME); function fpathconf (fd : int; name : int) return long; pragma Import (C, fpathconf, fpathconf_LINKNAME); function Is_Limited (Pathname : POSIX.Pathname; PC_Code : int) return Boolean; function Is_Limited (File : POSIX.IO.File_Descriptor; PC_Code : int) return Boolean; function Is_Supported (Pathname : POSIX.Pathname; PC_Code : int) return Boolean; function Is_Supported (File : POSIX.IO.File_Descriptor; PC_Code : int) return Boolean; function Limit (Pathname : POSIX.Pathname; PC_Code : int; Default_Maximum : long) return long; function Limit (File : POSIX.IO.File_Descriptor; PC_Code : int; Default_Maximum : long) return long; function Is_Limited (Pathname : POSIX.Pathname; PC_Code : int) return Boolean is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Store_Errno (0); -- -1 without errno unchanged -> no limit -- -1 with errno -> bad name or other error -- other values -> there exists a limit if pathconf (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, PC_Code) = -1 then if Fetch_Errno /= 0 then Raise_POSIX_Error; end if; return False; else return True; end if; end Is_Limited; function Is_Limited (File : POSIX.IO.File_Descriptor; PC_Code : int) return Boolean is begin Store_Errno (0); if fpathconf (int (File), PC_Code) = -1 then if Fetch_Errno /= 0 then Raise_POSIX_Error; end if; return False; else return True; end if; end Is_Limited; function Limit (Pathname : POSIX.Pathname; PC_Code : int; Default_Maximum : long) return long is Pathname_With_NUL : POSIX_String := Pathname & NUL; Result : long; begin Result := pathconf (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, PC_Code); if Result = -1 then if Fetch_Errno /= 0 then Raise_POSIX_Error; end if; return Default_Maximum; else return Result; end if; end Limit; function Limit (File : POSIX.IO.File_Descriptor; PC_Code : int; Default_Maximum : long) return long is Result : long; begin Result := fpathconf (int (File), PC_Code); if Result = -1 then if Fetch_Errno /= 0 then Raise_POSIX_Error; end if; return Default_Maximum; else return Result; end if; end Limit; function Is_Supported (Pathname : POSIX.Pathname; PC_Code : int) return Boolean is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin return pathconf (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, PC_Code) /= 0; end Is_Supported; function Is_Supported (File : POSIX.IO.File_Descriptor; PC_Code : int) return Boolean is begin return fpathconf (int (File), PC_Code) /= 0; end Is_Supported; ------------------- -- Link Limits -- ------------------- function Link_Is_Limited (Pathname : POSIX.Pathname) return Boolean is begin return Is_Limited (Pathname, PC_LINK_MAX); end Link_Is_Limited; function Link_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Limited (File, PC_LINK_MAX); end Link_Is_Limited; function Link_Limit (Pathname : POSIX.Pathname) return Link_Limit_Maxima is begin return Link_Limit_Maxima (Limit (Pathname, PC_LINK_MAX, long (Link_Limit_Maxima'Last))); end Link_Limit; function Link_Limit (File : POSIX.IO.File_Descriptor) return Link_Limit_Maxima is begin return Link_Limit_Maxima (Limit (File, PC_LINK_MAX, long (Link_Limit_Maxima'Last))); end Link_Limit; ------------------------ -- Input Line Limits -- ------------------------ function Input_Line_Is_Limited (Pathname : POSIX.Pathname) return Boolean is begin return Is_Limited (Pathname, PC_MAX_CANON); end Input_Line_Is_Limited; function Input_Line_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Limited (File, PC_MAX_CANON); end Input_Line_Is_Limited; function Input_Line_Limit (Pathname : POSIX.Pathname) return Input_Line_Limit_Maxima is begin return Input_Line_Limit_Maxima (Limit (Pathname, PC_MAX_CANON, long (Input_Line_Limit_Maxima'Last))); end Input_Line_Limit; function Input_Line_Limit (File : POSIX.IO.File_Descriptor) return Input_Line_Limit_Maxima is begin return Input_Line_Limit_Maxima (Limit (File, PC_MAX_CANON, long (Input_Line_Limit_Maxima'Last))); end Input_Line_Limit; ------------------------- -- Input Queue Limits -- ------------------------- function Input_Queue_Is_Limited (Pathname : POSIX.Pathname) return Boolean is begin return Is_Limited (Pathname, PC_MAX_INPUT); end Input_Queue_Is_Limited; function Input_Queue_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Limited (File, PC_MAX_INPUT); end Input_Queue_Is_Limited; function Input_Queue_Limit (Pathname : POSIX.Pathname) return Input_Queue_Limit_Maxima is begin return Input_Queue_Limit_Maxima (Limit (Pathname, PC_MAX_INPUT, long (Input_Queue_Limit_Maxima'Last))); end Input_Queue_Limit; function Input_Queue_Limit (File : POSIX.IO.File_Descriptor) return Input_Queue_Limit_Maxima is begin return Input_Queue_Limit_Maxima (Limit (File, PC_MAX_INPUT, long (Input_Queue_Limit_Maxima'Last))); end Input_Queue_Limit; ------------------------------------ -- Filename And Pathname Limits -- ------------------------------------ function Filename_Is_Limited (Pathname : POSIX.Pathname) return Boolean is begin return Is_Limited (Pathname, PC_NAME_MAX); end Filename_Is_Limited; function Filename_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Limited (File, PC_NAME_MAX); end Filename_Is_Limited; function Filename_Limit (Pathname : POSIX.Pathname) return Filename_Limit_Maxima is begin return Filename_Limit_Maxima (Limit (Pathname, PC_NAME_MAX, long (Filename_Limit_Maxima'Last))); end Filename_Limit; function Filename_Limit (File : POSIX.IO.File_Descriptor) return Filename_Limit_Maxima is begin return Filename_Limit_Maxima (Limit (File, PC_NAME_MAX, long (Filename_Limit_Maxima'Last))); end Filename_Limit; function Pathname_Is_Limited (Pathname : POSIX.Pathname) return Boolean is begin return Is_Limited (Pathname, PC_PATH_MAX); end Pathname_Is_Limited; function Pathname_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Limited (File, PC_PATH_MAX); end Pathname_Is_Limited; function Pathname_Limit (Pathname : POSIX.Pathname) return Pathname_Limit_Maxima is begin return Pathname_Limit_Maxima (Limit (Pathname, PC_PATH_MAX, long (Pathname_Limit_Maxima'Last))); end Pathname_Limit; function Pathname_Limit (File : POSIX.IO.File_Descriptor) return Pathname_Limit_Maxima is begin return Pathname_Limit_Maxima (Limit (File, PC_PATH_MAX, long (Pathname_Limit_Maxima'Last))); end Pathname_Limit; -------------------------- -- Pipe Length Limits -- -------------------------- function Pipe_Length_Is_Limited (Pathname : POSIX.Pathname) return Boolean is begin return Is_Limited (Pathname, PC_PIPE_BUF); end Pipe_Length_Is_Limited; function Pipe_Length_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Limited (File, PC_PIPE_BUF); end Pipe_Length_Is_Limited; function Pipe_Length_Limit (Pathname : POSIX.Pathname) return Pipe_Limit_Maxima is begin return Pipe_Limit_Maxima (Limit (Pathname, PC_PIPE_BUF, long (Pipe_Limit_Maxima'Last))); end Pipe_Length_Limit; function Pipe_Length_Limit (File : POSIX.IO.File_Descriptor) return Pipe_Limit_Maxima is begin return Pipe_Limit_Maxima (Limit (File, PC_PIPE_BUF, long (Pipe_Limit_Maxima'Last))); end Pipe_Length_Limit; -------------------------------- -- Change Owner Restriction -- -------------------------------- function Change_Owner_Is_Restricted (Pathname : POSIX.Pathname) return Change_Owner_Restriction is begin return Is_Supported (Pathname, PC_CHOWN_RESTRICTED); end Change_Owner_Is_Restricted; function Change_Owner_Is_Restricted (File : POSIX.IO.File_Descriptor) return Change_Owner_Restriction is begin return Is_Supported (File, PC_CHOWN_RESTRICTED); end Change_Owner_Is_Restricted; --------------------------- -- Filename Truncation -- --------------------------- function Filename_Is_Truncated (Pathname : POSIX.Pathname) return Filename_Truncation is begin return Is_Supported (Pathname, PC_NO_TRUNC); end Filename_Is_Truncated; function Filename_Is_Truncated (File : POSIX.IO.File_Descriptor) return Filename_Truncation is begin return Is_Supported (File, PC_NO_TRUNC); end Filename_Is_Truncated; ----------------------- -- Synchronized IO -- ----------------------- function Synchronized_IO_Is_Supported (Pathname : POSIX.Pathname) return Boolean is begin return Is_Supported (Pathname, PC_SYNC_IO); end Synchronized_IO_Is_Supported; function Synchronized_IO_Is_Supported (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Supported (File, PC_SYNC_IO); end Synchronized_IO_Is_Supported; ----------------------- -- Asynchronous IO -- ----------------------- function Asynchronous_IO_Is_Supported (Pathname : POSIX.Pathname) return Boolean is begin return Is_Supported (Pathname, PC_ASYNC_IO); end Asynchronous_IO_Is_Supported; function Asynchronous_IO_Is_Supported (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Supported (File, PC_ASYNC_IO); end Asynchronous_IO_Is_Supported; ---------------------- -- Prioritized IO -- ---------------------- function Prioritized_IO_Is_Supported (Pathname : POSIX.Pathname) return Boolean is begin return Is_Supported (Pathname, PC_PRIO_IO); end Prioritized_IO_Is_Supported; function Prioritized_IO_Is_Supported (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Supported (File, PC_PRIO_IO); end Prioritized_IO_Is_Supported; -- POSIX.5c [D2] additions function Socket_Buffer_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean is begin return Is_Limited (File, PC_SOCK_MAXBUF); end Socket_Buffer_Is_Limited; function Socket_Buffer_Is_Limited (Pathname : POSIX.Pathname) return Boolean is begin return Is_Limited (Pathname, PC_SOCK_MAXBUF); end Socket_Buffer_Is_Limited; function Socket_Buffer_Limit (Pathname : POSIX.Pathname) return POSIX.Limits.Socket_Buffer_Maxima is begin return POSIX.Limits.Socket_Buffer_Maxima (Limit (Pathname, PC_SOCK_MAXBUF, long (POSIX.Limits.Socket_Buffer_Maxima'Last))); end Socket_Buffer_Limit; function Socket_Buffer_Limit (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Socket_Buffer_Maxima is begin return POSIX.Limits.Socket_Buffer_Maxima (Limit (File, PC_SOCK_MAXBUF, long (POSIX.Limits.Socket_Buffer_Maxima'Last))); end Socket_Buffer_Limit; end POSIX.Configurable_File_Limits; libflorist-2025.1.0/libsrc/posix-configurable_file_limits.ads000066400000000000000000000220501473553204100242440ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C O N F I G U R A B L E _ F I L E _ L I M I T S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.IO, POSIX.Limits, POSIX.Options; package POSIX.Configurable_File_Limits is function Link_Is_Limited (Pathname : POSIX.Pathname) -- obsolescent return Boolean; -- obsolescent function Link_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean; -- obsolescent function Link_Limit (Pathname : POSIX.Pathname) -- obsolescent return POSIX.Link_Limit_Maxima; -- obsolescent function Link_Limit (File : POSIX.IO.File_Descriptor) -- obsolescent return POSIX.Link_Limit_Maxima; -- obsolescent function Links_Are_Limited (Pathname : POSIX.Pathname) return Boolean renames Link_Is_Limited; function Links_Are_Limited (File : POSIX.IO.File_Descriptor) return Boolean renames Link_Is_Limited; function Links_Maximum (Pathname : POSIX.Pathname) return POSIX.Limits.Links_Maxima renames Link_Limit; function Links_Maximum (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Links_Maxima renames Link_Limit; function Input_Line_Is_Limited (Pathname : POSIX.Pathname) return Boolean; function Input_Line_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean; function Input_Line_Limit (Pathname : POSIX.Pathname) -- obsolescent return POSIX.Input_Line_Limit_Maxima; -- obsolescent function Input_Line_Limit (File : POSIX.IO.File_Descriptor) return POSIX.Input_Line_Limit_Maxima; -- obsolescent function Input_Line_Maximum (Pathname : POSIX.Pathname) return POSIX.Limits.Input_Line_Maxima renames Input_Line_Limit; function Input_Line_Maximum (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Input_Line_Maxima renames Input_Line_Limit; function Input_Queue_Is_Limited (Pathname : POSIX.Pathname) return Boolean; function Input_Queue_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean; function Input_Queue_Limit (Pathname : POSIX.Pathname) -- obsolescent return POSIX.Input_Queue_Limit_Maxima; -- obsolescent function Input_Queue_Limit (File : POSIX.IO.File_Descriptor) return POSIX.Input_Queue_Limit_Maxima; -- obsolescent function Input_Queue_Maximum (Pathname : POSIX.Pathname) return POSIX.Limits.Input_Queue_Maxima renames Input_Queue_Limit; function Input_Queue_Maximum (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Input_Queue_Maxima renames Input_Queue_Limit; function Filename_Is_Limited (Pathname : POSIX.Pathname) return Boolean; function Filename_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean; function Filename_Limit (Pathname : POSIX.Pathname) -- obsolescent return POSIX.Filename_Limit_Maxima; -- obsolescent function Filename_Limit (File : POSIX.IO.File_Descriptor) return POSIX.Filename_Limit_Maxima; -- obsolescent function Filename_Maximum (Pathname : POSIX.Pathname) return POSIX.Limits.Filename_Maxima renames Filename_Limit; function Filename_Maximum (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Filename_Maxima renames Filename_Limit; function Pathname_Is_Limited (Pathname : POSIX.Pathname) return Boolean; function Pathname_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean; function Pathname_Limit (Pathname : POSIX.Pathname) -- obsolescent return POSIX.Pathname_Limit_Maxima; -- obsolescent function Pathname_Limit (File : POSIX.IO.File_Descriptor) return POSIX.Pathname_Limit_Maxima; -- obsolescent function Pathname_Maximum (Pathname : POSIX.Pathname) return POSIX.Limits.Pathname_Maxima renames Pathname_Limit; function Pathname_Maximum (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Pathname_Maxima renames Pathname_Limit; function Pipe_Length_Is_Limited (Pathname : POSIX.Pathname) return Boolean; function Pipe_Length_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean; function Pipe_Length_Limit (Pathname : POSIX.Pathname) -- obsolescent return POSIX.Pipe_Limit_Maxima; -- obsolescent function Pipe_Length_Limit (File : POSIX.IO.File_Descriptor) return POSIX.Pipe_Limit_Maxima; function Pipe_Length_Maximum (Pathname : POSIX.Pathname) return POSIX.Limits.Pipe_Length_Maxima renames Pipe_Length_Limit; function Pipe_Length_Maximum (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Pipe_Length_Maxima renames Pipe_Length_Limit; function Change_Owner_Is_Restricted (Pathname : POSIX.Pathname) return POSIX.Options.Change_Owner_Restriction; function Change_Owner_Is_Restricted (File : POSIX.IO.File_Descriptor) return POSIX.Options.Change_Owner_Restriction; function Filename_Is_Truncated (Pathname : POSIX.Pathname) return POSIX.Options.Filename_Truncation; function Filename_Is_Truncated (File : POSIX.IO.File_Descriptor) return POSIX.Options.Filename_Truncation; function Synchronized_IO_Is_Supported (Pathname : POSIX.Pathname) return Boolean; function Synchronized_IO_Is_Supported (File : POSIX.IO.File_Descriptor) return Boolean; function Asynchronous_IO_Is_Supported (Pathname : POSIX.Pathname) return Boolean; function Asynchronous_IO_Is_Supported (File : POSIX.IO.File_Descriptor) return Boolean; function Prioritized_IO_Is_Supported (Pathname : POSIX.Pathname) return Boolean; function Prioritized_IO_Is_Supported (File : POSIX.IO.File_Descriptor) return Boolean; -- Additions from POSIX.5c [Draft 2] -- 5.4.1 Socket Buffer Limits from P1003.5c function Socket_Buffer_Is_Limited (File : POSIX.IO.File_Descriptor) return Boolean; function Socket_Buffer_Is_Limited (Pathname : POSIX.Pathname) return Boolean; -- The following deviate from POSIX.5c/D1 function Socket_Buffer_Limit (Pathname : POSIX.Pathname) return POSIX.Limits.Socket_Buffer_Maxima; function Socket_Buffer_Limit (File : POSIX.IO.File_Descriptor) return POSIX.Limits.Socket_Buffer_Maxima; -- Craig Meyers has in D1: -- function Socket_Buffer_Maximum -- return POSIX.Limits.Socket_Buffer_Maxima; end POSIX.Configurable_File_Limits; libflorist-2025.1.0/libsrc/posix-configurable_system_limits.adb000066400000000000000000000312071473553204100246340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C O N F I G U R A B L E _ S Y S T E M _ L I M I T S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ package body POSIX.Configurable_System_Limits is package PO renames POSIX.Options; package PL renames POSIX.Limits; use POSIX.C; function sysconf (c_name : int) return long; pragma Import (C, sysconf, sysconf_LINKNAME); generic type Support_Subtype is range <>; Name : int; function Limit return Support_Subtype; function Limit return Support_Subtype is Result : long; begin Result := sysconf (Name); if Result = -1 then return Support_Subtype'Last; end if; return Support_Subtype (Result); end Limit; function Asynchronous_IO_Is_Supported return PO.Asynchronous_IO_Support is begin return sysconf (SC_ASYNCHRONOUS_IO) = 1; end Asynchronous_IO_Is_Supported; function File_Synchronization_Is_Supported return PO.File_Synchronization_Support is begin return sysconf (SC_FSYNC) = 1; end File_Synchronization_Is_Supported; function Job_Control_Supported return Job_Control_Support is begin return sysconf (SC_JOB_CONTROL) = 1; end Job_Control_Supported; function Memory_Mapped_Files_Are_Supported return PO.Memory_Mapped_Files_Support is begin return sysconf (SC_MAPPED_FILES) = 1; end Memory_Mapped_Files_Are_Supported; function Memory_Locking_Is_Supported return PO.Memory_Locking_Support is begin return sysconf (SC_MEMLOCK) = 1; end Memory_Locking_Is_Supported; function Memory_Range_Locking_Is_Supported return PO.Memory_Range_Locking_Support is begin return sysconf (SC_MEMLOCK_RANGE) = 1; end Memory_Range_Locking_Is_Supported; function Memory_Protection_Is_Supported return PO.Memory_Protection_Support is begin return sysconf (SC_MEMORY_PROTECTION) = 1; end Memory_Protection_Is_Supported; function Message_Queues_Are_Supported return PO.Message_Queues_Support is begin return sysconf (SC_MESSAGE_PASSING) = 1; end Message_Queues_Are_Supported; function Mutex_Priority_Ceiling_Is_Supported return PO.Mutex_Priority_Ceiling_Support is begin return sysconf (SC_THREAD_PRIO_PROTECT) = 1; end Mutex_Priority_Ceiling_Is_Supported; function Mutex_Priority_Inheritance_Is_Supported return PO.Mutex_Priority_Inheritance_Support is begin return sysconf (SC_THREAD_PRIO_INHERIT) = 1; end Mutex_Priority_Inheritance_Is_Supported; function Mutexes_Are_Supported return PO.Mutexes_Support is begin return True; end Mutexes_Are_Supported; function Prioritized_IO_Is_Supported return PO.Prioritized_IO_Support is begin return sysconf (SC_PRIORITIZED_IO) = 1; end Prioritized_IO_Is_Supported; function Priority_Process_Scheduling_Is_Supported return PO.Priority_Process_Scheduling_Support is begin return sysconf (SC_PRIORITY_SCHEDULING) = 1; end Priority_Process_Scheduling_Is_Supported; function Priority_Task_Scheduling_Is_Supported return PO.Priority_Task_Scheduling_Support is begin return sysconf (SC_THREAD_PRIORITY_SCHEDULING) = 1; end Priority_Task_Scheduling_Is_Supported; function Realtime_Signals_Are_Supported return PO.Realtime_Signals_Support is begin return sysconf (SC_REALTIME_SIGNALS) = 1; end Realtime_Signals_Are_Supported; function Saved_IDs_Supported return PO.Saved_IDs_Support is begin return sysconf (SC_SAVED_IDS) = 1; end Saved_IDs_Supported; function Semaphores_Are_Supported return PO.Semaphores_Support is begin return sysconf (SC_SEMAPHORES) = 1; end Semaphores_Are_Supported; function Shared_Memory_Objects_Are_Supported return PO.Shared_Memory_Objects_Support is begin return sysconf (SC_SHARED_MEMORY_OBJECTS) = 1; end Shared_Memory_Objects_Are_Supported; function Process_Shared_Is_Supported return PO.Process_Shared_Support is begin return sysconf (SC_THREAD_PROCESS_SHARED) = 1; end Process_Shared_Is_Supported; function Synchronized_IO_Is_Supported return PO.Synchronized_IO_Support is begin return sysconf (SC_SYNCHRONIZED_IO) = 1; end Synchronized_IO_Is_Supported; function Timers_Are_Supported return PO.Timers_Support is begin return sysconf (SC_TIMERS) = 1; end Timers_Are_Supported; function System_POSIX_Version return POSIX_Version is begin return POSIX_Version (sysconf (SC_VERSION)); end System_POSIX_Version; function System_POSIX_Ada_Version return POSIX_Version is begin return POSIX_Ada_Version; end System_POSIX_Ada_Version; function ALM is new Limit (PL.Argument_List_Maxima, SC_ARG_MAX); function Argument_List_Maximum return POSIX.Limits.Argument_List_Maxima renames ALM; function AIOM is new Limit (PL.Asynchronous_IO_Maxima, SC_AIO_MAX); function Asynchronous_IO_Maximum return PL.Asynchronous_IO_Maxima renames AIOM; function AIOPDM is new Limit (PL.Asynchronous_IO_Priority_Delta_Maxima, SC_AIO_PRIO_DELTA_MAX); function Asynchronous_IO_Priority_Delta_Maximum return PL.Asynchronous_IO_Priority_Delta_Maxima renames AIOPDM; function CPM is new Limit (PL.Child_Processes_Maxima, SC_CHILD_MAX); function Child_Processes_Maximum return PL.Child_Processes_Maxima renames CPM; function GM is new Limit (PL.Groups_Maxima, SC_NGROUPS_MAX); function Groups_Maximum return PL.Groups_Maxima renames GM; function LIOM is new Limit (PL.List_IO_Maxima, SC_AIO_LISTIO_MAX); function List_IO_Maximum return PL.List_IO_Maxima renames LIOM; function OMQM is new Limit (PL.Open_Message_Queues_Maxima, SC_MQ_OPEN_MAX); function Open_Message_Queues_Maximum return PL.Open_Message_Queues_Maxima renames OMQM; function MPM is new Limit (PL.Message_Priority_Maxima, SC_MQ_PRIO_MAX); function Message_Priority_Maximum return PL.Message_Priority_Maxima renames MPM; function OFM is new Limit (PL.Open_Files_Maxima, SC_OPEN_MAX); function Open_Files_Maximum return PL.Open_Files_Maxima renames OFM; function PSR is new Limit (PL.Page_Size_Range, SC_PAGESIZE); function Page_Size return PL.Page_Size_Range renames PSR; function QSM is new Limit (PL.Queued_Signals_Maxima, SC_SIGQUEUE_MAX); function Queued_Signals_Maximum return PL.Queued_Signals_Maxima renames QSM; function RSM is new Limit (PL.Realtime_Signals_Maxima, SC_RTSIG_MAX); function Realtime_Signals_Maximum return PL.Realtime_Signals_Maxima renames RSM; function SEM is new Limit (PL.Semaphores_Maxima, SC_SEM_NSEMS_MAX); function Semaphores_Maximum return PL.Semaphores_Maxima renames SEM; function SVM is new Limit (PL.Semaphores_Value_Maxima, SC_SEM_VALUE_MAX); function Semaphores_Value_Maximum return PL.Semaphores_Value_Maxima renames SVM; function STM is new Limit (PL.Streams_Maxima, SC_STREAM_MAX); function Stream_Maximum return PL.Streams_Maxima renames STM; function TM is new Limit (PL.Timers_Maxima, SC_TIMER_MAX); function Timers_Maximum return PL.Timers_Maxima renames TM; function TOM is new Limit (PL.Timer_Overruns_Maxima, SC_DELAYTIMER_MAX); function Timer_Overruns_Maximum return PL.Timer_Overruns_Maxima renames TOM; function TZSM is new Limit (PL.Time_Zone_String_Maxima, SC_TZNAME_MAX); function Time_Zone_String_Maximum return PL.Time_Zone_String_Maxima renames TZSM; -- additions from POSIX.5c [D2] -- POSIX.5c/D4 extensions function Internet_Datagram_Is_Supported return POSIX.Options.Internet_Datagram_Support is begin return sysconf (SC_PII_INTERNET_DGRAM) = 1; end Internet_Datagram_Is_Supported; function Internet_Protocol_Is_Supported return POSIX.Options.Internet_Protocol_Support is begin return sysconf (SC_PII_INTERNET) = 1; end Internet_Protocol_Is_Supported; function Internet_Stream_Is_Supported return POSIX.Options.Internet_Stream_Support is begin return sysconf (SC_PII_INTERNET_STREAM) = 1; end Internet_Stream_Is_Supported; function ISO_OSI_Protocol_Is_Supported return POSIX.Options.ISO_OSI_Protocol_Support is begin return sysconf (SC_PII_OSI) = 1; end ISO_OSI_Protocol_Is_Supported; function Network_Management_Is_Supported return POSIX.Options.Network_Management_Support is begin return sysconf (SC_POSIX_PII_NET_SUPPORT) = 1; end Network_Management_Is_Supported; function OSI_Connectionless_Is_Supported return POSIX.Options.OSI_Connectionless_Support is begin return sysconf (SC_PII_OSI_CLTS) = 1; end OSI_Connectionless_Is_Supported; function OSI_Connection_Is_Supported return POSIX.Options.OSI_Connection_Support is begin return sysconf (SC_PII_OSI_COTS) = 1; end OSI_Connection_Is_Supported; function OSI_Minimal_Is_Supported return POSIX.Options.OSI_Minimal_Support is begin return sysconf (SC_PII_OSI_M) = 1; end OSI_Minimal_Is_Supported; function Poll_Is_Supported return POSIX.Options.Poll_Support is begin return sysconf (SC_POLL) = 1; end Poll_Is_Supported; function Select_Is_Supported return POSIX.Options.Select_Support is begin return sysconf (SC_SELECT) = 1; end Select_Is_Supported; function Sockets_DNI_Is_Supported return POSIX.Options.Sockets_DNI_Support is begin return sysconf (SC_PII_SOCKET) = 1; end Sockets_DNI_Is_Supported; function XTI_DNI_Is_Supported return POSIX.Options.XTI_DNI_Support is begin return sysconf (SC_PII_XTI) = 1; end XTI_DNI_Is_Supported; function SIOVM is new Limit (PL.Socket_IO_Vector_Maxima, SC_UIO_MAXIOV); function Socket_IO_Vector_Maximum return POSIX.Limits.Socket_IO_Vector_Maxima renames SIOVM; end POSIX.Configurable_System_Limits; libflorist-2025.1.0/libsrc/posix-configurable_system_limits.ads000066400000000000000000000200311473553204100246460ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C O N F I G U R A B L E _ S Y S T E M _ L I M I T S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Limits, POSIX.Options; package POSIX.Configurable_System_Limits is function Asynchronous_IO_Is_Supported return POSIX.Options.Asynchronous_IO_Support; function File_Synchronization_Is_Supported return POSIX.Options.File_Synchronization_Support; function Job_Control_Supported -- obsolescent return POSIX.Job_Control_Support; -- obsolescent function Job_Control_Is_Supported return POSIX.Options.Job_Control_Support renames Job_Control_Supported; function Memory_Mapped_Files_Are_Supported return POSIX.Options.Memory_Mapped_Files_Support; function Memory_Locking_Is_Supported return POSIX.Options.Memory_Locking_Support; function Memory_Range_Locking_Is_Supported return POSIX.Options.Memory_Range_Locking_Support; function Memory_Protection_Is_Supported return POSIX.Options.Memory_Protection_Support; function Message_Queues_Are_Supported return POSIX.Options.Message_Queues_Support; function Mutex_Priority_Ceiling_Is_Supported return POSIX.Options.Mutex_Priority_Ceiling_Support; function Mutex_Priority_Inheritance_Is_Supported return POSIX.Options.Mutex_Priority_Inheritance_Support; function Mutexes_Are_Supported return POSIX.Options.Mutexes_Support; function Prioritized_IO_Is_Supported return POSIX.Options.Prioritized_IO_Support; function Process_Shared_Is_Supported return POSIX.Options.Process_Shared_Support; function Priority_Process_Scheduling_Is_Supported return POSIX.Options.Priority_Process_Scheduling_Support; function Priority_Task_Scheduling_Is_Supported return POSIX.Options.Priority_Task_Scheduling_Support; function Realtime_Signals_Are_Supported return POSIX.Options.Realtime_Signals_Support; function Saved_IDs_Supported -- obsolescent return POSIX.Saved_IDs_Support; -- obsolescent function Saved_IDs_Are_Supported return POSIX.Options.Saved_IDs_Support renames Saved_IDs_Supported; function Semaphores_Are_Supported return POSIX.Options.Semaphores_Support; function Shared_Memory_Objects_Are_Supported return POSIX.Options.Shared_Memory_Objects_Support; function Synchronized_IO_Is_Supported return POSIX.Options.Synchronized_IO_Support; function Timers_Are_Supported return POSIX.Options.Timers_Support; type POSIX_Version is new POSIX.C.long; function System_POSIX_Version return POSIX_Version; function System_POSIX_Ada_Version return POSIX_Version; function Argument_List_Maximum return POSIX.Limits.Argument_List_Maxima; function Asynchronous_IO_Maximum return POSIX.Limits.Asynchronous_IO_Maxima; function Asynchronous_IO_Priority_Delta_Maximum return POSIX.Limits.Asynchronous_IO_Priority_Delta_Maxima; function Child_Processes_Maximum return POSIX.Limits.Child_Processes_Maxima; function Groups_Maximum return POSIX.Limits.Groups_Maxima; function List_IO_Maximum return POSIX.Limits.List_IO_Maxima; function Open_Message_Queues_Maximum return POSIX.Limits.Open_Message_Queues_Maxima; function Message_Priority_Maximum return POSIX.Limits.Message_Priority_Maxima; function Open_Files_Maximum return POSIX.Limits.Open_Files_Maxima; function Page_Size return POSIX.Limits.Page_Size_Range; function Queued_Signals_Maximum return POSIX.Limits.Queued_Signals_Maxima; function Realtime_Signals_Maximum return POSIX.Limits.Realtime_Signals_Maxima; function Semaphores_Maximum return POSIX.Limits.Semaphores_Maxima; function Semaphores_Value_Maximum return POSIX.Limits.Semaphores_Value_Maxima; function Stream_Maximum -- obsolescent return POSIX.Stream_Maxima; -- obsolescent function Streams_Maximum return POSIX.Limits.Streams_Maxima renames Stream_Maximum; function Timers_Maximum return POSIX.Limits.Timers_Maxima; function Timer_Overruns_Maximum return POSIX.Limits.Timer_Overruns_Maxima; function Time_Zone_String_Maximum return POSIX.Limits.Time_Zone_String_Maxima; -- POSIX.5c/D4 extensions function Internet_Datagram_Is_Supported return POSIX.Options.Internet_Datagram_Support; function Internet_Protocol_Is_Supported return POSIX.Options.Internet_Protocol_Support; function Internet_Stream_Is_Supported return POSIX.Options.Internet_Stream_Support; function ISO_OSI_Protocol_Is_Supported return POSIX.Options.ISO_OSI_Protocol_Support; function Network_Management_Is_Supported return POSIX.Options.Network_Management_Support; function OSI_Connectionless_Is_Supported return POSIX.Options.OSI_Connectionless_Support; function OSI_Connection_Is_Supported return POSIX.Options.OSI_Connection_Support; function OSI_Minimal_Is_Supported return POSIX.Options.OSI_Minimal_Support; function Poll_Is_Supported return POSIX.Options.Poll_Support; function Select_Is_Supported return POSIX.Options.Select_Support; function Sockets_DNI_Is_Supported return POSIX.Options.Sockets_DNI_Support; function Socket_IO_Vector_Maximum return POSIX.Limits.Socket_IO_Vector_Maxima; function XTI_DNI_Is_Supported return POSIX.Options.XTI_DNI_Support; end POSIX.Configurable_System_Limits; libflorist-2025.1.0/libsrc/posix-error_codes.ads000066400000000000000000000070201473553204100215320ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . E R R O R _ C O D E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996-1999 Florida State University (FSU), All Rights -- -- Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- It may seem that this mechanism should not be necessary, since the -- errno value supported by the C-language interface is per-thread. -- Unfortunately, that per-thread value may be overwritten by -- implicit OS service calls that take place between the point an -- exception is raised and the point that it is handled. For -- example, if raising an exception involves calling longjmp(), the -- longjmp() call may overwrite the previous errno value. Since this -- mechanism does add overhead, we are making its use selectable, via -- gnatprep. with Ada.Task_Attributes; package POSIX.Error_Codes is new Ada.Task_Attributes (POSIX.Error_Code, POSIX.No_Error); libflorist-2025.1.0/libsrc/posix-file_locking.adb000066400000000000000000000154021473553204100216330ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E _ L O C K I N G -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.C, POSIX.Implementation; package body POSIX.File_Locking is use POSIX.C, POSIX.Implementation; function To_Process_ID is new Ada.Unchecked_Conversion (pid_t, POSIX.Process_Identification.Process_ID); C_Lock_Type : constant array (Lock_Kind) of short := (Read_Lock => F_RDLCK, Write_Lock => F_WRLCK, Unlock => F_UNLCK); C_Whence : constant array (POSIX.IO.Position) of short := (POSIX.IO.From_Beginning => SEEK_SET, POSIX.IO.From_End_Of_File => SEEK_END, POSIX.IO.From_Current_Position => SEEK_CUR); ---------------- -- Get_Lock -- ---------------- function fcntl (fd : int; cmd : int; arg : flock_ptr) return int; pragma Import (C, fcntl, fcntl_LINKNAME); procedure Get_Lock (File : POSIX.IO.File_Descriptor; Lock : File_Lock; Result : out File_Lock; Process : out POSIX.Process_Identification.Process_ID) is T : aliased struct_flock; Res : File_Lock (False); -- temporary is needed in case Result.Whole_File = True begin T.l_type := C_Lock_Type (Lock.Lock); if Lock.Whole_File then T.l_whence := SEEK_SET; T.l_start := 0; T.l_len := off_t (POSIX.IO.File_Size (File)); else T.l_whence := C_Whence (Lock.Starting_Point); T.l_start := off_t (Lock.Start); T.l_len := off_t (Lock.Length); end if; Check (fcntl (int (File), F_GETLK, T'Unchecked_Access)); if T.l_type = F_UNLCK then Process := POSIX.Process_Identification.Null_Process_ID; Res.Lock := Unlock; else Process := To_Process_ID (T.l_pid); if T.l_type = F_RDLCK then Res.Lock := Read_Lock; elsif T.l_type = F_WRLCK then Res.Lock := Write_Lock; else Res.Lock := Unlock; end if; if T.l_whence = SEEK_SET then Res.Starting_Point := POSIX.IO.From_Beginning; elsif T.l_whence = SEEK_END then Res.Starting_Point := POSIX.IO.From_End_Of_File; else Res.Starting_Point := POSIX.IO.From_Current_Position; end if; Res.Start := POSIX.IO.IO_Offset (T.l_start); Res.Length := IO_Count (T.l_len); end if; Result := Res; end Get_Lock; ---------------- -- Set_Lock -- ---------------- procedure Set_Lock (File : POSIX.IO.File_Descriptor; Lock : File_Lock) is T : aliased struct_flock; begin T.l_type := C_Lock_Type (Lock.Lock); if Lock.Whole_File then T.l_whence := SEEK_SET; T.l_start := 0; T.l_len := off_t (POSIX.IO.File_Size (File)); else T.l_whence := C_Whence (Lock.Starting_Point); T.l_start := off_t (Lock.Start); T.l_len := off_t (Lock.Length); end if; Check (fcntl (int (File), F_SETLK, T'Unchecked_Access)); end Set_Lock; ------------------------ -- Wait_To_Set_Lock -- ------------------------ procedure Wait_To_Set_Lock (File : POSIX.IO.File_Descriptor; Lock : File_Lock; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is T : aliased struct_flock; Result : int; Old_Mask : aliased Signal_Mask; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); T.l_type := C_Lock_Type (Lock.Lock); if Lock.Whole_File then T.l_whence := SEEK_SET; T.l_start := 0; T.l_len := off_t (POSIX.IO.File_Size (File)); else T.l_whence := C_Whence (Lock.Starting_Point); T.l_start := off_t (Lock.Start); T.l_len := off_t (Lock.Length); end if; Result := fcntl (int (File), F_SETLKW, T'Unchecked_Access); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Wait_To_Set_Lock; end POSIX.File_Locking; libflorist-2025.1.0/libsrc/posix-file_locking.ads000066400000000000000000000072721473553204100216620ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E _ L O C K I N G -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.IO, POSIX.Process_Identification; package POSIX.File_Locking is type Lock_Kind is (Read_Lock, Write_Lock, Unlock); type File_Lock (Whole_File : Boolean := True) is record Lock : Lock_Kind; case Whole_File is when True => null; when False => Starting_Point : POSIX.IO.Position; Start : POSIX.IO.IO_Offset; Length : POSIX.IO_Count; end case; end record; procedure Get_Lock (File : POSIX.IO.File_Descriptor; Lock : File_Lock; Result : out File_Lock; Process : out POSIX.Process_Identification.Process_ID); procedure Set_Lock (File : POSIX.IO.File_Descriptor; Lock : File_Lock); procedure Wait_To_Set_Lock (File : POSIX.IO.File_Descriptor; Lock : File_Lock; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); end POSIX.File_Locking; libflorist-2025.1.0/libsrc/posix-file_status-extensions.adb000066400000000000000000000065161473553204100237330ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E _ S T A T U S . E X T E N S I O N S -- -- -- -- B o d y -- -- -- -- Copyright (C) 2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.C; use POSIX.C; package body POSIX.File_Status.Extensions is ------------------------ -- IO_Block_Size_Of -- ------------------------ function IO_Block_Size_Of (File_Status : Status) return POSIX.IO_Count is begin return IO_Count (struct_stat (File_Status).st_blksize); end IO_Block_Size_Of; --------------------------- -- Allocated_Blocks_Of -- --------------------------- function Allocated_Blocks_Of (File_Status : Status) return POSIX.IO_Count is begin return IO_Count (struct_stat (File_Status).st_blocks); end Allocated_Blocks_Of; end POSIX.File_Status.Extensions; libflorist-2025.1.0/libsrc/posix-file_status-extensions.ads000066400000000000000000000063611473553204100237520ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E _ S T A T U S . E X T E N S I O N S -- -- -- -- S p e c -- -- -- -- Copyright (C) 2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ -- This file contains system-dependent (and therefore non-portable) -- extensions to POSIX.File_Status. package POSIX.File_Status.Extensions is function IO_Block_Size_Of (File_Status : Status) return POSIX.IO_Count; -- File system-specific preferred I/O block size for this object function Allocated_Blocks_Of (File_Status : Status) return POSIX.IO_Count; -- Number of blocks allocated for this object end POSIX.File_Status.Extensions; libflorist-2025.1.0/libsrc/posix-file_status.adb000066400000000000000000000267371473553204100215450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E _ S T A T U S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation, POSIX.Permissions.Implementation; package body POSIX.File_Status is use POSIX.C; use POSIX.Calendar; use POSIX.Implementation; use POSIX.Permissions.Implementation; function To_User_ID is new Ada.Unchecked_Conversion (uid_t, POSIX.Process_Identification.User_ID); function To_Group_ID is new Ada.Unchecked_Conversion (gid_t, POSIX.Process_Identification.Group_ID); pragma Warnings (Off); -- Disable warning that the representation of Time values may -- change between GNAT versions. function Duration_To_POSIX_Time is new Ada.Unchecked_Conversion (Duration, POSIX_Time); pragma Warnings (On); function stat (path : char_ptr; buf : stat_ptr) return int; pragma Import (C, stat, stat_LINKNAME); function lstat (path : char_ptr; buf : stat_ptr) return int; pragma Import (C, lstat, lstat_LINKNAME); function fstat (fildes : int; buf : stat_ptr) return int; pragma Import (C, fstat, fstat_LINKNAME); -- We had to redefine these functions in posix-macro.c. -- See the file for more info. ----------------------- -- Get_File_Status -- ----------------------- function Get_File_Status (Pathname : POSIX.Pathname) return Status is S : aliased struct_stat; Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (stat (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, S'Unchecked_Access)); return Status (S); end Get_File_Status; ----------------------- -- Get_File_Status -- ----------------------- function Get_File_Status (File : POSIX.IO.File_Descriptor) return Status is S : aliased struct_stat; begin Check (fstat (int (File), S'Unchecked_Access)); return Status (S); end Get_File_Status; ----------------------- -- Get_Link_Status -- ----------------------- function Get_Link_Status (Pathname : POSIX.Pathname) return Status is S : aliased struct_stat; Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (lstat (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, S'Unchecked_Access)); return Status (S); end Get_Link_Status; ------------------------- -- Permission_Set_Of -- ------------------------- function Permission_Set_Of (File_Status : Status) return POSIX.Permissions.Permission_Set is begin return Form_Ada_Permission (struct_stat (File_Status).st_mode); end Permission_Set_Of; ------------------ -- File_ID_Of -- ------------------ function File_ID_Of (File_Status : Status) return File_ID is begin return File_ID (struct_stat (File_Status).st_ino); end File_ID_Of; -------------------- -- Device_ID_Of -- -------------------- function Device_ID_Of (File_Status : Status) return Device_ID is begin return Device_ID (struct_stat (File_Status).st_dev); end Device_ID_Of; --------------------- -- Link_Count_Of -- --------------------- function Link_Count_Of (File_Status : Status) return Links is begin return Links (struct_stat (File_Status).st_nlink); end Link_Count_Of; ---------------- -- Owner_Of -- ---------------- function Owner_Of (File_Status : Status) return POSIX.Process_Identification.User_ID is begin return To_User_ID (struct_stat (File_Status).st_uid); end Owner_Of; ---------------- -- Group_Of -- ---------------- function Group_Of (File_Status : Status) return POSIX.Process_Identification.Group_ID is begin return To_Group_ID (struct_stat (File_Status).st_gid); end Group_Of; --------------- -- Size_Of -- --------------- function Size_Of (File_Status : Status) return POSIX.IO_Count is begin -- We depart from POSIX.5 5.3.2.3 (875) here, since the current -- POSIX C standard allows more cases of valid file descriptors -- for the st_size field, in particular symbolic links (the pathname -- length), shared memory objects, and typed memory objects. return IO_Count (struct_stat (File_Status).st_size); end Size_Of; --------------------------- -- Last_Access_Time_Of -- --------------------------- function Last_Access_Time_Of (File_Status : Status) return POSIX_Time is begin return Duration_To_POSIX_Time (Duration (struct_stat (File_Status).st_atime)); end Last_Access_Time_Of; --------------------------------- -- Last_Modification_Time_Of -- --------------------------------- function Last_Modification_Time_Of (File_Status : Status) return POSIX_Time is begin return Duration_To_POSIX_Time (Duration (struct_stat (File_Status).st_mtime)); end Last_Modification_Time_Of; ---------------------------------- -- Last_Status_Change_Time_Of -- ---------------------------------- function Last_Status_Change_Time_Of (File_Status : Status) return POSIX_Time is begin return Duration_To_POSIX_Time (Duration (struct_stat (File_Status).st_ctime)); end Last_Status_Change_Time_Of; -------------------- -- Is_Directory -- -------------------- function s_isdir (mode : mode_t) return int; pragma Import (C, s_isdir, "s_isdir"); function Is_Directory (File_Status : Status) return Boolean is begin return s_isdir (struct_stat (File_Status).st_mode) /= 0; end Is_Directory; --------------------------------- -- Is_Character_Special_File -- --------------------------------- function s_ischr (mode : mode_t) return int; pragma Import (C, s_ischr, "s_ischr"); function Is_Character_Special_File (File_Status : Status) return Boolean is begin return s_ischr (struct_stat (File_Status).st_mode) /= 0; end Is_Character_Special_File; ----------------------------- -- Is_Block_Special_File -- ----------------------------- function s_isblk (mode : mode_t) return int; pragma Import (C, s_isblk, "s_isblk"); function Is_Block_Special_File (File_Status : Status) return Boolean is begin return s_isblk (struct_stat (File_Status).st_mode) /= 0; end Is_Block_Special_File; ------------------------ -- Is_Symbolic_Link -- ------------------------ function s_islnk (mode : mode_t) return int; pragma Import (C, s_islnk, "s_islnk"); function Is_Symbolic_Link (File_Status : Status) return Boolean is begin return s_islnk (struct_stat (File_Status).st_mode) /= 0; end Is_Symbolic_Link; ----------------------- -- Is_Regular_FIle -- ----------------------- function s_isreg (mode : mode_t) return int; pragma Import (C, s_isreg, "s_isreg"); function Is_Regular_File (File_Status : Status) return Boolean is begin return s_isreg (struct_stat (File_Status).st_mode) /= 0; end Is_Regular_File; ----------------- -- Is_Socket -- ----------------- function s_issock (mode : mode_t) return int; pragma Import (C, s_issock, "s_issock"); function Is_Socket (File_Status : Status) return Boolean is begin return s_issock (struct_stat (File_Status).st_mode) /= 0; end Is_Socket; --------------- -- Is_FIFO -- --------------- function s_isfifo (mode : mode_t) return int; pragma Import (C, s_isfifo, "s_isfifo"); function Is_FIFO (File_Status : Status) return Boolean is begin return s_isfifo (struct_stat (File_Status).st_mode) /= 0; end Is_FIFO; ------------------------ -- Is_Shared_Memory -- ------------------------ function s_typeisshm (buf : stat_ptr) return int; pragma Import (C, s_typeisshm, "s_typeisshm"); function Is_Shared_Memory (File_Status : Status) return Boolean is begin return s_typeisshm (To_Stat_Ptr (File_Status'Address)) /= 0; end Is_Shared_Memory; ------------------------ -- Is_Message_Queue -- ------------------------ function s_typeismq (buf : stat_ptr) return int; pragma Import (C, s_typeismq, "s_typeismq"); function Is_Message_Queue (File_Status : Status) return Boolean is begin return s_typeismq (To_Stat_Ptr (File_Status'Address)) /= 0; end Is_Message_Queue; -------------------- -- Is_Semaphore -- -------------------- function s_typeissem (buf : stat_ptr) return int; pragma Import (C, s_typeissem, "s_typeissem"); function Is_Semaphore (File_Status : Status) return Boolean is begin return s_typeissem (To_Stat_Ptr (File_Status'Address)) /= 0; end Is_Semaphore; end POSIX.File_Status; libflorist-2025.1.0/libsrc/posix-file_status.ads000066400000000000000000000121161473553204100215500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E _ S T A T U S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Calendar, POSIX.IO, POSIX.Permissions, POSIX.Process_Identification; package POSIX.File_Status is type Status is private; function Get_File_Status (Pathname : POSIX.Pathname) return Status; function Get_File_Status (File : POSIX.IO.File_Descriptor) return Status; -- Get_Link_Status is not in the IEEE standard function Get_Link_Status (Pathname : POSIX.Pathname) return Status; type File_ID is private; type Device_ID is private; subtype Links is Natural range 0 .. POSIX.Link_Limit_Maxima'Last; function Permission_Set_Of (File_Status : Status) return POSIX.Permissions.Permission_Set; function File_ID_Of (File_Status : Status) return File_ID; function Device_ID_Of (File_Status : Status) return Device_ID; function Link_Count_Of (File_Status : Status) return Links; function Owner_Of (File_Status : Status) return POSIX.Process_Identification.User_ID; function Group_Of (File_Status : Status) return POSIX.Process_Identification.Group_ID; function Size_Of (File_Status : Status) return POSIX.IO_Count; function Last_Access_Time_Of (File_Status : Status) return POSIX.Calendar.POSIX_Time; function Last_Modification_Time_Of (File_Status : Status) return POSIX.Calendar.POSIX_Time; function Last_Status_Change_Time_Of (File_Status : Status) return POSIX.Calendar.POSIX_Time; function Is_Block_Special_File (File_Status : Status) return Boolean; function Is_Character_Special_File (File_Status : Status) return Boolean; function Is_Directory (File_Status : Status) return Boolean; function Is_FIFO (File_Status : Status) return Boolean; -- Is_Symbolic_Link is not in the IEEE standard function Is_Symbolic_Link (File_Status : Status) return Boolean; function Is_Regular_File (File_Status : Status) return Boolean; -- Is_Socket is part of the POSIX.5c [D2] function Is_Socket (File_Status : Status) return Boolean; function Is_Shared_Memory (File_Status : Status) return Boolean; function Is_Message_Queue (File_Status : Status) return Boolean; function Is_Semaphore (File_Status : Status) return Boolean; private type Status is new POSIX.C.struct_stat; type File_ID is new POSIX.C.ino_t; type Device_ID is new POSIX.C.dev_t; end POSIX.File_Status; libflorist-2025.1.0/libsrc/posix-files.adb000066400000000000000000000421351473553204100203130ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2017, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation, POSIX.File_Status, POSIX.Permissions.Implementation; package body POSIX.Files is use POSIX.C, POSIX.Implementation, POSIX.Permissions.Implementation; ------------------------- -- Local Subprograms -- ------------------------- pragma Warnings (Off); -- Disable warning that the representation of Time values may -- change between GNAT versions. function To_D_Int is new Ada.Unchecked_Conversion (POSIX.Calendar.POSIX_Time, D_Int); function To_time_t (Time : POSIX.Calendar.POSIX_Time) return time_t; function To_time_t (Time : POSIX.Calendar.POSIX_Time) return time_t is begin return time_t (To_Duration (To_D_Int (Time) / NS_per_S) * NS_per_S); end To_time_t; pragma Warnings (On); function c_access (path : char_ptr; amode : int) return int; pragma Import (C, c_access, access_LINKNAME); function Form_C_access (Modes : POSIX.Files.Access_Mode_Set) return int; function Form_C_access (Modes : POSIX.Files.Access_Mode_Set) return int is c_access : Bits := 0; begin if Modes (Read_Ok) then c_access := c_access or R_OK; end if; if Modes (Write_Ok) then c_access := c_access or W_OK; end if; if Modes (Execute_Ok) then c_access := c_access or X_OK; end if; return int (c_access); end Form_C_access; ------------------------ -- Create_Directory -- ------------------------ function mkdir (path : char_ptr; mode : mode_t) return int; pragma Import (C, mkdir, mkdir_LINKNAME); procedure Create_Directory (Pathname : POSIX.Pathname; Permission : POSIX.Permissions.Permission_Set) is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (mkdir (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, (Form_C_Permission (Permission)))); end Create_Directory; ------------------- -- Create_FIFO -- ------------------- function mkfifo (path : char_ptr; mode : mode_t) return int; pragma Import (C, mkfifo, mkfifo_LINKNAME); procedure Create_FIFO (Pathname : POSIX.Pathname; Permission : POSIX.Permissions.Permission_Set) is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (mkfifo (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, (Form_C_Permission (Permission)))); end Create_FIFO; -------------- -- Unlink -- -------------- function unlink (path : char_ptr) return int; pragma Import (C, unlink, unlink_LINKNAME); procedure Unlink (Pathname : POSIX.Pathname) is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (unlink (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access)); end Unlink; ------------------------ -- Remove_Directory -- ------------------------ function rmdir (path : char_ptr) return int; pragma Import (C, rmdir, rmdir_LINKNAME); procedure Remove_Directory (Pathname : POSIX.Pathname) is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (rmdir (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access)); end Remove_Directory; ------------------------ -- Is_Symbolic_Link -- ------------------------ function Is_Symbolic_Link (Pathname : POSIX.Pathname) return Boolean is stat : POSIX.File_Status.Status; begin stat := POSIX.File_Status.Get_Link_Status (Pathname); return (POSIX.File_Status.Is_Symbolic_Link (stat)); exception when POSIX_Error => return False; end Is_Symbolic_Link; --------------- -- Is_File -- --------------- function Is_File (Pathname : POSIX.Pathname) return Boolean is stat : POSIX.File_Status.Status; begin stat := POSIX.File_Status.Get_File_Status (Pathname); return (POSIX.File_Status.Is_Regular_File (stat)); exception when POSIX_Error => return False; end Is_File; ----------------- -- Is_Socket -- ----------------- function Is_Socket (Pathname : POSIX.Pathname) return Boolean is stat : POSIX.File_Status.Status; begin stat := POSIX.File_Status.Get_File_Status (Pathname); return (POSIX.File_Status.Is_Socket (stat)); exception when POSIX_Error => return False; end Is_Socket; -------------------- -- Is_Directory -- -------------------- function Is_Directory (Pathname : POSIX.Pathname) return Boolean is stat : POSIX.File_Status.Status; begin stat := POSIX.File_Status.Get_File_Status (Pathname); return (POSIX.File_Status.Is_Directory (stat)); exception when POSIX_Error => return False; end Is_Directory; --------------- -- Is_FIFO -- --------------- function Is_FIFO (Pathname : POSIX.Pathname) return Boolean is stat : POSIX.File_Status.Status; begin stat := POSIX.File_Status.Get_File_Status (Pathname); return (POSIX.File_Status.Is_FIFO (stat)); exception when POSIX_Error => return False; end Is_FIFO; --------------------------------- -- Is_Character_Special_File -- --------------------------------- function Is_Character_Special_File (Pathname : POSIX.Pathname) return Boolean is stat : POSIX.File_Status.Status; begin stat := POSIX.File_Status.Get_File_Status (Pathname); return (POSIX.File_Status.Is_Character_Special_File (stat)); exception when POSIX_Error => return False; end Is_Character_Special_File; ----------------------------- -- Is_Block_Special_File -- ----------------------------- function Is_Block_Special_File (Pathname : POSIX.Pathname) return Boolean is stat : POSIX.File_Status.Status; begin stat := POSIX.File_Status.Get_File_Status (Pathname); return (POSIX.File_Status.Is_Block_Special_File (stat)); exception when POSIX_Error => return False; end Is_Block_Special_File; ------------ -- Link -- ------------ function link (existing : char_ptr; new_name : char_ptr) return int; pragma Import (C, link, link_LINKNAME); procedure Link (Old_Pathname : Pathname; New_Pathname : Pathname) is Old_Pathname_With_NUL : POSIX_String := Old_Pathname & NUL; New_Pathname_With_NUL : POSIX_String := New_Pathname & NUL; begin Check (link (Old_Pathname_With_NUL (Old_Pathname_With_NUL'First)'Unchecked_Access, New_Pathname_With_NUL (New_Pathname_With_NUL'First)'Unchecked_Access)); end Link; -------------- -- Rename -- -------------- function rename (old_name : char_ptr; new_name : char_ptr) return int; pragma Import (C, rename, rename_LINKNAME); procedure Rename (Old_Pathname : Pathname; New_Pathname : Pathname) is Old_Pathname_With_NUL : POSIX_String := Old_Pathname & NUL; New_Pathname_With_NUL : POSIX_String := New_Pathname & NUL; begin Check (rename (Old_Pathname_With_NUL (Old_Pathname_With_NUL'First)'Unchecked_Access, New_Pathname_With_NUL (New_Pathname_With_NUL'First)'Unchecked_Access)); end Rename; ------------------- -- Filename_Of -- ------------------- function Filename_Of (D_Entry : Directory_Entry) return Filename is begin return Form_POSIX_String (To_char_ptr (D_Entry.d_name (1)'Address)); end Filename_Of; --------------------------------- -- For_Every_Directory_Entry -- --------------------------------- function opendir (dirname : char_ptr) return DIR_ptr; pragma Import (C, opendir, opendir_LINKNAME); function readdir (dirp : DIR_ptr) return dirent_ptr; pragma Import (C, readdir, readdir_LINKNAME); function closedir (dirp : DIR_ptr) return int; pragma Import (C, closedir, closedir_LINKNAME); -- ????? -- The following needs to be made safe for use in a multitasking -- environment. -- Clearly, readdir is a problem, since it returns a pointer to a -- structure that must be allocated somewhere. Thus, POSIX provides -- readdir_r. We should probably add conditional compilation code to -- Florist posix-files.adb to make use of readdir_r if that is -- supported. -- Note that we are not required to support safe concurrent use of -- multiple iterators on the same directory. A non-normative note -- has been placed in 3.3.5 on lines 19-22 to make this clear. It -- says: -- The requirement for tasking safety does not imply any greater -- degree of safety for concurrent use than is requird of the -- standard Ada libraries by the Ada RM. That is, unless it is so -- specified elsewhere in this standard, operations are [missin "not" -- here, which is a typo] necessarily atomic and are not necessarily -- safe to execute concurrently on the same data object. -- Thus, the thing is to cover the case where readdir is the only -- thing available, and it is not safe for concurrent use (even on -- different directories). procedure For_Every_Directory_Entry (Pathname : POSIX.Pathname) is Pathname_With_NUL : POSIX_String := Pathname & NUL; dirp : DIR_ptr; dirent : dirent_ptr; Quit : Boolean := False; rc : int; pragma Unreferenced (rc); begin dirp := opendir (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access); if dirp = null then Raise_POSIX_Error; end if; loop dirent := readdir (dirp); exit when dirent = null; Action (Directory_Entry (dirent), Quit); exit when Quit; end loop; Check (closedir (dirp)); exception when others => -- Ensure dirp is closed if an exception is raised. if dirp /= null then -- Do not call Check here, as that function may raise -- POSIX_Error and obscure an underlying problem raised -- in the procedure Action. rc := closedir (dirp); end if; raise; end For_Every_Directory_Entry; ------------------------------ -- Change_Owner_And_Group -- ------------------------------ function chown (path : char_ptr; owner : uid_t; group : gid_t) return int; pragma Import (C, chown, chown_LINKNAME); function To_uid_t is new Ada.Unchecked_Conversion (POSIX.Process_Identification.User_ID, uid_t); function To_gid_t is new Ada.Unchecked_Conversion (POSIX.Process_Identification.Group_ID, gid_t); procedure Change_Owner_And_Group (Pathname : POSIX.Pathname; Owner : POSIX.Process_Identification.User_ID; Group : POSIX.Process_Identification.Group_ID) is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (chown (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, To_uid_t (Owner), To_gid_t (Group))); end Change_Owner_And_Group; -------------------------- -- Change_Permissions -- -------------------------- function chmod (path : char_ptr; mode : mode_t) return int; pragma Import (C, chmod, chmod_LINKNAME); procedure Change_Permissions (Pathname : POSIX.Pathname; Permission : POSIX.Permissions.Permission_Set) is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (chmod (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, Form_C_Permission (Permission))); end Change_Permissions; ---------------------- -- Set_File_Times -- ---------------------- -- There is a problem in the difference between POSIX.1c and POSIX.5 -- definition of file related times. POSIX.1c requires the accuracy be -- in seconds while POSIX.5 requires it to be in POSIX_Time. -- To avoid inconsistency, we have implemented POSIX_Time so that -- all time values are truncated to the nearest second. function utime (path : char_ptr; actime : utimbuf_ptr) return int; pragma Import (C, utime, utime_LINKNAME); procedure Set_File_Times (Pathname : POSIX.Pathname; Access_Time : POSIX.Calendar.POSIX_Time; Modification_Time : POSIX.Calendar.POSIX_Time) is Pathname_With_NUL : POSIX_String := Pathname & NUL; Times : aliased struct_utimbuf; begin Times.actime := To_time_t (Access_Time); Times.modtime := To_time_t (Modification_Time); Check (utime (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, Times'Unchecked_Access)); end Set_File_Times; ---------------------- -- Set_File_Times -- ---------------------- procedure Set_File_Times (Pathname : POSIX.Pathname) is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin Check (utime (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, null)); end Set_File_Times; --------------------- -- Is_Accessible -- --------------------- function Is_Accessible (Pathname : POSIX.Pathname; Access_Modes : Access_Mode_Set) return Boolean is begin return Accessibility (Pathname, Access_Modes) = No_Error; end Is_Accessible; ----------------------- -- Accessibilitity -- ----------------------- function Accessibility (Pathname : POSIX.Pathname; Access_Modes : Access_Mode_Set) return Error_Code is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin if c_access (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, Form_C_access (Access_Modes)) = 0 then return No_Error; else return Fetch_Errno; end if; end Accessibility; ----------------------- -- Is_File_Present -- ----------------------- function Is_File_Present (Pathname : POSIX.Pathname) return Boolean is Pathname_With_NUL : POSIX_String := Pathname & NUL; begin return c_access (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, 0) = 0; end Is_File_Present; ----------------- -- Existence -- ----------------- function Existence (Pathname : POSIX.Pathname) return Error_Code is begin if Is_File_Present (Pathname) then return No_Error; else return Fetch_Errno; end if; end Existence; end POSIX.Files; libflorist-2025.1.0/libsrc/posix-files.ads000066400000000000000000000134431473553204100203340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . F I L E S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Permissions, POSIX.Process_Identification, POSIX.Calendar; package POSIX.Files is -- Operations to Create Files in the File System procedure Create_Directory (Pathname : POSIX.Pathname; Permission : POSIX.Permissions.Permission_Set); procedure Create_FIFO (Pathname : POSIX.Pathname; Permission : POSIX.Permissions.Permission_Set); -- Operations to remove files from the File System procedure Unlink (Pathname : POSIX.Pathname); procedure Remove_Directory (Pathname : POSIX.Pathname); -- Predicates on files in the File System function Is_Block_Special_File (Pathname : POSIX.Pathname) return Boolean; function Is_Character_Special_File (Pathname : POSIX.Pathname) return Boolean; function Is_Directory (Pathname : POSIX.Pathname) return Boolean; function Is_FIFO (Pathname : POSIX.Pathname) return Boolean; -- Is_Symbolic_Link is not in the IEEE standard function Is_Symbolic_Link (Pathname : POSIX.Pathname) return Boolean; -- .... Change POSIX.5? -- Why is this not called Is_Regular_File? Add renaming decl? function Is_File (Pathname : POSIX.Pathname) return Boolean; -- Is_Socket is from POSIX.5c [D2] function Is_Socket (Pathname : POSIX.Pathname) return Boolean; -- Operations to modify File Pathnames procedure Link (Old_Pathname : POSIX.Pathname; New_Pathname : POSIX.Pathname); procedure Rename (Old_Pathname : POSIX.Pathname; New_Pathname : POSIX.Pathname); -- Iterating over files within a directory type Directory_Entry is limited private; function Filename_Of (D_Entry : Directory_Entry) return POSIX.Filename; pragma Inline (Filename_Of); generic with procedure Action (D_Entry : Directory_Entry; Quit : in out Boolean); procedure For_Every_Directory_Entry (Pathname : POSIX.Pathname); -- Operations to Update File Status Information procedure Change_Owner_And_Group (Pathname : POSIX.Pathname; Owner : POSIX.Process_Identification.User_ID; Group : POSIX.Process_Identification.Group_ID); procedure Change_Permissions (Pathname : POSIX.Pathname; Permission : POSIX.Permissions.Permission_Set); procedure Set_File_Times (Pathname : POSIX.Pathname; Access_Time : POSIX.Calendar.POSIX_Time; Modification_Time : POSIX.Calendar.POSIX_Time); procedure Set_File_Times (Pathname : POSIX.Pathname); -- Operations to Determine File Accessibility type Access_Mode is (Read_Ok, Write_Ok, Execute_Ok); type Access_Mode_Set is array (Access_Mode) of Boolean; function Is_Accessible (Pathname : POSIX.Pathname; Access_Modes : Access_Mode_Set) return Boolean; function Accessibility (Pathname : POSIX.Pathname; Access_Modes : Access_Mode_Set) return POSIX.Error_Code; function Is_File_Present (Pathname : POSIX.Pathname) return Boolean; function Existence (Pathname : POSIX.Pathname) return POSIX.Error_Code; private type Directory_Entry is new POSIX.C.dirent_ptr; end POSIX.Files; libflorist-2025.1.0/libsrc/posix-generic_shared_memory.adb000066400000000000000000000306631473553204100235460ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . G E N E R I C _ S H A R E D _ M E M O R Y -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- See the warnings in the package spec. -- This package presents potential semantic and implementation -- problems. We do not want shared objects to be reinitialized for -- each process that uses them. We do not want shared objects -- finalized, or at least not until the "last close" of the -- shared memory object in which they reside. -- The present implementation makes no attempt to deal correctly -- with controlled types. -- It also relies on the assumption that an "access all" pointer -- is meaningfully unchecked-convertible to an ordinary "access" -- value. -- .... -- This has several critical sections, to give the effect of atomicity -- from a series of system calls. -- We have put exception handlers around these, to make sure the lock -- gets released if there happens to be an exception. -- In some cases we may be able to convince ourselves that no exception -- is possible, but there is still the possibility of Storage_Error. with Ada.Unchecked_Conversion, POSIX.Implementation, POSIX.Memory_Range_Locking, POSIX.Shared_Memory_Objects, System, System.Storage_Elements; package body POSIX.Generic_Shared_Memory is use POSIX.Implementation; use type POSIX.IO.File_Descriptor; use type POSIX.Memory_Mapping.Protection_Options; Length : constant POSIX.IO_Count := Object_Type'Max_Size_In_Storage_Elements; type Private_Ptr is access all Object_Type; function To_Shared_Access is new Ada.Unchecked_Conversion (Private_Ptr, Shared_Access); -- One instantiation of this package can be used to open -- several shared memory objects, with different file descriptors. -- We need a list to keep track of the mapping from file descriptor -- to start-address. type Node; type Node_List is access all Node; type Node is record FD : POSIX.IO.File_Descriptor; Start_addr : System.Address; Pointer : Private_Ptr; Next : Node_List; end record; Head : Node_List := null; pragma Volatile (Head); Avail : Node_List := null; pragma Volatile (Avail); ------------------------ -- Local Subprograms -- ------------------------ procedure Insert_Node (FD : POSIX.IO.File_Descriptor; Start : System.Address); function Start_Of_Shared_Memory (File : POSIX.IO.File_Descriptor) return System.Address; procedure Remove_Node (FD : POSIX.IO.File_Descriptor); ------------------- -- Insert_Node -- ------------------- procedure Insert_Node (FD : POSIX.IO.File_Descriptor; Start : System.Address) is T : Node_List; -- The local object is necessary to force initialization. -- Unfortunately, it means that if the type has finalization -- we also get the finalization, before we return from this call. -- .... That is unwanted, but what else can we do? X : aliased Object_Type; for X'Address use Start; begin if Avail /= null then T := Avail; Avail := Avail.Next; else T := new Node; end if; T.FD := FD; T.Start_addr := Start; T.Pointer := X'Unchecked_Access; T.Next := Head; Head := T; end Insert_Node; ------------------- -- Remove_Node -- ------------------- procedure Remove_Node (FD : POSIX.IO.File_Descriptor) is T, Prev : Node_List; begin T := Head; Prev := Head; while T /= null loop if T.FD = FD then if Prev = T then Head := T.Next; else Prev.Next := T.Next; end if; T.Next := Avail; Avail := T; return; else Prev := T; T := T.Next; end if; end loop; Raise_POSIX_Error (POSIX.Bad_File_Descriptor); end Remove_Node; ------------------------------ -- Start_Of_Shared_Memory -- ------------------------------ function Start_Of_Shared_Memory (File : POSIX.IO.File_Descriptor) return System.Address is T : Node_List; begin Begin_Critical_Section; begin T := Head; while T /= null loop if T.FD = File then End_Critical_Section; return T.Start_addr; end if; T := T.Next; end loop; End_Critical_Section; exception when others => End_Critical_Section; raise; end; Raise_POSIX_Error (POSIX.Bad_File_Descriptor); -- to suppress compiler warning: return System.Null_Address; end Start_Of_Shared_Memory; ---------------------------------- -- Open_And_Map_Shared_Memory -- ---------------------------------- -- No adjustment of signal mask in these procedures. -- We just pass on the masking information to the "open". function Open_And_Map_Shared_Memory (Name : POSIX.POSIX_String; Protection : POSIX.Memory_Mapping.Protection_Options; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor is FD : POSIX.IO.File_Descriptor; Mode : POSIX.IO.File_Mode; begin if Protection >= POSIX.Memory_Mapping.Allow_Write then Mode := POSIX.IO.Read_Write; else Mode := POSIX.IO.Read_Only; end if; Begin_Critical_Section; begin FD := POSIX.Shared_Memory_Objects.Open_Shared_Memory (Name, Mode, POSIX.IO.Empty_Set, Masked_Signals); if Protection >= POSIX.Memory_Mapping.Allow_Write then POSIX.IO.Truncate_File (FD, Length); end if; Insert_Node (FD, POSIX.Memory_Mapping.Map_Memory (System.Storage_Elements.Storage_Offset (Length), Protection, POSIX.Memory_Mapping.Map_Shared, FD, 0)); End_Critical_Section; exception when others => End_Critical_Section; raise; end; return FD; end Open_And_Map_Shared_Memory; -------------------------------------------- -- Open_Or_Create_And_Map_Shared_Memory -- -------------------------------------------- function Open_Or_Create_And_Map_Shared_Memory (Name : POSIX.POSIX_String; Protection : POSIX.Memory_Mapping.Protection_Options; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor is FD : POSIX.IO.File_Descriptor; Mode : POSIX.IO.File_Mode; begin if Protection >= POSIX.Memory_Mapping.Allow_Write then Mode := POSIX.IO.Read_Write; else Mode := POSIX.IO.Read_Only; end if; Begin_Critical_Section; begin FD := POSIX.Shared_Memory_Objects.Open_Or_Create_Shared_Memory (Name, Mode, Permissions, Options, Masked_Signals); if Protection >= POSIX.Memory_Mapping.Allow_Write then POSIX.IO.Truncate_File (FD, Length); end if; Insert_Node (FD, POSIX.Memory_Mapping.Map_Memory (System.Storage_Elements.Storage_Offset (Length), Protection, POSIX.Memory_Mapping.Map_Shared, FD, 0)); End_Critical_Section; exception when others => End_Critical_Section; raise; end; return FD; end Open_Or_Create_And_Map_Shared_Memory; ---------------------------- -- Access_Shared_Memory -- ---------------------------- function Access_Shared_Memory (File : POSIX.IO.File_Descriptor) return Shared_Access is T : Node_List; begin Begin_Critical_Section; begin T := Head; while T /= null loop if T.FD = File then End_Critical_Section; return To_Shared_Access (T.Pointer); end if; T := T.Next; end loop; End_Critical_Section; exception when others => End_Critical_Section; raise; end; Raise_POSIX_Error (POSIX.Bad_File_Descriptor); -- To suppress compiler warning message: return null; end Access_Shared_Memory; ------------------------------------- -- Unmap_And_Close_Shared_Memory -- ------------------------------------- procedure Unmap_And_Close_Shared_Memory (File : POSIX.IO.File_Descriptor) is begin Begin_Critical_Section; begin POSIX.Memory_Mapping.Unmap_Memory (Start_Of_Shared_Memory (File), Object_Type'Max_Size_In_Storage_Elements); Remove_Node (File); POSIX.IO.Close (File); End_Critical_Section; exception when others => End_Critical_Section; raise; end; -- .... If we could detect "last close", and if we could -- detect that the type has finalization, we might want to -- call finalization here, for the last close. end Unmap_And_Close_Shared_Memory; -------------------------- -- Lock_Shared_Memory -- -------------------------- procedure Lock_Shared_Memory (File : POSIX.IO.File_Descriptor) is begin POSIX.Memory_Range_Locking.Lock_Range (Start_Of_Shared_Memory (File), System.Storage_Elements.Storage_Offset (Object_Type'Max_Size_In_Storage_Elements)); end Lock_Shared_Memory; ---------------------------- -- Unlock_Shared_Memory -- ---------------------------- procedure Unlock_Shared_Memory (File : POSIX.IO.File_Descriptor) is begin POSIX.Memory_Range_Locking.Unlock_Range (Start_Of_Shared_Memory (File), System.Storage_Elements.Storage_Offset (Object_Type'Max_Size_In_Storage_Elements)); end Unlock_Shared_Memory; end POSIX.Generic_Shared_Memory; libflorist-2025.1.0/libsrc/posix-generic_shared_memory.ads000066400000000000000000000111661473553204100235640ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . G E N E R I C _ S H A R E D _ M E M O R Y -- -- -- -- S p e c -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ -- .... Change POSIX.5b???? -- ========== -- -- WARNINGS -- -- ========== -- -- 1) DO NOT instantiate this package for a controlled type. If you -- do, at best finalization will not work correctly. At worst, you -- will crash the entire process. -- 2) DO NOT instantiate and use Ada.Unchecked_Deallocation for the type -- Shared_Access belonging to an instantiation of this package. If -- you do, you are likely to end up corrupting the heap, and possibly -- crashing the entire process. with POSIX.IO, POSIX.Permissions, POSIX.Memory_Mapping; generic type Object_Type is private; -- Do not instantiate with a controlled type! -- See note below for reasons. package POSIX.Generic_Shared_Memory is type Shared_Access is access Object_Type; function Open_And_Map_Shared_Memory (Name : POSIX.POSIX_String; Protection : POSIX.Memory_Mapping.Protection_Options; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor; function Open_Or_Create_And_Map_Shared_Memory (Name : POSIX.POSIX_String; Protection : POSIX.Memory_Mapping.Protection_Options; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor; function Access_Shared_Memory (File : POSIX.IO.File_Descriptor) return Shared_Access; procedure Unmap_And_Close_Shared_Memory (File : POSIX.IO.File_Descriptor); procedure Lock_Shared_Memory (File : POSIX.IO.File_Descriptor); procedure Unlock_Shared_Memory (File : POSIX.IO.File_Descriptor); end POSIX.Generic_Shared_Memory; libflorist-2025.1.0/libsrc/posix-group_database.adb000066400000000000000000000146411473553204100221720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . G R O U P _ D A T A B A S E -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation; package body POSIX.Group_Database is use POSIX.C, POSIX.Implementation; function To_gid is new Ada.Unchecked_Conversion (POSIX.Process_Identification.Group_ID, gid_t); function To_Group_ID is new Ada.Unchecked_Conversion (gid_t, POSIX.Process_Identification.Group_ID); -- Operations to get information from a Group_Database_Item --------------------- -- Group_Name_Of -- --------------------- function Group_Name_Of (DB_Item : Group_Database_Item) return POSIX.POSIX_String is begin if DB_Item = null then Raise_POSIX_Error (Invalid_Argument); end if; return Form_POSIX_String (group_ptr (DB_Item).gr_name); end Group_Name_Of; ------------------- -- Group_ID_Of -- ------------------- function Group_ID_Of (DB_Item : Group_Database_Item) return POSIX.Process_Identification.Group_ID is begin if DB_Item = null then Raise_POSIX_Error (Invalid_Argument); end if; return To_Group_ID (group_ptr (DB_Item).gr_gid); end Group_ID_Of; ------------------------ -- Group_ID_List_Of -- ------------------------ function Group_ID_List_Of (DB_Item : Group_Database_Item) return Group_ID_List is begin if DB_Item = null then Raise_POSIX_Error (Invalid_Argument); end if; return Group_ID_List (group_ptr (DB_Item).gr_mem); end Group_ID_List_Of; ------------------------ -- For_Every_Member -- ------------------------ procedure For_Every_Member (List : Group_ID_List) is Quit : Boolean := False; P : char_ptr_ptr; begin P := char_ptr_ptr (List); if P = null then return; end if; while P.all /= null loop declare S : constant POSIX_String := Form_POSIX_String (P.all); begin Action (S, Quit); exit when Quit; end; Advance (P); end loop; end For_Every_Member; -------------- -- Length -- -------------- function Length (Member_List : Group_ID_List) return Natural is P : char_ptr_ptr := char_ptr_ptr (Member_List); Length : Natural := 0; begin if P = null then return 0; end if; while P.all /= null loop Length := Length + 1; Advance (P); end loop; return Length; end Length; ------------------------------- -- Get_Group_Database_Item -- ------------------------------- function getgrgid (gid : gid_t) return group_ptr; pragma Import (C, getgrgid, "getgrgid"); function getgrnam (name : char_ptr) return group_ptr; pragma Import (C, getgrnam, "getgrnam"); function Get_Group_Database_Item (GID : POSIX.Process_Identification.Group_ID) return Group_Database_Item is G : group_ptr; begin G := getgrgid (To_gid (GID)); if G = null then Raise_POSIX_Error (Invalid_Argument); end if; return Group_Database_Item (G); end Get_Group_Database_Item; ------------------------------- -- Get_Group_Database_Item -- ------------------------------- function Get_Group_Database_Item (Name : POSIX_String) return Group_Database_Item is Name_With_NUL : POSIX_String := Name & NUL; G : group_ptr; begin G := getgrnam (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access); if G = null then Raise_POSIX_Error (Invalid_Argument); end if; return Group_Database_Item (G); end Get_Group_Database_Item; end POSIX.Group_Database; libflorist-2025.1.0/libsrc/posix-group_database.ads000066400000000000000000000125221473553204100222070ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . G R O U P _ D A T A B A S E -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Process_Identification; package POSIX.Group_Database is type Group_Database_Item is private; type Group_ID_List is private; -- operations to get information from a Group_Database_Item function Group_Name_Of (DB_Item : Group_Database_Item) return POSIX.POSIX_String; function Group_ID_Of (DB_Item : Group_Database_Item) return POSIX.Process_Identification.Group_ID; function Group_ID_List_Of (DB_Item : Group_Database_Item) return Group_ID_List; -- iterator over the Group_ID_List generic with procedure Action (ID : POSIX.POSIX_String; Quit : in out Boolean); procedure For_Every_Member (List : Group_ID_List); function Length (Member_List : Group_ID_List) return Natural; -- operations to get a Group_Database_Item function Get_Group_Database_Item (GID : POSIX.Process_Identification.Group_ID) return Group_Database_Item; function Get_Group_Database_Item (Name : POSIX.POSIX_String) return Group_Database_Item; private -- .... Change POSIX.5b? -- For correct tasking-safe operation, without storage leakage, -- we want to make a copy of the entire group database item -- inside each value of type Group_Database_Item. -- The problem is that there is no fixed size, -- so we would like to make the size depend on a discriminant. -- We can't do this, as the interface stands. -- This leaves us few options: -- (a) impose a fixed size limit, which might overflow; -- (b) use dynamic allocation, risking storage leakage; -- (c) use the raw C interfaces, risking tasking unsafety -- and also storage leakage. -- Note that using the new thread-safe operations, -- getgrgid_r and getgrnam_r, does not solve our problem, -- since we would still have to provide space to hold the strings. -- We choose to use the raw C interfaces, since the other -- alternatives are not significantly more attractive. -- See also POSIX.User_Database. -- .... Another modification we want to make in POSIX.5b is to -- make types "limited private" where appropriate. For example, we -- do not want to compare the whole contents of two lists using "=" -- operation if we want to follow the POSIX.1 definition of group -- structure. We could provide the operation, of course, with some -- expensive structures and operations. However, this is not worth -- especially when we could perform the same operation using other -- operations (For_Every_Member). type Group_Database_Item is new POSIX.C.group_ptr; type Group_ID_List is new POSIX.C.char_ptr_ptr; end POSIX.Group_Database; libflorist-2025.1.0/libsrc/posix-implementation.ads000066400000000000000000000364261473553204100222650ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . I M P L E M E N T A T I O N -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.C, System.Interrupt_Management; package POSIX.Implementation is pragma Elaborate_Body; -- ========= -- -- WARNING -- -- ========= -- -- This package should NOT be used directly by an application. -- It is internal to the FLORIST implementation of the POSIX.5 API, -- and may be changed or replaced in future versions of FLORIST. ------------------------- -- Critical Sections -- ------------------------- -- NEVER raise an exception within a critical section -- or abort-deferred section! -- Not even indirectly, by calling a subprogram -- that might raise an exception. -- Always exit the section, then raise the exception. -- ALWAYS enclose critical sections in a block with an -- exception handler that will call End_Critical_Section -- before allowing the exception to propagate, unless you -- can prove that no exception will be raised in the code. -- (How about Storage_Error, due to stack overflow?) -- Try to avoid nesting critical sections, -- as it means extra overhead. procedure Defer_Abortion; procedure Undefer_Abortion; -- The following two also defer/undefer abort, as side-effects. procedure Begin_Critical_Section; procedure End_Critical_Section; -------------- -- Checks -- -------------- -- Don't ever call any of these within a critical section, -- or within an abort-deferred section! subtype Signal_Mask is System.Interrupt_Management.Interrupt_Mask; type Signal_Mask_Access is access all Signal_Mask; procedure Raise_POSIX_Error (Error : Error_Code := No_Error); pragma No_Return (Raise_POSIX_Error); procedure Check (Condition : Boolean; Error : Error_Code; Old_Mask : Signal_Mask_Access := null); -- if Condition is false, raise POSIX_Error with -- specified error code, else just return -- -- If Old_Mask /= null, then on failure call Restore_Signals with -- that mask before raising POSIX_Error. procedure Check (Result : POSIX.C.int; Old_Mask : Signal_Mask_Access := null); function Check (Result : POSIX.C.int; Old_Mask : Signal_Mask_Access := null) return POSIX.C.int; -- if Result is -1 raise POSIX_Error with current error code -- otherwise just return Result. -- -- If Old_Mask /= null, then call Restore_Signals with that mask -- before raising POSIX_Error. procedure Check_NNeg (Result : POSIX.C.int); function Check_NNeg (Result : POSIX.C.int) return POSIX.C.int; -- same as Check, except any negative value is treated -- as a failure -- pragma Inline (Check); procedure Check_NZ (Result : POSIX.C.int); -- same as Check, except any nonzero value is an error code -- pragma Inline (Check); function Not_Implemented_Neg_One return POSIX.C.int; -- return -1 with error code ENOSYS pragma Export (C, Not_Implemented_Neg_One, "nosys_neg_one"); function Not_Implemented_Direct return POSIX.C.int; -- return error code ENOSYS pragma Export (C, Not_Implemented_Direct, "nosys_direct"); function Not_Supported_Neg_One return POSIX.C.int; -- return -1 with error code ENOTSUP pragma Export (C, Not_Supported_Neg_One, "notsup_neg_one"); function Not_Supported_Direct return POSIX.C.int; -- return ENOTSUP pragma Export (C, Not_Supported_Direct, "notsup_direct"); -- These are used as stub link-names for C interface subprograms -- which are missing from the OS include-files. -- .... We still need to analyze all these functions, one by one, -- so that the code in c-posix.c initialized the corresponding ..._LINKNAME -- variable to the right value. -- If we have any calls to functions that may legitimately return -- a value of -1 for a non-error condition, we may need to add some -- special stubs for those functions. --------------- -- Strings -- --------------- NUL_String : POSIX_String := (1 => NUL); function Form_String (Str : POSIX.C.char_ptr) return String; function Trim_Leading_Blank (S : String) return String; -- pragma Inline (Trim_Leading_Blank); procedure Nulterminate (To : out POSIX_String; From : String); -------------------- -- String Lists -- -------------------- type POSIX_String_Ptr is access all POSIX_String; type PSP_Array is array (Positive range <>) of POSIX_String_Ptr; type String_List (Length : Natural) is record List : PSP_Array (1 .. Length); Char : POSIX.C.char_ptr_array (1 .. Length); -- X.Char(i) = X.List(i)(1)'Unchecked_access end record; type String_List_Ptr is access all String_List; -- No_Strict_Aliasing is necessary here to avoid potential -- optimization issues when making unchecked conversions to -- String_List_Ptr. pragma No_Strict_Aliasing (String_List_Ptr); Null_String_List : aliased String_List := (Length => 1, List => (1 => null), Char => (1 => null)); Null_String_List_Ptr : constant String_List_Ptr := Null_String_List'Access; -- We try to represent String_List in a form that does not -- require further conversion to pass it to the C interface. -- The main problem is that Ada strings carry along "dope" -- (including index range info) which will confuse a C subprogram, -- but which is needed for proper storage deallocation. -- We'd like to simply use char_ptr_ptr, but that does not -- give us the length information we need to do storage -- deallocation. Likewise, for the component strings, we -- can't just use char_ptr, since that does not carry along -- the length information we will need later. In principle, -- we could take advantage of compiler-dependent information -- about how arrays are laid out, including the location of -- dope, but then we'd have to change this code every time -- the compiler changes. Instead, we create a redundant -- data structure, that contains its own dope. -- Each element string must be null-terminated, as is -- the array of pointers Char. Thus, -- X.Length is not the virtual "length" of the list; -- that must be calculated, C-style, by counting positions -- until a null element is reached. -- We address the problem of predicting the length of -- array needed by blocking and recopying if necessary -- for the Append operation. -- For now, we guess the string length is 16, -- and double the length each time it overflows. -- On the average, this should result in fewer calls -- to malloc() than if we were to use a linked list. Min_String_List_Length : constant := 16; ---------------------- -- Signal Masking -- ---------------------- -- The following two also defer/undefer abortion, as side-effects. procedure Mask_Signals (Masking : Signal_Masking; Old_Mask : Signal_Mask_Access); procedure Restore_Signals (Masking : Signal_Masking; Old_Mask : Signal_Mask_Access); procedure Restore_Signals (Old_Mask : Signal_Mask_Access); -- The following are provided for exit from a critical -- section where error checking needs to be done. The issue -- here is that Restore_Signals may change the value of errno, -- so we need to combine the actions into one operation, -- saving the errno value over the call to Restore_Signals. procedure Restore_Signals_And_Raise_POSIX_Error (Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access); procedure Check_NNeg_And_Restore_Signals (Result : POSIX.C.int; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access); ------------------- -- Error Codes -- ------------------- -- The following operate on the raw Pthread errno value, -- and must be written in C since errno may be accessed via -- a macro. function Fetch_Errno return Error_Code; pragma Import (C, Fetch_Errno, "fetch_errno"); procedure Store_Errno (value : Error_Code); pragma Import (C, Store_Errno, "store_errno"); -- The following operate on the Ada per-task errno value. -- The difference is that this value is not affected by any -- implicit OS calls that might occur during the implementation -- of exception propagation. function Get_Ada_Error_Code return Error_Code; procedure Set_Ada_Error_Code (Error : Error_Code); package Bogus_Error_Codes is -- These names are enclosed in this inner -- package to avoid name conflicts -- with the real error code constants, which are -- exported by this package. type Error_Name_Enum is (No_Error, Argument_List_Too_Long, Bad_Address, Bad_File_Descriptor, Bad_Message, Broken_Pipe, Directory_Not_Empty, Exec_Format_Error, File_Exists, File_Too_Large, Filename_Too_Long, Improper_Link, Inappropriate_IO_Control_Operation, Input_Output_Error, Interrupted_Operation, Invalid_Argument, Invalid_Seek, Is_A_Directory, Message_Too_Long, No_Child_Process, No_Locks_Available, No_Space_Left_On_Device, No_Such_Operation_On_Device, No_Such_Device_Or_Address, No_Such_File_Or_Directory, No_Such_Process, Not_A_Directory, Not_Enough_Space, Operation_Canceled, Operation_In_Progress, Operation_Not_Implemented, Operation_Not_Permitted, Operation_Not_Supported, Permission_Denied, Read_Only_File_System, Resource_Busy, Resource_Deadlock_Avoided, Resource_Temporarily_Unavailable, Timed_Out, Too_Many_Links, Too_Many_Open_Files, Too_Many_Open_Files_In_System, -- 2.4.6 Socket Error Codes from P1003.5c Address_In_Use, Address_Not_Available, Already_Awaiting_Connection, Connection_Aborted, Connection_Refused, Connection_Reset, Domain_Error, Host_Down, Host_Unreachable, Inappropriate_Family, Is_Already_Connected, Network_Down, Network_Reset, Network_Unreachable, No_Buffer_Space, Not_A_Socket, Not_Connected, Option_Not_Supported, Protocol_Not_Supported, Socket_Not_Supported, Unknown_Protocol_Option, Would_Block, Wrong_Protocol_Type); type Error_Array_Type is array (Error_Name_Enum) of Error_Code; end Bogus_Error_Codes; Error_Array : constant Bogus_Error_Codes.Error_Array_Type := (No_Error, E2BIG, EFAULT, EBADF, EBADMSG, EPIPE, ENOTEMPTY, ENOEXEC, EEXIST, EFBIG, ENAMETOOLONG, EXDEV, ENOTTY, EIO, EINTR, EINVAL, ESPIPE, EISDIR, EMSGSIZE, ECHILD, ENOLCK, ENOSPC, ENODEV, ENXIO, ENOENT, ESRCH, ENOTDIR, ENOMEM, ECANCELED, EINPROGRESS, ENOSYS, EPERM, ENOTSUP, EACCES, EROFS, EBUSY, EDEADLK, EAGAIN, ETIMEDOUT, EMLINK, EMFILE, ENFILE, -- 2.4.6 Socket Error Codes from P1003.5c EADDRINUSE, EADDRNOTAVAIL, EALREADY, ECONNABORTED, ECONNREFUSED, ECONNRESET, EDOM, EHOSTDOWN, EHOSTUNREACH, EAFNOSUPPORT, EISCONN, ENETDOWN, ENETRESET, ENETUNREACH, ENOBUFS, ENOTSOCK, ENOTCONN, EOPNOTSUPP, EPROTONOSUPPORT, ESOCKTNOSUPPORT, ENOPROTOOPT, EWOULDBLOCK, EPROTOTYPE); ------------------------ -- Time Conversions -- ------------------------ NS_per_S : constant := 10#1#E9; MS_per_S : constant := 10#1#E6; type D_Int is mod 2 ** (Duration'Size); function To_D_Int is new Ada.Unchecked_Conversion (Duration, D_Int); function To_Duration is new Ada.Unchecked_Conversion (D_Int, Duration); Duration_Delta_Assertion : constant := Boolean'Pos (Boolean'Pred (Duration'Small = 0.000_000_001)); -- We rely that POSIX.Calendar.Time and Calendar.Time are -- implemented using the same representation as Duration, and -- both are implemented using a UNIX clock. function To_Struct_Timespec (D : Duration) return POSIX.C.struct_timespec; function To_Struct_Timespec (T : Timespec) return POSIX.C.struct_timespec; function To_Duration (TS : POSIX.C.struct_timespec) return Duration; function To_Timespec (TS : POSIX.C.struct_timespec) return Timespec; function To_Struct_Timeval (D : Duration) return POSIX.C.struct_timeval; function To_Duration (TV : POSIX.C.struct_timeval) return Duration; end POSIX.Implementation; libflorist-2025.1.0/libsrc/posix-implementation.gpb000066400000000000000000000343341473553204100222620ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . I M P L E M E N T A T I O N -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Exceptions, # if HAVE_Safe_Errno then # else POSIX.Error_Codes, # end if; System.Interrupt_Management.Operations, GNAT.Task_Lock, System.Soft_Links; package body POSIX.Implementation is use POSIX.C; package SIM renames System.Interrupt_Management; package SIMO renames System.Interrupt_Management.Operations; # if HAVE_Safe_Errno then procedure Set_Ada_Error_Code (Error : Error_Code) is begin Store_Errno (Error); end Set_Ada_Error_Code; function Get_Ada_Error_Code return Error_Code is begin return Fetch_Errno; end Get_Ada_Error_Code; # else procedure Set_Ada_Error_Code (Error : Error_Code) is begin POSIX.Error_Codes.Set_Value (Error); end Set_Ada_Error_Code; function Get_Ada_Error_Code return Error_Code is begin return POSIX.Error_Codes.Value; end Get_Ada_Error_Code; # end if; -- .... It would be nice if we had a way to check whether we -- are in a critical section, at the points (below) where we are -- about to raise an exception. These routines should never be -- called from inside a critical section, but that is an easy -- mistake to make. ------------------------------ -- Begin_Critical_Section -- ------------------------------ procedure Begin_Critical_Section is begin GNAT.Task_Lock.Lock; end Begin_Critical_Section; ---------------------------- -- End_Critical_Section -- ---------------------------- procedure End_Critical_Section is begin GNAT.Task_Lock.Unlock; end End_Critical_Section; ---------------------- -- Defer_Abortion -- ---------------------- procedure Defer_Abortion is begin System.Soft_Links.Abort_Defer.all; end Defer_Abortion; ------------------------ -- Undefer_Abortion -- ------------------------ procedure Undefer_Abortion is begin System.Soft_Links.Abort_Undefer.all; end Undefer_Abortion; ------------------------- -- Raise_POSIX_Error -- ------------------------- procedure Raise_POSIX_Error (Error : Error_Code := No_Error) is Tmp : Error_Code := Error; begin -- .... see note on critical sections above if Error = No_Error then Tmp := Fetch_Errno; end if; Set_Ada_Error_Code (Tmp); Ada.Exceptions.Raise_Exception (POSIX_Error'Identity, Image (Tmp)); end Raise_POSIX_Error; ------------- -- Check -- ------------- procedure Check (Condition : Boolean; Error : Error_Code; Old_Mask : Signal_Mask_Access := null) is begin -- .... see note on critical sections above if not Condition then if Old_Mask /= null then Restore_Signals (Old_Mask); end if; Raise_POSIX_Error (Error); end if; end Check; procedure Check (Result : int; Old_Mask : Signal_Mask_Access := null) is begin -- .... see note on critical sections above if Result = -1 then if Old_Mask /= null then Restore_Signals (Old_Mask); end if; Raise_POSIX_Error (Fetch_Errno); end if; end Check; function Check (Result : int; Old_Mask : Signal_Mask_Access := null) return int is begin -- .... see note on critical sections above if Result = -1 then if Old_Mask /= null then Restore_Signals (Old_Mask); end if; Raise_POSIX_Error (Fetch_Errno); end if; return Result; end Check; -- ....is there a better work-around???? -- Provenzano's threads seem to -- return nonstandard negative values for some calls, -- like "close". procedure Check_NNeg (Result : int) is begin -- .... see note on critical sections above if Result < 0 then Raise_POSIX_Error (Fetch_Errno); end if; end Check_NNeg; -- ....is there a better work-around???? -- Provenzano's threads seem to -- return nonstandard negative values for some calls, -- like "close". function Check_NNeg (Result : int) return int is begin -- .... see note on critical sections above. if Result < 0 then Raise_POSIX_Error (Fetch_Errno); end if; return Result; end Check_NNeg; procedure Check_NZ (Result : int) is begin -- .... see note on critical sections above. if Result /= 0 then Raise_POSIX_Error (Error_Code (Result)); end if; end Check_NZ; ------------------- -- Form_String -- ------------------- function strlen (str : char_ptr) return size_t; pragma Import (C, strlen, "strlen"); function Form_String (Str : char_ptr) return String is begin if Str = null then return ""; end if; declare subtype Substring is String (1 .. Integer (strlen (Str))); type Substring_Ptr is access Substring; pragma Warnings (Off); function char_ptr_to_pssptr is new Ada.Unchecked_Conversion (char_ptr, Substring_Ptr); pragma Warnings (On); begin return char_ptr_to_pssptr (Str).all; end; end Form_String; --------------------------- -- Trim_Leading_Blanks -- --------------------------- function Trim_Leading_Blank (S : String) return String is begin if S (S'First) /= ' ' then return S; end if; return S (S'First + 1 .. S'Last); end Trim_Leading_Blank; -------------------- -- Nulterminate -- -------------------- type Big_POSIX_String_Ptr is access all POSIX_String (Positive'Range); function From_Address is new Ada.Unchecked_Conversion (System.Address, Big_POSIX_String_Ptr); procedure Nulterminate (To : out POSIX_String; From : String) is L : constant Positive := From'Length; begin if To'Length <= L then raise Constraint_Error; end if; To (1 .. L) := From_Address (From'Address) (1 .. L); To (L + 1) := NUL; end Nulterminate; ----------------------- -- Not_Implemented -- ----------------------- function Not_Implemented_Neg_One return int is begin Store_Errno (ENOSYS); return -1; end Not_Implemented_Neg_One; function Not_Implemented_Direct return int is begin return ENOSYS; end Not_Implemented_Direct; function Not_Supported_Neg_One return int is begin Store_Errno (ENOTSUP); return -1; end Not_Supported_Neg_One; function Not_Supported_Direct return int is begin return ENOTSUP; end Not_Supported_Direct; ---------------------- -- Signal Masking -- ---------------------- -- For RTS_Signals we mask all the signals identified as reserved -- by the tasking RTS. However, we leave SIGABRT alone since it is being -- used as the signal for abortion which needs to be invoked for -- POSIX.Signals.Interrupt_Task. Do not mask SIGTRAP either because -- this signal is used by the debugger. -- ...Fix POSIX.5b???? -- It seems we are deviating here from what the standard says, but for -- very good reasons. procedure Mask_Signals (Masking : Signal_Masking; Old_Mask : Signal_Mask_Access) is use type SIM.Interrupt_ID; begin if Masking /= No_Signals then declare New_Mask : aliased Signal_Mask; begin Begin_Critical_Section; SIMO.Get_Interrupt_Mask (New_Mask'Unchecked_Access); SIMO.Copy_Interrupt_Mask (Old_Mask.all, New_Mask); if Masking = RTS_Signals then for J in 1 .. SIM.Interrupt_ID'Last loop if SIM.Reserve (J) and J /= SIGABRT and J /= SIGTRAP then SIMO.Add_To_Interrupt_Mask (New_Mask'Unchecked_Access, J); end if; end loop; else -- All_Signals SIMO.Fill_Interrupt_Mask (New_Mask'Unchecked_Access); end if; SIMO.Set_Interrupt_Mask (New_Mask'Unchecked_Access); End_Critical_Section; end; end if; end Mask_Signals; procedure Restore_Signals (Masking : Signal_Masking; Old_Mask : Signal_Mask_Access) is begin if Masking /= No_Signals then Begin_Critical_Section; SIMO.Set_Interrupt_Mask (Old_Mask); End_Critical_Section; end if; end Restore_Signals; procedure Restore_Signals (Old_Mask : Signal_Mask_Access) is begin Begin_Critical_Section; SIMO.Set_Interrupt_Mask (Old_Mask); End_Critical_Section; end Restore_Signals; ------------------------------------- -- Check_..._And_Restore_Signals -- ------------------------------------- procedure Restore_Signals_And_Raise_POSIX_Error (Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access) is Error : constant Error_Code := Fetch_Errno; begin Restore_Signals (Masked_Signals, Old_Mask); Raise_POSIX_Error (Error); end Restore_Signals_And_Raise_POSIX_Error; procedure Check_NNeg_And_Restore_Signals (Result : int; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access) is begin if Result < 0 then Restore_Signals_And_Raise_POSIX_Error (Masked_Signals, Old_Mask); else Restore_Signals (Masked_Signals, Old_Mask); end if; end Check_NNeg_And_Restore_Signals; -------------------------- -- To_Struct_Timespec -- -------------------------- function To_Struct_Timespec (D : Duration) return struct_timespec is S : time_t; F : Duration; begin S := time_t (Long_Long_Integer (D)); F := D - Duration (S); -- If F has negative value due to a round-up, adjust for positive F -- value. if F < 0.0 then S := S - 1; F := F + 1.0; end if; return struct_timespec'(tv_sec => S, tv_nsec => long (Long_Long_Integer (F * NS_per_S))); end To_Struct_Timespec; function To_Struct_Timespec (T : Timespec) return struct_timespec is begin return To_Struct_Timespec (To_Duration (T)); end To_Struct_Timespec; ------------------- -- To_Duration -- ------------------- function To_Duration (TS : struct_timespec) return Duration is begin return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / NS_per_S; end To_Duration; ------------------- -- To_Timespec -- ------------------- function To_Timespec (TS : struct_timespec) return Timespec is begin return Timespec' (Val => Duration (TS.tv_sec) + Duration (TS.tv_nsec) / NS_per_S); end To_Timespec; ------------------- -- To_Duration -- ------------------- function To_Duration (TV : struct_timeval) return Duration is begin return Duration (TV.tv_sec) + Duration (TV.tv_usec) / MS_per_S; end To_Duration; ------------------------- -- To_Struct_Timeval -- ------------------------- function To_Struct_Timeval (D : Duration) return struct_timeval is S : time_t; F : Duration; begin S := time_t (Long_Long_Integer (D)); F := D - Duration (S); -- If F has negative value due to a round-up, adjust for positive F -- value. if F < 0.0 then S := S - 1; F := F + 1.0; end if; return struct_timeval'(tv_sec => S, tv_usec => suseconds_t (Long_Long_Integer (F * MS_per_S))); end To_Struct_Timeval; end POSIX.Implementation; libflorist-2025.1.0/libsrc/posix-io.adb000066400000000000000000000636511473553204100176260ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . I O -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- ????? -- Perhaps we should put exception handlers around the critical -- sections in this code, in case Storage_Error is raised by one -- of the system calls within them? This would be a lot more overhead. with Ada.IO_Exceptions, Ada.Unchecked_Conversion, System.Storage_Elements, POSIX.Implementation, POSIX.Permissions.Implementation; package body POSIX.IO is use POSIX.C, POSIX.Implementation, POSIX.Permissions.Implementation; function To_int is new Ada.Unchecked_Conversion (Bits, int); function To_Bits is new Ada.Unchecked_Conversion (int, Bits); C_File_Mode : constant array (File_Mode) of Bits := (Read_Only => O_RDONLY, Write_Only => O_WRONLY, Read_Write => O_RDWR); C_Whence : constant array (Position) of int := (From_Beginning => SEEK_SET, From_End_Of_File => SEEK_END, From_Current_Position => SEEK_CUR); procedure Check_NNeg_And_Restore_Signals (Result : int; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access); procedure Check_NNeg_And_Restore_Signals (Result : ssize_t; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access); pragma Inline (Check_NNeg_And_Restore_Signals); procedure Check_NNeg_And_Restore_Signals (Result : int; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access) is begin if Result < 0 then Restore_Signals_And_Raise_POSIX_Error (Masked_Signals, Old_Mask); else Restore_Signals (Masked_Signals, Old_Mask); end if; end Check_NNeg_And_Restore_Signals; procedure Check_NNeg_And_Restore_Signals (Result : ssize_t; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access) is begin if Result < 0 then Restore_Signals_And_Raise_POSIX_Error (Masked_Signals, Old_Mask); else Restore_Signals (Masked_Signals, Old_Mask); end if; end Check_NNeg_And_Restore_Signals; ------------ -- Open -- ------------ function open (path : char_ptr; oflag : int) return int; function open (path : char_ptr; oflag : int; mode : mode_t) return int; pragma Import (C, open, open_LINKNAME); function Open (Name : Pathname; Mode : File_Mode; Options : Open_Option_Set := Empty_Set; Masked_Signals : Signal_Masking := RTS_Signals) return File_Descriptor is Result : int; Name_With_NUL : POSIX_String := Name & NUL; Old_Mask : aliased Signal_Mask; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := open (path => Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, oflag => To_int (Option_Set (Options).Option or C_File_Mode (Mode))); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); return File_Descriptor (Result); end Open; ---------------------- -- Open_Or_Create -- ---------------------- function Open_Or_Create (Name : Pathname; Mode : File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : Open_Option_Set := Empty_Set; Masked_Signals : POSIX.Signal_Masking := RTS_Signals) return File_Descriptor is Result : int; Name_With_NUL : POSIX_String := Name & NUL; Old_Mask : aliased Signal_Mask; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := open (path => Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, oflag => To_int (Option_Set (Options).Option or C_File_Mode (Mode) or O_CREAT), mode => Form_C_Permission (Permissions)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); return File_Descriptor (Result); end Open_Or_Create; --------------- -- Is_Open -- --------------- function fcntl (fildes : int; cmd : int) return int; function fcntl (fildes : int; cmd : int; arg : int) return int; pragma Import (C, fcntl, fcntl_LINKNAME); function Is_Open (File : File_Descriptor) return Boolean is begin return fcntl (int (File), F_GETFL) /= -1; end Is_Open; ------------- -- Close -- ------------- function close (fildes : int) return int; pragma Import (C, close, close_LINKNAME); procedure Close (File : File_Descriptor; Masked_Signals : Signal_Masking := RTS_Signals) is Old_Mask : aliased Signal_Mask; Result : int; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := close (int (File)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Close; ----------------- -- Duplicate -- ----------------- function dup (fildes : int) return int; pragma Import (C, dup, dup_LINKNAME); function Duplicate (File : File_Descriptor; Target : File_Descriptor := 0) return File_Descriptor is pragma Warnings (Off, Target); begin return File_Descriptor (Check (dup (int (File)))); end Duplicate; --------------------------- -- Duplicate_and_Close -- --------------------------- function dup2 (fildes, fildes2 : int) return int; -- fildes = old fd, fildes2 = new fd pragma Import (C, dup2, dup2_LINKNAME); function Duplicate_and_Close (File : File_Descriptor; Target : File_Descriptor := 0; Masked_Signals : Signal_Masking := RTS_Signals) return File_Descriptor is Old_Mask : aliased Signal_Mask; Result : int; begin if File = Target then return Target; end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := dup2 (int (File), int (Target)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); return File_Descriptor (Result); end Duplicate_and_Close; ------------------- -- Create_Pipe -- ------------------- type fildes_pair is array (1 .. 2) of File_Descriptor; function pipe (fildes : access fildes_pair) return int; pragma Import (C, pipe, pipe_LINKNAME); procedure Create_Pipe (Read_End : out File_Descriptor; Write_End : out File_Descriptor) is Fildes : aliased fildes_pair; begin Check_NZ (pipe (Fildes'Unchecked_Access)); Read_End := Fildes (1); Write_End := Fildes (2); end Create_Pipe; ------------ -- Read -- ------------ -- .... Change P1003.5? -- We have trouble getting a pointer to the Buffer argument, -- which we need in order to pass it through to the OS. -- 1) The type Ada.Streams.Stream_Element_Array -- is not declared with aliased components. This prevents us -- from using Buffer (Buffer'First)'Unchecked_Access. -- 2) The parameter Buffer is not aliased, so we can't use -- Buffer'Unchecked_Access. -- 3) The parameter Buffer is not itself an access parameter. -- Therefore, we use Buffer (Buffer'First)'Address. -- The compiler should always -- accept this, but some day it may quietly stop working, as it relies -- on assumptions about the meaning of 'Address and how the compiler -- chooses to pass the parameter Buffer. -- If this breaks here, then it will also break in several other -- places, where we use the same technique. function read (fildes : int; buf : System.Address; nbyte : size_t) return ssize_t; pragma Import (C, read, read_LINKNAME); procedure Read (File : File_Descriptor; Buffer : out IO_Buffer; Last : out IO_Count; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Old_Mask : aliased Signal_Mask; begin if Buffer'Length = 0 then Last := IO_Count (Buffer'First) - 1; return; end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := read (int (File), Buffer (Buffer'First)'Address, size_t (Buffer'Last - Buffer'First + 1)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); Last := IO_Count (Buffer'First) + IO_Count (Result) - 1; if Result = 0 then raise Ada.IO_Exceptions.End_Error; end if; end Read; procedure NONSTANDARD_Read (File : File_Descriptor; Buffer : out IO_Buffer; Last : out Natural; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Old_Mask : aliased Signal_Mask; begin if Buffer'Length = 0 then Last := Buffer'First - 1; return; end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := read (int (File), Buffer (Buffer'First)'Address, size_t (Buffer'Last - Buffer'First + 1)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); Last := Buffer'First + Integer (Result) - 1; if Result = 0 then raise Ada.IO_Exceptions.End_Error; end if; end NONSTANDARD_Read; procedure Read (File : File_Descriptor; Buffer : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Old_Mask : aliased Signal_Mask; use Ada.Streams; begin if Buffer'Length = 0 then Last := Buffer'First - 1; return; end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := read (int (File), Buffer (Buffer'First)'Address, size_t (Buffer'Last - Buffer'First + 1)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); Last := Buffer'First + Ada.Streams.Stream_Element_Offset (Result) - 1; if Result = 0 then raise Ada.IO_Exceptions.End_Error; end if; end Read; -- .... Consider writing one lower-level subprogram for Read and -- having both versions call it. Similarly for Write. ------------- -- Write -- ------------- function write (fildes : int; buf : System.Address; nbyte : size_t) return ssize_t; pragma Import (C, write, write_LINKNAME); -- ....Change POSIX.5???? -- Something is inconsistent here. -- If Last is the last position, then for a null array -- we don't want to set it to zero! procedure Write (File : File_Descriptor; Buffer : IO_Buffer; Last : out IO_Count; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Old_Mask : aliased Signal_Mask; begin if Buffer'Length = 0 then Last := IO_Count (Buffer'First - 1); return; end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := write (int (File), Buffer (Buffer'First)'Address, size_t (Buffer'Last - Buffer'First + 1)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); Last := IO_Count (Buffer'First) + IO_Count (Result) - 1; end Write; -- .... Change POSIX.5????? -- The type of Last really should be Natural, since it is -- an index in a POSIX_String array. procedure NONSTANDARD_Write (File : File_Descriptor; Buffer : IO_Buffer; Last : out Natural; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Old_Mask : aliased Signal_Mask; begin if Buffer'Length = 0 then Last := Buffer'First - 1; return; end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := write (int (File), Buffer (Buffer'First)'Address, size_t (Buffer'Last - Buffer'First + 1)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); Last := Buffer'First + Integer (Result) - 1; end NONSTANDARD_Write; procedure Write (File : File_Descriptor; Buffer : Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Old_Mask : aliased Signal_Mask; use Ada.Streams; begin if Buffer'Length = 0 then Last := Buffer'First - 1; return; end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := write (int (File), Buffer (Buffer'First)'Address, size_t (Buffer'Last - Buffer'First + 1)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); Last := Buffer'First + Ada.Streams.Stream_Element_Offset (Result) - 1; end Write; -------------------- -- Generic_Read -- -------------------- procedure Generic_Read (File : File_Descriptor; Item : out T; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Old_Mask : aliased Signal_Mask; begin if Item'Size rem char'Size /= 0 then Raise_POSIX_Error (Operation_Not_Implemented); end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := read (int (File), Item'Address, size_t (Item'Size / char'Size)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); if Result < Item'Size / char'Size then raise Ada.IO_Exceptions.End_Error; end if; end Generic_Read; --------------------- -- Generic_Write -- --------------------- procedure Generic_Write (File : File_Descriptor; Item : T; Masked_Signals : Signal_Masking := RTS_Signals) is Result : ssize_t; Written : System.Storage_Elements.Storage_Offset := 0; To_Write : System.Storage_Elements.Storage_Offset := System.Storage_Elements.Storage_Offset (Item'Size / char'Size); Old_Mask : aliased Signal_Mask; use System.Storage_Elements; begin if Item'Size rem char'Size /= 0 then Raise_POSIX_Error (Operation_Not_Implemented); end if; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); -- Write is called iteratively because it may only perform a -- partial write, for example in the case the filesystem is -- full. If fewer bytes are written than expected then try -- again to write the remaining portion of the object. loop Result := write (int (File), Item'Address + Written, size_t (To_Write - Written)); -- Exit if write fails or zero-length write succeeds. exit when Result <= 0; Written := Written + Storage_Offset (Result); To_Write := To_Write - Storage_Offset (Result); -- Exit if done writing. exit when To_Write = 0; end loop; Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Generic_Write; ------------ -- Seek -- ------------ function lseek (fildes : int; offset : off_t; whence : int) return off_t; pragma Import (C, lseek, lseek_LINKNAME); procedure Seek (File : File_Descriptor; Offset : IO_Offset; Result : out IO_Offset; Starting_Point : Position := From_Beginning) is begin Result := IO_Offset (lseek (int (File), off_t (Offset), C_Whence (Starting_Point))); Check (int (Result)); end Seek; ----------------- -- File_Size -- ----------------- function File_Size (File : File_Descriptor) return IO_Count is Prevoff, Endoff : off_t; begin Begin_Critical_Section; Prevoff := lseek (int (File), 0, SEEK_CUR); if Prevoff < 0 then End_Critical_Section; Raise_POSIX_Error; end if; Endoff := lseek (int (File), 0, SEEK_END); if Endoff < 0 then End_Critical_Section; Raise_POSIX_Error; end if; Prevoff := lseek (int (File), Prevoff, SEEK_SET); if Prevoff < 0 then End_Critical_Section; Raise_POSIX_Error; end if; End_Critical_Section; return (IO_Count (Endoff)); end File_Size; --------------------- -- File_Position -- --------------------- function File_Position (File : File_Descriptor) return IO_Offset is begin return IO_Offset (Check (int (lseek (int (File), 0, SEEK_CUR)))); end File_Position; --------------------- -- Is_A_Terminal -- --------------------- function isatty (fildes : int) return int; pragma Import (C, isatty, isatty_LINKNAME); function Is_A_Terminal (File : File_Descriptor) return Boolean is begin return isatty (int (File)) = 1; end Is_A_Terminal; ------------------------- -- Get_Terminal_Name -- ------------------------- function ttyname (fildes : int) return char_ptr; pragma Import (C, ttyname, ttyname_LINKNAME); function Get_Terminal_Name (File : File_Descriptor) return Pathname is Result : char_ptr; begin Result := ttyname (int (File)); if Result = null then Raise_POSIX_Error; end if; return Form_POSIX_String (Result); end Get_Terminal_Name; ------------------------ -- Get_File_Control -- ------------------------ procedure Get_File_Control (File : File_Descriptor; Mode : out File_Mode; Options : out Open_Option_Set) is Result : Bits; Access_Mode : Bits; begin Defer_Abortion; Result := To_Bits (Check (fcntl (int (File), F_GETFL))); Undefer_Abortion; Access_Mode := Result and O_ACCMODE; if Access_Mode = O_RDONLY then Mode := Read_Only; elsif Access_Mode = O_WRONLY then Mode := Write_Only; elsif Access_Mode = O_RDWR then Mode := Read_Write; else Raise_POSIX_Error (ENOSYS); -- should never be reached end if; Options := Open_Option_Set (Option_Set' (Option => Result and not O_ACCMODE)); end Get_File_Control; ------------------------ -- Set_File_Control -- ------------------------ C_Other_Open_Options : constant Bits := O_TRUNC or O_EXCL or O_NOCTTY or O_SYNC or O_DSYNC or O_RSYNC or O_RDONLY or O_RDWR or O_WRONLY; procedure Set_File_Control (File : File_Descriptor; Options : Open_Option_Set) is Old_Values : int; New_Values : Bits; begin Begin_Critical_Section; Old_Values := fcntl (int (File), F_GETFL); if Old_Values = -1 then End_Critical_Section; Raise_POSIX_Error; end if; New_Values := (Option_Set (Options).Option and not C_Other_Open_Options) or (To_Bits (Old_Values) and C_Other_Open_Options); if fcntl (int (File), F_SETFL, To_int (New_Values)) = -1 then End_Critical_Section; Raise_POSIX_Error; end if; End_Critical_Section; end Set_File_Control; ------------------------- -- Get_Close_On_Exec -- ------------------------- function Get_Close_On_Exec (File : File_Descriptor) return Boolean is Result : int; begin Result := fcntl (int (File), F_GETFD); if Result = -1 then Raise_POSIX_Error; end if; return (To_Bits (Result) and FD_CLOEXEC) /= 0; end Get_Close_On_Exec; ------------------------- -- Set_Close_On_Exec -- ------------------------- procedure Set_Close_On_Exec (File : File_Descriptor; To : Boolean := True) is Flags : Bits; pragma Warnings (Off); Result : int; begin Begin_Critical_Section; Flags := To_Bits (fcntl (int (File), F_GETFD)); if Flags = -1 then End_Critical_Section; Raise_POSIX_Error; end if; if To then Flags := Flags or FD_CLOEXEC; else Flags := Flags and not FD_CLOEXEC; end if; if fcntl (int (File), F_SETFD, To_int (Flags)) = -1 then End_Critical_Section; Raise_POSIX_Error; end if; Result := fcntl (int (File), F_GETFD); -- should not fail since previous call did not fail -- ??? Is it the case that the value of Result should not be checked pragma Warnings (Off); End_Critical_Section; end Set_Close_On_Exec; ------------------------- -- Change_Permission -- ------------------------- function fchmod (fildes : int; mode : mode_t) return int; pragma Import (C, fchmod, fchmod_LINKNAME); procedure Change_Permissions (File : File_Descriptor; Permission : POSIX.Permissions.Permission_Set) is begin Check (fchmod (int (File), Form_C_Permission (Permission))); end Change_Permissions; --------------------- -- Truncate_File -- --------------------- function ftruncate (fildes : int; length : off_t) return int; pragma Import (C, ftruncate, ftruncate_LINKNAME); procedure Truncate_File (File : File_Descriptor; Length : IO_Count) is begin Check (ftruncate (int (File), off_t (Length))); end Truncate_File; ------------------------ -- Synchronize_File -- ------------------------ function fsync (fildes : int) return int; pragma Import (C, fsync, fsync_LINKNAME); procedure Synchronize_File (File : File_Descriptor) is begin Check (fsync (int (File))); end Synchronize_File; ------------------------ -- Synchronize_Data -- ------------------------ function fdatasync (fildes : int) return int; pragma Import (C, fdatasync, fdatasync_LINKNAME); procedure Synchronize_Data (File : File_Descriptor) is begin Check (fdatasync (int (File))); end Synchronize_Data; -- 6.1.12 Sockets File Ownership procedures from P1003.5c pragma Warnings (Off); procedure Get_Owner (File : File_Descriptor; Process : out POSIX.Process_Identification.Process_ID; Group : out POSIX.Process_Identification.Process_Group_ID) is begin Raise_POSIX_Error (Operation_Not_Implemented); end Get_Owner; pragma Warnings (On); procedure Set_Socket_Process_Owner (File : File_Descriptor; Process : POSIX.Process_Identification.Process_ID) is pragma Unreferenced (File); pragma Unreferenced (Process); begin Raise_POSIX_Error (Operation_Not_Implemented); end Set_Socket_Process_Owner; procedure Set_Socket_Group_Owner (File : File_Descriptor; Group : POSIX.Process_Identification.Process_Group_ID) is pragma Unreferenced (File); pragma Unreferenced (Group); begin Raise_POSIX_Error (Operation_Not_Implemented); end Set_Socket_Group_Owner; procedure Set_Buffer (Vector : in out IO_Vector; Buffer : System.Address; Length : Positive) is begin Vector.C.iov_base := To_char_ptr (Buffer); Vector.C.iov_len := size_t (Length); end Set_Buffer; procedure Get_Buffer (Vector : IO_Vector; Buffer : out System.Address; Length : out POSIX.IO_Count) is begin Buffer := To_Address (Vector.C.iov_base); Length := POSIX.IO_Count (Vector.C.iov_len); end Get_Buffer; end POSIX.IO; libflorist-2025.1.0/libsrc/posix-io.ads000066400000000000000000000264401473553204100176420ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . I O -- -- -- -- S p e c -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2022, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Streams, POSIX.C, POSIX.Permissions, POSIX.Process_Identification, System; pragma Elaborate_All (POSIX); package POSIX.IO is type File_Descriptor is range 0 .. POSIX.Open_Files_Maxima'Last - 1; for File_Descriptor'Size use POSIX.C.int'Size; Standard_Input : constant File_Descriptor := 0; Standard_Output : constant File_Descriptor := 1; Standard_Error : constant File_Descriptor := 2; type IO_Offset is new POSIX.C.off_t; -- File Modes and Options type File_Mode is (Read_Only, Write_Only, Read_Write); type Open_Option_Set is new POSIX.Option_Set; -- Empty_Set, "+" and unary and binary "-" are derived operations Non_Blocking : constant Open_Option_Set; Append : constant Open_Option_Set; Truncate : constant Open_Option_Set; Exclusive : constant Open_Option_Set; Not_Controlling_Terminal : constant Open_Option_Set; File_Synchronized : constant Open_Option_Set; Data_Synchronized : constant Open_Option_Set; Read_Synchronized : constant Open_Option_Set; Close_On_Exec : constant Open_Option_Set; Directory : constant Open_Option_Set; No_Follow : constant Open_Option_Set; -- Operations to open or close file descriptors function Open (Name : POSIX.Pathname; Mode : File_Mode; Options : Open_Option_Set := Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return File_Descriptor; function Open_Or_Create (Name : POSIX.Pathname; Mode : File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : Open_Option_Set := Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return File_Descriptor; function Is_Open (File : File_Descriptor) return Boolean; procedure Close (File : File_Descriptor; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); function Duplicate (File : File_Descriptor; Target : File_Descriptor := 0) return File_Descriptor; function Duplicate_and_Close (File : File_Descriptor; Target : File_Descriptor := 0; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return File_Descriptor; procedure Create_Pipe (Read_End : out File_Descriptor; Write_End : out File_Descriptor); -- File Input/Output operations subtype IO_Buffer is POSIX.POSIX_String; procedure Read (File : File_Descriptor; Buffer : out IO_Buffer; Last : out POSIX.IO_Count; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure NONSTANDARD_Read (File : File_Descriptor; Buffer : out IO_Buffer; Last : out Natural; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Read (File : File_Descriptor; Buffer : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Write (File : File_Descriptor; Buffer : IO_Buffer; Last : out POSIX.IO_Count; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure NONSTANDARD_Write (File : File_Descriptor; Buffer : IO_Buffer; Last : out Natural; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Write (File : File_Descriptor; Buffer : Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); generic type T is private; procedure Generic_Read (File : File_Descriptor; Item : out T; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); generic type T is private; procedure Generic_Write (File : File_Descriptor; Item : T; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); -- File position operations type Position is (From_Beginning, From_Current_Position, From_End_Of_File); procedure Seek (File : File_Descriptor; Offset : IO_Offset; Result : out IO_Offset; Starting_Point : Position := From_Beginning); function File_Size (File : File_Descriptor) return POSIX.IO_Count; function File_Position (File : File_Descriptor) return IO_Offset; -- Terminal operations function Is_A_Terminal (File : File_Descriptor) return Boolean; function Get_Terminal_Name (File : File_Descriptor) return POSIX.Pathname; -- File Control operations procedure Get_File_Control (File : File_Descriptor; Mode : out File_Mode; Options : out Open_Option_Set); procedure Set_File_Control (File : File_Descriptor; Options : Open_Option_Set); function Get_Close_On_Exec (File : File_Descriptor) return Boolean; procedure Set_Close_On_Exec (File : File_Descriptor; To : Boolean := True); procedure Change_Permissions (File : POSIX.IO.File_Descriptor; Permission : POSIX.Permissions.Permission_Set); procedure Truncate_File (File : POSIX.IO.File_Descriptor; Length : POSIX.IO_Count); procedure Synchronize_File (File : POSIX.IO.File_Descriptor); procedure Synchronize_Data (File : POSIX.IO.File_Descriptor); -- POSIX.5c/D4 additions -- 6.1.1 Sockets Option Flags from P1003.5c Signal_When_Socket_Ready : constant Open_Option_Set; -- 6.1.12 Sockets File Ownership procedures from P1003.5c procedure Get_Owner (File : File_Descriptor; Process : out POSIX.Process_Identification.Process_ID; Group : out POSIX.Process_Identification.Process_Group_ID); procedure Set_Socket_Process_Owner (File : File_Descriptor; Process : POSIX.Process_Identification.Process_ID); procedure Set_Socket_Group_Owner (File : File_Descriptor; Group : POSIX.Process_Identification.Process_Group_ID); type IO_Vector is limited private; procedure Set_Buffer (Vector : in out IO_Vector; Buffer : System.Address; Length : Positive); procedure Get_Buffer (Vector : IO_Vector; Buffer : out System.Address; Length : out POSIX.IO_Count); private Non_Blocking : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_NONBLOCK)); Append : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_APPEND)); -- .... Change POSIX.5? -- This Append hides operation on String_Lists, and vice versa, -- if we "use" both this package and POSIX. Truncate : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_TRUNC)); Exclusive : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_EXCL)); Not_Controlling_Terminal : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_NOCTTY)); File_Synchronized : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_SYNC)); Data_Synchronized : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_DSYNC)); Read_Synchronized : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_RSYNC)); Close_On_Exec : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_CLOEXEC)); Directory : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_DIRECTORY)); No_Follow : constant Open_Option_Set := Open_Option_Set (Option_Set'(Option => POSIX.C.O_NOFOLLOW)); -- P1003.5c/D4 additions Signal_When_Socket_Ready : constant Open_Option_Set := Open_Option_Set (POSIX.Empty_Set); type IO_Vector is record C : aliased POSIX.C.Sockets.struct_iovec := POSIX.C.Sockets.struct_iovec'(iov_base => null, iov_len => 0); end record; end POSIX.IO; libflorist-2025.1.0/libsrc/posix-macros-sockets.c000066400000000000000000000010261473553204100216340ustar00rootroot00000000000000/* file: posix-macros-sockets.c ---------------------------- These subprograms provide access to POSIX functionality that is provided for C programs via macros. */ /* #include #include */ #include "pconfig.h" unsigned long c_ntohl (unsigned long val) { return ntohl (val); } unsigned long c_htonl (unsigned long val) { return htonl (val); } unsigned short c_ntohs (unsigned short val) { return ntohs (val); } unsigned long c_htons (unsigned long val) { return htons (val); } libflorist-2025.1.0/libsrc/posix-macros.c000066400000000000000000000143021473553204100201640ustar00rootroot00000000000000/*---------------------------------------------------------------------------- -- -- -- FLORIST (FSU Implementation of POISX.5) COMPONENTS -- -- -- -- -- -- P O S I X - M A C R O S . C -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- Copyright (C) 1997-2019, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ----------------------------------------------------------------------------*/ /* file: posix-macros.c -------------------- These subprograms provide access to POSIX functionality that is provided for C programs via macros. */ #define _REENTRANT #include "pconfig.h" #include #include #include #include #include #include #ifdef SIGRTMIN int __gnat_florist_sigrtmin(void) { return SIGRTMIN; } #endif /* SIGRTMIN */ /* This definition is need for multi-threaded error codes on Solaris */ int s_isdir(mode_t mode) { #ifdef S_ISDIR return S_ISDIR(mode); #else return -1; #endif } int s_ischr(mode_t mode) { #ifdef S_ISCHR return S_ISCHR(mode); #else return -1; #endif } int s_isblk(mode_t mode) { #ifdef S_ISBLK return S_ISBLK(mode); #else return -1; #endif } int s_isreg(mode_t mode) { #ifdef S_ISREG return S_ISREG(mode); #else return -1; #endif } int s_islnk(mode_t mode) { #ifdef S_ISLNK return S_ISLNK(mode); #else return -1; #endif } int s_issock(mode_t mode) { #ifdef S_ISSOCK return S_ISSOCK(mode); #else return -1; #endif } int s_isfifo(mode_t mode) { #ifdef S_ISFIFO return S_ISFIFO(mode); #else return -1; #endif } int s_ismsg(mode_t mode) { #ifdef S_ISMSG return S_ISMSG(mode); #else return -1; #endif } int s_typeismq(struct stat *p) { #ifdef S_TYPEISMQ return S_TYPEISMQ(p); #else return 0; #endif } int s_issem(mode_t mode) { #ifdef S_ISSEM return S_ISSEM(mode); #else return -1; #endif } int s_typeissem(struct stat *p) { #ifdef S_TYPEISSEM return S_TYPEISSEM(p); #else return 0; #endif } int s_isshm(mode_t mode) { #ifdef S_ISSHM return S_ISSHM(mode); #else return -1; #endif } int s_typeisshm(struct stat *p) { #ifdef S_TYPEISSHM return S_TYPEISSHM(p); #else return 0; #endif } int wifexited(int stat_val) { #ifdef WIFEXITED return WIFEXITED(stat_val); #else return -1; #endif } int wexitstatus(int stat_val) { #ifdef WEXITSTATUS return WEXITSTATUS(stat_val); #else return -1; #endif } int wifsignaled(int stat_val) { #ifdef WIFSIGNALED return WIFSIGNALED(stat_val); #else return -1; #endif } int wtermsig(int stat_val) { #ifdef WTERMSIG return WTERMSIG(stat_val); #else return -1; #endif } int wifstopped(int stat_val) { #ifdef WIFSTOPPED return WIFSTOPPED(stat_val); #else return -1; #endif } int wstopsig(int stat_val) { #ifdef WSTOPSIG return WSTOPSIG(stat_val); #else return -1; #endif } int fetch_errno() { return errno; } void store_errno(int value) { errno = value; } /* The following are variadic functions and on some platforms, for instance x86-64, calling a variadic function directly from Ada can cause problems. Here we provide wrappers that we import instead. */ int __gnat_florist_open(const char *path, int oflag, mode_t mode) { return open (path, oflag, mode); } sem_t *__gnat_florist_sem_open (char *name, int oflag, mode_t mode, unsigned value) { return sem_open (name, oflag, mode, value); } /* The following wrappers work around problems on systems where the stat family of functions are implemented using macros. (eg. Tru64 5.1A and Linux.) */ int __gnat_florist_stat(const char *path, struct stat *buf) { return stat(path, buf); } int __gnat_florist_lstat(const char *path, struct stat *buf) { return lstat(path, buf); } int __gnat_florist_fstat(int fd, struct stat *buf) { return fstat(fd, buf); } /* The following wrapper ensures that uname(3) is mapped correctly even when it is defined as an inlined function. */ int __gnat_florist_uname (struct utsname *s) { return uname (s); } libflorist-2025.1.0/libsrc/posix-memory_locking.adb000066400000000000000000000070421473553204100222250ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E M O R Y _ L O C K I N G -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Implementation; package body POSIX.Memory_Locking is use POSIX.C; use POSIX.Implementation; ---------------- -- Lock_All -- ---------------- procedure Lock_All (Options : Memory_Locking_Options) is function mlockall (flag : int) return int; pragma Import (C, mlockall, mlockall_LINKNAME); begin Check (mlockall (int (Option_Set (Options).Option))); end Lock_All; ------------------ -- Unlock_All -- ------------------ procedure Unlock_All is function munlockall return int; pragma Import (C, munlockall, munlockall_LINKNAME); begin Check (munlockall); end Unlock_All; end POSIX.Memory_Locking; libflorist-2025.1.0/libsrc/posix-memory_locking.ads000066400000000000000000000064201473553204100222450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E M O R Y _ L O C K I N G -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C; package POSIX.Memory_Locking is type Memory_Locking_Options is new POSIX.Option_Set; Current_Pages : constant Memory_Locking_Options; Future_Pages : constant Memory_Locking_Options; procedure Lock_All (Options : Memory_Locking_Options); procedure Unlock_All; private Current_Pages : constant Memory_Locking_Options := Memory_Locking_Options (Option_Set'(Option => POSIX.C.MCL_CURRENT)); Future_Pages : constant Memory_Locking_Options := Memory_Locking_Options (Option_Set'(Option => POSIX.C.MCL_FUTURE)); end POSIX.Memory_Locking; libflorist-2025.1.0/libsrc/posix-memory_mapping.adb000066400000000000000000000146511473553204100222360ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E M O R Y _ M A P P I N G -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation; package body POSIX.Memory_Mapping is use POSIX.Implementation; use System; function To_Address is new Ada.Unchecked_Conversion (ptr_as_int, System.Address); Zero_Address : constant System.Address := To_Address (0); Failure : constant System.Address := To_Address (MAP_FAILED); ------------------ -- Map_Memory -- ------------------ function mmap (addr : System.Address; len : size_t; prot : int; flags : int; fildes : int; off : off_t) return System.Address; pragma Import (C, mmap, mmap_LINKNAME); function Map_Memory (First : System.Address; Length : System.Storage_Elements.Storage_Offset; Protection : Protection_Options; Mapping : Mapping_Options; Location : Location_Options; File : POSIX.IO.File_Descriptor; Offset : POSIX.IO_Count) return System.Address is Result : System.Address; begin Result := mmap (First, size_t (Length), int (Option_Set (Protection).Option), int (Option_Set (Mapping).Option or Option_Set (Location).Option or MAP_FILE), int (File), off_t (Offset)); if Result = Failure then Raise_POSIX_Error; end if; return Result; end Map_Memory; ------------------ -- Map_Memory -- ------------------ function Map_Memory (Length : System.Storage_Elements.Storage_Offset; Protection : Protection_Options; Mapping : Mapping_Options; File : POSIX.IO.File_Descriptor; Offset : POSIX.IO_Count) return System.Address is Result : System.Address; begin Result := mmap (Zero_Address, size_t (Length), int (Option_Set (Protection).Option), int (Option_Set (Mapping).Option or MAP_FILE), int (File), off_t (Offset)); if Result = Failure then Raise_POSIX_Error; end if; return Result; end Map_Memory; -------------------- -- Unmap_Memory -- -------------------- procedure Unmap_Memory (First : System.Address; Length : System.Storage_Elements.Storage_Offset) is function munmap (addr : System.Address; len : size_t) return int; pragma Import (C, munmap, munmap_LINKNAME); begin Check (munmap (First, size_t (Length))); end Unmap_Memory; ------------------------- -- Change_Protection -- ------------------------- procedure Change_Protection (First : System.Address; Length : System.Storage_Elements.Storage_Offset; Protection : Protection_Options) is function mprotect (addr : System.Address; len : size_t; prot : int) return int; pragma Import (C, mprotect, mprotect_LINKNAME); begin Check (mprotect (First, size_t (Length), int (Option_Set (Protection).Option))); end Change_Protection; -------------------------- -- Synchronize_Memory -- -------------------------- procedure Synchronize_Memory (First : System.Address; Length : System.Storage_Elements.Storage_Offset; Options : Synchronize_Memory_Options := Wait_For_Completion) is function msync (address : System.Address; len : size_t; flags : int) return int; pragma Import (C, msync, msync_LINKNAME); begin Check (msync (First, size_t (Length), int (Option_Set (Options).Option))); end Synchronize_Memory; end POSIX.Memory_Mapping; libflorist-2025.1.0/libsrc/posix-memory_mapping.ads000066400000000000000000000140371473553204100222550ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E M O R Y _ M A P P I N G -- -- -- -- S p e c -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.IO, System, System.Storage_Elements; pragma Elaborate_All (POSIX); package POSIX.Memory_Mapping is use POSIX.C; type Protection_Options is new POSIX.Option_Set; Allow_Read : constant Protection_Options; Allow_Write : constant Protection_Options; Allow_Execute : constant Protection_Options; type Mapping_Options is new POSIX.Option_Set; Map_Shared : constant Mapping_Options; Map_Private : constant Mapping_Options; type Location_Options is new POSIX.Option_Set; Exact_Address : constant Location_Options; Nearby_Address : constant Location_Options; function Map_Memory (First : System.Address; Length : System.Storage_Elements.Storage_Offset; Protection : Protection_Options; Mapping : Mapping_Options; Location : Location_Options; File : POSIX.IO.File_Descriptor; Offset : POSIX.IO_Count) return System.Address; function Map_Memory (Length : System.Storage_Elements.Storage_Offset; Protection : Protection_Options; Mapping : Mapping_Options; File : POSIX.IO.File_Descriptor; Offset : POSIX.IO_Count) return System.Address; procedure Unmap_Memory (First : System.Address; Length : System.Storage_Elements.Storage_Offset); procedure Change_Protection (First : System.Address; Length : System.Storage_Elements.Storage_Offset; Protection : Protection_Options); type Synchronize_Memory_Options is new POSIX.Option_Set; Wait_For_Completion : constant Synchronize_Memory_Options; No_Wait_For_Completion : constant Synchronize_Memory_Options; Invalidate_Cached_Data : constant Synchronize_Memory_Options; procedure Synchronize_Memory (First : System.Address; Length : System.Storage_Elements.Storage_Offset; Options : Synchronize_Memory_Options := Wait_For_Completion); private Allow_Read : constant Protection_Options := Protection_Options (Option_Set'(Option => POSIX.C.PROT_READ)); Allow_Write : constant Protection_Options := Protection_Options (Option_Set'(Option => POSIX.C.PROT_WRITE)); Allow_Execute : constant Protection_Options := Protection_Options (Option_Set'(Option => POSIX.C.PROT_EXEC)); Map_Shared : constant Mapping_Options := Mapping_Options (Option_Set'(Option => POSIX.C.MAP_SHARED)); Map_Private : constant Mapping_Options := Mapping_Options (Option_Set'(Option => POSIX.C.MAP_PRIVATE)); Exact_Address : constant Location_Options := Location_Options (Option_Set'(Option => POSIX.C.MAP_FIXED)); Nearby_Address : constant Location_Options := Empty_Set; Wait_For_Completion : constant Synchronize_Memory_Options := Synchronize_Memory_Options (Option_Set'(Option => POSIX.C.MS_SYNC)); No_Wait_For_Completion : constant Synchronize_Memory_Options := Synchronize_Memory_Options (Option_Set'(Option => POSIX.C.MS_ASYNC)); Invalidate_Cached_Data : constant Synchronize_Memory_Options := Synchronize_Memory_Options (Option_Set'(Option => POSIX.C.MS_INVALIDATE)); end POSIX.Memory_Mapping; libflorist-2025.1.0/libsrc/posix-memory_range_locking.adb000066400000000000000000000121331473553204100233760ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E M O R Y _ R A N G E _ L O C K I N G -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1996-1998 Florida State University (FSU) -- -- All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Implementation; package body POSIX.Memory_Range_Locking is use POSIX.C, POSIX.Implementation; ------------------ -- Lock_Range -- ------------------ procedure Lock_Range (First : System.Address; Length : System.Storage_Elements.Storage_Offset) is function mlock (addr : access System.Address; len : size_t) return int; pragma Import (C, mlock, mlock_LINKNAME); Addr : aliased System.Address := First; begin -- .... Some OS (eg. Solaris) has non-standard mlock/munlock. -- For the reason if "mlock/munlock" fails with EINVAL, -- we speculate that the OS has non-standard form of the -- functions. So, try it again with a different form of the function. -- .... This is not a perfact solution and we feel that this kind of -- thing has to be resolved in the configuration management. It does its -- work for now.... if mlock (Addr'Unchecked_Access, size_t (Length)) = -1 and then Fetch_Errno = Invalid_Argument then declare function mlock (addr : System.Address; len : size_t) return int; pragma Import (C, mlock, mlock_LINKNAME); begin Check (mlock (Addr, size_t (Length))); end; else Check (mlock (Addr'Unchecked_Access, size_t (Length))); end if; end Lock_Range; -------------------- -- UnLock_Range -- -------------------- procedure Unlock_Range (First : System.Address; Length : System.Storage_Elements.Storage_Offset) is function munlock (addr : access System.Address; len : size_t) return int; pragma Import (C, munlock, munlock_LINKNAME); Addr : aliased System.Address := First; begin if munlock (Addr'Unchecked_Access, size_t (Length)) = -1 and then Fetch_Errno = Invalid_Argument then declare function munlock (addr : System.Address; len : size_t) return int; pragma Import (C, munlock, munlock_LINKNAME); begin Check (munlock (Addr, size_t (Length))); end; else Check (munlock (Addr'Unchecked_Access, size_t (Length))); end if; end Unlock_Range; end POSIX.Memory_Range_Locking; libflorist-2025.1.0/libsrc/posix-memory_range_locking.ads000066400000000000000000000060371473553204100234250ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E M O R Y _ R A N G E _ L O C K I N G -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with System, System.Storage_Elements; package POSIX.Memory_Range_Locking is procedure Lock_Range (First : System.Address; Length : System.Storage_Elements.Storage_Offset); procedure Unlock_Range (First : System.Address; Length : System.Storage_Elements.Storage_Offset); end POSIX.Memory_Range_Locking; libflorist-2025.1.0/libsrc/posix-page_alignment.adb000066400000000000000000000116601473553204100221620ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P A G E _ A L I G N M E N T -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Configurable_System_Limits; pragma Elaborate_All (POSIX.Configurable_System_Limits); package body POSIX.Page_Alignment is use System.Storage_Elements, System; Page_Size : constant Storage_Offset := Storage_Offset (POSIX.Configurable_System_Limits.Page_Size); ------------------------ -- Truncate_To_Page -- ------------------------ function Truncate_To_Page (Addr : Address) return Address is begin if Page_Size /= 0 then return Addr - (Addr mod Page_Size); else return Addr; end if; end Truncate_To_Page; function Truncate_To_Page (Offset : IO_Count) return IO_Count is begin if Page_Size /= 0 then return Offset - (Offset rem IO_Count (Page_Size)); else return Offset; end if; end Truncate_To_Page; --------------------- -- Adjust_Length -- --------------------- function Adjust_Length (Addr : Address; Length : Storage_Offset) return Storage_Offset is L : Storage_Offset; begin L := Length + Addr - Truncate_To_Page (Addr); if Page_Size = 0 then return L; end if; if L mod Page_Size = 0 then return L; end if; return Page_Size * (L / Page_Size + 1); end Adjust_Length; function Adjust_Length (Offset : IO_Count; Length : Storage_Offset) return Storage_Offset is O : IO_Count; L : Storage_Offset; begin O := Offset - Truncate_To_Page (Offset); L := Length + Storage_Offset (O); if Page_Size = 0 then return L; end if; if L mod Page_Size = 0 then return L; end if; return Page_Size * (L / Page_Size + 1); end Adjust_Length; -------------- -- Length -- -------------- function Length (Size : Natural) return Storage_Offset is begin if Size mod System.Storage_Unit = 0 then return Storage_Offset (Size); else return Storage_Offset (Size / System.Storage_Unit + 1); end if; end Length; end POSIX.Page_Alignment; libflorist-2025.1.0/libsrc/posix-page_alignment.ads000066400000000000000000000065621473553204100222100ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P A G E _ A L I G N M E N T -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with System.Storage_Elements; package POSIX.Page_Alignment is function Truncate_To_Page (Addr : System.Address) return System.Address; function Truncate_To_Page (Offset : POSIX.IO_Count) return POSIX.IO_Count; function Adjust_Length (Addr : System.Address; Length : System.Storage_Elements.Storage_Offset) return System.Storage_Elements.Storage_Offset; function Adjust_Length (Offset : POSIX.IO_Count; Length : System.Storage_Elements.Storage_Offset) return System.Storage_Elements.Storage_Offset; function Length (Size : Natural) return System.Storage_Elements.Storage_Offset; end POSIX.Page_Alignment; libflorist-2025.1.0/libsrc/posix-permissions-implementation.adb000066400000000000000000000126621473553204100246110ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P E R M I S S I O N S . I M P L E M E N T A T I O N -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ package body POSIX.Permissions.Implementation is ------------------- -- Permissions -- ------------------- function Form_C_Permission (perm : Permission_Set) return mode_t is c_perm : mode_t; begin c_perm := 0; if perm (Others_Execute) then c_perm := c_perm or S_IXOTH; end if; if perm (Others_Write) then c_perm := c_perm or S_IWOTH; end if; if perm (Others_Read) then c_perm := c_perm or S_IROTH; end if; if perm (Group_Execute) then c_perm := c_perm or S_IXGRP; end if; if perm (Group_Write) then c_perm := c_perm or S_IWGRP; end if; if perm (Group_Read) then c_perm := c_perm or S_IRGRP; end if; if perm (Owner_Execute) then c_perm := c_perm or S_IXUSR; end if; if perm (Owner_Write) then c_perm := c_perm or S_IWUSR; end if; if perm (Owner_Read) then c_perm := c_perm or S_IRUSR; end if; if perm (Set_User_ID) then c_perm := c_perm or S_ISUID; end if; if perm (Set_Group_ID) then c_perm := c_perm or S_ISGID; end if; return c_perm; end Form_C_Permission; ----------------------------- -- form_posix_permission -- ----------------------------- function Form_Ada_Permission (perm : mode_t) return Permission_Set is a_perm : Permission_Set := (others => False); c_perm : mode_t; begin c_perm := perm; if (c_perm and S_IXOTH) /= 0 then a_perm (Others_Execute) := True; end if; if (c_perm and S_IWOTH) /= 0 then a_perm (Others_Write) := True; end if; if (c_perm and S_IROTH) /= 0 then a_perm (Others_Read) := True; end if; if (c_perm and S_IXGRP) /= 0 then a_perm (Group_Execute) := True; end if; if (c_perm and S_IWGRP) /= 0 then a_perm (Group_Write) := True; end if; if (c_perm and S_IRGRP) /= 0 then a_perm (Group_Read) := True; end if; if (c_perm and S_IXUSR) /= 0 then a_perm (Owner_Execute) := True; end if; if (c_perm and S_IWUSR) /= 0 then a_perm (Owner_Write) := True; end if; if (c_perm and S_IRUSR) /= 0 then a_perm (Owner_Read) := True; end if; if (c_perm and S_ISGID) /= 0 then a_perm (Set_Group_ID) := True; end if; if (c_perm and S_ISUID) /= 0 then a_perm (Set_User_ID) := True; end if; return a_perm; end Form_Ada_Permission; end POSIX.Permissions.Implementation; libflorist-2025.1.0/libsrc/posix-permissions-implementation.ads000066400000000000000000000072411473553204100246270ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P E R M I S S I O N S . I M P L E M E N T A T I O N -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996, 1997 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.C; use POSIX.C; package POSIX.Permissions.Implementation is -- ========= -- -- WARNING -- -- ========= -- -- This package should NOT be used directly by an application. -- It is internal to the FLORIST implementation of the POSIX.5 API, -- and may be changed or replaced in future versions of FLORIST. Permission_Bits : constant POSIX.C.mode_t := POSIX.C.S_IRWXU or POSIX.C.S_IRWXG or POSIX.C.S_IRWXO or POSIX.C.S_ISUID or POSIX.C.S_ISGID; File_Access_Permission_Bits : constant POSIX.C.mode_t := POSIX.C.S_IRWXU or POSIX.C.S_IRWXG or POSIX.C.S_IRWXO; function Form_Ada_Permission (perm : POSIX.C.mode_t) return Permission_Set; function Form_C_Permission (perm : Permission_Set) return POSIX.C.mode_t; end POSIX.Permissions.Implementation; libflorist-2025.1.0/libsrc/posix-permissions.adb000066400000000000000000000123671473553204100215700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P E R M I S S I O N S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1996, 1997 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Implementation, POSIX.Permissions.Implementation; package body POSIX.Permissions is use POSIX.C; use POSIX.Implementation; use POSIX.Permissions.Implementation; ------------------------ -- local declarations -- ------------------------ Cached_Umask : mode_t := 0; ----------------------- -- local subprograms -- ----------------------- function umask (c_mask : mode_t) return mode_t; pragma Import (C, umask, umask_LINKNAME); --------------------------------------- -- Get_Allowed_Process_Permissions -- --------------------------------------- function Get_Allowed_Process_Permissions return Permission_Set is Mask : mode_t; begin Begin_Critical_Section; Mask := umask (Cached_Umask); if Mask /= Cached_Umask then Cached_Umask := Mask; Mask := umask (Mask); end if; End_Critical_Section; return Form_Ada_Permission ((not Cached_Umask) and File_Access_Permission_Bits); -- The allowed process permissions are the complement of the -- file permission bits in umask. -- The Ada interface requires that the other bits be zero. -- We cache the old umask, to reduce the number of calls. end Get_Allowed_Process_Permissions; --------------------------------------- -- Set_Allowed_Process_Permissions -- --------------------------------------- procedure Set_Allowed_Process_Permissions (Permissions : Permission_Set) is Mask : mode_t := not (Form_C_Permission (Permissions) and File_Access_Permission_Bits); -- Mask is assigned to but never referenced when umask is -- evaluated for its side effect. pragma Warnings (Off, Mask); begin Cached_Umask := Mask; Mask := umask (Mask); end Set_Allowed_Process_Permissions; --------------------------------------- -- Set_Allowed_Process_Permissions -- --------------------------------------- procedure Set_Allowed_Process_Permissions (Permissions : Permission_Set; Old_Perms : out Permission_Set) is Mask : constant mode_t := not (Form_C_Permission (Permissions) and File_Access_Permission_Bits); begin Cached_Umask := Mask; Old_Perms := Form_Ada_Permission ((not umask (Mask)) and File_Access_Permission_Bits); end Set_Allowed_Process_Permissions; end POSIX.Permissions; libflorist-2025.1.0/libsrc/posix-permissions.ads000066400000000000000000000104271473553204100216040ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P E R M I S S I O N S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ package POSIX.Permissions is type Permission is (Others_Execute, Others_Write, Others_Read, Group_Execute, Group_Write, Group_Read, Owner_Execute, Owner_Write, Owner_Read, Set_Group_ID, Set_User_ID); type Permission_Set is array (Permission) of Boolean; Owner_Permission_Set : constant Permission_Set := Permission_Set' (Owner_Read | Owner_Write | Owner_Execute => True, others => False); Group_Permission_Set : constant Permission_Set := Permission_Set' (Group_Read | Group_Write | Group_Execute => True, others => False); Others_Permission_Set : constant Permission_Set := Permission_Set' (Others_Read | Others_Write | Others_Execute => True, others => False); Access_Permission_Set : constant Permission_Set := Permission_Set' (Owner_Read | Owner_Write | Owner_Execute => True, Group_Read | Group_Write | Group_Execute => True, Others_Read | Others_Write | Others_Execute => True, others => False); Set_Group_ID_Set : constant Permission_Set := Permission_Set' (Set_Group_ID => True, others => False); Set_User_ID_Set : constant Permission_Set := Permission_Set' (Set_User_ID => True, others => False); -- POSIX Permission-oriented operations function Get_Allowed_Process_Permissions return Permission_Set; procedure Set_Allowed_Process_Permissions (Permissions : Permission_Set); procedure Set_Allowed_Process_Permissions (Permissions : Permission_Set; Old_Perms : out Permission_Set); end POSIX.Permissions; libflorist-2025.1.0/libsrc/posix-process_environment.adb000066400000000000000000000666731473553204100233300ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ E N V I R O N M E N T -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5 : 1990 and IEEE STD -- -- 1003.5b : 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Command_Line, Ada.Unchecked_Deallocation, POSIX.C, POSIX.Implementation; package body POSIX.Process_Environment is use POSIX.C; use POSIX.Implementation; type Environment_List is new POSIX.Implementation.String_List; type var_char_ptr_ptr is access all char_ptr; pragma Warnings (Off); function To_Variable is new Ada.Unchecked_Conversion (char_ptr_ptr, var_char_ptr_ptr); pragma Warnings (On); procedure Free is new Ada.Unchecked_Deallocation (POSIX_String, POSIX_String_Ptr); --------------------------------------- -- Interfaced C String Subprograms -- --------------------------------------- function strlen (str : char_ptr) return size_t; pragma Import (C, strlen, "strlen"); function strcpy (dest : char_ptr; src : char_ptr) return char_ptr; pragma Import (C, strcpy, "strcpy"); function strcat (dest : char_ptr; src : char_ptr) return char_ptr; pragma Import (C, strcat, "strcat"); function strncat (dest : char_ptr; src : char_ptr; n : size_t) return char_ptr; pragma Import (C, strncat, "strncat"); ---------------------------------------------------------- -- Interfaced C Environment Subprograms and Variables -- ---------------------------------------------------------- environ : char_ptr_ptr; pragma Import (C, environ, "environ"); function c_setenv (name : char_ptr; value : char_ptr; overwrite : int) return int; pragma Import (C, c_setenv, setenv_LINKNAME); function c_getenv (name : char_ptr) return char_ptr; pragma Import (C, c_getenv, getenv_LINKNAME); function c_putenv (pair : char_ptr) return int; -- This creates a potentially permanent reference; the -- storage pointed to by pair must not be recovered! pragma Import (C, c_putenv, putenv_LINKNAME); function c_unsetenv (name : char_ptr) return int; pragma Import (C, c_unsetenv, unsetenv_LINKNAME); ------------------------- -- Local_Subprograms -- ------------------------- procedure Validate (Name : POSIX_String); -- Verify that a name is legal, raising posix_error otherwise. function Split_Point (Str : POSIX_String) return Natural; -- Return location of first "=" in string, -- or zero if no "=" is found. -- Assume the string is NUL terminated. function Match (Pair : POSIX_String_Ptr; Name : POSIX_String) return Natural; -- Match returns zero unless Pair has the form -- Name & '=' & ..., in which case it returns the index -- immediately following the '=' in Pair. -- The following C-style version of Match is used -- only if the environment does not provide one or more -- of the standard functions putenv, setenv, getenv, unsetenv. function C_Match (Pair : char_ptr; Name : char_ptr) return char_ptr; -- If the C environment has the standard functions to modify -- the environment, we use those. Otherwise, we hack our own. function Setenv (Name : char_ptr; Value : char_ptr; Overwrite : int) return int; function Unsetenv (Name : char_ptr) return int; function Getenv (Name : char_ptr) return char_ptr; function Create_Pair (Name, Value : char_ptr) return char_ptr; ------------------- -- Create_Pair -- ------------------- function Create_Pair (Name, Value : char_ptr) return char_ptr is Tmp : char_ptr; Eqls : aliased constant POSIX_String := "="; begin Tmp := malloc (strlen (Name) + strlen (Value) + 2); Tmp := strcpy (Tmp, Name); Tmp := strncat (Tmp, Eqls (1)'Unchecked_Access, 1); Tmp := strcat (Tmp, Value); return Tmp; end Create_Pair; -------------- -- Setenv -- -------------- function Setenv (Name : char_ptr; Value : char_ptr; Overwrite : int) return int is begin if HAVE_putenv then if Overwrite = 0 and then c_getenv (Name) /= null then return 0; end if; return c_putenv (Create_Pair (Name, Value)); elsif HAVE_setenv then return c_setenv (Name, Value, Overwrite); else declare P : char_ptr_ptr := environ; PP : char_ptr_ptr; T : char_ptr_ptr; K : size_t := 0; begin while P.all /= null loop if C_Match (P.all, Name) /= null then if Overwrite = 0 then return 0; end if; -- don't risk freeing P.all! To_Variable (P).all := Create_Pair (Name, Value); end if; K := K + 1; Advance (P); end loop; PP := malloc ((K + 2) * (char_ptr'Size / char'Size)); T := PP; P := environ; for I in 1 .. K loop To_Variable (T).all := P.all; Advance (T); Advance (P); end loop; To_Variable (T).all := Create_Pair (Name, Value); Advance (T); To_Variable (T).all := null; environ := PP; -- .... this risks storage leakage (see note above) end; return 0; end if; end Setenv; ---------------- -- Unsetenv -- ---------------- function Unsetenv (Name : char_ptr) return int is begin if HAVE_unsetenv then return c_unsetenv (Name); else declare P : char_ptr_ptr := environ; PP : char_ptr_ptr; Q : char_ptr; begin while P.all /= null loop Q := C_Match (P.all, Name); if Q /= null then loop PP := P; Advance (P); To_Variable (PP).all := P.all; if P.all = null then return 0; end if; end loop; end if; Advance (P); end loop; end; return 0; end if; end Unsetenv; -------------- -- Getenv -- -------------- function Getenv (Name : char_ptr) return char_ptr is begin if HAVE_getenv then return c_getenv (Name); else declare P : char_ptr_ptr := environ; Q : char_ptr; begin while P.all /= null loop Q := C_Match (P.all, Name); if Q /= null then return Q; end if; Advance (P); end loop; end; end if; return null; end Getenv; ---------------- -- Validate -- ---------------- procedure Validate (Name : POSIX_String) is begin if Name = "" then Raise_POSIX_Error (Invalid_Argument); end if; for P in Name'Range loop if Name (P) = '=' or Name (P) = NUL then Raise_POSIX_Error (Invalid_Argument); end if; end loop; end Validate; ------------------- -- Split_Point -- ------------------- function Split_Point (Str : POSIX_String) return Natural is begin for J in Str'Range loop if Str (J) = '=' then return J; end if; if Str (J) = NUL then return 0; end if; end loop; return 0; end Split_Point; ------------- -- Match -- ------------- function Match (Pair : POSIX_String_Ptr; Name : POSIX_String) return Natural is J, JL, K, KL : Integer; begin J := Pair'First; K := Name'First; JL := Pair'Last; KL := Name'Last; while (J <= JL and K <= KL) and then Pair (J) = Name (K) loop J := J + 1; K := K + 1; end loop; -- J > JL or K > KL or Pair (J) /= Name (K) if (K > KL and J <= JL) and then Pair (J) = '=' then return J + 1; end if; return 0; end Match; function C_Match (Pair : char_ptr; Name : char_ptr) return char_ptr is J, K : char_ptr; begin J := Pair; K := Name; while (J.all /= NUL and K.all /= NUL) and then J.all = K.all loop Advance (J); Advance (K); end loop; -- J.all = NUL or K.all = NUL or J.all /= K.all if K.all = NUL and J.all = '=' then Advance (J); return J; end if; return null; end C_Match; -------------------------- -- Current Environment -- -------------------------- -- .... Change P1003.5? -- It is not clear from P1003.5 whether the current environment -- should be shared between Ada and C code. We assume that -- it should be shared, and therefore we use the C-language -- operations to access the current environment. -- P1003.5 says we need to recover the storage of the old value -- of the current environment when we modify it. We must trust -- the C interface to do it, if we want compatibility. -- We choose not to try to make these operations tasking-safe, -- as it is not required by the standard and there is no way -- we can make the C interfaces tasking safe. -- .... consider trying to reduce storage leakage here -- Suppose every string that we allocate to become part of the current -- environment is actually part of a record, with a pointer field -- that is used to keep a linked list of all such records. -- When we change an environment value we could run down the list -- and if the string is found, we could safely recover the storage. -- Of course, for this to be safe for concurrent usage, we would need -- to make the operations that modify the list into critical sections. -- Similarly, we could reduce storage leakage for the object corresponding -- to the current environment, when we need to grow it, in Setenv. -- For example, we might declare : -- Our_Environ : char_ptr_ptr := null; -- Points to the last storage we malloced and used for C's environ. -- Our_Environ_Length : Integer := -1; -- The length in pointers of Our_Environ, if that is not null. -- When we shrink the environment, we could remember that there is -- extra space, using Our_Environ_Length, so that when we need to -- grow it again we would not need to allocate a new block. -- When we need to allocate a larger block, we could recover the -- old one, if environ = Our_Environ. --------------------- -- Argument_List -- --------------------- function Argument_List return POSIX.POSIX_String_List is use Ada.Command_Line; Argv : POSIX_String_List; begin Append (Argv, To_POSIX_String (Command_Name)); for I in 1 .. Argument_Count loop Append (Argv, To_POSIX_String (Argument (I))); end loop; return Argv; end Argument_List; -- .... Consider rewriting the above to use the direct C interface. -- That is, get rid of the extra string copying and type conversion. ------------------------------------- -- Copy_From_Current_Environment -- ------------------------------------- procedure Copy_From_Current_Environment (Env : in out Environment) is P : char_ptr_ptr := environ; Tmp : POSIX_String_List := To_POSIX_String_List (Env); begin if P /= null then while P.all /= null loop -- .... concise but inefficient -- We first remove the NUL and then reappend it. Append (Tmp, Form_POSIX_String (P.all)); Advance (P); end loop; end if; Env := To_Environment (Tmp); end Copy_From_Current_Environment; ----------------------------------- -- Copy_To_Current_Environment -- ----------------------------------- procedure Copy_To_Current_Environment (Env : Environment) is procedure Copy_One (Name : POSIX_String; Value : POSIX_String; Quit : in out Boolean); procedure Copy_One (Name : POSIX_String; Value : POSIX_String; Quit : in out Boolean) is pragma Warnings (Off, Quit); begin Set_Environment_Variable (Name, Value); end Copy_One; procedure Copy_All is new For_Every_Environment_Variable (Copy_One); -- .... concise but inefficient -- We split up pairs, and recombine them, -- adding and removing NUL along the way. -- If we could count on having putenv(), -- the splitting and recombining could be avoided. begin Clear_Environment; Copy_All (Env); end Copy_To_Current_Environment; ------------------------ -- Copy_Environment -- ------------------------ procedure Copy_Environment (Source : Environment; Target : in out Environment) is T_Source : constant POSIX_String_List := To_POSIX_String_List (Source); T_Target : POSIX_String_List; procedure Copy_One (Str : POSIX_String; Done : in out Boolean); procedure Copy_One (Str : POSIX_String; Done : in out Boolean) is pragma Warnings (Off, Done); begin Append (T_Target, Str); end Copy_One; procedure Copy_All is new For_Every_Item (Copy_One); begin Clear_Environment (Target); Copy_All (T_Source); Target := To_Environment (T_Target); end Copy_Environment; ---------------------------- -- Environment_Value_Of -- ---------------------------- function Environment_Value_Of (Name : POSIX.POSIX_String; Env : Environment; Undefined : POSIX.POSIX_String := "") return POSIX.POSIX_String is J : Integer; begin Validate (Name); if Env /= null then for I in 1 .. Env.Length loop exit when Env.List (I) = null; J := Match (Env.List (I), Name); if J /= 0 then return Form_POSIX_String (Env.List (I)(J)'Unchecked_Access); end if; end loop; end if; return Undefined; end Environment_Value_Of; ---------------------------- -- Environment_Value_Of -- ---------------------------- function Environment_Value_Of (Name : POSIX.POSIX_String; Undefined : POSIX.POSIX_String := "") return POSIX.POSIX_String is c_name : POSIX_String := Name & NUL; Result : constant char_ptr := Getenv (c_name (c_name'First)'Unchecked_Access); begin Validate (Name); if Result = null then return Undefined; end if; return Form_POSIX_String (Result); end Environment_Value_Of; ------------------------------- -- Is_Environment_Variable -- ------------------------------- function Is_Environment_Variable (Name : POSIX.POSIX_String; Env : Environment) return Boolean is Result : Boolean := False; procedure Check (Name : POSIX_String; Value : POSIX_String; Done : in out Boolean); procedure Check (Name : POSIX_String; Value : POSIX_String; Done : in out Boolean) is pragma Warnings (Off, Value); begin if Name = Is_Environment_Variable.Name then Result := True; Done := True; end if; end Check; procedure Check_All is new For_Every_Environment_Variable (Check); begin Validate (Name); Check_All (Env); return Result; end Is_Environment_Variable; ------------------------------- -- Is_Environment_Variable -- ------------------------------- function Is_Environment_Variable (Name : POSIX.POSIX_String) return Boolean is c_name : POSIX_String := Name & NUL; begin Validate (Name); return Getenv (c_name (c_name'First)'Unchecked_Access) /= null; end Is_Environment_Variable; ------------------------- -- Clear_Environment -- ------------------------- procedure Clear_Environment (Env : in out Environment) is Tmp : POSIX_String_List := To_POSIX_String_List (Env); begin Make_Empty (Tmp); Env := To_Environment (Tmp); end Clear_Environment; ------------------------- -- Clear_Environment -- ------------------------- procedure Clear_Environment is P : char_ptr_ptr := environ; Strings : POSIX_String_List; procedure Clear_One (Str : POSIX_String; Done : in out Boolean); procedure Clear_One (Str : POSIX_String; Done : in out Boolean) is pragma Warnings (Off, Done); begin Check (Unsetenv (Str (Str'First)'Unchecked_Access)); end Clear_One; procedure Clear_All is new For_Every_Item (Clear_One); begin if P /= null then while P.all /= null loop -- .... concise but inefficient declare S : constant POSIX_String := Form_POSIX_String (P.all); J : constant Integer := Split_Point (S); begin Append (Strings, S (1 .. J - 1)); end; Advance (P); end loop; Clear_All (Strings); Make_Empty (Strings); P := environ; while P.all /= null loop Advance (P); end loop; end if; end Clear_Environment; -------------------------------- -- Set_Environment_Variable -- -------------------------------- procedure Set_Environment_Variable (Name : POSIX.POSIX_String; Value : POSIX.POSIX_String; Env : in out Environment) is J, L : Natural; Tmp : POSIX_String_List; begin Validate (Name); if Env /= null then L := 0; -- last empty location for I in 1 .. Env.Length loop if Env.List (I) = null then if L = 0 then L := I; end if; exit; end if; J := Match (Env.List (I), Name); if J /= 0 then Free (Env.List (I)); Env.List (I) := new POSIX_String'(Name & "=" & Value & NUL); Env.Char (I) := Env.List (I)(1)'Unchecked_Access; return; end if; end loop; pragma Assert (L /= 0); if L < Env.Length then Env.List (L) := new POSIX_String'(Name & "=" & Value & NUL); Env.Char (L) := Env.List (L)(1)'Unchecked_Access; return; end if; end if; Tmp := To_POSIX_String_List (Env); Append (Tmp, Name & "=" & Value); Env := To_Environment (Tmp); end Set_Environment_Variable; -------------------------------- -- Set_Environment_Variable -- -------------------------------- procedure Set_Environment_Variable (Name : POSIX.POSIX_String; Value : POSIX.POSIX_String) is c_name : POSIX_String := Name & NUL; c_value : POSIX_String := Value & NUL; begin Validate (Name); Check (Setenv (c_name (c_name'First)'Unchecked_Access, c_value (c_value'First)'Unchecked_Access, 1)); end Set_Environment_Variable; ----------------------------------- -- Delete_Environment_Variable -- ----------------------------------- procedure Delete_Environment_Variable (Name : POSIX.POSIX_String; Env : in out Environment) is K : Natural; -- the location where Env.List (I) should be; -- eventually lags behind I if we have deleted something begin Validate (Name); if Env /= null then K := 1; for I in 1 .. Env.Length loop -- copy Ith pair down, if necessary -- to fill in for deleted pair if K /= I then Env.List (K) := Env.List (I); Env.Char (K) := Env.Char (I); Env.List (I) := null; Env.Char (I) := null; end if; exit when Env.List (K) = null; if Match (Env.List (K), Name) /= 0 then Free (Env.List (K)); Env.Char (K) := null; else K := K + 1; end if; end loop; end if; end Delete_Environment_Variable; ----------------------------------- -- Delete_Environment_Variable -- ----------------------------------- procedure Delete_Environment_Variable (Name : POSIX.POSIX_String) is c_name : POSIX_String := Name & NUL; begin Validate (Name); Check (Unsetenv (c_name (c_name'First)'Unchecked_Access)); end Delete_Environment_Variable; -------------- -- Length -- -------------- function Length (Env : Environment) return Natural is begin return Length (To_POSIX_String_List (Env)); end Length; -------------- -- Length -- -------------- function Length return Natural is P : char_ptr_ptr := environ; L : Natural := 0; begin if P /= null then while P.all /= null loop L := L + 1; Advance (P); end loop; end if; return L; end Length; -------------------------------------- -- For_Every_Environment_Variable -- -------------------------------------- -- .... Should we try to protect against side-effects of Action? -- We can do this by making a temporary local copy of the -- environment, to use in the traversal. The cost is the overhead -- of making this copy. We currently choose not to do this, -- though it means cannot use For_Every_Environment_Variable to implement -- Clear_Environment. procedure For_Every_Environment_Variable (Env : Environment) is Quit : Boolean := False; begin if Env = null then return; end if; for I in 1 .. Env.Length loop exit when Env.List (I) = null; declare L : constant Integer := Env.List (I)'Length; J : constant Integer := Split_Point (Env.List (I).all); begin if J /= 0 then if J < L then declare Value : constant POSIX_String (1 .. L - (J + 1)); for Value'Address use Env.List (I)(J + 1 .. L - 1)'Address; pragma Import (Ada, Value); -- contortion needed so index range starts with 1 begin Action (Env.List (I)(1 .. J - 1), Value, Quit); end; else Action (Env.List (I)(1 .. J - 1), "", Quit); end if; end if; end; exit when Quit; end loop; end For_Every_Environment_Variable; ---------------------------------------------- -- For_Every_Current_Environment_Variable -- ---------------------------------------------- procedure For_Every_Current_Environment_Variable is Quit : Boolean := False; P : char_ptr_ptr := environ; begin if P = null then return; end if; while P.all /= null loop declare Str : POSIX_String := Form_POSIX_String (P.all); I : constant Natural := Split_Point (Str); begin if I /= 0 then Str (I) := NUL; declare Value : constant POSIX_String (1 .. Str'Last - I); for Value'Address use Str (I + 1 .. Str'Last)'Address; pragma Import (Ada, Value); -- contortion needed so index range starts with 1 begin Action (Str (1 .. I - 1), Value, Quit); end; end if; end; exit when Quit; Advance (P); end loop; end For_Every_Current_Environment_Variable; -------------------------------- -- Change_Working_Directory -- -------------------------------- procedure Change_Working_Directory (Directory_Name : POSIX.Pathname) is function chdir (path : char_ptr) return int; pragma Import (C, chdir, chdir_LINKNAME); c_name : POSIX_String := Directory_Name & NUL; begin Check (chdir (c_name (c_name'First)'Unchecked_Access)); end Change_Working_Directory; ----------------------------- -- Get_Working_Directory -- ----------------------------- function Get_Working_Directory return POSIX.Pathname is function getcwd (buf : char_ptr; size : size_t) return char_ptr; pragma Import (C, getcwd, getcwd_LINKNAME); Guessed_Length : Positive := 256; Result : char_ptr; begin loop declare Buf : POSIX_String (1 .. Guessed_Length); begin Result := getcwd (Buf (1)'Unchecked_Access, size_t (Guessed_Length)); if Result /= null then return Form_POSIX_String (Result); end if; end; exit when Fetch_Errno /= ERANGE; Guessed_Length := Guessed_Length * 2; end loop; Raise_POSIX_Error; return ""; -- to suppress compiler warning end Get_Working_Directory; end POSIX.Process_Environment; libflorist-2025.1.0/libsrc/posix-process_environment.ads000066400000000000000000000133621473553204100233340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ E N V I R O N M E N T -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion; package POSIX.Process_Environment is pragma Elaborate_Body; -- Process Parameters function Argument_List return POSIX.POSIX_String_List; -- .... Change POSIX.5? -- By rights, this function should have been a procedure. -- As a function, it is very awkward, since the type POSIX_String_List -- is limited (i.e. we cannot assign the value returned by the -- function above). Not only is this inefficient, it forces storage -- leakage, unless we implement POSIX_String_List as a controlled type -- with automatic storage reclamation -- which is still less efficient, -- and which nullifies the original reason for making POSIX_String_List -- a limited type! -- Environment Variables type Environment is limited private; procedure Copy_From_Current_Environment (Env : in out Environment); procedure Copy_To_Current_Environment (Env : Environment); procedure Copy_Environment (Source : Environment; Target : in out Environment); function Environment_Value_Of (Name : POSIX.POSIX_String; Env : Environment; Undefined : POSIX.POSIX_String := "") return POSIX.POSIX_String; function Environment_Value_Of (Name : POSIX.POSIX_String; Undefined : POSIX.POSIX_String := "") return POSIX.POSIX_String; function Is_Environment_Variable (Name : POSIX.POSIX_String; Env : Environment) return Boolean; function Is_Environment_Variable (Name : POSIX.POSIX_String) return Boolean; procedure Clear_Environment (Env : in out Environment); procedure Clear_Environment; procedure Set_Environment_Variable (Name : POSIX.POSIX_String; Value : POSIX.POSIX_String; Env : in out Environment); procedure Set_Environment_Variable (Name : POSIX.POSIX_String; Value : POSIX.POSIX_String); procedure Delete_Environment_Variable (Name : POSIX.POSIX_String; Env : in out Environment); procedure Delete_Environment_Variable (Name : POSIX.POSIX_String); function Length (Env : Environment) return Natural; function Length return Natural; generic with procedure Action (Name : POSIX.POSIX_String; Value : POSIX.POSIX_String; Quit : in out Boolean); procedure For_Every_Environment_Variable (Env : Environment); generic with procedure Action (Name : POSIX.POSIX_String; Value : POSIX.POSIX_String; Quit : in out Boolean); procedure For_Every_Current_Environment_Variable; -- Process Working Directory procedure Change_Working_Directory (Directory_Name : POSIX.Pathname); function Get_Working_Directory return POSIX.Pathname; private type Environment_List; type Environment is access Environment_List; function To_Environment is new Ada.Unchecked_Conversion (POSIX_String_List, Environment); function To_POSIX_String_List is new Ada.Unchecked_Conversion (Environment, POSIX_String_List); end POSIX.Process_Environment; libflorist-2025.1.0/libsrc/posix-process_identification.adb000066400000000000000000000240131473553204100237330ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ I D E N T I F I C A T I O N -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Implementation; package body POSIX.Process_Identification is use POSIX.C, POSIX.Implementation; --------------------- -- Get_Process_ID -- --------------------- function getpid return pid_t; pragma Import (C, getpid, getpid_LINKNAME); function Get_Process_ID return Process_ID is begin return Process_ID (getpid); end Get_Process_ID; ----------------------------- -- Get_Parent_Process_ID -- ----------------------------- function Get_Parent_Process_ID return Process_ID is function getppid return pid_t; pragma Import (C, getppid, getppid_LINKNAME); begin return Process_ID (getppid); end Get_Parent_Process_ID; ----------- -- Image -- ----------- function Image (ID : Process_ID) return Standard.String is begin return Process_ID'Image (ID); end Image; ----------- -- Value -- ----------- function Value (Str : Standard.String) return Process_ID is begin return Process_ID'Value (Str); end Value; -------------------------- -- Get_Process_Group_ID -- -------------------------- -- The getpgrp takes an argument under BSD but not under POSIX. -- We pass it an argument in all cases and hope that the function -- call mechanism will not be confused by unexpected arguments. function getpgrp (ID : Process_ID) return Process_Group_ID; pragma Import (C, getpgrp, "getpgrp"); function Get_Process_Group_ID return Process_Group_ID is begin return getpgrp (Get_Process_ID); end Get_Process_Group_ID; -------------------------- -- Set_Process_Group_ID -- -------------------------- function setpgid (pid : pid_t; pgrp : pid_t) return int; pragma Import (C, setpgid, setpgid_LINKNAME); procedure Set_Process_Group_ID (Process : Process_ID := Get_Process_ID; Process_Group : Process_Group_ID := Get_Process_Group_ID) is begin Check (Process /= Null_Process_ID, Invalid_Argument); Check (setpgid (pid_t (Process), pid_t (Process_Group))); end Set_Process_Group_ID; -------------------------- -- Create_Process_Group -- -------------------------- procedure Create_Process_Group (Process : Process_ID; Process_Group : out Process_Group_ID) is function setpgid (pid : pid_t; pgrp : pid_t) return int; pragma Import (C, setpgid, setpgid_LINKNAME); begin Check (setpgid (pid_t (Process), 0)); Process_Group := Process_Group_ID (Process); end Create_Process_Group; ---------------------- -- Create_Session -- ---------------------- procedure Create_Session (Session_Leader : out Process_Group_ID) is function setsid return pid_t; pragma Import (C, setsid, setsid_LINKNAME); begin Session_Leader := Process_Group_ID (setsid); if Session_Leader = -1 then Raise_POSIX_Error; end if; end Create_Session; ----------- -- Image -- ----------- function Image (ID : Process_Group_ID) return Standard.String renames Process_Group_ID'Image; ----------- -- Value -- ----------- function Value (Str : Standard.String) return Process_Group_ID is begin return Process_Group_ID'Value (Str); end Value; ---------------------- -- Get_Real_User_ID -- ---------------------- function Get_Real_User_ID return User_ID is function getuid return uid_t; pragma Import (C, getuid, getuid_LINKNAME); begin return User_ID (getuid); end Get_Real_User_ID; --------------------------- -- Get_Effective_user_ID -- --------------------------- function Get_Effective_User_ID return User_ID is function geteuid return uid_t; pragma Import (C, geteuid, geteuid_LINKNAME); begin return User_ID (geteuid); end Get_Effective_User_ID; ----------------- -- Set_User_ID -- ----------------- procedure Set_User_ID (ID : User_ID) is function setuid (uid : uid_t) return int; pragma Import (C, setuid, setuid_LINKNAME); begin Check (setuid (uid => uid_t (ID))); end Set_User_ID; -------------------- -- Get_Login_Name -- -------------------- -- .... Consider using getlogin_r if that is supported. -- Use conditional code, based on configurable constant -- HAVE_getlogin_r. function Get_Login_Name return POSIX.POSIX_String is function getlogin return char_ptr; pragma Import (C, getlogin, getlogin_LINKNAME); Name_Ptr : char_ptr; begin Name_Ptr := getlogin; if Name_Ptr = null then Raise_POSIX_Error; end if; return Form_POSIX_String (Name_Ptr); end Get_Login_Name; ----------- -- image -- ----------- function Image (ID : User_ID) return Standard.String is begin return User_ID'Image (ID); end Image; ----------- -- Value -- ----------- function Value (Str : Standard.String) return User_ID is begin return User_ID'Value (Str); end Value; -- User Group Identification -- type Group_ID is private; ----------------------- -- Get_Real_Group_ID -- ----------------------- function Get_Real_Group_ID return Group_ID is function getgid return gid_t; pragma Import (C, getgid, getgid_LINKNAME); begin return Group_ID (getgid); end Get_Real_Group_ID; ---------------------------- -- Get_Effective_Group_ID -- ---------------------------- function Get_Effective_Group_ID return Group_ID is function getegid return gid_t; pragma Import (C, getegid, getegid_LINKNAME); begin return Group_ID (getegid); end Get_Effective_Group_ID; ------------------ -- Set_Group_ID -- ------------------ procedure Set_Group_ID (ID : Group_ID) is function setgid (gid : gid_t) return int; pragma Import (C, setgid, setgid_LINKNAME); begin Check (setgid (gid_t (ID))); end Set_Group_ID; ---------------- -- Get_Groups -- ---------------- type Access_Group_ID is access all Group_ID; function Get_Groups return Group_List is function getgroups (gidsetsize : int; grouplist : Access_Group_ID) return C.int; pragma Import (C, getgroups, getgroups_LINKNAME); begin loop declare NGroups_1 : constant int := getgroups (0, null); Groups : aliased Group_List (1 .. Integer (NGroups_1)); NGroups_2 : int; begin NGroups_2 := getgroups (Groups'Length, Groups (1)'Unchecked_Access); Check (NGroups_2); if NGroups_1 = NGroups_2 then return Groups; end if; end; end loop; -- the loop is in case some other process changes the number of -- items in the group list, -- before the first and second call to getgroups end Get_Groups; ----------- -- Image -- ----------- function Image (ID : Group_ID) return Standard.String is begin return Trim_Leading_Blank (Group_ID'Image (ID)); end Image; ----------- -- Value -- ----------- function Value (Str : Standard.String) return Group_ID is begin return Group_ID (Group_ID'Value (Str)); end Value; end POSIX.Process_Identification; libflorist-2025.1.0/libsrc/posix-process_identification.ads000066400000000000000000000121211473553204100237510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ I D E N T I F I C A T I O N -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C; package POSIX.Process_Identification is -- Process Identification type Process_ID is private; Null_Process_ID : constant Process_ID; System_Process_ID : constant Process_ID; function Get_Process_ID return Process_ID; function Get_Parent_Process_ID return Process_ID; function Image (ID : Process_ID) return Standard.String; function Value (Str : Standard.String) return Process_ID; -- Process Group Identification type Process_Group_ID is private; function Get_Process_Group_ID return Process_Group_ID; procedure Set_Process_Group_ID (Process : Process_ID := Get_Process_ID; Process_Group : Process_Group_ID := Get_Process_Group_ID); procedure Create_Process_Group (Process : Process_ID; Process_Group : out Process_Group_ID); procedure Create_Session (Session_Leader : out Process_Group_ID); function Image (ID : Process_Group_ID) return Standard.String; function Value (Str : Standard.String) return Process_Group_ID; -- User Identification type User_ID is private; function Get_Real_User_ID return User_ID; function Get_Effective_User_ID return User_ID; procedure Set_User_ID (ID : User_ID); function Get_Login_Name return POSIX.POSIX_String; function Image (ID : User_ID) return Standard.String; function Value (Str : Standard.String) return User_ID; -- User Group Identification type Group_ID is private; function Get_Real_Group_ID return Group_ID; function Get_Effective_Group_ID return Group_ID; procedure Set_Group_ID (ID : Group_ID); subtype Group_List_Index is Positive range 1 .. POSIX.Groups_Maxima'Last; type Group_List is array (Group_List_Index range <>) of aliased Group_ID; -- ... Applications may not rely on "aliased" here being portable. -- We have added it to allow for simpler implementation. function Get_Groups return Group_List; function Image (ID : Group_ID) return Standard.String; function Value (Str : Standard.String) return Group_ID; private type Process_ID is new POSIX.C.pid_t; Null_Process_ID : constant Process_ID := 0; System_Process_ID : constant Process_ID := 1; -- The process ID value 1 is reserved for use by the system. type Process_Group_ID is new POSIX.C.pid_t; type User_ID is new POSIX.C.uid_t; type Group_ID is new POSIX.C.gid_t; end POSIX.Process_Identification; libflorist-2025.1.0/libsrc/posix-process_scheduling.adb000066400000000000000000000172211473553204100230720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ S C H E D U L I N G -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation, POSIX.Process_Identification; package body POSIX.Process_Scheduling is use POSIX.C; use POSIX.Implementation; -------------------- -- Get_Priority -- -------------------- function Get_Priority (Parameters : Scheduling_Parameters) return Scheduling_Priority is begin return Scheduling_Priority (Parameters.Param.sched_priority); end Get_Priority; -------------------- -- Set_Priority -- -------------------- procedure Set_Priority (Parameters : in out Scheduling_Parameters; Priority : Scheduling_Priority) is begin Parameters.Param.sched_priority := int (Priority); end Set_Priority; --------------------------------- -- Set_Scheduling_Parameters -- --------------------------------- function sched_setparam (pid : pid_t; param : sched_param_ptr) return int; pragma Import (C, sched_setparam, sched_setparam_LINKNAME); function To_pid_t is new Ada.Unchecked_Conversion (POSIX.Process_Identification.Process_ID, pid_t); procedure Set_Scheduling_Parameters (Process : POSIX_Process_Identification.Process_ID; Parameters : Scheduling_Parameters) is begin Check (sched_setparam (To_pid_t (Process), Parameters.Param'Unchecked_Access)); end Set_Scheduling_Parameters; --------------------------------- -- Get_Scheduling_Parameters -- --------------------------------- function sched_getparam (pid : pid_t; param : access struct_sched_param) return int; pragma Import (C, sched_getparam, sched_getparam_LINKNAME); function Get_Scheduling_Parameters (Process : POSIX_Process_Identification.Process_ID) return Scheduling_Parameters is Params : aliased Scheduling_Parameters; begin Check (sched_getparam (To_pid_t (Process), Params.Param'Unchecked_Access)); return Params; end Get_Scheduling_Parameters; ----------------------------- -- Set_Scheduling_Policy -- ----------------------------- function sched_setscheduler (pid : pid_t; policy : int; param : sched_param_ptr) return int; pragma Import (C, sched_setscheduler, sched_setscheduler_LINKNAME); procedure Set_Scheduling_Policy (Process : POSIX_Process_Identification.Process_ID; New_Policy : Scheduling_Policy; Parameters : Scheduling_Parameters) is begin Check (sched_setscheduler (To_pid_t (Process), int (New_Policy), Parameters.Param'Unchecked_Access)); end Set_Scheduling_Policy; ----------------------------- -- Get_Scheduling_Policy -- ----------------------------- function sched_getscheduler (pid : pid_t) return int; pragma Import (C, sched_getscheduler, sched_getscheduler_LINKNAME); function Get_Scheduling_Policy (Process : POSIX_Process_Identification.Process_ID) return Scheduling_Policy is begin return Scheduling_Policy (Check (sched_getscheduler (To_pid_t (Process)))); end Get_Scheduling_Policy; ------------- -- Yield -- ------------- function sched_yield return int; pragma Import (C, sched_yield, sched_yield_LINKNAME); procedure Yield is begin Check (sched_yield); end Yield; ---------------------------- -- Get_Maximum_Priority -- ---------------------------- function sched_get_priority_max (policy : int) return int; pragma Import (C, sched_get_priority_max, sched_get_priority_max_LINKNAME); function Get_Maximum_Priority (Policy : Scheduling_Policy) return Scheduling_Priority is begin return Scheduling_Priority (Check (sched_get_priority_max (int (Policy)))); end Get_Maximum_Priority; ---------------------------- -- Get_Minimum_Priority -- ---------------------------- function sched_get_priority_min (policy : int) return int; pragma Import (C, sched_get_priority_min, sched_get_priority_min_LINKNAME); function Get_Minimum_Priority (Policy : Scheduling_Policy) return Scheduling_Priority is begin return Scheduling_Priority (Check (sched_get_priority_min (int (Policy)))); end Get_Minimum_Priority; --------------------------------- -- Get_Round_Robin_Interval -- --------------------------------- function sched_rr_get_interval (pid : pid_t; interval : access struct_timespec) return int; pragma Import (C, sched_rr_get_interval, sched_rr_get_interval_LINKNAME); function Get_Round_Robin_Interval (Process : POSIX_Process_Identification.Process_ID) return POSIX.Timespec is TS : aliased struct_timespec; begin Check (sched_rr_get_interval (To_pid_t (Process), TS'Unchecked_Access)); return To_Timespec (TS); end Get_Round_Robin_Interval; end POSIX.Process_Scheduling; libflorist-2025.1.0/libsrc/posix-process_scheduling.ads000066400000000000000000000116351473553204100231160ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ S C H E D U L I N G -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX_Process_Identification; package POSIX.Process_Scheduling is subtype Scheduling_Priority is Integer; type Scheduling_Parameters is private; function Get_Priority (Parameters : Scheduling_Parameters) return Scheduling_Priority; procedure Set_Priority (Parameters : in out Scheduling_Parameters; Priority : Scheduling_Priority); type Scheduling_Policy is new Integer; -- One might consider auto-configuring -- the upper and lower bounds of this range to more tightly fit -- the range of values supported by the underlying OS. -- However, that would not help much. For example, LynxOS is -- reputed to have the following values: -- Sched_Fifo : constant := 2097152; -- Sched_Other : constant := 4194304; -- Sched_Rr : constant := 1048576; -- Also, we should not limit it to the just three values shown below, -- because we might want to use these interfaces with implementation -- defined policies. Sched_FIFO : constant Scheduling_Policy := POSIX.C.SCHED_FIFO; Sched_RR : constant Scheduling_Policy := POSIX.C.SCHED_RR; Sched_Other : constant Scheduling_Policy := POSIX.C.SCHED_OTHER; procedure Set_Scheduling_Parameters (Process : POSIX_Process_Identification.Process_ID; Parameters : Scheduling_Parameters); function Get_Scheduling_Parameters (Process : POSIX_Process_Identification.Process_ID) return Scheduling_Parameters; procedure Set_Scheduling_Policy (Process : POSIX_Process_Identification.Process_ID; New_Policy : Scheduling_Policy; Parameters : Scheduling_Parameters); function Get_Scheduling_Policy (Process : POSIX_Process_Identification.Process_ID) return Scheduling_Policy; procedure Yield; function Get_Maximum_Priority (Policy : Scheduling_Policy) return Scheduling_Priority; function Get_Minimum_Priority (Policy : Scheduling_Policy) return Scheduling_Priority; function Get_Round_Robin_Interval (Process : POSIX_Process_Identification.Process_ID) return POSIX.Timespec; private type Scheduling_Parameters is record Param : aliased POSIX.C.struct_sched_param; end record; end POSIX.Process_Scheduling; libflorist-2025.1.0/libsrc/posix-process_times.adb000066400000000000000000000116311473553204100220650ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ T I M E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ package body POSIX.Process_Times is use POSIX.C; ------------------------- -- Elapsed_Real_Time -- ------------------------- function times (buf : tms_ptr) return clock_t; pragma Import (C, times, times_LINKNAME); function Elapsed_Real_Time return Tick_Count is T : Process_Times; begin return Tick_Count (times (T.tms'Unchecked_Access)); end Elapsed_Real_Time; ------------------------- -- Get_Process_Times -- ------------------------- function Get_Process_Times return Process_Times is t : Process_Times; begin t.Elapsed_Real_Time := times (t.tms'Unchecked_Access); return t; end Get_Process_Times; ---------------------------- -- Elapsed_Real_Time_Of -- ---------------------------- function Elapsed_Real_Time_Of (Times : Process_Times) return Tick_Count is begin return Tick_Count (Times.Elapsed_Real_Time); end Elapsed_Real_Time_Of; ----------------------- -- User_CPU_Time_Of -- ----------------------- function User_CPU_Time_Of (Times : Process_Times) return Tick_Count is begin return Tick_Count (Times.tms.tms_utime); end User_CPU_Time_Of; -------------------------- -- System_CPU_Time_Of -- -------------------------- function System_CPU_Time_Of (Times : Process_Times) return Tick_Count is begin return Tick_Count (Times.tms.tms_stime); end System_CPU_Time_Of; ------------------------------------ -- Descendants_User_CPU_Time_Of -- ------------------------------------ function Descendants_User_CPU_Time_Of (Times : Process_Times) return Tick_Count is begin return Tick_Count (Times.tms.tms_cutime); end Descendants_User_CPU_Time_Of; -------------------------------------- -- Descendants_System_CPU_Time_Of -- -------------------------------------- function Descendants_System_CPU_Time_Of (Times : Process_Times) return Tick_Count is begin return Tick_Count (Times.tms.tms_cstime); end Descendants_System_CPU_Time_Of; end POSIX.Process_Times; libflorist-2025.1.0/libsrc/posix-process_times.ads000066400000000000000000000074111473553204100221070ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ T I M E S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C; package POSIX.Process_Times is type Tick_Count is new POSIX.C.clock_t; -- Minimally 0 to 24 hours Ticks_Per_Second : constant Tick_Count; function Elapsed_Real_Time return Tick_Count; type Process_Times is private; function Get_Process_Times return Process_Times; function Elapsed_Real_Time_Of (Times : Process_Times) return Tick_Count; function User_CPU_Time_Of (Times : Process_Times) return Tick_Count; function System_CPU_Time_Of (Times : Process_Times) return Tick_Count; function Descendants_User_CPU_Time_Of (Times : Process_Times) return Tick_Count; function Descendants_System_CPU_Time_Of (Times : Process_Times) return Tick_Count; private function sysconf (c_name : POSIX.C.int) return POSIX.C.long; pragma Import (C, sysconf, POSIX.C.sysconf_LINKNAME); Ticks_Per_Second : constant Tick_Count := Tick_Count (sysconf (POSIX.C.SC_CLK_TCK)); type Process_Times is record tms : aliased POSIX.C.struct_tms; Elapsed_Real_Time : POSIX.C.clock_t; end record; end POSIX.Process_Times; libflorist-2025.1.0/libsrc/posix-semaphores.adb000066400000000000000000000237471473553204100213670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S E M A P H O R E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation, POSIX.Permissions.Implementation; package body POSIX.Semaphores is use POSIX.C, POSIX.Implementation, POSIX.Permissions.Implementation; function To_int is new Ada.Unchecked_Conversion (Bits, int); function To_int is new Ada.Unchecked_Conversion (Semaphore_Descriptor, ptr_as_int); procedure Check_And_Restore_Signals (Result : Semaphore_Descriptor; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access); pragma Inline (Check_And_Restore_Signals); procedure Check_And_Restore_Signals (Result : Semaphore_Descriptor; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access) is begin if To_int (Result) = -1 then Restore_Signals_And_Raise_POSIX_Error (Masked_Signals, Old_Mask); else Restore_Signals (Masked_Signals, Old_Mask); end if; end Check_And_Restore_Signals; procedure Validate (Sem : Semaphore_Descriptor); pragma Inline (Validate); procedure Validate (Sem : Semaphore_Descriptor) is begin if Sem = null then Raise_POSIX_Error (Invalid_Argument); end if; end Validate; --------------------------------- -- Initialize -- --------------------------------- function sem_init (s : Semaphore_Descriptor; pshared : int; value : unsigned) return int; pragma Import (C, sem_init, sem_init_LINKNAME); procedure Initialize (Sem : in out Semaphore; Value : Natural; Is_Shared : Boolean := False) is begin Check (sem_init (Sem.Sem'Unchecked_Access, Boolean'Pos (Is_Shared), unsigned (Value))); end Initialize; --------------------------------- -- Descriptor_Of -- --------------------------------- function Descriptor_Of (Sem : Semaphore) return Semaphore_Descriptor is begin return Sem.Sem'Unchecked_Access; end Descriptor_Of; --------------------------------- -- Finalize -- --------------------------------- function sem_destroy (sem : Semaphore_Descriptor) return int; pragma Import (C, sem_destroy, sem_destroy_LINKNAME); procedure Finalize (Sem : in out Semaphore) is begin Check (sem_destroy (Sem.Sem'Unchecked_Access)); end Finalize; --------------------------------- -- Open -- --------------------------------- function sem_open (name : char_ptr; oflag : int; mode : mode_t; value : unsigned) return Semaphore_Descriptor; function sem_open (name : char_ptr; oflag : int) return Semaphore_Descriptor; pragma Import (C, sem_open, sem_open_LINKNAME); function Open (Name : POSIX.POSIX_String; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return Semaphore_Descriptor is Result : Semaphore_Descriptor; Name_With_NUL : POSIX_String := Name & NUL; Old_Mask : aliased Signal_Mask; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := sem_open (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, 0); Check_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); return Result; end Open; --------------------------------- -- Open_Or_Create -- --------------------------------- function Open_Or_Create (Name : POSIX.POSIX_String; Permissions : POSIX.Permissions.Permission_Set; Value : Natural; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return Semaphore_Descriptor is Result : Semaphore_Descriptor; Name_With_NUL : POSIX_String := Name & NUL; Old_Mask : aliased Signal_Mask; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := sem_open (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, To_int (Option_Set (Options).Option or O_CREAT), Form_C_Permission (Permissions), unsigned (Value)); Check_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); return Result; end Open_Or_Create; --------------------------------- -- Close -- --------------------------------- function sem_close (sem : Semaphore_Descriptor) return int; pragma Import (C, sem_close, sem_close_LINKNAME); procedure Close (Sem : in out Semaphore_Descriptor) is begin Check (sem_close (Sem)); end Close; --------------------------------- -- Unlink_Semaphore -- --------------------------------- function sem_unlink (name : char_ptr) return int; pragma Import (C, sem_unlink, sem_unlink_LINKNAME); procedure Unlink_Semaphore (Name : POSIX.POSIX_String) is Name_With_NUL : POSIX_String := Name & NUL; begin Check (sem_unlink (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access)); end Unlink_Semaphore; --------------------------------- -- Wait -- --------------------------------- function sem_wait (sem : Semaphore_Descriptor) return int; pragma Import (C, sem_wait, sem_wait_LINKNAME); procedure Wait (Sem : Semaphore_Descriptor; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is Result : int; Old_Mask : aliased Signal_Mask; begin Validate (Sem); Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := sem_wait (Sem); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Wait; --------------------------------- -- Try_Wait -- --------------------------------- function sem_trywait (sem : Semaphore_Descriptor) return int; pragma Import (C, sem_trywait, sem_trywait_LINKNAME); function Try_Wait (Sem : Semaphore_Descriptor) return Boolean is Result : int; begin Validate (Sem); Result := sem_trywait (Sem); if Result = 0 then return True; elsif Fetch_Errno = EAGAIN then return False; else Raise_POSIX_Error; -- return statement to suppress compiler warning message return False; end if; end Try_Wait; --------------------------------- -- Post -- --------------------------------- function sem_post (sem : Semaphore_Descriptor) return int; pragma Import (C, sem_post, sem_post_LINKNAME); procedure Post (Sem : Semaphore_Descriptor) is begin Validate (Sem); Check (sem_post (Sem)); end Post; --------------------------------- -- Get_Value -- --------------------------------- function sem_getvalue (sem : Semaphore_Descriptor; sval : access int) return int; pragma Import (C, sem_getvalue, sem_getvalue_LINKNAME); function Get_Value (Sem : Semaphore_Descriptor) return Integer is Value : aliased int; begin Validate (Sem); Check (sem_getvalue (Sem, Value'Unchecked_Access)); return Integer (Value); end Get_Value; end POSIX.Semaphores; libflorist-2025.1.0/libsrc/posix-semaphores.ads000066400000000000000000000126231473553204100213770ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S E M A P H O R E S -- -- -- -- S p e c -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.IO, POSIX.Permissions; package POSIX.Semaphores is type Semaphore is limited private; type Semaphore_Descriptor is private; procedure Initialize (Sem : in out Semaphore; Value : Natural; Is_Shared : Boolean := False); function Descriptor_Of (Sem : Semaphore) return Semaphore_Descriptor; procedure Finalize (Sem : in out Semaphore); function Open (Name : POSIX.POSIX_String; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return Semaphore_Descriptor; function Open_Or_Create (Name : POSIX.POSIX_String; Permissions : POSIX.Permissions.Permission_Set; Value : Natural; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return Semaphore_Descriptor; procedure Close (Sem : in out Semaphore_Descriptor); procedure Unlink_Semaphore (Name : POSIX.POSIX_String); procedure Wait (Sem : Semaphore_Descriptor; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); function Try_Wait (Sem : Semaphore_Descriptor) return Boolean; procedure Post (Sem : Semaphore_Descriptor); function Get_Value (Sem : Semaphore_Descriptor) return Integer; -- .... Change POSIX.5b? -- The Wait and Try_Wait operations are allowed to be interruptible -- by a signal, according to the C binding. Here, we have no -- Masked_Signals parameter. If the system support POSIX threads, -- we are probably OK, since we will want to keep most signals masked, -- in all threads but the corresponding handler (if any). private -- We rely that type Semaphore will be passed by reference, -- so that we can use 'Address of a parameter (even an "in" parameter) -- to get a pointer to the actual object. -- If there is any danger that it will not be passed by reference, -- we will need to enclose the "sem_t" value as an aliased component of a -- record or even of a tagged type. type Dummy is tagged null record; type Semaphore is record Sem : aliased POSIX.C.sem_t; -- to force by-reference parameter mode: D : Dummy; end record; -- The "access constant" is sometimes a lie, but it allows -- us to emulate the POSIX C-language interface without violating -- Ada rules about pointers to variables vs. pointers to constants. type Semaphore_Descriptor is access constant POSIX.C.sem_t; pragma Convention (C, Semaphore_Descriptor); end POSIX.Semaphores; libflorist-2025.1.0/libsrc/posix-shared_memory_objects.adb000066400000000000000000000140061473553204100235540ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S H A R E D _ M E M O R Y _ O B J E C T S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.C, POSIX.Implementation, POSIX.Permissions.Implementation; package body POSIX.Shared_Memory_Objects is use POSIX.C; use POSIX.Implementation; use POSIX.Permissions.Implementation; function To_int is new Ada.Unchecked_Conversion (Bits, int); C_File_Mode : constant array (POSIX.IO.File_Mode) of Bits := (POSIX.IO.Read_Only => O_RDONLY, POSIX.IO.Write_Only => O_WRONLY, POSIX.IO.Read_Write => O_RDWR); -------------------------- -- Open_Shared_Memory -- -------------------------- function shm_open (name : char_ptr; oflag : int; mode : mode_t) return int; pragma Import (C, shm_open, shm_open_LINKNAME); function Open_Shared_Memory (Name : POSIX.POSIX_String; Mode : POSIX.IO.File_Mode; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor is Old_Mask : aliased Signal_Mask; Name_With_NUL : POSIX_String := Name & NUL; Result : POSIX.IO.File_Descriptor; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := POSIX.IO.File_Descriptor (Check (shm_open (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, To_int (Option_Set (Options).Option or C_File_Mode (Mode)), 0), Old_Mask'Unchecked_Access)); Check_NNeg_And_Restore_Signals (int (Result), Masked_Signals, Old_Mask'Unchecked_Access); return Result; end Open_Shared_Memory; ------------------------------------ -- Open_Or_Create_Shared_Memory -- ------------------------------------ function Open_Or_Create_Shared_Memory (Name : POSIX.POSIX_String; Mode : POSIX.IO.File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor is Old_Mask : aliased Signal_Mask; Name_With_NUL : POSIX_String := Name & NUL; Result : POSIX.IO.File_Descriptor; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := POSIX.IO.File_Descriptor (Check (shm_open (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, To_int (Option_Set (Options).Option or C_File_Mode (Mode) or O_CREAT), Form_C_Permission (Permissions)), Old_Mask'Unchecked_Access)); Check_NNeg_And_Restore_Signals (int (Result), Masked_Signals, Old_Mask'Unchecked_Access); return Result; end Open_Or_Create_Shared_Memory; ---------------------------- -- Unlink_Shared_Memory -- ---------------------------- procedure Unlink_Shared_Memory (Name : POSIX.POSIX_String) is Name_With_NUL : POSIX_String := Name & NUL; function shm_unlink (name : char_ptr) return int; pragma Import (C, shm_unlink, shm_unlink_LINKNAME); begin Check (shm_unlink (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access)); end Unlink_Shared_Memory; end POSIX.Shared_Memory_Objects; libflorist-2025.1.0/libsrc/posix-shared_memory_objects.ads000066400000000000000000000072561473553204100236060ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S H A R E D _ M E M O R Y _ O B J E C T S -- -- -- -- S p e c -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.IO, POSIX.Permissions; package POSIX.Shared_Memory_Objects is function Open_Shared_Memory (Name : POSIX.POSIX_String; Mode : POSIX.IO.File_Mode; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor; function Open_Or_Create_Shared_Memory (Name : POSIX.POSIX_String; Mode : POSIX.IO.File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return POSIX.IO.File_Descriptor; procedure Unlink_Shared_Memory (Name : POSIX.POSIX_String); end POSIX.Shared_Memory_Objects; libflorist-2025.1.0/libsrc/posix-supplement_to_ada_io.adb000066400000000000000000000131521473553204100234000ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S U P P L E M E N T _ T O _ A D A _ I O -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- .... This cannot be fully implemented without special support -- from the implementation of the package Ada.Text_IO. -- The present version is just a stub. A true implementation -- will apparently need to coordinate with -- the implementation of the standard Ada IO packages, e.g. -- System.File_Control_Block -- System.File_IO -- System.Direct_IO -- System.Sequential_IO -- Interfaces.C_Streams -- The modifications we need to make to those packages will -- need coordination with ACT. with Ada.Unchecked_Conversion, POSIX.Implementation, Interfaces.C_Streams, System.File_Control_Block, System.File_IO; package body POSIX.Supplement_to_Ada_IO is use Interfaces.C_Streams; use POSIX.Implementation; subtype System_File_Type is System.File_Control_Block.AFCB_Ptr; function Form_String (Val : Form_Values_for_Open) return String is pragma Unreferenced (Val); begin Raise_POSIX_Error (Operation_Not_Supported); return ""; end Form_String; function Form_Value (Str : String) return Form_Values_for_Open is pragma Unreferenced (Str); A : Form_Values_for_Open; begin Raise_POSIX_Error (Operation_Not_Supported); return A; end Form_Value; function Form_String (Val : Form_Values_for_Create) return String is pragma Unreferenced (Val); begin Raise_POSIX_Error (Operation_Not_Supported); return ""; end Form_String; function Form_Value (Str : String) return Form_Values_for_Create is pragma Unreferenced (Str); A : Form_Values_for_Create; begin Raise_POSIX_Error (Operation_Not_Supported); return A; end Form_Value; -- .... We may be able to implement Flush_All, using the open file -- chain, which is maintained by System.File_IO. procedure Flush_All is begin Raise_POSIX_Error (Operation_Not_Supported); end Flush_All; procedure Flush_Text_IO (File : Ada.Text_IO.File_Type) is begin Ada.Text_IO.Flush (File); end Flush_Text_IO; procedure Flush_Sequential_IO (File : File_Type) is function To_SFT is new Ada.Unchecked_Conversion (File_Type, System_File_Type); F : System_File_Type; Ret : int; pragma Unreferenced (Ret); begin F := To_SFT (File); System.File_IO.Check_File_Open (F); Ret := fflush (F.Stream); end Flush_Sequential_IO; procedure Flush_Direct_IO (File : File_Type) is function To_SFT is new Ada.Unchecked_Conversion (File_Type, System_File_Type); F : System_File_Type; Ret : int; pragma Unreferenced (Ret); begin F := To_SFT (File); System.File_IO.Check_File_Open (F); Ret := fflush (F.Stream); end Flush_Direct_IO; end POSIX.Supplement_to_Ada_IO; libflorist-2025.1.0/libsrc/posix-supplement_to_ada_io.ads000066400000000000000000000117301473553204100234210ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S U P P L E M E N T _ T O _ A D A _ I O -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with Ada.IO_Exceptions, Ada.Text_IO, POSIX.IO, POSIX.Permissions; package POSIX.Supplement_to_Ada_IO is type File_Structure_Values is (Regular, FIFO); type Terminal_Input_Values is (Lines, Characters); type Possible_File_Descriptor (Valid : Boolean := False) is record case Valid is when True => Descriptor : POSIX.IO.File_Descriptor; when False => null; end case; end record; type Form_Values_for_Open is record Append : Boolean := False; Blocking : POSIX.Text_IO_Blocking_Behavior := POSIX.IO_Blocking_Behavior; Terminal_Input : Terminal_Input_Values := Lines; Page_Terminators : Boolean := True; File_Descriptor : Possible_File_Descriptor; end record; type Form_Values_for_Create is record Permission_Mask : POSIX.Permissions.Permission_Set := POSIX.Permissions.Access_Permission_Set; Blocking : POSIX.Text_IO_Blocking_Behavior := POSIX.IO_Blocking_Behavior; Terminal_Input : Terminal_Input_Values := Lines; File_Structure : File_Structure_Values := Regular; Page_Terminators : Boolean := True; end record; function Form_String (Val : Form_Values_for_Open) return String; function Form_Value (Str : String) return Form_Values_for_Open; function Form_String (Val : Form_Values_for_Create) return String; function Form_Value (Str : String) return Form_Values_for_Create; procedure Flush_All; procedure Flush_Text_IO (File : Ada.Text_IO.File_Type); generic type File_Type is limited private; procedure Flush_Sequential_IO (File : File_Type); generic type File_Type is limited private; procedure Flush_Direct_IO (File : File_Type); -- .... Change POSIX.5? -- This is a terrible interface! -- These generic procedures can only be implemented by trickery, -- since we have no way of getting a handle for the corresponding -- instantiation, or the set of files that may be open using those -- the particular instantiation. Use_Error : exception renames Ada.IO_Exceptions.Use_Error; end POSIX.Supplement_to_Ada_IO; libflorist-2025.1.0/libsrc/posix-terminal_functions.adb000066400000000000000000000525321473553204100231160ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . T E R M I N A L _ F U N C T I O N S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation; package body POSIX.Terminal_Functions is use POSIX.C, POSIX.Implementation; ------------------------- -- Local Subprograms -- ------------------------- procedure Validate (Characteristics : Terminal_Characteristics); function To_Ada_Baud (Val : speed_t) return Baud_Rate; procedure Validate (Characteristics : Terminal_Characteristics) is begin Check (Characteristics.Valid, Invalid_Argument); end Validate; pragma Inline (Validate); function To_Ada_Baud (Val : speed_t) return Baud_Rate is begin if Val = POSIX.C.B0 then return B0; end if; if Val = POSIX.C.B50 then return B50; end if; if Val = POSIX.C.B75 then return B75; end if; if Val = POSIX.C.B110 then return B110; end if; if Val = POSIX.C.B134 then return B134; end if; if Val = POSIX.C.B150 then return B150; end if; if Val = POSIX.C.B200 then return B200; end if; if Val = POSIX.C.B300 then return B300; end if; if Val = POSIX.C.B600 then return B600; end if; if Val = POSIX.C.B1200 then return B1200; end if; if Val = POSIX.C.B1800 then return B1800; end if; if Val = POSIX.C.B2400 then return B2400; end if; if Val = POSIX.C.B4800 then return B4800; end if; if Val = POSIX.C.B9600 then return B9600; end if; if Val = POSIX.C.B19200 then return B19200; end if; if Val = POSIX.C.B38400 then return B38400; end if; if Val = POSIX.C.B57600 then return B57600; end if; if Val = POSIX.C.B115200 then return B115200; end if; if Val = POSIX.C.B230400 then return B230400; end if; if Val = POSIX.C.B460800 then return B460800; end if; Raise_POSIX_Error (Invalid_Argument); -- fake return to avoid compiler warning message return B38400; end To_Ada_Baud; ---------------------------------- -- Get_Terminal_Characteristics -- ---------------------------------- function tcgetattr (fd : int; pt : access struct_termios) return int; pragma Import (C, tcgetattr, tcgetattr_LINKNAME); function Get_Terminal_Characteristics (File : POSIX.IO.File_Descriptor) return Terminal_Characteristics is Pt : Terminal_Characteristics; begin Pt.Valid := True; Check (tcgetattr (int (File), Pt.termios'Unchecked_Access)); return Pt; end Get_Terminal_Characteristics; ---------------------------------- -- Set_Terminal_Characteristics -- ---------------------------------- To_C_Times : constant array (Terminal_Action_Times) of int := (Immediately => TCSANOW, After_Output => TCSADRAIN, After_Output_And_Input => TCSAFLUSH); function tcsetattr (fd : int; action : int; pt : termios_ptr) return int; pragma Import (C, tcsetattr, tcsetattr_LINKNAME); procedure Set_Terminal_Characteristics (File : POSIX.IO.File_Descriptor; Characteristics : Terminal_Characteristics; Apply : Terminal_Action_Times := Immediately; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is Old_Mask : aliased Signal_Mask; Result : int; begin Validate (Characteristics); Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := tcsetattr (int (File), To_C_Times (Apply), Characteristics.termios'Unchecked_Access); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Set_Terminal_Characteristics; ----------------------- -- Terminal_Modes_Of -- ----------------------- To_C_Terminal_Mode : constant array (Terminal_Modes) of tcflag_t := ( -- Input_Modes Interrupt_On_Break => BRKINT, Map_CR_To_LF => ICRNL, Ignore_Break => IGNBRK, Ignore_CR => IGNCR, Ignore_Parity_Errors => IGNPAR, Map_LF_To_CR => INLCR, Enable_Parity_Check => INPCK, Strip_Character => ISTRIP, Enable_Start_Stop_Input => IXOFF, Enable_Start_Stop_Output => IXON, Mark_Parity_Errors => PARMRK, -- Output_Modes Perform_Output_Processing => OPOST, -- Control_Modes Ignore_Modem_Status => CLOCAL, Enable_Receiver => CREAD, Send_Two_Stop_Bits => CSTOPB, Hang_Up_On_Last_Close => HUPCL, Parity_Enable => PARENB, Odd_Parity => PARODD, -- Local_Modes Echo => POSIX.C.ECHO, Echo_Erase => ECHOE, Echo_Kill => ECHOK, Echo_LF => ECHONL, Canonical_Input => ICANON, Extended_Functions => IEXTEN, Enable_Signals => ISIG, No_Flush => NOFLSH, Send_Signal_For_BG_Output => TOSTOP); i_mask : constant tcflag_t := BRKINT or ICRNL or IGNBRK or IGNCR or IGNPAR or INLCR or INPCK or ISTRIP or IXOFF or IXON or PARMRK; o_mask : constant tcflag_t := OPOST; c_mask : constant tcflag_t := CLOCAL or CREAD or CSTOPB or HUPCL or PARENB or PARODD; l_mask : constant tcflag_t := POSIX.C.ECHO or ECHOE or ECHOK or ECHONL or ICANON or IEXTEN or ISIG or NOFLSH or TOSTOP; function Terminal_Modes_Of (Characteristics : Terminal_Characteristics) return Terminal_Modes_Set is Modes : Terminal_Modes_Set := (others => False); begin Validate (Characteristics); for I in Input_Modes loop if (Characteristics.termios.c_iflag and To_C_Terminal_Mode (I)) /= 0 then Modes (I) := True; end if; end loop; for I in Output_Modes loop if (Characteristics.termios.c_oflag and To_C_Terminal_Mode (I)) /= 0 then Modes (I) := True; end if; end loop; for I in Control_Modes loop if (Characteristics.termios.c_cflag and To_C_Terminal_Mode (I)) /= 0 then Modes (I) := True; end if; end loop; for I in Local_Modes loop if (Characteristics.termios.c_lflag and To_C_Terminal_Mode (I)) /= 0 then Modes (I) := True; end if; end loop; return Modes; end Terminal_Modes_Of; --------------------------- -- Define_Terminal_Modes -- --------------------------- procedure Define_Terminal_Modes (Characteristics : in out Terminal_Characteristics; Modes : Terminal_Modes_Set) is Tmp : tcflag_t; begin Validate (Characteristics); Tmp := 0; for I in Input_Modes loop if Modes (I) then Tmp := Tmp or To_C_Terminal_Mode (I); end if; end loop; Characteristics.termios.c_iflag := (Characteristics.termios.c_iflag and not i_mask) or Tmp; Tmp := 0; for I in Output_Modes loop if Modes (I) then Tmp := Tmp or To_C_Terminal_Mode (I); end if; end loop; Characteristics.termios.c_oflag := (Characteristics.termios.c_oflag and not o_mask) or Tmp; Tmp := 0; for I in Control_Modes loop if Modes (I) then Tmp := Tmp or To_C_Terminal_Mode (I); end if; end loop; Characteristics.termios.c_cflag := (Characteristics.termios.c_cflag and not c_mask) or Tmp; Tmp := 0; for I in Local_Modes loop if Modes (I) then Tmp := Tmp or To_C_Terminal_Mode (I); end if; end loop; Characteristics.termios.c_lflag := (Characteristics.termios.c_lflag and not l_mask) or Tmp; end Define_Terminal_Modes; --------------------------- -- Bits_Per_Character_Of -- --------------------------- function Bits_Per_Character_Of (Characteristics : Terminal_Characteristics) return Bits_Per_Character is csize_bits : constant tcflag_t := Characteristics.termios.c_cflag and CSIZE; begin Validate (Characteristics); if csize_bits = CS5 then return 5; end if; if csize_bits = CS6 then return 6; end if; if csize_bits = CS7 then return 7; end if; if csize_bits = CS8 then return 8; end if; Raise_POSIX_Error (Invalid_Argument); -- fake return to avoid compiler warning message return 8; end Bits_Per_Character_Of; ------------------------------- -- Define_Bits_Per_Character -- ------------------------------- To_C_Bits : constant array (Bits_Per_Character) of tcflag_t := (5 => CS5, 6 => CS6, 7 => CS7, 8 => CS8); procedure Define_Bits_Per_Character (Characteristics : in out Terminal_Characteristics; Bits : Bits_Per_Character) is begin Validate (Characteristics); Characteristics.termios.c_cflag := (Characteristics.termios.c_cflag and not CSIZE) or To_C_Bits (Bits); end Define_Bits_Per_Character; ------------------------ -- Input_Baud_Rate_Of -- ------------------------ function cfgetispeed (termios_p : termios_ptr) return speed_t; pragma Import (C, cfgetispeed, cfgetispeed_LINKNAME); function Input_Baud_Rate_Of (Characteristics : Terminal_Characteristics) return Baud_Rate is begin Validate (Characteristics); return To_Ada_Baud (cfgetispeed (Characteristics.termios'Unchecked_Access)); end Input_Baud_Rate_Of; ---------------------------- -- Define_Input_Baud_Rate -- ---------------------------- To_C_Baud : constant array (Baud_Rate) of speed_t := (B0 => POSIX.C.B0, B50 => POSIX.C.B50, B75 => POSIX.C.B75, B110 => POSIX.C.B110, B134 => POSIX.C.B134, B150 => POSIX.C.B150, B200 => POSIX.C.B200, B300 => POSIX.C.B300, B600 => POSIX.C.B600, B1200 => POSIX.C.B1200, B1800 => POSIX.C.B1800, B2400 => POSIX.C.B2400, B4800 => POSIX.C.B4800, B9600 => POSIX.C.B9600, B19200 => POSIX.C.B19200, B38400 => POSIX.C.B38400, B57600 => POSIX.C.B57600, B115200 => POSIX.C.B115200, B230400 => POSIX.C.B230400, B460800 => POSIX.C.B460800); function cfsetispeed (termios_p : termios_ptr; speed : speed_t) return int; pragma Import (C, cfsetispeed, cfsetispeed_LINKNAME); procedure Define_Input_Baud_Rate (Characteristics : in out Terminal_Characteristics; Input_Baud_Rate : Baud_Rate) is begin Validate (Characteristics); Check (cfsetispeed (Characteristics.termios'Unchecked_Access, To_C_Baud (Input_Baud_Rate))); end Define_Input_Baud_Rate; ------------------------- -- Output_Baud_Rate_Of -- ------------------------- function cfgetospeed (termios_p : termios_ptr) return speed_t; pragma Import (C, cfgetospeed, cfgetospeed_LINKNAME); function Output_Baud_Rate_Of (Characteristics : Terminal_Characteristics) return Baud_Rate is begin Validate (Characteristics); return To_Ada_Baud (cfgetospeed (Characteristics.termios'Unchecked_Access)); end Output_Baud_Rate_Of; ----------------------------- -- Define_Output_Baud_Rate -- ----------------------------- function cfsetospeed (termios_p : termios_ptr; speed : speed_t) return int; pragma Import (C, cfsetospeed, cfsetospeed_LINKNAME); procedure Define_Output_Baud_Rate (Characteristics : in out Terminal_Characteristics; Output_Baud_Rate : Baud_Rate) is begin Validate (Characteristics); Check (cfsetospeed (Characteristics.termios'Unchecked_Access, To_C_Baud (Output_Baud_Rate))); end Define_Output_Baud_Rate; ---------------------------------- -- Special_Control_Character_Of -- ---------------------------------- To_Integer : constant array (Control_Character_Selector) of Integer := (EOF_Char => VEOF, EOL_Char => VEOL, Erase_Char => VERASE, Interrupt_Char => VINTR, Kill_Char => VKILL, Quit_Char => VQUIT, Suspend_Char => VSUSP, Start_Char => VSTART, Stop_Char => VSTOP); function Special_Control_Character_Of (Characteristics : Terminal_Characteristics; Selector : Control_Character_Selector) return POSIX.POSIX_Character is begin return POSIX.POSIX_Character'Val (Characteristics.termios.c_cc (To_Integer (Selector))); end Special_Control_Character_Of; -------------------------------------- -- Define_Special_Control_Character -- -------------------------------------- procedure Define_Special_Control_Character (Characteristics : in out Terminal_Characteristics; Selector : Control_Character_Selector; Char : POSIX.POSIX_Character) is begin Validate (Characteristics); Characteristics.termios.c_cc (To_Integer (Selector)) := cc_t (POSIX.POSIX_Character'Pos (Char)); end Define_Special_Control_Character; ------------------------------- -- Disable_Control_Character -- ------------------------------- procedure Disable_Control_Character (Characteristics : in out Terminal_Characteristics; Selector : Control_Character_Selector) is begin Characteristics.termios.c_cc (To_Integer (Selector)) := 0; end Disable_Control_Character; ------------------- -- Input_Time_Of -- ------------------- function Input_Time_Of (Characteristics : Terminal_Characteristics) return Duration is begin Validate (Characteristics); return Duration (Characteristics.termios.c_cc (VTIME)) / 10.0; end Input_Time_Of; ----------------------- -- Define_Input_Time -- ----------------------- procedure Define_Input_Time (Characteristics : in out Terminal_Characteristics; Input_Time : Duration) is begin Validate (Characteristics); if Input_Time < 0.0 or else Input_Time > Duration (cc_t'Last) / 10.0 then Raise_POSIX_Error (Invalid_Argument); end if; Characteristics.termios.c_cc (VTIME) := cc_t (Input_Time * 10); end Define_Input_Time; ---------------------------- -- Minimum_Input_Count_Of -- ---------------------------- function Minimum_Input_Count_Of (Characteristics : Terminal_Characteristics) return Natural is begin Validate (Characteristics); return Natural (Characteristics.termios.c_cc (VMIN)); end Minimum_Input_Count_Of; -------------------------------- -- Define_Minimum_Input_Count -- -------------------------------- procedure Define_Minimum_Input_Count (Characteristics : in out Terminal_Characteristics; Minimum_Input_Count : Natural) is begin Validate (Characteristics); Check (Minimum_Input_Count <= Natural (cc_t'Last), Invalid_Argument); Characteristics.termios.c_cc (VMIN) := cc_t (Minimum_Input_Count); end Define_Minimum_Input_Count; ---------------- -- Send_Break -- ---------------- function tcsendbreak (fd : int; dur : int) return int; pragma Import (C, tcsendbreak, tcsendbreak_LINKNAME); procedure Send_Break (File : POSIX.IO.File_Descriptor; The_Duration : Duration := 0.0) is Num : Float; begin Num := Float (The_Duration); Check (tcsendbreak (int (File), int (Num / 0.25))); end Send_Break; ----------- -- Drain -- ----------- function tcdrain (fd : int) return int; pragma Import (C, tcdrain, tcdrain_LINKNAME); procedure Drain (File : POSIX.IO.File_Descriptor; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is Old_Mask : aliased Signal_Mask; Result : int; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := tcdrain (int (File)); Restore_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Check (Result); end Drain; ------------------ -- Discard_Data -- ------------------ To_C_Queue : constant array (Queue_Selector) of int := (Received_But_Not_Read => TCIFLUSH, Written_But_Not_Transmitted => TCOFLUSH, Both => TCIOFLUSH); function tcflush (fd : int; action : int) return int; pragma Import (C, tcflush, tcflush_LINKNAME); procedure Discard_Data (File : POSIX.IO.File_Descriptor; Selector : Queue_Selector) is begin Check (tcflush (int (File), To_C_Queue (Selector))); end Discard_Data; ---------- -- Flow -- ---------- To_C_Flow_Action : constant array (Flow_Action) of int := (Suspend_Output => TCOOFF, Restart_Output => TCOON, Transmit_Stop => TCIOFF, Transmit_Start => TCION); function tcflow (fd : int; action : int) return int; pragma Import (C, tcflow, tcflow_LINKNAME); procedure Flow (File : POSIX.IO.File_Descriptor; Action : Flow_Action) is begin Check (tcflow (int (File), To_C_Flow_Action (Action))); end Flow; -------------------------- -- Get_Process_Group_ID -- -------------------------- function tcgetpgrp (fd : int) return pid_t; pragma Import (C, tcgetpgrp, tcgetpgrp_LINKNAME); function To_Process_Group_ID is new Ada.Unchecked_Conversion (pid_t, POSIX.Process_Identification.Process_Group_ID); function Get_Process_Group_ID (File : POSIX.IO.File_Descriptor) return POSIX.Process_Identification.Process_Group_ID is Result : pid_t; begin Result := tcgetpgrp (int (File)); if Result = -1 then Raise_POSIX_Error; end if; return To_Process_Group_ID (Result); end Get_Process_Group_ID; -------------------------- -- Set_Process_Group_ID -- -------------------------- function tcsetpgrp (fd : int; pgrp : pid_t) return int; pragma Import (C, tcsetpgrp, tcsetpgrp_LINKNAME); function To_pid_t is new Ada.Unchecked_Conversion (POSIX.Process_Identification.Process_Group_ID, pid_t); procedure Set_Process_Group_ID (File : POSIX.IO.File_Descriptor; Group_ID : POSIX.Process_Identification.Process_Group_ID) is begin Check (tcsetpgrp (int (File), To_pid_t (Group_ID))); end Set_Process_Group_ID; ----------------------------------- -- Get_Controlling_Terminal_Name -- ----------------------------------- function ctermid (s : char_ptr) return char_ptr; pragma Import (C, ctermid, ctermid_LINKNAME); function Get_Controlling_Terminal_Name return POSIX.Pathname is Result : POSIX_String (1 .. L_ctermid); begin return Form_POSIX_String (ctermid (Result (1)'Unchecked_Access)); end Get_Controlling_Terminal_Name; end POSIX.Terminal_Functions; libflorist-2025.1.0/libsrc/posix-terminal_functions.ads000066400000000000000000000224511473553204100231340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . T E R M I N A L _ F U N C T I O N S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.IO, POSIX.Process_Identification; package POSIX.Terminal_Functions is -- Special Characters used in terminal input Null_POSIX_Character : constant POSIX.POSIX_Character := POSIX.POSIX_Character'Val (0); Flag_POSIX_Character : constant POSIX.POSIX_Character := POSIX.POSIX_Character'Val (0); -- Get and Define Terminal operating characteristics type Terminal_Characteristics is private; Invalid_Terminal_Characteristics : constant Terminal_Characteristics; function Get_Terminal_Characteristics (File : POSIX.IO.File_Descriptor) return Terminal_Characteristics; type Terminal_Action_Times is (Immediately, After_Output, After_Output_And_Input); procedure Set_Terminal_Characteristics (File : POSIX.IO.File_Descriptor; Characteristics : Terminal_Characteristics; Apply : Terminal_Action_Times := Immediately; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); type Terminal_Modes is -- Subtype Input_Modes: (Interrupt_On_Break, Map_CR_To_LF, Ignore_Break, Ignore_CR, Ignore_Parity_Errors, Map_LF_To_CR, Enable_Parity_Check, Strip_Character, Enable_Start_Stop_Input, Enable_Start_Stop_Output, Mark_Parity_Errors, -- Subtype Output_Modes : Perform_Output_Processing, -- Subtype Control_Modes : Ignore_Modem_Status, Enable_Receiver, Send_Two_Stop_Bits, Hang_Up_On_Last_Close, Parity_Enable, Odd_Parity, -- Subtype Local_Modes: Echo, Echo_Erase, Echo_Kill, Echo_LF, Canonical_Input, Extended_Functions, Enable_Signals, No_Flush, Send_Signal_For_BG_Output); subtype Input_Modes is Terminal_Modes range Interrupt_On_Break .. Mark_Parity_Errors; subtype Output_Modes is Terminal_Modes range Perform_Output_Processing .. Perform_Output_Processing; subtype Control_Modes is Terminal_Modes range Ignore_Modem_Status .. Odd_Parity; subtype Local_Modes is Terminal_Modes range Echo .. Send_Signal_For_BG_Output; type Terminal_Modes_Set is array (Terminal_Modes) of Boolean; subtype Bits_Per_Character is Positive range 5 .. 8; type Baud_Rate is (B0, B50, B75, B110, B134, B150, B200, B300, B600, B1200, B1800, B2400, B4800, B9600, B19200, B38400, B57600, B115200, B230400, B460800); function Terminal_Modes_Of (Characteristics : Terminal_Characteristics) return Terminal_Modes_Set; procedure Define_Terminal_Modes (Characteristics : in out Terminal_Characteristics; Modes : Terminal_Modes_Set); function Bits_Per_Character_Of (Characteristics : Terminal_Characteristics) return Bits_Per_Character; procedure Define_Bits_Per_Character (Characteristics : in out Terminal_Characteristics; Bits : Bits_Per_Character); function Input_Baud_Rate_Of (Characteristics : Terminal_Characteristics) return Baud_Rate; procedure Define_Input_Baud_Rate (Characteristics : in out Terminal_Characteristics; Input_Baud_Rate : Baud_Rate); function Output_Baud_Rate_Of (Characteristics : Terminal_Characteristics) return Baud_Rate; procedure Define_Output_Baud_Rate (Characteristics : in out Terminal_Characteristics; Output_Baud_Rate : Baud_Rate); type Control_Character_Selector is (EOF_Char, EOL_Char, Erase_Char, Interrupt_Char, Kill_Char, Quit_Char, Suspend_Char, Start_Char, Stop_Char); function Special_Control_Character_Of (Characteristics : Terminal_Characteristics; Selector : Control_Character_Selector) return POSIX.POSIX_Character; procedure Define_Special_Control_Character (Characteristics : in out Terminal_Characteristics; Selector : Control_Character_Selector; Char : POSIX.POSIX_Character); procedure Disable_Control_Character (Characteristics : in out Terminal_Characteristics; Selector : Control_Character_Selector); function Input_Time_Of (Characteristics : Terminal_Characteristics) return Duration; procedure Define_Input_Time (Characteristics : in out Terminal_Characteristics; Input_Time : Duration); function Minimum_Input_Count_Of (Characteristics : Terminal_Characteristics) return Natural; procedure Define_Minimum_Input_Count (Characteristics : in out Terminal_Characteristics; Minimum_Input_Count : Natural); -- Line Control Operations procedure Send_Break (File : POSIX.IO.File_Descriptor; The_Duration : Duration := 0.0); procedure Drain (File : POSIX.IO.File_Descriptor; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); type Queue_Selector is (Received_But_Not_Read, Written_But_Not_Transmitted, Both); procedure Discard_Data (File : POSIX.IO.File_Descriptor; Selector : Queue_Selector); type Flow_Action is (Suspend_Output, Restart_Output, Transmit_Stop, Transmit_Start); procedure Flow (File : POSIX.IO.File_Descriptor; Action : Flow_Action); -- Foreground Process Group ID function Get_Process_Group_ID (File : POSIX.IO.File_Descriptor) return POSIX.Process_Identification.Process_Group_ID; procedure Set_Process_Group_ID (File : POSIX.IO.File_Descriptor; Group_ID : POSIX.Process_Identification.Process_Group_ID); -- Get pathname of current controlling terminal for the current process function Get_Controlling_Terminal_Name return POSIX.Pathname; private -- .... Change POSIX.5? -- This is a terrible choice of interface. -- The type Terminal_Characteristics should have been a -- limited private type, but is is declared private here! -- We are forced to do strange contortions to provide: -- (1) implicit initialization of objects of this type to -- a recognizable "undefined" value -- (2) a constant to stand for this undefined value -- (3) no use of "access types" -- i.e. heap allocation -- Were it not for the latter, we could easily map the type -- Terminal_Characteristics to the C type struct termios *. type Terminal_Characteristics is record Valid : Boolean := False; termios : aliased POSIX.C.struct_termios; end record; Dummy : Terminal_Characteristics; -- provides a default initial value, without depending on -- internal structure of type POSIX.C.struct_termios Invalid_Terminal_Characteristics : constant Terminal_Characteristics := Dummy; end POSIX.Terminal_Functions; libflorist-2025.1.0/libsrc/posix-unsafe_process_primitives.adb000066400000000000000000000236141473553204100245040ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . U N S A F E _ P R O C E S S _ P R I M I T I V E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2017, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.C, POSIX.Implementation, System, System.Secondary_Stack, System.Soft_Links; package body POSIX.Unsafe_Process_Primitives is use POSIX.C, POSIX.Implementation; function To_Process_ID is new Ada.Unchecked_Conversion (pid_t, POSIX.Process_Identification.Process_ID); function To_String_List_Ptr is new Ada.Unchecked_Conversion (POSIX_String_List, String_List_Ptr); function To_String_List_Ptr is new Ada.Unchecked_Conversion (POSIX.Process_Environment.Environment, String_List_Ptr); ------------------------- -- Local Subprograms -- ------------------------- function Make_Path_Name (Directory : POSIX_String; File : POSIX_String) return POSIX_String; pragma Inline (Make_Path_Name); -- Concatenate a directory name and a file name. function Make_Path_Name (Directory : POSIX_String; File : POSIX_String) return POSIX_String is begin if Directory = "" then return File; end if; if Directory (Directory'Last) = '/' then return Directory & File; end if; return Directory & '/' & File; end Make_Path_Name; ------------ -- Fork -- ------------ function fork return pid_t; pragma Import (C, fork, fork_LINKNAME); function Fork return POSIX.Process_Identification.Process_ID is Result : pid_t; package SSL renames System.Soft_Links; -- save local values of soft-link data NT_Sec_Stack : constant System.Secondary_Stack.SS_Stack_Ptr := SSL.Get_Sec_Stack.all; NT_Jmpbuf_Address : constant System.Address := SSL.Get_Jmpbuf_Address.all; begin Result := fork; if Result = -1 then Raise_POSIX_Error; end if; if Result = 0 then -- reset soft links to non-tasking versions of operations SSL.Abort_Defer := SSL.Abort_Defer_NT'Access; SSL.Abort_Undefer := SSL.Abort_Undefer_NT'Access; SSL.Lock_Task := SSL.Task_Lock_NT'Access; SSL.Unlock_Task := SSL.Task_Unlock_NT'Access; SSL.Get_Jmpbuf_Address := SSL.Get_Jmpbuf_Address_NT'Access; SSL.Set_Jmpbuf_Address := SSL.Set_Jmpbuf_Address_NT'Access; SSL.Get_Sec_Stack := SSL.Get_Sec_Stack_NT'Access; SSL.Set_Sec_Stack := SSL.Set_Sec_Stack_NT'Access; -- reset global data to saved local values for this thread SSL.Set_Sec_Stack (NT_Sec_Stack); SSL.Set_Jmpbuf_Address (NT_Jmpbuf_Address); end if; return To_Process_ID (Result); end Fork; ------------ -- Exec -- ------------ function execve (path : char_ptr; argv : char_ptr_ptr; envp : char_ptr_ptr) return int; pragma Import (C, execve, execve_LINKNAME); procedure Exec (Pathname : POSIX.Pathname; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List; Env_List : POSIX.Process_Environment.Environment) is Pathname_With_NUL : POSIX_String := Pathname & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); Env : String_List_Ptr := To_String_List_Ptr (Env_List); begin if Arg = null then Arg := Null_String_List_Ptr; end if; if Env = null then Env := Null_String_List_Ptr; end if; Check (execve (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Unchecked_Access, Env.Char (1)'Unchecked_Access)); end Exec; ------------ -- Exec -- ------------ function execv (path : char_ptr; argv : char_ptr_ptr) return int; pragma Import (C, execv, execv_LINKNAME); procedure Exec (Pathname : POSIX.Pathname; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List) is Pathname_With_NUL : POSIX_String := Pathname & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); begin if Arg = null then Arg := Null_String_List_Ptr; end if; Check (execv (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Unchecked_Access)); end Exec; ------------------- -- Exec_Search -- ------------------- procedure Exec_Search (Filename : POSIX.Filename; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List; Env_List : POSIX.Process_Environment.Environment) is Filename_With_NUL : POSIX_String := Filename & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); Env : String_List_Ptr := To_String_List_Ptr (Env_List); begin -- .... Change POSIX.5? -- There is no POSIX.1 function that takes an environment list -- and searches for a filename, apparently, so we have to simulate -- the effect here. if Arg = null then Arg := Null_String_List_Ptr; end if; if Env = null then Env := Null_String_List_Ptr; end if; for I in Filename'Range loop if Filename (I) = '/' then Check (execve (Filename_With_NUL (Filename_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Unchecked_Access, Env.Char (1)'Unchecked_Access)); return; end if; end loop; -- filename does not contain "/" declare Path : constant POSIX_String := POSIX.Process_Environment.Environment_Value_Of ("PATH", "/bin:/usr/bin"); Start : Positive; P : Positive; Err : Error_Code := No_Such_File_Or_Directory; begin P := Path'First; loop Start := P; while P <= Path'Last and then Path (P) /= ':' loop P := P + 1; end loop; declare Pathname : constant POSIX_String := Make_Path_Name (Path (Start .. P - 1), Filename); begin Exec (Pathname, Arg_List, Env_List); exception when POSIX_Error => null; end; if Get_Error_Code /= No_Such_File_Or_Directory then Err := Get_Error_Code; end if; exit when P > Path'Last; P := P + 1; -- skip colon end loop; Raise_POSIX_Error (Err); end; end Exec_Search; ------------------- -- Exec_Search -- ------------------- function execvp (file : char_ptr; argv : char_ptr_ptr) return int; pragma Import (C, execvp, execvp_LINKNAME); procedure Exec_Search (Filename : POSIX.Filename; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List) is Filename_With_NUL : POSIX_String := Filename & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); begin if Arg = null then Arg := Null_String_List_Ptr; end if; Check (execvp (Filename_With_NUL (Filename_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Unchecked_Access)); end Exec_Search; end POSIX.Unsafe_Process_Primitives; libflorist-2025.1.0/libsrc/posix-unsafe_process_primitives.ads000066400000000000000000000070061473553204100245220ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . U N S A F E _ P R O C E S S _ P R I M I T I V E S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.Process_Environment, POSIX.Process_Identification; package POSIX.Unsafe_Process_Primitives is function Fork return POSIX.Process_Identification.Process_ID; procedure Exec (Pathname : POSIX.Pathname; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List; Env_List : POSIX.Process_Environment.Environment); procedure Exec (Pathname : POSIX.Pathname; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List); procedure Exec_Search (Filename : POSIX.Filename; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List; Env_List : POSIX.Process_Environment.Environment); procedure Exec_Search (Filename : POSIX.Filename; Arg_List : POSIX.POSIX_String_List := POSIX.Empty_String_List); end POSIX.Unsafe_Process_Primitives; libflorist-2025.1.0/libsrc/posix-user_database.adb000066400000000000000000000134061473553204100220120ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . U S E R _ D A T A B A S E -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation; package body POSIX.User_Database is use POSIX.C; use POSIX.Implementation; function To_uid_t is new Ada.Unchecked_Conversion (POSIX_Process_Identification.User_ID, uid_t); function To_User_ID is new Ada.Unchecked_Conversion (uid_t, POSIX_Process_Identification.User_ID); function To_Group_ID is new Ada.Unchecked_Conversion (gid_t, POSIX_Process_Identification.Group_ID); -------------------- -- User_Name_Of -- -------------------- function User_Name_Of (DB_Item : User_Database_Item) return POSIX.POSIX_String is begin return Form_POSIX_String (DB_Item.pw_name); end User_Name_Of; ------------------ -- User_ID_Of -- ------------------ function User_ID_Of (DB_Item : User_Database_Item) return POSIX_Process_Identification.User_ID is begin return To_User_ID (DB_Item.pw_uid); end User_ID_Of; ------------------- -- Group_ID_Of -- ------------------- function Group_ID_Of (DB_Item : User_Database_Item) return POSIX_Process_Identification.Group_ID is begin return To_Group_ID (DB_Item.pw_gid); end Group_ID_Of; ---------------------------- -- Initial_Directory_Of -- ---------------------------- function Initial_Directory_Of (DB_Item : User_Database_Item) return POSIX.POSIX_String is begin return Form_POSIX_String (DB_Item.pw_dir); end Initial_Directory_Of; -------------------------- -- Initial_Program_Of -- -------------------------- function Initial_Program_Of (DB_Item : User_Database_Item) return POSIX.POSIX_String is begin return Form_POSIX_String (DB_Item.pw_shell); end Initial_Program_Of; ------------------------------ -- Get_User_Database_Item -- ------------------------------ function getpwuid (c_uid : uid_t) return passwd_ptr; pragma Import (C, getpwuid, getpwuid_LINKNAME); function Get_User_Database_Item (UID : POSIX_Process_Identification.User_ID) return User_Database_Item is Result : passwd_ptr; begin Result := getpwuid (To_uid_t (UID)); if Result = null then Raise_POSIX_Error; end if; return User_Database_Item (Result); end Get_User_Database_Item; ------------------------------ -- Get_User_Database_Item -- ------------------------------ function getpwnam (c_name : char_ptr) return passwd_ptr; pragma Import (C, getpwnam, getpwnam_LINKNAME); function Get_User_Database_Item (Name : POSIX_String) return User_Database_Item is Result : passwd_ptr; Name_With_NUL : POSIX_String := Name & NUL; begin Result := getpwnam (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access); if Result = null then Raise_POSIX_Error; end if; return User_Database_Item (Result); end Get_User_Database_Item; end POSIX.User_Database; libflorist-2025.1.0/libsrc/posix-user_database.ads000066400000000000000000000101541473553204100220300ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . U S E R _ D A T A B A S E -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX_Process_Identification; package POSIX.User_Database is type User_Database_Item is private; -- operations to get information From a User_Database_Entry function User_Name_Of (DB_Item : User_Database_Item) return POSIX.POSIX_String; pragma Inline (User_Name_Of); function User_ID_Of (DB_Item : User_Database_Item) return POSIX_Process_Identification.User_ID; pragma Inline (User_ID_Of); function Group_ID_Of (DB_Item : User_Database_Item) return POSIX_Process_Identification.Group_ID; pragma Inline (Group_ID_Of); function Initial_Directory_Of (DB_Item : User_Database_Item) return POSIX.POSIX_String; pragma Inline (Initial_Directory_Of); function Initial_Program_Of (DB_Item : User_Database_Item) return POSIX.POSIX_String; pragma Inline (Initial_Program_Of); -- operations to Get User_Database_Item function Get_User_Database_Item (UID : POSIX_Process_Identification.User_ID) return User_Database_Item; function Get_User_Database_Item (Name : POSIX.POSIX_String) return User_Database_Item; private type User_Database_Item is new POSIX.C.passwd_ptr; -- .... Change POSIX.5? -- This direct mapping to the C interface means these operations -- are not tasking-safe. However, we see no reasonable alternative. -- See comments in POSIX.Group_Database for more detail. end POSIX.User_Database; libflorist-2025.1.0/libsrc/posix.adb000066400000000000000000000557111473553204100172170ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X -- -- -- -- B o d y -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2022, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, Ada.Unchecked_Deallocation, POSIX.C, POSIX.Implementation, System; pragma Elaborate (POSIX.C); pragma Elaborate (POSIX.Implementation); package body POSIX is use Ada.Streams; use POSIX.C; use POSIX.Implementation; type String_List is new POSIX.Implementation.String_List; ----------------------------- -- Unchecked Conversions -- ----------------------------- type Big_POSIX_String_Ptr is access all POSIX_String (Positive'Range); type Big_Stream_Element_Array_Ptr is access all Stream_Element_Array (Stream_Element_Offset); function From_Address is new Ada.Unchecked_Conversion (System.Address, Big_POSIX_String_Ptr); function From_Address is new Ada.Unchecked_Conversion (System.Address, Big_Stream_Element_Array_Ptr); ----------------------- -- To_POSIX_String -- ----------------------- function To_POSIX_String (Str : String) return POSIX_String is begin return POSIX_String (Str); end To_POSIX_String; ----------------- -- To_String -- ----------------- function To_String (Str : POSIX_String) return String is begin return String (Str); end To_String; ---------------------- -- To_Wide_String -- ---------------------- function To_Wide_String (Str : POSIX_String) return Wide_String is Result : Wide_String (Str'Range); begin for I in Str'Range loop Result (I) := Wide_Character'Val (POSIX_Character'Pos (Str (I))); end loop; return Result; end To_Wide_String; -- We cannot use direct unchecked conversion here, -- since the sizes of the characters are different. -- However, we rely that the integer codes for the -- first 256 wide characters are the same as those -- of the ordinary characters. [See ARM A.1 (36)] ----------------------- -- To_POSIX_String -- ----------------------- function To_POSIX_String (Str : Wide_String) return POSIX_String is Result : POSIX_String (Str'Range); begin for I in Str'Range loop Result (I) := POSIX_Character'Val (Wide_Character'Pos (Str (I)) rem 256); end loop; return Result; end To_POSIX_String; ------------------------------- -- To_Stream_Element_Array -- ------------------------------- function To_Stream_Element_Array (Buffer : POSIX_String) return Ada.Streams.Stream_Element_Array is subtype Offset is Stream_Element_Offset; begin return From_Address (Buffer'Address) ((Offset (Buffer'First) + Offset'First - 1) .. (Offset (Buffer'Last) + Offset'First - 1)); end To_Stream_Element_Array; ----------------------- -- To_POSIX_String -- ----------------------- function To_POSIX_String (Buffer : Ada.Streams.Stream_Element_Array) return POSIX_String is subtype Offset is Stream_Element_Offset; begin return From_Address (Buffer'Address) (Positive (Buffer'First - Offset'First + 1) .. Positive (Buffer'Last - Offset'First + 1)); end To_POSIX_String; ------------------- -- Is_Filename -- ------------------- function Is_Filename (Str : POSIX_String) return Boolean is begin if To_String (Str)'Length = 0 then return False; end if; for I in Str'Range loop if Str (I) = '/' or Str (I) = NUL or Str (I) = ' ' then return False; end if; end loop; return True; end Is_Filename; -- These two functions (Is_Pathname and Is_Filename) seem -- not to be unimplementable in a portable way, since they are -- supposed to "check all constraints set on filename and -- pathname by the implementation that can be checked without -- accessing the file system directly. ------------------- -- Is_Pathname -- ------------------- function Is_Pathname (Str : POSIX_String) return Boolean is begin if To_String (Str)'Length = 0 then return False; end if; for I in Str'Range loop if Str (I) = NUL or Str (I) = ' ' then return False; end if; end loop; return True; end Is_Pathname; ---------------------------- -- Is_Portable_filename -- ---------------------------- function Is_Portable_Filename (Str : POSIX_String) return Boolean is begin if To_String (Str)'Length = 0 then return False; end if; for I in Str'Range loop case Str (I) is when 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '.' | '_' => null; when '-' => if I = Str'First then return False; end if; when others => return False; end case; end loop; return True; end Is_Portable_Filename; ---------------------------- -- Is_Portable_Pathname -- ---------------------------- function Is_Portable_Pathname (Str : POSIX_String) return Boolean is Start : Positive; P : Positive; begin if To_String (Str)'Length = 0 then return False; end if; Start := Str'First; P := Str'First; loop if P > Str'Last or else Str (P) = '/' then if Start < P and then not Is_Portable_Filename (Str (Start .. P - 1)) then return False; end if; if P > Str'Last then return True; end if; Start := P + 1; end if; P := P + 1; end loop; end Is_Portable_Pathname; ------------------ -- Make_Empty -- ------------------ procedure Free is new Ada.Unchecked_Deallocation (POSIX_String, POSIX_String_Ptr); procedure Free is new Ada.Unchecked_Deallocation (String_List, POSIX_String_List); procedure Make_Empty (List : in out POSIX_String_List) is begin if List = null then return; end if; for I in 1 .. List.Length loop if List.List (I) = null then exit; end if; Free (List.List (I)); end loop; Free (List); end Make_Empty; -------------- -- Append -- -------------- procedure Append (List : in out POSIX_String_List; Str : POSIX_String) is Tmp : POSIX_String_List; Len : constant Integer := Str'Length; begin if List = null then List := new String_List (Min_String_List_Length); -- rely that pointers all initialized to null end if; for I in 1 .. List.Length loop if List.List (I) = null then if I = List.Length then Tmp := new String_List (2 * List.Length); Tmp.List (List.List'Range) := List.List; Tmp.Char (List.List'Range) := List.Char; Free (List); List := Tmp; end if; List.List (I) := new POSIX_String (1 .. Len + 1); List.List (I)(1 .. Len) := Str; List.List (I)(Len + 1) := NUL; List.Char (I) := List.List (I)(1)'Unchecked_Access; return; end if; end loop; end Append; ---------------------- -- For_Every_Item -- ---------------------- -- generic -- with procedure Action -- (Item: POSIX_String; Quit: in out Boolean); procedure For_Every_Item (List : POSIX_String_List) is Quit : Boolean := False; begin if List = null then return; end if; for I in 1 .. List.Length loop exit when List.List (I) = null; declare L : constant Integer := List.List (I)'Length; begin Action (List.List (I)(1 .. L - 1), Quit); end; exit when Quit; end loop; end For_Every_Item; -------------- -- Length -- -------------- function Length (List : POSIX_String_List) return Natural is begin if List = null then return 0; end if; for I in 1 .. List.Length loop if List.List (I) = null then return Natural (I - 1); end if; end loop; raise Program_Error; return 0; end Length; ------------- -- Value -- ------------- function Value (List : POSIX_String_List; Index : Positive) return POSIX_String is I : constant Positive := Index; begin if List = null or else not (I <= List.Length) or else List.List (I) = null then raise Constraint_Error; end if; declare L : constant Integer := List.List (I).all'Length; begin return List.List (I)(1 .. L - 1); end; end Value; ----------------- -- Empty_set -- ----------------- function Empty_Set return Option_Set is begin return (Option => 0); end Empty_Set; ----------- -- "+" -- ----------- function "+" (L, R : Option_Set) return Option_Set is begin return (Option => Bits (unsigned (L.Option) or unsigned (R.Option))); end "+"; ----------- -- "-" -- ----------- function "-" (L, R : Option_Set) return Option_Set is begin return (Option => Bits (unsigned (L.Option) and not (unsigned (R.Option)))); end "-"; --------- -- < -- --------- function "<" (Left, Right : Option_Set) return Boolean is begin return Left <= Right and Left /= Right; end "<"; --------- -- <= -- --------- function "<=" (Left, Right : Option_Set) return Boolean is begin return ((not Bits (unsigned (Right.Option))) and Bits (unsigned (Left.Option))) = 0; end "<="; --------- -- > -- --------- function ">" (Left, Right : Option_Set) return Boolean is begin return Right < Left; end ">"; ---------- -- >= -- ---------- function ">=" (Left, Right : Option_Set) return Boolean is begin return Right <= Left; end ">="; ---------------------- -- Get_Error_Code -- ---------------------- function Get_Error_Code return Error_Code is begin return POSIX.Implementation.Get_Ada_Error_Code; end Get_Error_Code; ---------------------- -- Set_Error_Code -- ---------------------- procedure Set_Error_Code (Error : Error_Code) is begin POSIX.Implementation.Set_Ada_Error_Code (Error); end Set_Error_Code; ---------------------- -- Is_POSIX_Error -- ---------------------- function Is_POSIX_Error (Error : Error_Code) return Boolean is begin for I in Error_Array'Range loop if Error = Error_Array (I) then return True; end if; end loop; return False; end Is_POSIX_Error; ------------- -- Image -- ------------- function Image (Error : Error_Code) return String is use Bogus_Error_Codes; begin for I in Error_Array'Range loop if Error = Error_Array (I) then return Error_Name_Enum'Image (I); end if; end loop; declare Tmp : constant String := Error_Code'Image (Error); begin if Tmp (Tmp'First) /= ' ' then return Tmp; end if; return Tmp (Tmp'First + 1 .. Tmp'Last); end; end Image; ------------------------- -- Print_Error_Message -- ------------------------- procedure Print_Error_Message is procedure perror (Ignore : System.Address := System.Null_Address); pragma Import (C, perror, XTI.perror_LINKNAME); begin if C.XTI.HAVE_perror then perror; else declare Text : constant String := Image (Get_Error_Code) & ASCII.LF; procedure write (fildes : int; buf : System.Address; nbyte : size_t); pragma Import (C, write, write_LINKNAME); -- Unable to use Write and Standard_Error from POSIX.IO directly -- because of cyclic dependencies. begin write (2, Text'Address, Text'Length); end; end if; end Print_Error_Message; function uname (name : access struct_utsname) return int; pragma Import (C, uname, uname_LINKNAME); ------------------- -- System_Name -- ------------------- function System_Name return POSIX_String is Name : aliased struct_utsname; begin Check (uname (Name'Unchecked_Access)); return Form_POSIX_String (Name.sysname (1)'Unchecked_Access); end System_Name; ----------------- -- Node_Name -- ----------------- function Node_Name return POSIX_String is Name : aliased struct_utsname; begin Check (uname (Name'Unchecked_Access)); return Form_POSIX_String (Name.nodename (1)'Unchecked_Access); end Node_Name; --------------- -- Release -- --------------- function Release return POSIX_String is Name : aliased struct_utsname; begin Check (uname (Name'Unchecked_Access)); return Form_POSIX_String (Name.release (1)'Unchecked_Access); end Release; --------------- -- Version -- --------------- function Version return POSIX_String is Name : aliased struct_utsname; begin Check (uname (Name'Unchecked_Access)); return Form_POSIX_String (Name.version (1)'Unchecked_Access); end Version; --------------- -- Machine -- --------------- function Machine return POSIX_String is Name : aliased struct_utsname; begin Check (uname (Name'Unchecked_Access)); return Form_POSIX_String (Name.machine (1)'Unchecked_Access); end Machine; ----------------------------------------- -- Timespec Composition/Decomposition -- ----------------------------------------- procedure Split (D : Duration; S : out Duration; NS : out Duration); pragma Inline (Split); -- Decompose D into seconds (S) and nanoseconds (NS) parts, -- with the nanosecond part in the range 0.0 .. 0.999999999. procedure Split (D : Duration; S : out Duration; NS : out Duration) is begin S := POSIX.Implementation.To_Duration (To_D_Int (D / NS_per_S) * NS_per_S); NS := D - S; if NS < 0.0 then S := S - 1.0; NS := NS + 1.0; end if; end Split; ------------- -- Split -- ------------- procedure Split (Time : Timespec; S : out Seconds; NS : out Nanoseconds) is SD, NSD : Duration; begin Split (Time.Val, S => SD, NS => NSD); S := Seconds (SD); NS := Nanoseconds (NSD * NS_per_S); end Split; ------------------- -- To_Timespec -- ------------------- function To_Timespec (S : Seconds; NS : Nanoseconds) return Timespec is begin return Timespec' (Val => Duration (S) + Duration (NS) / NS_per_S); end To_Timespec; ------------------- -- Get_Seconds -- ------------------- function Get_Seconds (Time : Timespec) return Seconds is SD, NSD : Duration; begin Split (Time.Val, S => SD, NS => NSD); return Seconds (SD); end Get_Seconds; ----------------------- -- Get_Nanoseconds -- ----------------------- function Get_Nanoseconds (Time : Timespec) return Nanoseconds is SD, NSD : Duration; begin Split (Time.Val, S => SD, NS => NSD); return Nanoseconds (NSD * NS_per_S); end Get_Nanoseconds; ----------------------- -- Set_Nanoseconds -- ----------------------- procedure Set_Nanoseconds (Time : in out Timespec; NS : Nanoseconds) is SD, NSD : Duration; begin Split (Time.Val, S => SD, NS => NSD); Time.Val := SD + Duration (NS) / NS_per_S; end Set_Nanoseconds; ------------------- -- Set_Seconds -- ------------------- procedure Set_Seconds (Time : in out Timespec; S : Seconds) is SD, NSD : Duration; begin Split (Time.Val, S => SD, NS => NSD); Time.Val := Duration (S) + NSD; end Set_Seconds; ----------- -- "+" -- ----------- function "+" (Left, Right : Timespec) return Timespec is begin return Timespec'(Val => Left.Val + Right.Val); end "+"; ----------- -- "+" -- ----------- function "+" (Left : Timespec; Right : Nanoseconds) return Timespec is begin return Timespec' (Val => Left.Val + Duration (Right) / NS_per_S); end "+"; ----------- -- "-" -- ----------- function "-" (Right : Timespec) return Timespec is begin return Timespec'(Val => -Right.Val); end "-"; ----------- -- "-" -- ----------- function "-" (Left, Right : Timespec) return Timespec is begin return Timespec'(Val => Left.Val - Right.Val); end "-"; ----------- -- "-" -- ----------- function "-" (Left : Timespec; Right : Nanoseconds) return Timespec is begin return Timespec'(Val => Left.Val - Duration (Right) / NS_per_S); end "-"; ----------- -- "*" -- ----------- function "*" (Left : Timespec; Right : Integer) return Timespec is begin return Timespec'(Val => Left.Val * Duration (Right)); end "*"; ----------- -- "*" -- ----------- function "*" (Left : Integer; Right : Timespec) return Timespec is begin return Timespec'(Val => Left * Right.Val); end "*"; ----------- -- "/" -- ----------- function "/" (Left : Timespec; Right : Integer) return Timespec is begin return Timespec'(Val => Left.Val / Right); end "/"; ----------- -- "/" -- ----------- function "/" (Left, Right : Timespec) return Integer is begin return Integer (Left.Val / Right.Val); end "/"; ----------- -- "<" -- ----------- function "<" (Left, Right : Timespec) return Boolean is begin return Left.Val < Right.Val; end "<"; ----------- -- "<=" -- ----------- function "<=" (Left, Right : Timespec) return Boolean is begin return Left.Val <= Right.Val; end "<="; ----------- -- ">" -- ----------- function ">" (Left, Right : Timespec) return Boolean is begin return Right <= Left; end ">"; ------------ -- ">=" -- ------------ function ">=" (Left, Right : Timespec) return Boolean is begin return Right < Left; end ">="; ------------------- -- To_Timespec -- ------------------- function To_Timespec (D : Duration) return Timespec is begin return Timespec'(Val => D); end To_Timespec; ------------------- -- To_Duration -- ------------------- function To_Duration (Time : Timespec) return Duration is begin return Time.Val; end To_Duration; -------------------------------- -- Host_To_Network_Byte_Order -- -------------------------------- function Host_To_Network_Byte_Order (Host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32 is function c_htonl (host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32; pragma Import (C, c_htonl, "c_htonl"); begin return c_htonl (Host_32); end Host_To_Network_Byte_Order; function Host_To_Network_Byte_Order (Host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16 is function c_htons (host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16; pragma Import (C, c_htons, "c_htons"); begin return c_htons (Host_16); end Host_To_Network_Byte_Order; -------------------------------- -- Host_To_Network_Byte_Order -- -------------------------------- function Network_To_Host_Byte_Order (Host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32 is function c_ntohl (host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32; pragma Import (C, c_ntohl, "c_ntohl"); begin return c_ntohl (Host_32); end Network_To_Host_Byte_Order; function Network_To_Host_Byte_Order (Host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16 is function c_ntohs (host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16; pragma Import (C, c_ntohs, "c_ntohs"); begin return c_ntohs (Host_16); end Network_To_Host_Byte_Order; begin -- We rely on Duration being an exact count of nanoseconds pragma Assert (Duration'Small = 1.0 / NS_per_S); null; end POSIX; libflorist-2025.1.0/libsrc/posix_c.ads000066400000000000000000000053751473553204100175430ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ C -- -- -- -- S p e c -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.C; package POSIX_C renames POSIX.C; libflorist-2025.1.0/libsrc/posix_calendar.ads000066400000000000000000000057271473553204100210730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ C A L E N D A R -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Calendar; pragma Elaborate_All (POSIX.Calendar); package POSIX_Calendar renames POSIX.Calendar; libflorist-2025.1.0/libsrc/posix_configurable_file_limits.ads000066400000000000000000000060321473553204100243300ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ C O N F I G U R A B L E _ F I L E _ L I M I T S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Configurable_File_Limits; pragma Elaborate_All (POSIX.Configurable_File_Limits); package POSIX_Configurable_File_Limits renames POSIX.Configurable_File_Limits; libflorist-2025.1.0/libsrc/posix_configurable_system_limits.ads000066400000000000000000000060411473553204100247350ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ C O N F I G U R A B L E _ S Y S T E M _ L I M I T S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Configurable_System_Limits; pragma Elaborate_All (POSIX.Configurable_System_Limits); package POSIX_Configurable_System_Limits renames POSIX.Configurable_System_Limits; libflorist-2025.1.0/libsrc/posix_error_codes.ads000066400000000000000000000056241473553204100216240ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ E R R O R _ C O D E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Error_Codes; pragma Elaborate_All (POSIX.Error_Codes); package POSIX_Error_Codes renames POSIX.Error_Codes; libflorist-2025.1.0/libsrc/posix_file_locking.ads000066400000000000000000000057471473553204100217510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ F I L E _ L O C K I N G -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.File_Locking; pragma Elaborate_All (POSIX.File_Locking); package POSIX_File_Locking renames POSIX.File_Locking; libflorist-2025.1.0/libsrc/posix_file_status.ads000066400000000000000000000057431473553204100216420ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ F I L E _ S T A T U S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.File_Status; pragma Elaborate_All (POSIX.File_Status); package POSIX_File_Status renames POSIX.File_Status; libflorist-2025.1.0/libsrc/posix_files.ads000066400000000000000000000057131473553204100204170ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ F I L E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Files; pragma Elaborate_All (POSIX.Files); package POSIX_Files renames POSIX.Files; libflorist-2025.1.0/libsrc/posix_generic_shared_memory.ads000066400000000000000000000060161473553204100236440ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ G E N E R I C _ S H A R E D _ M E M O R Y -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ pragma Warnings (Off); with POSIX.Generic_Shared_Memory; pragma Warnings (On); generic package POSIX_Generic_Shared_Memory renames POSIX.Generic_Shared_Memory; libflorist-2025.1.0/libsrc/posix_group_database.ads000066400000000000000000000056401473553204100222740ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ G R O U P _ D A T A B A S E -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Group_Database; pragma Elaborate_All (POSIX.Group_Database); package POSIX_Group_Database renames POSIX.Group_Database; libflorist-2025.1.0/libsrc/posix_io.ads000066400000000000000000000055601473553204100177240ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ I O -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.IO; pragma Elaborate_All (POSIX.IO); package POSIX_IO renames POSIX.IO; libflorist-2025.1.0/libsrc/posix_limits.ads000066400000000000000000000056001473553204100206110ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ L I M I T S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Limits; pragma Elaborate_All (POSIX.Limits); package POSIX_Limits renames POSIX.Limits; libflorist-2025.1.0/libsrc/posix_memory_locking.ads000066400000000000000000000056401473553204100223320ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ M E M O R Y _ L O C K I N G -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Memory_Locking; pragma Elaborate_All (POSIX.Memory_Locking); package POSIX_Memory_Locking renames POSIX.Memory_Locking; libflorist-2025.1.0/libsrc/posix_memory_mapping.ads000066400000000000000000000056401473553204100223370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ M E M O R Y _ M A P P I N G -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Memory_Mapping; pragma Elaborate_All (POSIX.Memory_Mapping); package POSIX_Memory_Mapping renames POSIX.Memory_Mapping; libflorist-2025.1.0/libsrc/posix_memory_range_locking.ads000066400000000000000000000056701473553204100235110ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ M E M O R Y _ R A N G E _ L O C K I N G -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Memory_Range_Locking; pragma Elaborate_All (POSIX.Memory_Range_Locking); package POSIX_Memory_Range_Locking renames POSIX.Memory_Range_Locking; libflorist-2025.1.0/libsrc/posix_options.ads000066400000000000000000000056041473553204100210070ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ O P T I O N S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Options; pragma Elaborate_All (POSIX.Options); package POSIX_Options renames POSIX.Options; libflorist-2025.1.0/libsrc/posix_page_alignment.ads000066400000000000000000000056401473553204100222660ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ P A G E _ A L I G N M E N T -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Page_Alignment; pragma Elaborate_All (POSIX.Page_Alignment); package POSIX_Page_Alignment renames POSIX.Page_Alignment; libflorist-2025.1.0/libsrc/posix_permissions.ads000066400000000000000000000056241473553204100216710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ P E R M I S S I O N S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Permissions; pragma Elaborate_All (POSIX.Permissions); package POSIX_Permissions renames POSIX.Permissions; libflorist-2025.1.0/libsrc/posix_process_environment.ads000066400000000000000000000056641473553204100234240ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ P R O C E S S _ E N V I R O N M E N T -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Process_Environment; pragma Elaborate_All (POSIX.Process_Environment); package POSIX_Process_Environment renames POSIX.Process_Environment; libflorist-2025.1.0/libsrc/posix_process_identification.ads000066400000000000000000000057031473553204100240430ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ P R O C E S S _ I D E N T I F I C A T I O N -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Process_Identification; pragma Elaborate_All (POSIX.Process_Identification); package POSIX_Process_Identification renames POSIX.Process_Identification; libflorist-2025.1.0/libsrc/posix_process_scheduling.ads000066400000000000000000000056601473553204100232010ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ P R O C E S S _ S C H E D U L I N G -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Process_Scheduling; pragma Elaborate_All (POSIX.Process_Scheduling); package POSIX_Process_Scheduling renames POSIX.Process_Scheduling; libflorist-2025.1.0/libsrc/posix_process_times.ads000066400000000000000000000056341473553204100221760ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ P R O C E S S _ T I M E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Process_Times; pragma Elaborate_All (POSIX.Process_Times); package POSIX_Process_Times renames POSIX.Process_Times; libflorist-2025.1.0/libsrc/posix_semaphores.ads000066400000000000000000000056201473553204100214600ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ S E M A P H O R E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Semaphores; pragma Elaborate_All (POSIX.Semaphores); package POSIX_Semaphores renames POSIX.Semaphores; libflorist-2025.1.0/libsrc/posix_shared_memory_objects.ads000066400000000000000000000056741473553204100236720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ S H A R E D _ M E M O R Y _ O B J E C T S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Shared_Memory_Objects; pragma Elaborate_All (POSIX.Shared_Memory_Objects); package POSIX_Shared_Memory_Objects renames POSIX.Shared_Memory_Objects; libflorist-2025.1.0/libsrc/posix_supplement_to_ada_io.ads000066400000000000000000000060121473553204100235000ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ S U P P L E M E N T _ T O _ A D A _ I O -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Supplement_to_Ada_IO; pragma Elaborate_All (POSIX.Supplement_to_Ada_IO); package POSIX_Supplement_to_Ada_IO renames POSIX.Supplement_to_Ada_IO; libflorist-2025.1.0/libsrc/posix_terminal_functions.ads000066400000000000000000000056601473553204100232210ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ T E R M I N A L _ F U N C T I O N S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Terminal_Functions; pragma Elaborate_All (POSIX.Terminal_Functions); package POSIX_Terminal_Functions renames POSIX.Terminal_Functions; libflorist-2025.1.0/libsrc/posix_unsafe_process_primitives.ads000066400000000000000000000057161473553204100246120ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ U N S A F E _ P R O C E S S _ P R I M I T I V E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Unsafe_Process_Primitives; pragma Elaborate_All (POSIX.Unsafe_Process_Primitives); package POSIX_Unsafe_Process_Primitives renames POSIX.Unsafe_Process_Primitives; libflorist-2025.1.0/libsrc/posix_user_database.ads000066400000000000000000000056341473553204100221210ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ U S E R _ D A T A B A S E -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.User_Database; pragma Elaborate_All (POSIX.User_Database); package POSIX_User_Database renames POSIX.User_Database; libflorist-2025.1.0/libsrc/system_storage_elements.ads000066400000000000000000000061511473553204100230340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- S Y S T E M _ S T O R A G E _ E L E M E N T S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996, 1997 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- Copyright (C) 2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with System.Storage_Elements; package System_Storage_Elements renames System.Storage_Elements; libflorist-2025.1.0/libsrc/threads/000077500000000000000000000000001473553204100170265ustar00rootroot00000000000000libflorist-2025.1.0/libsrc/threads/ada_task_identification.ads000066400000000000000000000061511473553204100243420ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- A D A _ T A S K _ I D E N T I F I C A T I O N -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996, 1997 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- Copyright (C) 2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Task_Identification; package Ada_Task_Identification renames Ada.Task_Identification; libflorist-2025.1.0/libsrc/threads/posix-asynchronous_io.adb000066400000000000000000000434201473553204100240630ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . A S Y N C H R O N O U S _ I O -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2017, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Streams, Ada.Unchecked_Conversion, Ada.Unchecked_Deallocation, System, POSIX.Implementation; package body POSIX.Asynchronous_IO is use POSIX.C, POSIX.Implementation; --------------------------------- -- Create_AIO_Control_Block -- --------------------------------- function Create_AIO_Control_Block return AIO_Descriptor is begin return new Aiocb_Wrapper; end Create_AIO_Control_Block; --------------------------------- -- Destroy_AIO_Control_Block -- --------------------------------- function aio_error (AD : AIO_Descriptor) return Error_Code; pragma Import (C, aio_error, aio_error_LINKNAME); procedure Free is new Ada.Unchecked_Deallocation (Aiocb_Wrapper, AIO_Descriptor); -- ????? Change POSIX.5b? -- This operation is very difficult to use correctly, since -- it is not idempotent. That is, if there is an exception and -- we want to clean up after it, we cannot safely call Destroy_... -- since we don't know whether the AIO_Descriptor is valid. procedure Destroy_AIO_Control_Block (AD : in out AIO_Descriptor) is begin Check (AD /= null, Invalid_Argument); if aio_error (AD) = EINPROGRESS then Raise_POSIX_Error (Operation_Not_Permitted); end if; Free (AD); end Destroy_AIO_Control_Block; ---------------- -- Get_File -- ---------------- function Get_File (AD : AIO_Descriptor) return POSIX.IO.File_Descriptor is begin Check (AD /= null, Invalid_Argument); return POSIX.IO.File_Descriptor (AD.C.aio_fildes); end Get_File; ---------------- -- Set_File -- ---------------- procedure Set_File (AD : AIO_Descriptor; File : POSIX.IO.File_Descriptor) is begin Check (AD /= null, Invalid_Argument); AD.C.aio_fildes := int (File); end Set_File; ------------------ -- Get_Offset -- ------------------ function Get_Offset (AD : AIO_Descriptor) return POSIX.IO.IO_Offset is begin Check (AD /= null, Invalid_Argument); return POSIX.IO.IO_Offset (AD.C.aio_offset); end Get_Offset; ------------------ -- Set_Offset -- ------------------ procedure Set_Offset (AD : AIO_Descriptor; Offset : POSIX.IO.IO_Offset) is begin Check (AD /= null, Invalid_Argument); AD.C.aio_offset := off_t (Offset); end Set_Offset; ------------------ -- Get_Buffer -- ------------------ -- .... Change POSIX.5? -- The component aio_buf is of type volatile void * in C -- The Ada buffer should also be required to be declared volatile. function Get_Buffer (AD : AIO_Descriptor) return IO_Array_Pointer is begin Check (AD /= null, Invalid_Argument); return AD.P; end Get_Buffer; ------------------ -- Set_Buffer -- ------------------ procedure Set_Buffer (AD : AIO_Descriptor; Buffer : IO_Array_Pointer) is begin Check (AD /= null, Invalid_Argument); AD.C.aio_nbytes := Buffer'Length; AD.C.aio_buf := Buffer (Buffer'First)'Address; AD.P := Buffer; end Set_Buffer; ------------------ -- Get_Length -- ------------------ function Get_Length (AD : AIO_Descriptor) return IO_Count is begin Check (AD /= null, Invalid_Argument); return IO_Count (AD.C.aio_nbytes); end Get_Length; ------------------ -- Set_Length -- ------------------ procedure Set_Length (AD : AIO_Descriptor; Length : IO_Count) is begin Check (AD /= null, Invalid_Argument); AD.C.aio_nbytes := size_t (Length); end Set_Length; ------------------------------ -- Get_Priority_Reduction -- ------------------------------ function Get_Priority_Reduction (AD : AIO_Descriptor) return Natural is begin Check (AD /= null, Invalid_Argument); return Natural (AD.C.aio_reqprio); end Get_Priority_Reduction; ------------------------------ -- Set_Priority_Reduction -- ------------------------------ procedure Set_Priority_Reduction (AD : AIO_Descriptor; Priority_Reduction : Natural) is begin Check (AD /= null, Invalid_Argument); AD.C.aio_reqprio := int (Priority_Reduction); end Set_Priority_Reduction; ----------------- -- Get_Event -- ----------------- function To_Signal_Event is new Ada.Unchecked_Conversion (struct_sigevent, POSIX.Signals.Signal_Event); function Get_Event (AD : AIO_Descriptor) return POSIX.Signals.Signal_Event is begin Check (AD /= null, Invalid_Argument); return To_Signal_Event (AD.C.aio_sigevent); end Get_Event; ----------------- -- Set_Event -- ----------------- function To_struct_sigevent is new Ada.Unchecked_Conversion (POSIX.Signals.Signal_Event, struct_sigevent); procedure Set_Event (AD : AIO_Descriptor; Event : POSIX.Signals.Signal_Event) is begin Check (AD /= null, Invalid_Argument); AD.C.aio_sigevent := To_struct_sigevent (Event); end Set_Event; --------------------- -- Get_Operation -- --------------------- function Get_Operation (AD : AIO_Descriptor) return List_IO_Operations is opcode : int; begin Check (AD /= null, Invalid_Argument); opcode := AD.C.aio_lio_opcode; pragma Warnings (Off); -- Disable warning on some platforms where LIO_NOP=LIO_READ=LIO_WRITE=0 if opcode = LIO_NOP then return No_Op; elsif opcode = LIO_READ then return Read; elsif opcode = LIO_WRITE then return Write; end if; pragma Warnings (On); Raise_POSIX_Error (Invalid_Argument); -- to suppress compiler warning message: return No_Op; end Get_Operation; --------------------- -- Set_Operation -- --------------------- C_lio_op : constant array (List_IO_Operations) of int := (No_Op => LIO_NOP, Read => LIO_READ, Write => LIO_WRITE); procedure Set_Operation (AD : AIO_Descriptor; Operation : List_IO_Operations) is begin Check (AD /= null, Invalid_Argument); AD.C.aio_lio_opcode := C_lio_op (Operation); end Set_Operation; ------------ -- Read -- ------------ procedure Read (AD : AIO_Descriptor) is function aio_read (AD : AIO_Descriptor) return int; pragma Import (C, aio_read, aio_read_LINKNAME); begin Check (AD /= null, Invalid_Argument); Check (aio_read (AD)); end Read; ------------- -- Write -- ------------- procedure Write (AD : AIO_Descriptor) is function aio_write (AD : AIO_Descriptor) return int; pragma Import (C, aio_write, aio_write_LINKNAME); begin Check (AD /= null, Invalid_Argument); Check (aio_write (AD)); end Write; ----------------------- -- List_IO_No_Wait -- ----------------------- function lio_listio (mode : int; list : access AIO_Descriptor; nent : int; sig : sigevent_ptr) return int; pragma Import (C, lio_listio, lio_listio_LINKNAME); procedure List_IO_No_Wait (List : in out AIO_Descriptor_List; Event : POSIX.Signals.Signal_Event) is sigevent : aliased struct_sigevent := To_struct_sigevent (Event); begin for i in List'Range loop Check (List (i) /= null, Invalid_Argument); end loop; Check (lio_listio (LIO_NOWAIT, List (List'First)'Unchecked_Access, int (List'Length), sigevent'Unchecked_Access)); end List_IO_No_Wait; --------------------- -- List_IO_Wait -- --------------------- procedure List_IO_Wait (List : in out AIO_Descriptor_List; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is Old_Mask : aliased Signal_Mask; Result : int; begin for i in List'Range loop Check (List (i) /= null, Invalid_Argument); end loop; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := lio_listio (LIO_WAIT, List (List'First)'Unchecked_Access, int (List'Length), null); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end List_IO_Wait; ---------------------- -- Get_AIO_Status -- ---------------------- function Get_AIO_Status (AD : AIO_Descriptor) return AIO_Status is Result : Error_Code; begin Check (AD /= null, Invalid_Argument); Result := aio_error (AD); if Result = 0 then return Completed_Successfully; elsif Result = EINPROGRESS then return In_Progress; elsif Result = ECANCELED then return Canceled; end if; Raise_POSIX_Error; -- to supress compiler warning message return Canceled; end Get_AIO_Status; -------------------------- -- Get_AIO_Error_Code -- -------------------------- function Get_AIO_Error_Code (AD : AIO_Descriptor) return POSIX.Error_Code is Result : Error_Code; begin Check (AD /= null, Invalid_Argument); Result := aio_error (AD); if Result = ENOSYS or else Result = EINVAL then Raise_POSIX_Error; end if; return Result; end Get_AIO_Error_Code; ------------------------------- -- Get_Bytest_Transferred -- ------------------------------- function Get_Bytes_Transferred (AD : AIO_Descriptor) return IO_Count is function aio_return (AD : AIO_Descriptor) return ssize_t; pragma Import (C, aio_return, aio_return_LINKNAME); Result : ssize_t; begin Check (AD /= null, Invalid_Argument); Result := aio_return (AD); Check (int (Result)); return IO_Count (Result); end Get_Bytes_Transferred; -------------- -- Cancel -- -------------- function aio_cancel (fildes : int; aiocb : AIO_Descriptor) return int; pragma Import (C, aio_cancel, aio_cancel_LINKNAME); function Cancel (AD : AIO_Descriptor) return Cancelation_Status is Result : int; begin Result := aio_cancel (AD.C.aio_fildes, AD); pragma Warnings (Off); -- Disable warning on some platforms where AIO_*=0 if Result = AIO_CANCELED then return Canceled; elsif Result = AIO_NOTCANCELED then return Not_Canceled; elsif Result = AIO_ALLDONE then return All_Done; end if; pragma Warnings (On); Raise_POSIX_Error; -- to suppress compiler warning message return All_Done; end Cancel; function Cancel (File : POSIX.IO.File_Descriptor) return Cancelation_Status is Result : int; begin Result := aio_cancel (int (File), null); pragma Warnings (Off); -- Disable warning on some platforms where AIO_*=0 if Result = AIO_CANCELED then return Canceled; elsif Result = AIO_NOTCANCELED then return Not_Canceled; elsif Result = AIO_ALLDONE then return All_Done; end if; pragma Warnings (On); Raise_POSIX_Error; -- to suppress compiler warning message return All_Done; end Cancel; --------------------------- -- Await_IO_Or_Timeout -- --------------------------- type aiocb_ptr_ptr is access constant AIO_Descriptor; function aio_suspend (list : aiocb_ptr_ptr; nent : int; timeout : timespec_ptr) return int; pragma Import (C, aio_suspend, aio_suspend_LINKNAME); procedure Await_IO_Or_Timeout (AD : AIO_Descriptor; Timeout : POSIX.Timespec; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is TS : aliased struct_timespec; Old_Mask : aliased Signal_Mask; List : AIO_Descriptor_List (1 .. 1) := (others => AD); Result : int; begin Check (AD /= null, Invalid_Argument); TS := To_Struct_Timespec (To_Duration (Timeout)); Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := aio_suspend (List (List'First)'Unchecked_Access, List'Length, TS'Unchecked_Access); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Await_IO_Or_Timeout; procedure Await_IO_Or_Timeout (List : AIO_Descriptor_List; Timeout : POSIX.Timespec; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is TS : aliased struct_timespec; Old_Mask : aliased Signal_Mask; Result : int; begin for i in List'Range loop Check (List (i) /= null, Invalid_Argument); end loop; TS := To_Struct_Timespec (To_Duration (Timeout)); Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := aio_suspend (List (List'First)'Unchecked_Access, List'Length, TS'Unchecked_Access); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Await_IO_Or_Timeout; ---------------- -- Await_IO -- ---------------- procedure Await_IO (AD : AIO_Descriptor; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is Old_Mask : aliased Signal_Mask; List : AIO_Descriptor_List (1 .. 1) := (others => AD); Result : int; begin Check (AD /= null, Invalid_Argument); Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := aio_suspend (List (List'First)'Unchecked_Access, List'Length, null); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Await_IO; procedure Await_IO (List : AIO_Descriptor_List; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is Old_Mask : aliased Signal_Mask; Result : int; begin for i in List'Range loop if List (i) = null then Raise_POSIX_Error (Invalid_Argument); end if; end loop; Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := aio_suspend (List (List'First)'Unchecked_Access, List'Length, null); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Await_IO; ------------------------ -- Synchronize_File -- ------------------------ function aio_fsync (op : int; AD : AIO_Descriptor) return int; pragma Import (C, aio_fsync, aio_fsync_LINKNAME); procedure Synchronize_File (AD : AIO_Descriptor) is begin Check (AD /= null, Invalid_Argument); Check (aio_fsync (O_SYNC, AD)); end Synchronize_File; ------------------------ -- Synchronize_Data -- ------------------------ procedure Synchronize_Data (AD : AIO_Descriptor) is begin Check (AD /= null, Invalid_Argument); Check (aio_fsync (O_DSYNC, AD)); end Synchronize_Data; begin -- Check that struct aiocb component is allocated in first position, -- so that we can safely convert pointers. declare X : aliased Aiocb_Wrapper; use System; begin if X'Address /= X.C'Address then raise Program_Error; end if; end; end POSIX.Asynchronous_IO; libflorist-2025.1.0/libsrc/threads/posix-asynchronous_io.ads000066400000000000000000000163511473553204100241070ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . A S Y N C H R O N O U S _ I O -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.IO, POSIX.Signals; package POSIX.Asynchronous_IO is type AIO_Descriptor is private; function Create_AIO_Control_Block return AIO_Descriptor; procedure Destroy_AIO_Control_Block (AD : in out AIO_Descriptor); type List_IO_Operations is (No_Op, Read, Write); type IO_Array_Pointer is access Ada.Streams.Stream_Element_Array; for IO_Array_Pointer'Size use Standard'Address_Size; -- force this to be a "thin" pointer, like C pointers function Get_File (AD : AIO_Descriptor) return POSIX.IO.File_Descriptor; procedure Set_File (AD : AIO_Descriptor; File : POSIX.IO.File_Descriptor); function Get_Offset (AD : AIO_Descriptor) return POSIX.IO.IO_Offset; procedure Set_Offset (AD : AIO_Descriptor; Offset : POSIX.IO.IO_Offset); function Get_Buffer (AD : AIO_Descriptor) return IO_Array_Pointer; procedure Set_Buffer (AD : AIO_Descriptor; Buffer : IO_Array_Pointer); function Get_Length (AD : AIO_Descriptor) return POSIX.IO_Count; procedure Set_Length (AD : AIO_Descriptor; Length : POSIX.IO_Count); function Get_Priority_Reduction (AD : AIO_Descriptor) return Natural; procedure Set_Priority_Reduction (AD : AIO_Descriptor; Priority_Reduction : Natural); function Get_Event (AD : AIO_Descriptor) return POSIX.Signals.Signal_Event; procedure Set_Event (AD : AIO_Descriptor; Event : POSIX.Signals.Signal_Event); function Get_Operation (AD : AIO_Descriptor) return List_IO_Operations; procedure Set_Operation (AD : AIO_Descriptor; Operation : List_IO_Operations); procedure Read (AD : AIO_Descriptor); procedure Write (AD : AIO_Descriptor); type AIO_Descriptor_List is array (Positive range <>) of aliased AIO_Descriptor; -- .... "aliased" is not in POSIX.5b -- ????? Change POSIX.5b? -- This array should probably have been a private (or limited private) -- type, so that we could hide a copy of the C-style array of pointers -- inside the object. As things stand, the need to be able to recover -- an Ada pointer to the buffer of each AIOCB is forcing us to put a -- wrapper around each AIOCB pointer, and so we cannot pass the array -- directly as argument to any C system call. Instead, we have to -- dynamically create a C-style array at the point of call. procedure List_IO_No_Wait (List : in out AIO_Descriptor_List; Event : POSIX.Signals.Signal_Event); procedure List_IO_Wait (List : in out AIO_Descriptor_List; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); type AIO_Status is (In_Progress, Completed_Successfully, Canceled); function Get_AIO_Status (AD : AIO_Descriptor) return AIO_Status; function Get_AIO_Error_Code (AD : AIO_Descriptor) return POSIX.Error_Code; function Get_Bytes_Transferred (AD : AIO_Descriptor) return POSIX.IO_Count; type Cancelation_Status is (Canceled, Not_Canceled, All_Done); function Cancel (AD : AIO_Descriptor) return Cancelation_Status; function Cancel (File : POSIX.IO.File_Descriptor) return Cancelation_Status; procedure Await_IO_Or_Timeout (AD : AIO_Descriptor; Timeout : POSIX.Timespec; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Await_IO (AD : AIO_Descriptor; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Await_IO_Or_Timeout (List : AIO_Descriptor_List; Timeout : POSIX.Timespec; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Await_IO (List : AIO_Descriptor_List; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Synchronize_File (AD : AIO_Descriptor); procedure Synchronize_Data (AD : AIO_Descriptor); private -- The following wrapper is needed around the C struct aiocb -- in order to preserve the Ada "fat" pointer (including constraint info) -- that we need in order to be able to recover the range constraint of the -- Stream_Element_Array object referenced by the aiocb. -- Our code is going to rely on the component C being allocated in first -- position. There will be code in the package body to verify this -- assumption. type Aiocb_Wrapper is record C : aliased POSIX.C.struct_aiocb; P : IO_Array_Pointer; end record; type AIO_Descriptor is access Aiocb_Wrapper; end POSIX.Asynchronous_IO; libflorist-2025.1.0/libsrc/threads/posix-condition_variables.adb000066400000000000000000000207401473553204100246570ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C O N D I T I O N _ V A R I A B L E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation, POSIX.Implementation; package body POSIX.Condition_Variables is use POSIX.C; use POSIX.Implementation; procedure Free is new Ada.Unchecked_Deallocation (pthread_condattr_t, Attributes_Descriptor); procedure Free is new Ada.Unchecked_Deallocation (pthread_cond_t, Condition_Descriptor); ---------------- -- Initialize -- ---------------- procedure Initialize (Attr : in out Attributes) is function pthread_condattr_init (attr : access pthread_condattr_t) return int; pragma Import (C, pthread_condattr_init, pthread_condattr_init_LINKNAME); begin Attr.Attr := new pthread_condattr_t; Check_NZ (pthread_condattr_init (Attr.Attr)); end Initialize; -------------- -- Finalize -- -------------- procedure Finalize (Attr : in out Attributes) is function pthread_condattr_destroy (attr : access pthread_condattr_t) return int; pragma Import (C, pthread_condattr_destroy, pthread_condattr_destroy_LINKNAME); begin Check_NZ (pthread_condattr_destroy (Attr.Attr)); Free (Attr.Attr); end Finalize; ------------------------ -- Get_Process_Shared -- ------------------------ function Get_Process_Shared (Attr : Attributes) return Boolean is Result : aliased int; function pthread_condattr_getpshared (attr : Attributes_Descriptor; pshared : access int) return int; pragma Import (C, pthread_condattr_getpshared, pthread_condattr_getpshared_LINKNAME); begin Check_NZ (pthread_condattr_getpshared (Attr.Attr, Result'Unchecked_Access)); return Result = PTHREAD_PROCESS_SHARED; end Get_Process_Shared; ------------------------ -- Set_Process_Shared -- ------------------------ To_pshared : constant array (Boolean) of int := (True => PTHREAD_PROCESS_SHARED, False => PTHREAD_PROCESS_PRIVATE); procedure Set_Process_Shared (Attr : in out Attributes; Is_Shared : Boolean := False) is function pthread_condattr_setpshared (attr : access pthread_condattr_t; pshared : C.int) return int; pragma Import (C, pthread_condattr_setpshared, pthread_condattr_setpshared_LINKNAME); begin Check_NZ (pthread_condattr_setpshared (Attr.Attr, To_pshared (Is_Shared))); end Set_Process_Shared; ---------------- -- Initialize -- ---------------- function pthread_cond_init (cond : access pthread_cond_t; attr : Attributes_Descriptor) return int; pragma Import (C, pthread_cond_init, pthread_cond_init_LINKNAME); procedure Initialize (Cond : in out Condition; Attr : Attributes) is begin Cond.Cond := new pthread_cond_t; Check_NZ (pthread_cond_init (Cond.Cond, Attr.Attr)); end Initialize; procedure Initialize (Cond : in out Condition) is begin Cond.Cond := new pthread_cond_t; Check_NZ (pthread_cond_init (Cond.Cond, null)); end Initialize; ------------------- -- Descriptor_Of -- ------------------- function Descriptor_Of (Cond : Condition) return Condition_Descriptor is begin return Cond.Cond; end Descriptor_Of; -------------- -- Finalize -- -------------- function pthread_cond_destroy (cond : access pthread_cond_t) return int; pragma Import (C, pthread_cond_destroy, pthread_cond_destroy_LINKNAME); procedure Finalize (Cond : in out Condition) is begin Check_NZ (pthread_cond_destroy (Cond.Cond)); Free (Cond.Cond); end Finalize; ------------ -- Signal -- ------------ procedure Signal (Cond : Condition_Descriptor) is function pthread_cond_signal (cond : Condition_Descriptor) return int; pragma Import (C, pthread_cond_signal, pthread_cond_signal_LINKNAME); begin Check_NZ (pthread_cond_signal (Cond)); end Signal; --------------- -- Broadcast -- --------------- procedure Broadcast (Cond : Condition_Descriptor) is function pthread_cond_broadcast (cond : Condition_Descriptor) return int; pragma Import (C, pthread_cond_broadcast, pthread_cond_broadcast_LINKNAME); begin Check_NZ (pthread_cond_broadcast (Cond)); end Broadcast; ---------- -- Wait -- ---------- procedure Wait (Cond : Condition_Descriptor; M : POSIX.Mutexes.Mutex_Descriptor) is function pthread_cond_wait (cond : Condition_Descriptor; mutex : POSIX.Mutexes.Mutex_Descriptor) return int; pragma Import (C, pthread_cond_wait, pthread_cond_wait_LINKNAME); begin Check_NZ (pthread_cond_wait (Cond, M)); end Wait; ---------------- -- Timed_Wait -- ---------------- -- .....change POSIX.5b?????? -- When we tested this operation we found that people tended to -- use it incorrectly, not expecting to get an exception if it times -- out. Perhaps there should be an alternate binding closer to the -- C-language pthread_cond_timedwait, which does not treat ETIME as -- at true error. procedure Timed_Wait (Cond : Condition_Descriptor; M : POSIX.Mutexes.Mutex_Descriptor; Timeout : POSIX.Timespec) is function pthread_cond_timedwait (cond : Condition_Descriptor; mutex : POSIX.Mutexes.Mutex_Descriptor; abstime : access struct_timespec) return int; pragma Import (C, pthread_cond_timedwait, pthread_cond_timedwait_LINKNAME); T : aliased struct_timespec := To_Struct_Timespec (Timeout); begin Check_NZ (pthread_cond_timedwait (Cond, M, T'Unchecked_Access)); end Timed_Wait; end POSIX.Condition_Variables; libflorist-2025.1.0/libsrc/threads/posix-condition_variables.ads000066400000000000000000000111251473553204100246750ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . C O N D I T I O N _ V A R I A B L E S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Mutexes; package POSIX.Condition_Variables is -- ========== -- -- WARNINGS -- -- ========== -- -- This package is for mixed-language programming, in which -- an Ada task needs to synchronize with a C thread. -- Do NOT use POSIX CVs to synchronize between Ada tasks. -- Instead, use Ada protected objects. -- If you use one of these "raw" CVs, you risk undefined -- behavior if you violate any of the POSIX.1c rules about CVs, -- or if you attempt to abort (including ATC) a task that is performing -- a mutex or CV operation. type Condition is limited private; type Condition_Descriptor is private; type Attributes is private; procedure Initialize (Attr : in out Attributes); procedure Finalize (Attr : in out Attributes); function Get_Process_Shared (Attr : Attributes) return Boolean; procedure Set_Process_Shared (Attr : in out Attributes; Is_Shared : Boolean := False); procedure Initialize (Cond : in out Condition; Attr : Attributes); procedure Initialize (Cond : in out Condition); function Descriptor_Of (Cond : Condition) return Condition_Descriptor; procedure Finalize (Cond : in out Condition); procedure Signal (Cond : Condition_Descriptor); procedure Broadcast (Cond : Condition_Descriptor); procedure Wait (Cond : Condition_Descriptor; M : POSIX.Mutexes.Mutex_Descriptor); procedure Timed_Wait (Cond : Condition_Descriptor; M : POSIX.Mutexes.Mutex_Descriptor; Timeout : POSIX.Timespec); private type Condition_Descriptor is access POSIX.C.pthread_cond_t; type Attributes_Descriptor is access POSIX.C.pthread_condattr_t; type Attributes is record Attr : Attributes_Descriptor; end record; type Condition is record Cond : Condition_Descriptor; end record; end POSIX.Condition_Variables; libflorist-2025.1.0/libsrc/threads/posix-message_queues.adb000066400000000000000000000403311473553204100236520ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E S S A G E _ Q U E U E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Streams, Ada.Unchecked_Conversion, POSIX.Implementation, POSIX.Permissions.Implementation, System; package body POSIX.Message_Queues is use Ada.Streams; use POSIX.C; use POSIX.Implementation; use POSIX.Permissions.Implementation; function To_int is new Ada.Unchecked_Conversion (Bits, int); function To_Bits is new Ada.Unchecked_Conversion (int, Bits); C_File_Mode : constant array (POSIX.IO.File_Mode) of Bits := (POSIX.IO.Read_Only => O_RDONLY, POSIX.IO.Write_Only => O_WRONLY, POSIX.IO.Read_Write => O_RDWR); function Check_NNeg_And_Restore_Signals (Result : Message_Queue_Descriptor; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access) return Message_Queue_Descriptor; function Check_NNeg_And_Restore_Signals (Result : Message_Queue_Descriptor; Masked_Signals : Signal_Masking; Old_Mask : Signal_Mask_Access) return Message_Queue_Descriptor is begin if Result < 0 then Restore_Signals_And_Raise_POSIX_Error (Masked_Signals, Old_Mask); return Result; else Restore_Signals (Masked_Signals, Old_Mask); return Result; end if; end Check_NNeg_And_Restore_Signals; ------------------------ -- Set_Max_Messages -- ------------------------ procedure Set_Max_Messages (Attrs : in out Attributes; Value : Natural) is begin Attrs.Attrs.mq_maxmsg := long (Value); end Set_Max_Messages; ------------------------ -- Get_Max_Messages -- ------------------------ function Get_Max_Messages (Attrs : Attributes) return Natural is begin return Natural (Attrs.Attrs.mq_maxmsg); end Get_Max_Messages; -------------------------- -- Set_Message_Length -- -------------------------- procedure Set_Message_Length (Attrs : in out Attributes; Value : Natural) is begin Attrs.Attrs.mq_msgsize := long (Value); end Set_Message_Length; -------------------------- -- Get_Message_Length -- -------------------------- function Get_Message_Length (Attrs : Attributes) return Natural is begin return Natural (Attrs.Attrs.mq_msgsize); end Get_Message_Length; ------------------- -- Set_Options -- ------------------- procedure Set_Options (Attrs : in out Attributes; Value : Message_Queue_Options) is begin Attrs.Attrs.mq_flags := long (To_int (Option_Set (Value).Option)); end Set_Options; ------------------- -- Get_Options -- ------------------- function Get_Options (Attrs : Attributes) return Message_Queue_Options is begin return Message_Queue_Options (Option_Set '(Option => To_Bits (int (Attrs.Attrs.mq_flags)))); -- ???? -- The above conversion of long value to int is risky. -- If the high-order bits are used, we may need to consider -- reimplementing Option_Set as long, or changing the POSIX.5b spec. -- .... Change POSIX.5b? -- It was a mistake to use Option_Set here for a value that the -- C-language interface says is a "long". Option_Set in other places -- is only used to map bit-vectors of type "int". end Get_Options; ------------------------- -- Get_Message_Count -- ------------------------- function Get_Message_Count (Attrs : Attributes) return Natural is begin return Natural (Attrs.Attrs.mq_curmsgs); end Get_Message_Count; ------------ -- Open -- ------------ function mq_open (name : char_ptr; oflag : int; mode : mode_t; attr : mq_attr_ptr) return Message_Queue_Descriptor; pragma Import (C, mq_open, mq_open_LINKNAME); function Open (Name : POSIX_String; Mode : POSIX.IO.File_Mode; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : Signal_Masking := RTS_Signals) return Message_Queue_Descriptor is Name_With_NUL : POSIX_String := Name & NUL; Old_Mask : aliased Signal_Mask; Result : Message_Queue_Descriptor; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := mq_open (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, To_int (Option_Set (Options).Option or C_File_Mode (Mode)), 0, null); return Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Open; ---------------------- -- Open_Or_Create -- ---------------------- function Open_Or_Create (Name : POSIX_String; Mode : POSIX.IO.File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : Signal_Masking := RTS_Signals) return Message_Queue_Descriptor is Name_With_NUL : POSIX_String := Name & NUL; Old_Mask : aliased Signal_Mask; Result : Message_Queue_Descriptor; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := mq_open (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, To_int (Option_Set (Options).Option or C_File_Mode (Mode) or O_CREAT), Form_C_Permission (Permissions), null); return Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Open_Or_Create; function Open_Or_Create (Name : POSIX_String; Mode : POSIX.IO.File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Attrs : Attributes; Masked_Signals : Signal_Masking := RTS_Signals) return Message_Queue_Descriptor is Name_With_NUL : POSIX_String := Name & NUL; Old_Mask : aliased Signal_Mask; Result : Message_Queue_Descriptor; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := mq_open (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access, To_int (Option_Set (Options).Option or C_File_Mode (Mode) or O_CREAT), Form_C_Permission (Permissions), Attrs.Attrs'Unchecked_Access); return Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Open_Or_Create; ------------- -- Close -- ------------- procedure Close (MQ : in out Message_Queue_Descriptor) is function mq_close (mqdes : Message_Queue_Descriptor) return int; pragma Import (C, mq_close, mq_close_LINKNAME); begin Check (mq_close (MQ)); end Close; ---------------------------- -- Unlink_Message_Queue -- ---------------------------- procedure Unlink_Message_Queue (Name : POSIX_String) is function mq_unlink (name : char_ptr) return int; pragma Import (C, mq_unlink, mq_unlink_LINKNAME); Name_With_NUL : POSIX_String := Name & NUL; begin Check (mq_unlink (Name_With_NUL (Name_With_NUL'First)'Unchecked_Access)); end Unlink_Message_Queue; ------------ -- Send -- ------------ function mq_send (mqdes : Message_Queue_Descriptor; msg_ptr : char_ptr; msg_len : size_t; msg_prio : unsigned) return int; pragma Import (C, mq_send, mq_send_LINKNAME); procedure Send (MQ : Message_Queue_Descriptor; Message : Ada.Streams.Stream_Element_Array; Priority : Message_Priority; Masked_Signals : Signal_Masking := RTS_Signals) is Old_Mask : aliased Signal_Mask; Result : int; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := mq_send (MQ, To_char_ptr (Message (Message'First)'Address), size_t (Message'Length), unsigned (Priority)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Send; --------------- -- Receive -- --------------- function mq_receive (mqdes : Message_Queue_Descriptor; msg_ptr : System.Address; msg_len : size_t; msg_prio : access unsigned) return ssize_t; pragma Import (C, mq_receive, mq_receive_LINKNAME); procedure Receive (MQ : Message_Queue_Descriptor; Message : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Priority : out Message_Priority; Masked_Signals : Signal_Masking := RTS_Signals) is Old_Mask : aliased Signal_Mask; Prio : aliased unsigned; Result : ssize_t; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := mq_receive (MQ, Message (Message'First)'Address, size_t (Message'Length), Prio'Unchecked_Access); Check_NNeg_And_Restore_Signals (int (Result), Masked_Signals, Old_Mask'Unchecked_Access); Priority := Message_Priority (Prio); Last := Message'First + Stream_Element_Offset (Result) - 1; end Receive; package body Generic_Message_Queues is SES : constant Stream_Element_Offset := Stream_Element'Size; Buffer_Length : constant Stream_Element_Offset := (Message_Type'Size + SES - 1) / SES; Buffer : aliased Stream_Element_Array (1 .. Buffer_Length); Length : Stream_Element_Offset; ------------ -- Send -- ------------ procedure Send (MQ : Message_Queue_Descriptor; Message : Message_Type; Priority : Message_Priority; Masked_Signals : Signal_Masking := RTS_Signals) is Old_Mask : aliased Signal_Mask; Result : int; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := mq_send (MQ, To_char_ptr (Message'Address), size_t ((Message'Size + char'Size - 1) / char'Size), unsigned (Priority)); Check_NNeg_And_Restore_Signals (Result, Masked_Signals, Old_Mask'Unchecked_Access); end Send; --------------- -- Receive -- --------------- type Message_Ptr is access all Message_Type; function To_Message_Ptr is new Ada.Unchecked_Conversion (System.Address, Message_Ptr); procedure Receive (MQ : Message_Queue_Descriptor; Message : out Message_Type; Priority : out Message_Priority; Masked_Signals : Signal_Masking := RTS_Signals) is Old_Mask : aliased Signal_Mask; Prio : aliased unsigned; Result : ssize_t; begin Mask_Signals (Masked_Signals, Old_Mask'Unchecked_Access); Result := mq_receive (MQ, Buffer'Address, size_t (Buffer'Size / char'Size), Prio'Unchecked_Access); Check_NNeg_And_Restore_Signals (int (Result), Masked_Signals, Old_Mask'Unchecked_Access); Length := Stream_Element_Offset (Result); if Result /= Buffer'Size / char'Size then raise Constraint_Error; end if; Priority := Message_Priority (Prio); Message := To_Message_Ptr (Buffer'Address).all; end Receive; ------------------------ -- Get_Error_Buffer -- ------------------------ function Get_Error_Buffer return Ada.Streams.Stream_Element_Array is begin return Buffer (1 .. Length); end Get_Error_Buffer; end Generic_Message_Queues; ---------------------- -- Request_Notify -- ---------------------- type Event_Ptr is access all POSIX.Signals.Signal_Event; function mq_notify (mqdes : Message_Queue_Descriptor; notification : Event_Ptr) return int; pragma Import (C, mq_notify, mq_notify_LINKNAME); procedure Request_Notify (MQ : Message_Queue_Descriptor; Event : POSIX.Signals.Signal_Event) is E : aliased POSIX.Signals.Signal_Event := Event; begin Check (mq_notify (MQ, E'Unchecked_Access)); end Request_Notify; --------------------- -- Remove_Notify -- --------------------- procedure Remove_Notify (MQ : Message_Queue_Descriptor) is begin Check (mq_notify (MQ, null)); end Remove_Notify; ---------------------- -- Set_Attributes -- ---------------------- function mq_setattr (mqdes : Message_Queue_Descriptor; mqstat : mq_attr_ptr; omqstat : mq_attr_ptr) return int; pragma Import (C, mq_setattr, mq_setattr_LINKNAME); procedure Set_Attributes (MQ : Message_Queue_Descriptor; New_Attrs : Attributes; Old_Attrs : out Attributes) is begin Check (mq_setattr (MQ, New_Attrs.Attrs'Unchecked_Access, Old_Attrs.Attrs'Unchecked_Access)); end Set_Attributes; ---------------------- -- Set_Attributes -- ---------------------- procedure Set_Attributes (MQ : Message_Queue_Descriptor; New_Attrs : Attributes) is begin Check (mq_setattr (MQ, New_Attrs.Attrs'Unchecked_Access, null)); end Set_Attributes; ---------------------- -- Get_Attributes -- ---------------------- function Get_Attributes (MQ : Message_Queue_Descriptor) return Attributes is function mq_getattr (mqdes : Message_Queue_Descriptor; mqstat : access struct_mq_attr) return int; pragma Import (C, mq_getattr, mq_getattr_LINKNAME); Attrs : Attributes; begin Check (mq_getattr (MQ, Attrs.Attrs'Unchecked_Access)); return Attrs; end Get_Attributes; end POSIX.Message_Queues; libflorist-2025.1.0/libsrc/threads/posix-message_queues.ads000066400000000000000000000200071473553204100236710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M E S S A G E _ Q U E U E S -- -- -- -- S p e c -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2010, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.IO, POSIX.Configurable_System_Limits, POSIX.Permissions, POSIX.Signals; pragma Elaborate_All (POSIX.Configurable_System_Limits); package POSIX.Message_Queues is type Message_Queue_Descriptor is private; type Attributes is private; type Message_Queue_Options is new POSIX.Option_Set; Non_Blocking : constant Message_Queue_Options := Message_Queue_Options (POSIX.IO.Non_Blocking); subtype Message_Priority is Integer range 0 .. POSIX.Configurable_System_Limits.Message_Priority_Maximum; -- ????? -- POSIX.5b may need revision here. By definining the range -- of Message_Priority sufficiently precisely, we end up raising -- Constraint_Error in all situations where the priority is out -- of the supported range, but the standard says we should raise -- POSIX_Error with Invalid_Argument in these situations. In -- particular, see the procedure Send. Technically, it is not -- necessary to list Constraint_Error as a possibility in the -- Error Handling section of the standard, since it follows from -- the Ada language definition that Constraint_Error is raised -- under such circumstances, but it might be better if there were -- an explicit note pointing this out. procedure Set_Max_Messages (Attrs : in out Attributes; Value : Natural); function Get_Max_Messages (Attrs : Attributes) return Natural; procedure Set_Message_Length (Attrs : in out Attributes; Value : Natural); function Get_Message_Length (Attrs : Attributes) return Natural; procedure Set_Options (Attrs : in out Attributes; Value : Message_Queue_Options); function Get_Options (Attrs : Attributes) return Message_Queue_Options; function Get_Message_Count (Attrs : Attributes) return Natural; function Open (Name : POSIX.POSIX_String; Mode : POSIX.IO.File_Mode; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return Message_Queue_Descriptor; function Open_Or_Create (Name : POSIX.POSIX_String; Mode : POSIX.IO.File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return Message_Queue_Descriptor; function Open_Or_Create (Name : POSIX.POSIX_String; Mode : POSIX.IO.File_Mode; Permissions : POSIX.Permissions.Permission_Set; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set; Attrs : Attributes; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) return Message_Queue_Descriptor; procedure Close (MQ : in out Message_Queue_Descriptor); procedure Unlink_Message_Queue (Name : POSIX.POSIX_String); procedure Send (MQ : Message_Queue_Descriptor; Message : Ada.Streams.Stream_Element_Array; Priority : Message_Priority; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Receive (MQ : Message_Queue_Descriptor; Message : out Ada.Streams.Stream_Element_Array; Last : out Ada.Streams.Stream_Element_Offset; Priority : out Message_Priority; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); generic type Message_Type is private; package Generic_Message_Queues is procedure Send (MQ : Message_Queue_Descriptor; Message : Message_Type; Priority : Message_Priority; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Receive (MQ : Message_Queue_Descriptor; Message : out Message_Type; Priority : out Message_Priority; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); function Get_Error_Buffer return Ada.Streams.Stream_Element_Array; end Generic_Message_Queues; procedure Request_Notify (MQ : Message_Queue_Descriptor; Event : POSIX.Signals.Signal_Event); procedure Remove_Notify (MQ : Message_Queue_Descriptor); procedure Set_Attributes (MQ : Message_Queue_Descriptor; New_Attrs : Attributes; Old_Attrs : out Attributes); procedure Set_Attributes (MQ : Message_Queue_Descriptor; New_Attrs : Attributes); function Get_Attributes (MQ : Message_Queue_Descriptor) return Attributes; private type Message_Queue_Descriptor is new POSIX.C.mqd_t; type Attributes is record Attrs : aliased POSIX.C.struct_mq_attr := (0, 0, 0, 0); end record; end POSIX.Message_Queues; -- .... Change POSIX.5b????? -- These interfaces would be easier to use if it were possible to specify -- a message buffer via its address, rather than an unconstrained array -- parameter. The present interface forces people to copy data into the -- buffer, and possibly also out from the buffer. It would be more -- convenient and efficient to pass references to data to these calls and -- leave the data itself in-place. libflorist-2025.1.0/libsrc/threads/posix-mutexes.adb000066400000000000000000000273021473553204100223340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M U T E X E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2007, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Implementation; package body POSIX.Mutexes is use POSIX.C; use POSIX.Implementation; type Mutexattr_Descriptor is access constant pthread_mutexattr_t; ------------------ -- Initialize -- ------------------ function pthread_mutexattr_init (attr : access pthread_mutexattr_t) return int; pragma Import (C, pthread_mutexattr_init, pthread_mutexattr_init_LINKNAME); procedure Initialize (Attr : in out Attributes) is begin Check_NZ (pthread_mutexattr_init (Attr.Attr'Unchecked_Access)); end Initialize; ---------------- -- Finalize -- ---------------- function pthread_mutexattr_destroy (attr : access pthread_mutexattr_t) return int; pragma Import (C, pthread_mutexattr_destroy, pthread_mutexattr_destroy_LINKNAME); procedure Finalize (Attr : in out Attributes) is begin Check_NZ (pthread_mutexattr_destroy (Attr.Attr'Unchecked_Access)); end Finalize; -------------------------- -- Get_Process_Shared -- -------------------------- function pthread_mutexattr_getpshared (attr : Mutexattr_Descriptor; pshared : access int) return int; pragma Import (C, pthread_mutexattr_getpshared, pthread_mutexattr_getpshared_LINKNAME); function Get_Process_Shared (Attr : Attributes) return Boolean is Result : aliased int; begin Check_NZ (pthread_mutexattr_getpshared (Attr.Attr'Unchecked_Access, Result'Unchecked_Access)); return Result = PTHREAD_PROCESS_SHARED; end Get_Process_Shared; -------------------------- -- Set_Process_Shared -- -------------------------- function pthread_mutexattr_setpshared (attr : access pthread_mutexattr_t; pshared : int) return int; pragma Import (C, pthread_mutexattr_setpshared, pthread_mutexattr_setpshared_LINKNAME); To_pshared : constant array (Boolean) of int := (True => PTHREAD_PROCESS_SHARED, False => PTHREAD_PROCESS_PRIVATE); procedure Set_Process_Shared (Attr : in out Attributes; Is_Shared : Boolean := False) is begin Check_NZ (pthread_mutexattr_setpshared (Attr.Attr'Unchecked_Access, To_pshared (Is_Shared))); end Set_Process_Shared; -------------------------- -- Set_Locking_Policy -- -------------------------- function pthread_mutexattr_setprotocol (attr : access pthread_mutexattr_t; protocol : int) return int; pragma Import (C, pthread_mutexattr_setprotocol, pthread_mutexattr_setprotocol_LINKNAME); To_C_Policy : constant array (Locking_Policy) of int := (No_Priority_Inheritance => PTHREAD_PRIO_NONE, Highest_Blocked_Task => PTHREAD_PRIO_INHERIT, Highest_Ceiling_Priority => PTHREAD_PRIO_PROTECT); procedure Set_Locking_Policy (Attr : in out Attributes; Locking : Locking_Policy) is begin Check_NZ (pthread_mutexattr_setprotocol (Attr.Attr'Unchecked_Access, To_C_Policy (Locking))); end Set_Locking_Policy; -------------------------- -- Get_Locking_Policy -- -------------------------- function pthread_mutexattr_getprotocol (attr : Mutexattr_Descriptor; value_ptr : access int) return int; pragma Import (C, pthread_mutexattr_getprotocol, pthread_mutexattr_getprotocol_LINKNAME); function Get_Locking_Policy (Attr : Attributes) return Locking_Policy is Result : aliased int; begin Check_NZ (pthread_mutexattr_getprotocol (Attr.Attr'Unchecked_Access, Result'Unchecked_Access)); if Result = PTHREAD_PRIO_NONE then return No_Priority_Inheritance; elsif Result = PTHREAD_PRIO_INHERIT then return Highest_Blocked_Task; elsif Result = PTHREAD_PRIO_PROTECT then return Highest_Ceiling_Priority; else Raise_POSIX_Error (Operation_Not_Supported); -- to suppress compiler warning return No_Priority_Inheritance; end if; end Get_Locking_Policy; ---------------------------- -- Set_Ceiling_Priority -- ---------------------------- function pthread_mutexattr_setprioceiling (attr : access pthread_mutexattr_t; prioceiling : int) return int; pragma Import (C, pthread_mutexattr_setprioceiling, pthread_mutexattr_setprioceiling_LINKNAME); procedure Set_Ceiling_Priority (Attr : in out Attributes; New_Ceiling : Ceiling_Priority) is begin Check_NZ (pthread_mutexattr_setprioceiling (Attr.Attr'Unchecked_Access, int (New_Ceiling))); end Set_Ceiling_Priority; ---------------------------- -- Get_Ceiling_Priority -- ---------------------------- function pthread_mutexattr_getprioceiling (attr : Mutexattr_Descriptor; prioceiling : access int) return int; pragma Import (C, pthread_mutexattr_getprioceiling, pthread_mutexattr_getprioceiling_LINKNAME); function Get_Ceiling_Priority (Attr : Attributes) return Ceiling_Priority is Result : aliased int; begin Check_NZ (pthread_mutexattr_getprioceiling (Attr.Attr'Unchecked_Access, Result'Unchecked_Access)); return (Ceiling_Priority (Result)); end Get_Ceiling_Priority; ------------------ -- Initialize -- ------------------ function pthread_mutex_init (mutex : access pthread_mutex_t; attr : Mutexattr_Descriptor) return int; pragma Import (C, pthread_mutex_init, pthread_mutex_init_LINKNAME); procedure Initialize (M : in out Mutex; Attr : Attributes) is begin Check_NZ (pthread_mutex_init (M.Mutex'Unchecked_Access, Attr.Attr'Unchecked_Access)); end Initialize; procedure Initialize (M : in out Mutex) is begin Check_NZ (pthread_mutex_init (M.Mutex'Unchecked_Access, null)); end Initialize; --------------------- -- Descriptor_Of -- --------------------- function Descriptor_Of (M : Mutex) return Mutex_Descriptor is begin return M.Mutex'Unchecked_Access; end Descriptor_Of; ---------------- -- Finalize -- ---------------- function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; pragma Import (C, pthread_mutex_destroy, pthread_mutex_destroy_LINKNAME); procedure Finalize (M : in out Mutex) is begin Check_NZ (pthread_mutex_destroy (M.Mutex'Unchecked_Access)); end Finalize; ---------------------------- -- Set_Ceiling_Priority -- ---------------------------- type int_ptr is access all int; function pthread_mutex_setprioceiling (mutex : Mutex_Descriptor; prioceiling : int; old_ceiling : int_ptr) return int; pragma Import (C, pthread_mutex_setprioceiling, pthread_mutex_setprioceiling_LINKNAME); procedure Set_Ceiling_Priority (M : Mutex_Descriptor; New_Ceiling : Ceiling_Priority; Old_Ceiling : out Ceiling_Priority) is Result : aliased int; begin Check_NZ (pthread_mutex_setprioceiling (M, int (New_Ceiling), Result'Unchecked_Access)); Old_Ceiling := Ceiling_Priority (Result); end Set_Ceiling_Priority; ---------------------------- -- Get_Ceiling_Priority -- ---------------------------- function pthread_mutex_getprioceiling (mutex : Mutex_Descriptor; prioceiling : access int) return int; pragma Import (C, pthread_mutex_getprioceiling, pthread_mutex_getprioceiling_LINKNAME); function Get_Ceiling_Priority (M : Mutex_Descriptor) return Ceiling_Priority is Result : aliased int; begin Check_NZ (pthread_mutex_getprioceiling (M, Result'Unchecked_Access)); return Ceiling_Priority (Result); end Get_Ceiling_Priority; ------------ -- Lock -- ------------ function pthread_mutex_lock (mutex : Mutex_Descriptor) return int; pragma Import (C, pthread_mutex_lock, pthread_mutex_lock_LINKNAME); procedure Lock (M : Mutex_Descriptor) is begin Check_NZ (pthread_mutex_lock (M)); end Lock; ---------------- -- Try_Lock -- ---------------- function pthread_mutex_trylock (mutex : Mutex_Descriptor) return int; pragma Import (C, pthread_mutex_trylock, pthread_mutex_trylock_LINKNAME); function Try_Lock (M : Mutex_Descriptor) return Boolean is Result : constant int := pthread_mutex_trylock (M); -- Note: pthread_mutex_trylock returns an error code in Result, and -- does not set errno. begin case Result is when 0 => return True; when EBUSY => return False; when others => Raise_POSIX_Error (Error_Code (Result)); end case; end Try_Lock; -------------- -- Unlock -- -------------- function pthread_mutex_unlock (mutex : Mutex_Descriptor) return int; pragma Import (C, pthread_mutex_unlock, pthread_mutex_unlock_LINKNAME); procedure Unlock (M : Mutex_Descriptor) is begin Check_NZ (pthread_mutex_unlock (M)); end Unlock; end POSIX.Mutexes; libflorist-2025.1.0/libsrc/threads/posix-mutexes.ads000066400000000000000000000135451473553204100223610ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M U T E X E S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C; package POSIX.Mutexes is -- ========== -- -- WARNINGS -- -- ========== -- -- This package is for mixed-language programming, in which -- an Ada task needs to synchronize with a C thread. -- Do NOT use POSIX mutexes to synchronize between Ada tasks. -- Instead, use Ada protected objects. -- Protected objects are implemented using mutexes. -- The difference is that they are safer. -- In particular protected operations are abort-deferred, -- and have cleanup code to ensure mutexes are always released, -- even if a protected operation completes abnormally due to an exception. -- If you use one of these "raw" mutexes, you risk undefined -- behavior if you violate any of the POSIX.1c rules about mutexes, -- or if you attempt to abort (including ATC) a task that is performing -- a mutex or CV operation. type Mutex is limited private; type Mutex_Descriptor is private; type Attributes is private; procedure Initialize (Attr : in out Attributes); procedure Finalize (Attr : in out Attributes); function Get_Process_Shared (Attr : Attributes) return Boolean; procedure Set_Process_Shared (Attr : in out Attributes; Is_Shared : Boolean := False); subtype Ceiling_Priority is Integer; type Locking_Policy is range 0 .. 2; No_Priority_Inheritance : constant Locking_Policy := 0; Highest_Blocked_Task : constant Locking_Policy := 1; Highest_Ceiling_Priority : constant Locking_Policy := 2; procedure Set_Locking_Policy (Attr : in out Attributes; Locking : Locking_Policy); function Get_Locking_Policy (Attr : Attributes) return Locking_Policy; procedure Set_Ceiling_Priority (Attr : in out Attributes; New_Ceiling : Ceiling_Priority); function Get_Ceiling_Priority (Attr : Attributes) return Ceiling_Priority; procedure Initialize (M : in out Mutex; Attr : Attributes); procedure Initialize (M : in out Mutex); function Descriptor_Of (M : Mutex) return Mutex_Descriptor; procedure Finalize (M : in out Mutex); procedure Set_Ceiling_Priority (M : Mutex_Descriptor; New_Ceiling : Ceiling_Priority; Old_Ceiling : out Ceiling_Priority); function Get_Ceiling_Priority (M : Mutex_Descriptor) return Ceiling_Priority; procedure Lock (M : Mutex_Descriptor); function Try_Lock (M : Mutex_Descriptor) return Boolean; procedure Unlock (M : Mutex_Descriptor); private type Dummy is tagged null record; type Attributes is record Attr : aliased POSIX.C.pthread_mutexattr_t; -- to force by-reference parameter mode: D : Dummy; end record; type Mutex is record Mutex : aliased POSIX.C.pthread_mutex_t; -- to force by-reference parameter mode: D : Dummy; end record; -- The "access constant" is sometimes a lie, but it allows -- us to emulate the POSIX C-language interface without violating -- Ada rules about pointers to variables vs. pointers to constants. type Mutex_Descriptor is access constant POSIX.C.pthread_mutex_t; pragma Convention (C, Mutex_Descriptor); end POSIX.Mutexes; libflorist-2025.1.0/libsrc/threads/posix-process_primitives.adb000066400000000000000000000735131473553204100246000ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ P R I M I T I V E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2022, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, Ada.Unchecked_Deallocation, POSIX.Implementation, POSIX.Unsafe_Process_Primitives; package body POSIX.Process_Primitives is use POSIX.C, POSIX.Implementation, POSIX.Process_Identification, POSIX.Process_Environment; C_File_Mode : constant array (POSIX.IO.File_Mode) of Bits := (POSIX.IO.Read_Only => O_RDONLY, POSIX.IO.Write_Only => O_WRONLY, POSIX.IO.Read_Write => O_RDWR); ----------------------------- -- Unchecked Conversions -- ----------------------------- function To_int is new Ada.Unchecked_Conversion (Bits, int); function To_String_List_Ptr is new Ada.Unchecked_Conversion (POSIX_String_List, String_List_Ptr); function To_String_List_Ptr is new Ada.Unchecked_Conversion (POSIX.Process_Environment.Environment, String_List_Ptr); function To_Process_ID is new Ada.Unchecked_Conversion (pid_t, Process_ID); function To_pid_t is new Ada.Unchecked_Conversion (Process_Group_ID, pid_t); function To_pid_t is new Ada.Unchecked_Conversion (Process_ID, pid_t); procedure Free is new Ada.Unchecked_Deallocation (FD_Set_Element, FD_Set_Ptr); ------------------------- -- Local Subprograms -- ------------------------- function Make_Path_Name (Directory : POSIX_String; File : POSIX_String) return POSIX_String; pragma Inline (Make_Path_Name); -- Concatenate a directory name and a file name. function Make_Path_Name (Directory : POSIX_String; File : POSIX_String) return POSIX_String is begin if Directory = "" then return File & NUL; end if; if Directory (Directory'Last) = '/' then return Directory & File & NUL; end if; return Directory & '/' & File & NUL; end Make_Path_Name; procedure Delete_Head (Pointer : in out FD_Set_Ptr); procedure Delete_Head (Pointer : in out FD_Set_Ptr) is Head : FD_Set_Ptr := Pointer; begin Pointer := Head.Next; Free (Head); end Delete_Head; procedure Execute_Template (Template : Process_Template); procedure Void (Ignore : int); pragma Inline (Void); procedure Void (Ignore : int) is pragma Unreferenced (Ignore); begin null; end Void; function sigemptyset (set : sigset_t_ptr) return int; pragma Import (C, sigemptyset, sigemptyset_LINKNAME); function sigaddset (set : sigset_t_ptr; sig : POSIX.Signals.Signal) return int; pragma Import (C, sigaddset, sigaddset_LINKNAME); function pthread_sigmask (how : int; set : sigset_t_ptr; oset : sigset_t_ptr) return int; pragma Import (C, pthread_sigmask, pthread_sigmask_LINKNAME); procedure Check_Fatal (Result : int); -- See comments in Execute_Template, below. procedure Check_Fatal (Result : int) is begin if Result = -1 then Exit_Process (Failed_Creation_Exit); end if; end Check_Fatal; function getuid return uid_t; pragma Import (C, getuid, getuid_LINKNAME); function setuid (uid : uid_t) return int; pragma Import (C, setuid, setuid_LINKNAME); function getgid return gid_t; pragma Import (C, getgid, getgid_LINKNAME); function setgid (gid : gid_t) return int; pragma Import (C, setgid, setgid_LINKNAME); function close (fildes : int) return int; pragma Import (C, close, close_LINKNAME); function open (path : char_ptr; oflag : int) return int; pragma Import (C, open, open_LINKNAME); function dup2 (fildes, fildes2 : int) return int; pragma Import (C, dup2, dup2_LINKNAME); procedure Execute_Template (Template : Process_Template) is FD1, FD2 : int; Cur : FD_Set_Ptr := Template.FD_Set; New_Mask, Old_Mask : aliased sigset_t; begin if not Template.Keep_Effective_IDs then -- See note below why we do not call operations from -- POSIX_Process_Identification, since they may raise -- exceptions, and we worry about our ability to handle -- them. Check_Fatal (setuid (getuid)); Check_Fatal (setgid (getgid)); end if; -- We cannot use signal masking operations from -- POSIX.Signals, since they are implemented as -- virtual operations, relative to the Ada task's -- view of the signal interface. We normally keep -- most signals masked in all tasks except the designated -- signal handler threads, so that we can safely use -- sigwait. During this situation, we have just forked -- and we hope|expect there are no other threads active -- in the new (child) process. Under these conditions -- (only) it should be safe to use the raw signal masking -- operations. In earlier versions, we used the almost-raw -- versions, from System.Interrupt_Management.Operations. -- These had the advantage that the Ada RTS has already -- taken care of mapping to any nonstandard functions, -- such as the Solaris 2.x thr_sigmask, versus the -- POSIX.1c pthread_sigmask. However, more recent versions -- of Unix operating systems do support the standard, -- and in posi-signals.gpb we have already used some of -- the raw C interfaces. In the current version, we have -- gone over to completely avoiding calls to the Ada tasking -- runtime system. -- If an exception is raised during this time, the tasking -- runtime system's data structures may "lie" about there -- being other tasks active. This could prevent -- orderly shutdown of the process. Hence, we use -- Check_Fatal instead of the usual Check, and generally -- try to avoid calling anything that could raise an -- exception. -- .... ???? -- The code below may not be robust against exceptions -- that occur between fork and exec calls. There may be -- a possibility of deadlock, if the fork occurred while some -- other task is holding an RTS-internal lock that we need to -- process exceptions. -- The present approach is to avoid exceptions, by calling the -- "raw" C interfaces below, and to replace the soft-links that are -- used to set up exception-handling frames to use the nontasking -- versions, since we may not be able to avoid those routines being -- called. The soft links are switched inside the version of Fork -- that we import from POSIX.Unsafe_Process_Primitives. while Cur /= null loop case Cur.Action is when Close => Check_Fatal (close (int (Cur.FD))); when Open => FD1 := open (Cur.File_Name (Cur.File_Name'First)'Unchecked_Access, To_int (Option_Set (Cur.File_Options).Option or C_File_Mode (Cur.File_Mode))); if FD1 = -1 then Exit_Process (Failed_Creation_Exit); end if; -- FD2 := dup2 (FD1, int (Cur.FD)); should be enough for the -- following if/else statement. However, we have a mulfunction -- under Linux when the two arguments are the same. The following -- code is a workaround. if FD1 /= int (Cur.FD) then FD2 := dup2 (FD1, int (Cur.FD)); else FD2 := FD1; end if; if FD2 = -1 then Exit_Process (Failed_Creation_Exit); end if; when Duplicate => FD2 := dup2 (int (Cur.Dup_From), int (Cur.FD)); if FD2 = -1 then Exit_Process (Failed_Creation_Exit); end if; end case; Cur := Cur.Next; end loop; Void (sigemptyset (New_Mask'Unchecked_Access)); for Sig in 1 .. POSIX.Signals.Signal'Last loop if POSIX.Signals.Is_Member (Template.Sig_Set, Sig) then Void (sigaddset (New_Mask'Unchecked_Access, Sig)); end if; end loop; Void (pthread_sigmask (SIG_SETMASK, New_Mask'Unchecked_Access, Old_Mask'Unchecked_Access)); -- ???? is pthread_sigmask OK after a fork? -- sigprocmask is not safe in a multithreaded process, but after -- the fork() call we are effectively in a single-threaded process, -- so it might be better to use sigprocmask? -- Void (sigprocmask (SIG_SETMASK, New_Mask'Unchecked_Access, null)); exception when others => Exit_Process (Failed_Creation_Exit); -- Since this may not work, we have tried to avoid raising -- any exceptions. However, in case we have missed something -- and an exception is raised, we leave the handler here, -- on the off-chance it might work. end Execute_Template; procedure Validate (Template : Process_Template); procedure Validate (Template : Process_Template) is begin if Template.Is_Closed then Raise_POSIX_Error (Invalid_Argument); end if; end Validate; --------------------- -- Open_Template -- --------------------- procedure Open_Template (Template : in out Process_Template) is begin Template.Is_Closed := False; Template.Keep_Effective_IDs := False; Template.Masked_Sig := No_Signals; Template.FD_Set := null; end Open_Template; ---------------------- -- Close_Template -- ---------------------- procedure Close_Template (Template : in out Process_Template) is begin Validate (Template); while Template.FD_Set /= null loop Delete_Head (Template.FD_Set); end loop; Template.Is_Closed := True; end Close_Template; ------------------------------ -- Set_Keep_Effective_IDs -- ------------------------------ procedure Set_Keep_Effective_IDs (Template : in out Process_Template) is begin Validate (Template); Template.Keep_Effective_IDs := True; end Set_Keep_Effective_IDs; ----------------------- -- Set_Signal_Mask -- ----------------------- procedure Set_Signal_Mask (Template : in out Process_Template; Mask : POSIX.Signals.Signal_Set) is begin Validate (Template); Template.Sig_Set := Mask; end Set_Signal_Mask; ----------------------------------- -- Set_Creation_Signal_Masking -- ----------------------------------- procedure Set_Creation_Signal_Masking (Template : in out Process_Template; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is begin Validate (Template); Template.Masked_Sig := Masked_Signals; end Set_Creation_Signal_Masking; -------------------------------- -- Set_File_Action_To_Close -- -------------------------------- procedure Set_File_Action_To_Close (Template : in out Process_Template; File : POSIX.IO.File_Descriptor) is Tmp : FD_Set_Ptr := Template.FD_Set; begin Validate (Template); if Tmp = null then Template.FD_Set := new FD_Set_Element (Close, 1); Tmp := Template.FD_Set; else while Tmp.Next /= null loop Tmp := Tmp.Next; end loop; Tmp.Next := new FD_Set_Element (Close, 1); Tmp := Tmp.Next; end if; Tmp.FD := File; Tmp.Next := null; Tmp.Action := Close; end Set_File_Action_To_Close; ------------------------------- -- Set_File_Action_To_Open -- ------------------------------- procedure Set_File_Action_To_Open (Template : in out Process_Template; File : POSIX.IO.File_Descriptor; Name : POSIX.Pathname; Mode : POSIX.IO.File_Mode := POSIX.IO.Read_Only; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set) is Name_With_NUL : constant POSIX_String := Name & NUL; Tmp : FD_Set_Ptr := Template.FD_Set; begin Validate (Template); if Tmp = null then Template.FD_Set := new FD_Set_Element (Open, Name_With_NUL'Length); Tmp := Template.FD_Set; else while Tmp.Next /= null loop Tmp := Tmp.Next; end loop; Tmp.Next := new FD_Set_Element (Open, Name_With_NUL'Length); Tmp := Tmp.Next; end if; Tmp.FD := File; Tmp.Next := null; Tmp.Action := Open; Tmp.File_Name := Name_With_NUL; Tmp.File_Mode := Mode; Tmp.File_Options := Options; end Set_File_Action_To_Open; ------------------------------------ -- Set_File_Action_To_Duplicate -- ------------------------------------ procedure Set_File_Action_To_Duplicate (Template : in out Process_Template; File : POSIX.IO.File_Descriptor; From_File : POSIX.IO.File_Descriptor) is Tmp : FD_Set_Ptr := Template.FD_Set; begin Validate (Template); if Tmp = null then Template.FD_Set := new FD_Set_Element (Duplicate, 1); Tmp := Template.FD_Set; else while Tmp.Next /= null loop Tmp := Tmp.Next; end loop; Tmp.Next := new FD_Set_Element (Duplicate, 1); Tmp := Tmp.Next; end if; Tmp.FD := File; Tmp.Next := null; Tmp.Action := Duplicate; Tmp.Dup_From := From_File; end Set_File_Action_To_Duplicate; --------------------- -- Start_Process -- --------------------- function execv (path : char_ptr; argv : char_ptr_ptr) return int; pragma Import (C, execv, execv_LINKNAME); function execve (path : char_ptr; argv : char_ptr_ptr; envp : char_ptr_ptr) return int; pragma Import (C, execve, execve_LINKNAME); function execvp (file : char_ptr; argv : char_ptr_ptr) return int; pragma Import (C, execvp, execvp_LINKNAME); function UFork return POSIX.Process_Identification.Process_ID renames POSIX.Unsafe_Process_Primitives.Fork; procedure Start_Process (Child : out Process_Identification.Process_ID; Pathname : POSIX.Pathname; Template : Process_Template; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null) is pid : pid_t; Result : int; pragma Unreferenced (Result); Pathname_With_NUL : POSIX_String := Pathname & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); Default_Arg : POSIX_String_List; Old_Mask : aliased Signal_Mask; begin -- Construct a default argument list with the executable name (argv[0]) if Arg_List = null or else Length (Arg_List) = 0 then Append (Default_Arg, Pathname_With_NUL); Arg := To_String_List_Ptr (Default_Arg); end if; Validate (Template); -- .... Consider trying to "quiesce" the tasking system -- before doing the fork. It is probably not feasible. Mask_Signals (Template.Masked_Sig, Old_Mask'Unchecked_Access); pid := To_pid_t (UFork); Check (int (pid)); if pid = 0 then -- child process Execute_Template (Template); Result := execv (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Unchecked_Access); if On_Child_Failure /= null then On_Child_Failure.all; end if; Exit_Process (Failed_Creation_Exit); else Child := To_Process_ID (pid); Make_Empty (Default_Arg); Restore_Signals (Template.Masked_Sig, Old_Mask'Unchecked_Access); end if; end Start_Process; procedure Start_Process (Child : out Process_Identification.Process_ID; Pathname : POSIX.Pathname; Template : Process_Template; Env_List : Process_Environment.Environment; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null) is pid : pid_t; Result : int; pragma Unreferenced (Result); Pathname_With_NUL : POSIX_String := Pathname & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); Env : String_List_Ptr := To_String_List_Ptr (Env_List); begin if Arg = null then Arg := Null_String_List_Ptr; end if; if Env = null then Env := Null_String_List_Ptr; end if; Validate (Template); pid := To_pid_t (UFork); Check (int (pid)); if pid = 0 then -- child process Execute_Template (Template); Result := execve (Pathname_With_NUL (Pathname_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Access, Env.Char (1)'Access); if On_Child_Failure /= null then On_Child_Failure.all; end if; Exit_Process (Failed_Creation_Exit); else Child := To_Process_ID (pid); end if; end Start_Process; ---------------------------- -- Start_Process_Search -- ---------------------------- procedure Start_Process_Search (Child : out Process_Identification.Process_ID; Filename : POSIX.Filename; Template : Process_Template; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null) is pid : pid_t; Result : int; pragma Unreferenced (Result); Filename_With_NUL : POSIX_String := Filename & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); begin if Arg = null then Arg := Null_String_List_Ptr; end if; Validate (Template); pid := To_pid_t (UFork); Check (int (pid)); if pid = 0 then -- child process Execute_Template (Template); Result := execvp (Filename_With_NUL (Filename_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Access); if On_Child_Failure /= null then On_Child_Failure.all; end if; Exit_Process (Failed_Creation_Exit); else Child := To_Process_ID (pid); end if; end Start_Process_Search; ---------------------------- -- Start_Process_Search -- ---------------------------- procedure Start_Process_Search (Child : out Process_Identification.Process_ID; Filename : POSIX.Filename; Template : Process_Template; Env_List : Process_Environment.Environment; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null) is pid : pid_t; Filename_With_NUL : POSIX_String := Filename & NUL; Arg : String_List_Ptr := To_String_List_Ptr (Arg_List); Env : String_List_Ptr := To_String_List_Ptr (Env_List); Result : int; pragma Unreferenced (Result); begin if Arg = null then Arg := Null_String_List_Ptr; end if; if Env = null then Env := Null_String_List_Ptr; end if; Validate (Template); pid := To_pid_t (UFork); Check (int (pid)); if pid = 0 then -- child process Execute_Template (Template); -- See comments in POSIX.Unsafe_Process_Primitives.Exec_Search. -- We duplicate the code here, since we don't want to raise -- any exceptions in the child process. for I in Filename'Range loop if Filename (I) = '/' then Result := execve (Filename_With_NUL (Filename_With_NUL'First)'Unchecked_Access, Arg.Char (1)'Access, Env.Char (1)'Access); if On_Child_Failure /= null then On_Child_Failure.all; end if; Exit_Process (Failed_Creation_Exit); end if; end loop; -- filename does not contain "/" declare Path : constant POSIX_String := POSIX.Process_Environment.Environment_Value_Of ("PATH", "/bin:/usr/bin"); Start : Positive; P : Positive; begin P := Path'First; loop Start := P; while P <= Path'Last and then Path (P) /= ':' loop P := P + 1; end loop; declare Pathname : POSIX_String := Make_Path_Name (Path (Start .. P - 1), Filename); begin Result := execve (Pathname (Pathname'First)'Unchecked_Access, Arg.Char (1)'Access, Env.Char (1)'Access); if Fetch_Errno /= ENOENT then if On_Child_Failure /= null then On_Child_Failure.all; end if; Exit_Process (Failed_Creation_Exit); end if; end; exit when P > Path'Last; P := P + 1; -- skip colon end loop; end; if On_Child_Failure /= null then On_Child_Failure.all; end if; Exit_Process (Failed_Creation_Exit); else Child := To_Process_ID (pid); end if; end Start_Process_Search; -------------------- -- Exit_Process -- -------------------- procedure sys_exit (status : int); pragma Import (C, sys_exit, "_exit"); procedure Exit_Process (Status : Exit_Status := Normal_Exit) is begin sys_exit (int (Status)); end Exit_Process; ------------------------ -- Status_Available -- ------------------------ function Status_Available (Status : Termination_Status) return Boolean is begin return Status.pid /= 0 and Status.pid /= -1; end Status_Available; --------------------- -- Process_ID_Of -- --------------------- function Process_ID_Of (Status : Termination_Status) return POSIX.Process_Identification.Process_ID is begin if not Status_Available (Status) then Raise_POSIX_Error (Invalid_Argument); end if; return To_Process_ID (Status.pid); end Process_ID_Of; ---------------------- -- Exit_Status_Of -- ---------------------- function wifexited (stat_val : int) return int; pragma Import (C, wifexited, "wifexited"); function wexitstatus (stat_val : int) return int; pragma Import (C, wexitstatus, "wexitstatus"); function Exit_Status_Of (Status : Termination_Status) return Exit_Status is begin if not Status_Available (Status) or else wifexited (Status.stat_val) = 0 then Raise_POSIX_Error (Invalid_Argument); end if; return Exit_Status (wexitstatus (Status.stat_val)); end Exit_Status_Of; ----------------------------- -- Termination_Signal_Of -- ----------------------------- function wifsignaled (stat_val : int) return int; pragma Import (C, wifsignaled, "wifsignaled"); function wtermsig (stat_val : int) return int; pragma Import (C, wtermsig, "wtermsig"); function Termination_Signal_Of (Status : Termination_Status) return POSIX.Signals.Signal is begin if not Status_Available (Status) or else wifsignaled (Status.stat_val) = 0 then Raise_POSIX_Error (Invalid_Argument); end if; return POSIX.Signals.Signal (wtermsig (Status.stat_val)); end Termination_Signal_Of; -------------------------- -- Stopping_Signal_Of -- -------------------------- function wifstopped (stat_val : int) return int; pragma Import (C, wifstopped, "wifstopped"); function wstopsig (stat_val : int) return int; pragma Import (C, wstopsig, "wstopsig"); function Stopping_Signal_Of (Status : Termination_Status) return POSIX.Signals.Signal is begin if not Status_Available (Status) or else wifstopped (Status.stat_val) = 0 then Raise_POSIX_Error (Invalid_Argument); end if; return POSIX.Signals.Signal (wstopsig (Status.stat_val)); end Stopping_Signal_Of; ---------------------------- -- Termination_Cause_Of -- ---------------------------- function Termination_Cause_Of (Status : Termination_Status) return Termination_Cause is begin if not Status_Available (Status) then Raise_POSIX_Error (Invalid_Argument); end if; if wifexited (Status.stat_val) /= 0 then return Exited; end if; if wifsignaled (Status.stat_val) /= 0 then return Terminated_By_Signal; end if; if wifstopped (Status.stat_val) /= 0 then return Stopped_By_Signal; end if; -- should never get here, unles system is broken -- .... so we punt Raise_POSIX_Error (ENOSYS); return Stopped_By_Signal; -- to suppress compiler warning; end Termination_Cause_Of; ------------------------------ -- Wait_For_Child_Process -- ------------------------------ function waitpid (pid : pid_t; stat_loc : access int; options : int) return pid_t; pragma Import (C, waitpid, waitpid_LINKNAME); procedure Wait_For_Child_Process (Status : out Termination_Status; Child : POSIX.Process_Identification.Process_ID; Block : Boolean := True; Trace_Stopped : Boolean := True; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is pragma Unreferenced (Masked_Signals); Options : Bits := 0; begin if Trace_Stopped then Options := Options or WUNTRACED; end if; if not Block then Options := Options or WNOHANG; end if; Defer_Abortion; -- .... Change P1003.5? -- We ignore the signal masking parameter, since we keep -- most signals masked all the time except in the special -- handler threads. Thus, effectively, this operation -- cannot be interrupted, except by somebody asynchronously -- sending the thread or process one of the signals that -- are: mapped to exceptions (e.g. SIGSEGV); used by the -- threads library (which we dare not mask); or used for -- Ada abortion (e.g. SIGABRT). We think it is unsafe to -- mask these, and so intentionally do not implement the -- exact POSIX.5 semantics here. Status.pid := waitpid (To_pid_t (Child), Status.stat_val'Unchecked_Access, To_int (Options)); Undefer_Abortion; Check (int (Status.pid)); end Wait_For_Child_Process; ------------------------------ -- Wait_For_Child_Process -- ------------------------------ procedure Wait_For_Child_Process (Status : out Termination_Status; Group : POSIX.Process_Identification.Process_Group_ID; Block : Boolean := True; Trace_Stopped : Boolean := True; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is begin Wait_For_Child_Process (Status, To_Process_ID (-To_pid_t (Group)), Block, Trace_Stopped, Masked_Signals); end Wait_For_Child_Process; ------------------------------ -- Wait_For_Child_Process -- ------------------------------ procedure Wait_For_Child_Process (Status : out Termination_Status; Block : Boolean := True; Trace_Stopped : Boolean := True; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals) is begin Wait_For_Child_Process (Status, To_Process_ID (-1), Block, Trace_Stopped, Masked_Signals); end Wait_For_Child_Process; end POSIX.Process_Primitives; libflorist-2025.1.0/libsrc/threads/posix-process_primitives.ads000066400000000000000000000227651473553204100246240ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . P R O C E S S _ P R I M I T I V E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2022, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.IO, POSIX.Process_Environment, POSIX.Process_Identification, POSIX.Signals; package POSIX.Process_Primitives is -- Process Template type Process_Template is limited private; type Procedure_Access is access procedure; procedure Open_Template (Template : in out Process_Template); procedure Close_Template (Template : in out Process_Template); procedure Set_Keep_Effective_IDs (Template : in out Process_Template); procedure Set_Signal_Mask (Template : in out Process_Template; Mask : POSIX.Signals.Signal_Set); procedure Set_Creation_Signal_Masking (Template : in out Process_Template; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Set_File_Action_To_Close (Template : in out Process_Template; File : POSIX.IO.File_Descriptor); procedure Set_File_Action_To_Open (Template : in out Process_Template; File : POSIX.IO.File_Descriptor; Name : POSIX.Pathname; Mode : POSIX.IO.File_Mode := POSIX.IO.Read_Only; Options : POSIX.IO.Open_Option_Set := POSIX.IO.Empty_Set); procedure Set_File_Action_To_Duplicate (Template : in out Process_Template; File : POSIX.IO.File_Descriptor; From_File : POSIX.IO.File_Descriptor); -- Process Creation procedure Start_Process (Child : out Process_Identification.Process_ID; Pathname : POSIX.Pathname; Template : Process_Template; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null); -- On_Child_Failure, if not null, is an access to a procedure which is -- called when an error is detected inside the child during the child -- process's creation (e.g. a failure to "exec"). This function can then be -- used to report the error. One simple way to report this error is just -- printing a debug trace, usually with the associated errno information. A -- more sophisticated approach, if we wanted that information to be routed -- back to the parent process, would be to create a socket, and then have -- this callback report that information back to the parent via that -- socket. procedure Start_Process (Child : out Process_Identification.Process_ID; Pathname : POSIX.Pathname; Template : Process_Template; Env_List : Process_Environment.Environment; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null); -- On_Child_Failure: Same as in Start_Process procedure above. procedure Start_Process_Search (Child : out Process_Identification.Process_ID; Filename : POSIX.Filename; Template : Process_Template; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null); -- On_Child_Failure: Same as in Start_Process procedure above. procedure Start_Process_Search (Child : out Process_Identification.Process_ID; Filename : POSIX.Filename; Template : Process_Template; Env_List : Process_Environment.Environment; Arg_List : POSIX_String_List := Empty_String_List; On_Child_Failure : Procedure_Access := null); -- On_Child_Failure: Same as in Start_Process procedure above. -- Process Exit type Exit_Status is range 0 .. 2 ** 8 - 1; Normal_Exit : constant Exit_Status := 0; Failed_Creation_Exit : constant Exit_Status := 41; Unhandled_Exception_Exit : constant Exit_Status := 42; procedure Exit_Process (Status : Exit_Status := Normal_Exit); -- Termination Status type Termination_Status is private; type Termination_Cause is (Exited, Terminated_By_Signal, Stopped_By_Signal); function Status_Available (Status : Termination_Status) return Boolean; function Process_ID_Of (Status : Termination_Status) return POSIX.Process_Identification.Process_ID; function Termination_Cause_Of (Status : Termination_Status) return Termination_Cause; function Exit_Status_Of (Status : Termination_Status) return Exit_Status; function Termination_Signal_Of (Status : Termination_Status) return POSIX.Signals.Signal; function Stopping_Signal_Of (Status : Termination_Status) return POSIX.Signals.Signal; -- Wait for Process Termination procedure Wait_For_Child_Process (Status : out Termination_Status; Child : POSIX.Process_Identification.Process_ID; Block : Boolean := True; Trace_Stopped : Boolean := True; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Wait_For_Child_Process (Status : out Termination_Status; Group : POSIX.Process_Identification.Process_Group_ID; Block : Boolean := True; Trace_Stopped : Boolean := True; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); procedure Wait_For_Child_Process (Status : out Termination_Status; Block : Boolean := True; Trace_Stopped : Boolean := True; Masked_Signals : POSIX.Signal_Masking := POSIX.RTS_Signals); private type Termination_Status is record pid : POSIX.C.pid_t := POSIX.C.pid_t (Integer'(-1)); stat_val : aliased POSIX.C.int := 0; end record; type FD_Action_Type is (Open, Close, Duplicate); type FD_Set_Element (FD_Action : FD_Action_Type; File_Name_Size : Positive); type FD_Set_Ptr is access FD_Set_Element; type FD_Set_Element (FD_Action : FD_Action_Type; File_Name_Size : Positive) is record FD : POSIX.IO.File_Descriptor; Next : FD_Set_Ptr; Action : FD_Action_Type; case FD_Action is when Close => null; when Open => File_Name : POSIX.Pathname (1 .. File_Name_Size); File_Mode : POSIX.IO.File_Mode; File_Options : POSIX.IO.Open_Option_Set; when Duplicate => Dup_From : POSIX.IO.File_Descriptor; end case; end record; type Process_Template is record Is_Closed : Boolean := True; Keep_Effective_IDs : Boolean; Sig_Set : POSIX.Signals.Signal_Set; -- Implicitly initialized to no signal by POSIX_Signals. Masked_Sig : POSIX.Signal_Masking := POSIX.RTS_Signals; FD_Set : FD_Set_Ptr; end record; end POSIX.Process_Primitives; libflorist-2025.1.0/libsrc/threads/posix-signals.adb000066400000000000000000001155101473553204100223010ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S I G N A L S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2017, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- Please take care in future maintenance updates to avoid adding -- direct system calls that modify the signal action or signal -- masking, and to coordinate changes with the GNAT runtime. -- The implementation of this package is closely dependent on the -- GNAT packages System.Interrupts, and -- System.Interrupt_Management. See comments in those packages -- for related explanation of the design for signal handling. -- Unfortunately, this means maintenance changes to Florist and -- GNAT need to be synchronized. A person with an older version of -- GNAT will have problems using the current version of Florist. -- The present design is a compromise. If it were not for the -- backward compatibility issue, all of the necessary POSIX -- signal management support would be implemented directly in -- the package System.Interrupts. (That was the original design.) -- We have tried to avoid changing the GNARL runtime system package -- interfaces, in order that it would be possible to compile Florist -- using earlier versions of GNAT. This has meant in some cases -- putting the implementation of new functionality (e.g., the -- POSIX.5b Interrupt_Task and the POSIX.5c Install_Empty_Handler) -- directly into the body of POSIX.Signals. As a result, the -- functionality is now divided between the two packages, in a -- way that may not make much sense to a new reader. -- With luck, it should be possible to compile this version of Florist -- with earlier versions of GNAT. There will a variable degree of -- effect on the functioning of the signal management interfaces. -- Since there were significant defects in this part of earlier releases -- of Florist (detected by the POSIX.5b validation tests), we hope -- no earlier Florist users are dependent on the way these operations -- "worked" before. We had to make the changes. -- Ideally, there should be no operations in here that directly modify the -- signal state of the process or thread. For safety, all such operations -- should be implemented by calls to operations in System.Interrupts. -- Otherwise, we could break invariants upon which the Ada tasking -- runtime system depends. However, to allow this version of Florist -- to be used with earlier versions of GNAT, there are some places where -- direct system calls are done. People doing maintenance should beware -- of adding other direct calls without careful analysis of how they -- might interact with what the GNAT runtime system is doing. with Ada.Unchecked_Conversion, POSIX.Implementation, System.Tasking, System.Interrupts, System.Task_Primitives.Operations; package body POSIX.Signals is use POSIX.C, POSIX.Implementation, System, System.Storage_Elements; package SI renames System.Interrupts; subtype SIID is SI.Interrupt_ID; package Bogus_Signal_Enum is package PS renames POSIX.Signals; type Signal_Name_Enum is (Signal_Null, SIGNULL, Signal_Abort, SIGABRT, Signal_Alarm, SIGALRM, Signal_Bus_Error, SIGBUS, Signal_Floating_Point_Error, SIGFPE, Signal_Hangup, SIGHUP, Signal_Illegal_Instruction, SIGILL, Signal_Interrupt, SIGINT, Signal_Kill, SIGKILL, Signal_Pipe_Write, SIGPIPE, Signal_Quit, SIGQUIT, Signal_Segmentation_Violation, SIGSEGV, Signal_Terminate, SIGTERM, Signal_User_1, SIGUSR1, Signal_User_2, SIGUSR2, Signal_Child, SIGCHLD, Signal_Continue, SIGCONT, Signal_Stop, SIGSTOP, Signal_Terminal_Stop, SIGTSTP, Signal_Terminal_Input, SIGTTIN, Signal_Terminal_Output, SIGTTOU, Signal_IO, SIGIO, Signal_Out_Of_Band_Data, SIGURG); Enum_To_Signal : array (Signal_Name_Enum'Range) of Signal := (Signal_Null => 0, SIGNULL => 0, Signal_Abort => PS.SIGABRT, SIGABRT => PS.SIGABRT, Signal_Alarm => PS.SIGALRM, SIGALRM => PS.SIGALRM, Signal_Bus_Error => PS.SIGBUS, SIGBUS => PS.SIGBUS, Signal_Floating_Point_Error => PS.SIGFPE, SIGFPE => PS.SIGFPE, Signal_Hangup => PS.SIGHUP, SIGHUP => PS.SIGHUP, Signal_Illegal_Instruction => PS.SIGILL, SIGILL => PS.SIGILL, Signal_Interrupt => PS.SIGINT, SIGINT => PS.SIGINT, Signal_Kill => PS.SIGKILL, SIGKILL => PS.SIGKILL, Signal_Pipe_Write => PS.SIGPIPE, SIGPIPE => PS.SIGPIPE, Signal_Quit => PS.SIGQUIT, SIGQUIT => PS.SIGQUIT, Signal_Segmentation_Violation => PS.SIGSEGV, SIGSEGV => PS.SIGSEGV, Signal_Terminate => PS.SIGTERM, SIGTERM => PS.SIGTERM, Signal_User_1 => PS.SIGUSR1, SIGUSR1 => PS.SIGUSR1, Signal_User_2 => PS.SIGUSR2, SIGUSR2 => PS.SIGUSR2, Signal_Child => PS.SIGCHLD, SIGCHLD => PS.SIGCHLD, Signal_Continue => PS.SIGCONT, SIGCONT => PS.SIGCONT, Signal_Stop => PS.SIGSTOP, SIGSTOP => PS.SIGSTOP, Signal_Terminal_Stop => PS.SIGTSTP, SIGTSTP => PS.SIGTSTP, Signal_Terminal_Input => PS.SIGTTIN, SIGTTIN => PS.SIGTTIN, Signal_Terminal_Output => PS.SIGTTOU, SIGTTOU => PS.SIGTTOU, Signal_IO => PS.SIGIO, SIGIO => PS.SIGIO, Signal_Out_Of_Band_Data => PS.SIGURG, SIGURG => PS.SIGURG); Signal_To_Enum : array (Signal'Range) of Signal_Name_Enum := (0 => Signal_Null, PS.SIGABRT => Signal_Abort, PS.SIGALRM => Signal_Alarm, PS.SIGBUS => Signal_Bus_Error, PS.SIGFPE => Signal_Floating_Point_Error, PS.SIGHUP => Signal_Hangup, PS.SIGILL => Signal_Illegal_Instruction, PS.SIGINT => Signal_Interrupt, PS.SIGKILL => Signal_Kill, PS.SIGPIPE => Signal_Pipe_Write, PS.SIGQUIT => Signal_Quit, PS.SIGSEGV => Signal_Segmentation_Violation, PS.SIGTERM => Signal_Terminate, PS.SIGUSR1 => Signal_User_1, PS.SIGUSR2 => Signal_User_2, PS.SIGCHLD => Signal_Child, PS.SIGCONT => Signal_Continue, PS.SIGSTOP => Signal_Stop, PS.SIGTSTP => Signal_Terminal_Stop, PS.SIGTTIN => Signal_Terminal_Input, PS.SIGTTOU => Signal_Terminal_Output, PS.SIGIO => Signal_IO, PS.SIGURG => Signal_Out_Of_Band_Data, others => Signal_Null); end Bogus_Signal_Enum; use Bogus_Signal_Enum; ------------------ -- Global Data -- ------------------ type Signal_Bit_Vector is array (Signal) of Boolean; -- Reserved_Signal is the union of the following sets of -- signals: -- (1) The reserved signals, as defined -- by the POSIX.5 standard. The reserved signals -- include the named required reserved signals, plus any other -- signals that are reserved by the implementation. -- (2) The signals for which the -- implementation does not allow us to set the action. -- (3) The signals for which sigwait is not safe. -- (4) The set of signals, as defined by -- the Ada runtime system, for which it is unsafe to call -- System.Interrupt_Management.Ignore_Signal. -- (5) The set of signals, as defined by -- the Ada runtime system, for which user-defined signal entries -- are not supported. -- (6) The set of signals, as defined by -- the Ada runtime system, for which it is unsafe to call -- System.Interrupt_Management.Block_Signals. -- This constant is initialized -- in the begin-end block of the package body, below, because -- it depends on values in POSIX.Implementation.OK_Signals. Reserved_Signal : Signal_Bit_Vector; -- Signal_Disposition is use by Set_Blocked_Signals, to decide who -- should mask or unmask a given signal. type Signal_Disposition is (No_Change, SI_To_Mask, SI_To_Unmask); ------------------------ -- Local Subprograms -- ------------------------ function To_pid_t is new Ada.Unchecked_Conversion (POSIX.Process_Identification.Process_ID, pid_t); function To_pid_t is new Ada.Unchecked_Conversion (POSIX.Process_Identification.Process_Group_ID, pid_t); function Convert_Ids is new Ada.Unchecked_Conversion (Ada.Task_Identification.Task_Id, System.Tasking.Task_Id); function To_Signal_Data is new Ada.Unchecked_Conversion (sigval, Signal_Data); function To_sigval is new Ada.Unchecked_Conversion (Signal_Data, sigval); function sigismember (set : sigset_t_ptr; sig : int) return int; pragma Import (C, sigismember, sigismember_LINKNAME); function sigaddset (set : access sigset_t; sig : int) return int; pragma Import (C, sigaddset, sigaddset_LINKNAME); function sigfillset (set : access sigset_t) return int; pragma Import (C, sigfillset, sigfillset_LINKNAME); function sigemptyset (set : access sigset_t) return int; pragma Import (C, sigemptyset, sigemptyset_LINKNAME); function sigdelset (set : access sigset_t; sig : int) return int; pragma Import (C, sigdelset, sigdelset_LINKNAME); function sigpending (set : sigset_t_ptr) return int; pragma Import (C, sigpending, sigpending_LINKNAME); function sigaction (sig : int; act : sigaction_ptr; oact : sigaction_ptr) return int; pragma Import (C, sigaction, sigaction_LINKNAME); function pthread_sigmask (how : int; set : sigset_t_ptr; oset : sigset_t_ptr) return int; pragma Import (C, pthread_sigmask, pthread_sigmask_LINKNAME); function sigwait (set : sigset_t_ptr; sig : int_ptr) return int; pragma Import (C, sigwait, sigwait_LINKNAME); function sigwaitinfo (set : sigset_t_ptr; info : siginfo_t_ptr) return int; pragma Import (C, sigwaitinfo, sigwaitinfo_LINKNAME); function sigtimedwait (set : sigset_t_ptr; info : siginfo_t_ptr; timeout : timespec_ptr) return int; pragma Import (C, sigtimedwait, sigtimedwait_LINKNAME); procedure Check_Awaitable (Set : Signal_Set); pragma Inline (Check_Awaitable); procedure Null_Handler; pragma Convention (C, Null_Handler); procedure Void (Ignore : int); pragma Inline (Void); -- The Await_Signal operations report Invalid_Argument for -- the reserved signals and for signals that are attached to -- a task entry. By extension, we treat signals that are -- attached to protected procedures as if they were attached -- to a task entry. procedure Check_Awaitable (Set : Signal_Set) is begin for Sig in Signal loop if Reserved_Signal (Sig) then if Sig /= SIGKILL and then Sig /= SIGSTOP and then sigismember (Set.C'Unchecked_Access, int (Sig)) = 1 then Raise_POSIX_Error (Invalid_Argument); end if; else -- This signal might be attached to a -- task entry or protected procedure if sigismember (Set.C'Unchecked_Access, int (Sig)) = 1 and then (SI.Is_Entry_Attached (SIID (Sig)) or else SI.Is_Handler_Attached (SIID (Sig))) then Raise_POSIX_Error (Invalid_Argument); end if; end if; end loop; end Check_Awaitable; procedure Null_Handler is begin null; end Null_Handler; procedure Void (Ignore : int) is pragma Warnings (Off, Ignore); begin null; end Void; ---------------------------------------- -- Signal_Set Initialize and Finalize -- ---------------------------------------- procedure Initialize (Set : in out Signal_Set) is begin Void (sigemptyset (Set.C'Unchecked_Access)); end Initialize; procedure Finalize (Set : in out Signal_Set) is begin Void (sigemptyset (Set.C'Unchecked_Access)); end Finalize; ----------- -- Image -- ----------- function Image (Sig : Signal) return String is Tmp : constant Signal_Name_Enum := Signal_To_Enum (Sig); begin if Tmp = Bogus_Signal_Enum.Signal_Null and then Sig /= 0 then declare Img : constant String := Signal'Image (Sig); begin return "SIGNAL_" & Img (Img'First + 1 .. Img'Last); end; else return Signal_Name_Enum'Image (Tmp); end if; end Image; ----------- -- Value -- ----------- function Value (Str : String) return Signal is A : constant Positive := Str'First; begin if Str'Length > 7 and then Str (A .. A + 6) = "SIGNAL_" and then Str (A + 7) in '0' .. '9' then return Signal'Value (Str (A + 7 .. Str'Last)); else return Enum_To_Signal (Signal_Name_Enum'Value (Str)); end if; end Value; ---------------- -- Add_Signal -- ---------------- procedure Add_Signal (Set : in out Signal_Set; Sig : Signal) is begin if Sig /= Signal_Null then Void (sigaddset (Set.C'Unchecked_Access, int (Sig))); end if; -- Signal_Null (i.e., zero) is implicitly a member of every set. end Add_Signal; -------------------- -- Add_All_Signal -- -------------------- procedure Add_All_Signals (Set : in out Signal_Set) is begin Void (sigfillset (Set.C'Unchecked_Access)); end Add_All_Signals; ------------------- -- Delete_Signal -- ------------------- procedure Delete_Signal (Set : in out Signal_Set; Sig : Signal) is begin if Sig /= Signal_Null then Void (sigdelset (Set.C'Unchecked_Access, int (Sig))); end if; end Delete_Signal; ------------------------ -- Delete_All_Signals -- ------------------------ procedure Delete_All_Signals (Set : in out Signal_Set) is begin if sigemptyset (Set.C'Unchecked_Access) = 0 then null; end if; end Delete_All_Signals; --------------- -- Is_Member -- --------------- function Is_Member (Set : Signal_Set; Sig : Signal) return Boolean is begin if Sig = Signal_Null or else sigismember (Set.C'Unchecked_Access, int (Sig)) = 1 then return True; end if; return False; end Is_Member; ----------------------------------- -- Set_Blocked_Signals -- ----------------------------------- -- The operations that block/unblock signals do not raise an -- exception for any reserved or uncatchable signals, but -- quietly have no effect on the masking of SIGKILL, SIGSTOP, -- and the reserved signals. procedure Set_Blocked_Signals (New_Mask : Signal_Set; Old_Mask : out Signal_Set) is os_new_mask : aliased sigset_t; Prev_Mask : Signal_Set; Disposition : array (Signal) of Signal_Disposition := (others => No_Change); begin Begin_Critical_Section; Prev_Mask := Blocked_Signals; Void (pthread_sigmask (SIG_SETMASK, null, os_new_mask'Unchecked_Access)); -- Partition the signals between those that -- are managed by System.Interrupts and those that we manage -- directly here. for Sig in Signal loop if not Reserved_Signal (Sig) then -- It is OK to modify this signal's masking, using the -- interfaces of System.Interrupts. if sigismember (New_Mask.C'Unchecked_Access, int (Sig)) = 1 then if not SI.Is_Blocked (SIID (Sig)) then Disposition (Sig) := SI_To_Mask; end if; else if SI.Is_Blocked (SIID (Sig)) then Disposition (Sig) := SI_To_Unmask; end if; end if; end if; end loop; -- Update the record of which task has which signal unblocked. for Sig in Signal loop case Disposition (Sig) is when No_Change => null; when SI_To_Mask => SI.Block_Interrupt (SIID (Sig)); -- ???? Rely that no exception can be raised, due to previous -- checks? Otherwise, we need to provide a handler to end the -- critical section. when SI_To_Unmask => SI.Unblock_Interrupt (SIID (Sig)); -- ???? Rely that no exception can be raised, due to previous -- checks? Otherwise, we need to provide a handler to end the -- critical section. end case; end loop; End_Critical_Section; Old_Mask := Prev_Mask; end Set_Blocked_Signals; --------------------- -- Block_Signals -- --------------------- procedure Block_Signals (Mask_to_Add : Signal_Set; Old_Mask : out Signal_Set) is os_new_mask : aliased sigset_t; Prev_Mask : Signal_Set; Disposition : array (Signal) of Signal_Disposition := (others => No_Change); begin Begin_Critical_Section; Prev_Mask := Blocked_Signals; Void (sigemptyset (os_new_mask'Unchecked_Access)); for Sig in Signal loop if not Reserved_Signal (Sig) then -- It is OK to modify this signal's masking, using the -- interfaces of System.Interrupts. if sigismember (Mask_to_Add.C'Unchecked_Access, int (Sig)) = 1 then if not SI.Is_Blocked (SIID (Sig)) then Disposition (Sig) := SI_To_Mask; end if; else null; end if; end if; end loop; -- Update the record of which task has which signal unblocked. for Sig in Signal loop case Disposition (Sig) is when No_Change => null; when SI_To_Mask => SI.Block_Interrupt (SIID (Sig)); -- ???? Rely that no exception can be raised, due to previous -- checks? Otherwise, we need to provide a handler to end the -- critical section. when SI_To_Unmask => -- Should never get here! raise Program_Error; end case; end loop; End_Critical_Section; Old_Mask := Prev_Mask; end Block_Signals; ----------------------- -- Unblock_Signals -- ----------------------- procedure Unblock_Signals (Mask_to_Subtract : Signal_Set; Old_Mask : out Signal_Set) is os_new_mask : aliased sigset_t; Prev_Mask : Signal_Set; Disposition : array (Signal) of Signal_Disposition := (others => No_Change); begin Begin_Critical_Section; Prev_Mask := Blocked_Signals; Void (sigemptyset (os_new_mask'Unchecked_Access)); -- Partition the signals between those that -- are managed by System.Interrupts and those that we manage -- directly here. for Sig in Signal loop if not Reserved_Signal (Sig) then -- It is OK to modify this signal's masking, using the -- interfaces of System.Interrupts. if sigismember (Mask_to_Subtract.C'Unchecked_Access, int (Sig)) = 1 then if SI.Is_Blocked (SIID (Sig)) then Disposition (Sig) := SI_To_Unmask; end if; end if; end if; end loop; -- Update the record of which task has which signal unblocked. for Sig in Signal loop case Disposition (Sig) is when No_Change => null; when SI_To_Mask => raise Program_Error; -- Should never get here! when SI_To_Unmask => SI.Unblock_Interrupt (SIID (Sig)); -- ???? Rely that no exception can be raised, due to previous -- checks? Otherwise, we need to provide a handler to end the -- critical section. end case; end loop; End_Critical_Section; Old_Mask := Prev_Mask; end Unblock_Signals; ----------------------- -- Blocked_Signals -- ----------------------- function Blocked_Signals return Signal_Set is Old_Mask : Signal_Set; begin -- Get thread-level signal mask, directly from OS, since -- for a badly matched GNARL and operating system, there -- may be more values in POSIX.Signal -- than System.Interrupts.Interrupt_ID if pthread_sigmask (SIG_BLOCK, null, Old_Mask.C'Unchecked_Access) = 0 then null; end if; -- Delete any ublocked signals from System.Interrupts. for Sig in Signal loop if not Reserved_Signal (Sig) then if SI.Is_Blocked (SIID (Sig)) then null; -- Void (sigaddset (Old_Mask.C'Unchecked_Access, int (Sig))); -- Rely that we cannot have a signal that is unmasked -- in the current thread and is also logically -- blocked by the signal manager. else Void (sigdelset (Old_Mask.C'Unchecked_Access, int (Sig))); end if; end if; end loop; return Old_Mask; end Blocked_Signals; ------------------- -- Ignore_Signal -- ------------------- -- The signal ignoring/unignoring operations report -- Invalid_Operation for SIGKILL, SIGSTOP, the reserved signals, -- Signal_Null, or any other signals for which the signal action -- is not permitted to be set by an application. procedure Ignore_Signal (Sig : Signal) is begin if Reserved_Signal (Sig) then Raise_POSIX_Error (Invalid_Argument); else SI.Ignore_Interrupt (SIID (Sig)); end if; end Ignore_Signal; --------------------- -- Unignore_Signal -- --------------------- procedure Unignore_Signal (Sig : Signal) is begin if Reserved_Signal (Sig) then Raise_POSIX_Error (Invalid_Argument); else SI.Unignore_Interrupt (SIID (Sig)); end if; end Unignore_Signal; ---------------- -- Is_Ignored -- ---------------- function Is_Ignored (Sig : Signal) return Boolean is act : aliased struct_sigaction; begin if Reserved_Signal (Sig) then Raise_POSIX_Error (Invalid_Argument); return False; else Check (sigaction (int (Sig), null, act'Unchecked_Access)); return act.sa_handler = To_Address (SIG_IGN); end if; end Is_Ignored; --------------------------- -- Install_Empty_Handler -- --------------------------- -- This is a POSIX.5c addition. -- .... This functionality needs to be merged into the -- Ada runtime system (s-interr.adb) so as to ensure mutual -- exclusion between these changes to signal handler state -- and changes that are done there. -- The best solution may be to export operations for -- locking/unlocking, rather than to add new entries to the -- signal manager task. procedure Install_Empty_Handler (Sig : Signal) is act, oact : aliased struct_sigaction; Result : int; begin if Reserved_Signal (Sig) then Raise_POSIX_Error (Invalid_Argument); end if; Begin_Critical_Section; act.sa_flags := 0; act.sa_handler := Null_Handler'Address; Check (sigemptyset (act.sa_mask'Unrestricted_Access)); Result := sigaction (int (Sig), act'Unchecked_Access, oact'Unchecked_Access); End_Critical_Section; Check (Result); end Install_Empty_Handler; ------------------------------ -- Set_Stopped_Child_Signal -- ------------------------------ -- .... This functionality needs to be merged into the -- Ada runtime system (s-interr.adb) so as to ensure mutual -- exclusion between these changes to signal handler state -- and changes that are done there. -- The best solution may be to export operations for -- locking/unlocking, rather than to add new entries to the -- signal manager task. procedure Set_Stopped_Child_Signal (Enable : Boolean := True) is Action, Oact : aliased struct_sigaction; Result : int; begin Begin_Critical_Section; -- ... Need to coordinate with System.Interrupts -- to enforce mutual exclusion on signal state changes Result := sigaction (POSIX.C.SIGCHLD, null, Oact'Unchecked_Access); if Result /= -1 then Action := Oact; -- .... need to check that this feature is really supported -- and raise POSIX_Error, if it is not, else we will have some -- strange effects from the default values of these constants!! -- In general, should look at various systems to see which features -- are not supported, and make sure we are fail-safe if those -- features are missing. if Enable then Action.sa_flags := int (Bits (Action.sa_flags) and not SA_NOCLDSTOP); else Action.sa_flags := int (Bits (Action.sa_flags) or SA_NOCLDSTOP); end if; Result := sigaction (POSIX.C.SIGCHLD, Action'Unchecked_Access, Oact'Unchecked_Access); end if; End_Critical_Section; Check (Result); end Set_Stopped_Child_Signal; ---------------------------------- -- Stopped_Child_Signal_Enabled -- ---------------------------------- function Stopped_Child_Signal_Enabled return Boolean is Action : aliased struct_sigaction; Result : int; begin Begin_Critical_Section; Result := sigaction (POSIX.C.SIGCHLD, null, Action'Unchecked_Access); End_Critical_Section; Check (Result); return ((Bits (Action.sa_flags) and SA_NOCLDSTOP) = 0); end Stopped_Child_Signal_Enabled; --------------------- -- Pending_Signals -- --------------------- function Pending_Signals return Signal_Set is Set : Signal_Set; Result : int; begin Begin_Critical_Section; Result := sigpending (Set.C'Unchecked_Access); End_Critical_Section; Check (Result); return Set; end Pending_Signals; ------------------ -- Get_Signal -- ------------------ function Get_Signal (Event : Signal_Event) return Signal is begin return Signal (Event.sigev_signo); end Get_Signal; ------------------ -- Set_Signal -- ------------------ procedure Set_Signal (Event : in out Signal_Event; Sig : Signal) is begin Event.sigev_signo := int (Sig); end Set_Signal; ------------------------ -- Get_Notification -- ------------------------ function Get_Notification (Event : Signal_Event) return Notification is begin return Notification (Event.sigev_notify); end Get_Notification; ------------------------ -- Set_Notification -- ------------------------ procedure Set_Notification (Event : in out Signal_Event; Notify : Notification) is begin Event.sigev_notify := int (Notify); end Set_Notification; ---------------- -- Get_Data -- ---------------- function Get_Data (Event : Signal_Event) return Signal_Data is begin return To_Signal_Data (Event.sigev_value); end Get_Data; ---------------- -- Set_Data -- ---------------- procedure Set_Data (Event : in out Signal_Event; Data : Signal_Data) is begin Event.sigev_value := To_sigval (Data); end Set_Data; ------------------ -- Get_Signal -- ------------------ function Get_Signal (Info : Signal_Info) return Signal is begin return Signal (Info.si_signo); end Get_Signal; ------------------ -- Set_Signal -- ------------------ procedure Set_Signal (Info : in out Signal_Info; Sig : Signal) is begin Info.si_signo := int (Sig); end Set_Signal; ------------------ -- Get_Source -- ------------------ function Get_Source (Info : Signal_Info) return Signal_Source is begin return Signal_Source (Info.si_code); end Get_Source; ------------------ -- Set_Source -- ------------------ procedure Set_Source (Info : in out Signal_Info; Source : Signal_Source) is begin Info.si_code := int (Source); end Set_Source; ---------------- -- Has_Data -- ---------------- function Has_Data (Source : Signal_Source) return Boolean is begin return Source = From_Queue_Signal or Source = From_Async_IO or Source = From_Message_Queue or Source = From_Timer; end Has_Data; ---------------- -- Get_Data -- ---------------- function Get_Data (Info : Signal_Info) return Signal_Data is begin return To_Signal_Data (Info.si_value); end Get_Data; ---------------- -- Set_Data -- ---------------- procedure Set_Data (Info : in out Signal_Info; Data : Signal_Data) is begin Info.si_value := To_sigval (Data); end Set_Data; ----------------------- -- Enable_Queueing -- ----------------------- -- .... POSIX.5 needs fixing here, to reflect the fact that -- Enabling/Disabling queueing on a signal might not have -- any effect unless there is a handler (even null) installed, -- or to require that this operation install a null handler, -- as a side-effect. -- .... This functionality needs to be merged into the -- Ada runtime system (s-interr.adb) so as to ensure mutual -- exclusion between these changes to signal handler state -- and changes that are done there. -- The best solution may be to export operations for -- locking/unlocking, rather than to add new entries to the -- signal manager task. procedure Enable_Queueing (Sig : Signal) is Action : aliased struct_sigaction; Result : int; begin if not HAVE_sigqueue then Raise_POSIX_Error (Operation_Not_Supported); end if; Begin_Critical_Section; Result := sigaction (int (Sig), null, Action'Unchecked_Access); if Result /= -1 then Action.sa_flags := int (Bits (Action.sa_flags) or SA_SIGINFO); Result := sigaction (int (Sig), Action'Unchecked_Access, null); end if; End_Critical_Section; Check (Result); end Enable_Queueing; ------------------------ -- Disable_Queueing -- ------------------------ procedure Disable_Queueing (Sig : Signal) is Action : aliased struct_sigaction; Result : int; begin if not HAVE_sigqueue then Raise_POSIX_Error (Operation_Not_Supported); end if; Begin_Critical_Section; Result := sigaction (int (Sig), null, Action'Unchecked_Access); if Result /= -1 then Action.sa_flags := int (Bits (Action.sa_flags) and not SA_SIGINFO); Result := sigaction (int (Sig), Action'Unchecked_Access, null); end if; End_Critical_Section; end Disable_Queueing; -------------------- -- Await_Signal -- -------------------- function Await_Signal (Set : Signal_Set) return Signal is Result : aliased int; begin Check_Awaitable (Set); if sigwait (Set.C'Unchecked_Access, Result'Unchecked_Access) = -1 then Raise_POSIX_Error (Fetch_Errno); end if; return Signal (Result); end Await_Signal; ------------------------------- -- Await_Signal_Or_Timeout -- ------------------------------- function Await_Signal_Or_Timeout (Set : Signal_Set; Timeout : POSIX.Timespec) return Signal is begin return Signal (Await_Signal_Or_Timeout (Set, Timeout).si_signo); end Await_Signal_Or_Timeout; -------------------- -- Await_Signal -- -------------------- function Await_Signal (Set : Signal_Set) return Signal_Info is Info : aliased siginfo_t; begin Check_Awaitable (Set); Check (sigwaitinfo (Set.C'Unchecked_Access, Info'Unchecked_Access)); return Signal_Info (Info); end Await_Signal; ------------------------------- -- Await_Signal_Or_Timeout -- ------------------------------- function Await_Signal_Or_Timeout (Set : Signal_Set; Timeout : POSIX.Timespec) return Signal_Info is c_timeout : aliased struct_timespec; Info : aliased siginfo_t; S : Seconds; NS : Nanoseconds; begin Check_Awaitable (Set); Split (Timeout, S, NS); c_timeout.tv_sec := time_t (S); c_timeout.tv_nsec := long (NS); Check (sigtimedwait (Set.C'Unchecked_Access, Info'Unchecked_Access, c_timeout'Unchecked_Access)); return Signal_Info (Info); end Await_Signal_Or_Timeout; ------------------------ -- Signal_Reference -- ------------------------ function Signal_Reference (Sig : Signal) return System.Address is begin -- Signal_Reference reports Invalid_Argument if signal entries -- are not supported for the specified signal. if Reserved_Signal (Sig) then Raise_POSIX_Error (Invalid_Argument); end if; return To_Address (Integer_Address (Sig)); end Signal_Reference; ----------------- -- Send_Signal -- ----------------- function kill (pid : pid_t; sig : C.int) return int; pragma Import (C, kill, kill_LINKNAME); procedure Send_Signal (Process : POSIX.Process_Identification.Process_ID; Sig : Signal) is begin Check (kill (To_pid_t (Process), int (Sig))); end Send_Signal; ----------------- -- Send_Signal -- ----------------- procedure Send_Signal (Group : POSIX.Process_Identification.Process_Group_ID; Sig : Signal) is begin Check (kill (-To_pid_t (Group), int (Sig))); end Send_Signal; ----------------- -- Send_Signal -- ----------------- procedure Send_Signal (Sig : Signal) is begin Check (kill (0, int (Sig))); end Send_Signal; -------------------- -- Queue_Signal -- -------------------- function sigqueue (pid : pid_t; signo : int; value : sigval) return int; pragma Import (C, sigqueue, sigqueue_LINKNAME); procedure Queue_Signal (Process : POSIX.Process_Identification.Process_ID; Sig : Signal; Data : Signal_Data) is begin Check (sigqueue (To_pid_t (Process), int (Sig), To_sigval (Data))); end Queue_Signal; ---------------------- -- Interrupt_Task -- ---------------------- procedure Interrupt_Task (T : Ada.Task_Identification.Task_Id) is begin System.Task_Primitives.Operations.Abort_Task (Convert_Ids (T)); end Interrupt_Task; begin Reserved_Signal := (others => False); for Sig in Signal loop case Sig is when SIGALRM | SIGBUS | SIGILL | SIGSEGV | SIGFPE | SIGABRT => Reserved_Signal (Sig) := True; when SIGKILL | SIGSTOP => Reserved_Signal (Sig) := True; when others => Reserved_Signal (Sig) := not POSIX.Implementation.OK_Signals.OK (Integer (Sig)); end case; end loop; -- Merge in signals that are reserved by the Ada runtime system. for Sig in Signal loop pragma Warnings (Off); -- Kill warning about condition being always true generated -- on some platforms, since this code is meant to be compiled -- on several platforms. if Integer (Sig) <= Integer (SIID'Last) then if SI.Is_Reserved (SIID (Sig)) and then (Sig /= SIGKILL and Sig /= SIGSTOP) then Reserved_Signal (Sig) := True; end if; else Reserved_Signal (Sig) := True; end if; pragma Warnings (On); end loop; end POSIX.Signals; libflorist-2025.1.0/libsrc/threads/posix-signals.ads000066400000000000000000000320321473553204100223170ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . S I G N A L S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with Ada.Task_Identification, Ada.Finalization, POSIX.C, POSIX.Process_Identification, System, System.Interrupt_Management, System.Storage_Elements; -- To ensure that this file does not get compiled when thread support is -- disabled pragma Warnings (Off); with POSIX.Implementation.OK_Signals; pragma Warnings (On); package POSIX.Signals is -- Signal Type type Signal is new System.Interrupt_Management.Interrupt_ID'Base range 0 .. POSIX.C.NSIGS; for Signal'Size use POSIX.C.int'Size; function Image (Sig : Signal) return String; function Value (Str : String) return Signal; -- Standard Signals (required) Signal_Null, SIGNULL : constant Signal := 0; Signal_Abort, SIGABRT : constant Signal := POSIX.C.SIGABRT; Signal_Alarm, SIGALRM : constant Signal := POSIX.C.SIGALRM; Signal_Bus_Error, SIGBUS : constant Signal := POSIX.C.SIGBUS; Signal_Floating_Point_Error, SIGFPE : constant Signal := POSIX.C.SIGFPE; Signal_Hangup, SIGHUP : constant Signal := POSIX.C.SIGHUP; Signal_Illegal_Instruction, SIGILL : constant Signal := POSIX.C.SIGILL; Signal_Interrupt, SIGINT : constant Signal := POSIX.C.SIGINT; Signal_Kill, SIGKILL : constant Signal := POSIX.C.SIGKILL; Signal_Pipe_Write, SIGPIPE : constant Signal := POSIX.C.SIGPIPE; Signal_Quit, SIGQUIT : constant Signal := POSIX.C.SIGQUIT; Signal_Segmentation_Violation, SIGSEGV : constant Signal := POSIX.C.SIGSEGV; Signal_Terminate, SIGTERM : constant Signal := POSIX.C.SIGTERM; Signal_User_1, SIGUSR1 : constant Signal := POSIX.C.SIGUSR1; Signal_User_2, SIGUSR2 : constant Signal := POSIX.C.SIGUSR2; -- Standard Signals (job control) Signal_Child, SIGCHLD : constant Signal := POSIX.C.SIGCHLD; Signal_Continue, SIGCONT : constant Signal := POSIX.C.SIGCONT; Signal_Stop, SIGSTOP : constant Signal := POSIX.C.SIGSTOP; Signal_Terminal_Stop, SIGTSTP : constant Signal := POSIX.C.SIGTSTP; Signal_Terminal_Input, SIGTTIN : constant Signal := POSIX.C.SIGTTIN; Signal_Terminal_Output, SIGTTOU : constant Signal := POSIX.C.SIGTTOU; -- Signals from P1003.5c Signal_IO, SIGIO : constant Signal := POSIX.C.SIGIO; Signal_Out_Of_Band_Data, SIGURG : constant Signal := POSIX.C.SIGURG; subtype Realtime_Signal is Signal range Signal (POSIX.C.SIGRTMIN) .. POSIX.C.SIGRTMAX; -- Signal sets type Signal_Set is private; procedure Add_Signal (Set : in out Signal_Set; Sig : Signal); procedure Add_All_Signals (Set : in out Signal_Set); procedure Delete_Signal (Set : in out Signal_Set; Sig : Signal); procedure Delete_All_Signals (Set : in out Signal_Set); function Is_Member (Set : Signal_Set; Sig : Signal) return Boolean; -- Blocking and Unblocking Signals procedure Set_Blocked_Signals (New_Mask : Signal_Set; Old_Mask : out Signal_Set); procedure Block_Signals (Mask_to_Add : Signal_Set; Old_Mask : out Signal_Set); procedure Unblock_Signals (Mask_to_Subtract : Signal_Set; Old_Mask : out Signal_Set); function Blocked_Signals return Signal_Set; -- Ignoring Signals procedure Ignore_Signal (Sig : Signal); procedure Unignore_Signal (Sig : Signal); function Is_Ignored (Sig : Signal) return Boolean; procedure Install_Empty_Handler (Sig : Signal); -- Controlling Delivery of Signal_Child Signal procedure Set_Stopped_Child_Signal (Enable : Boolean := True); function Stopped_Child_Signal_Enabled return Boolean; -- Examining Pending Signals function Pending_Signals return Signal_Set; type Signal_Event is private; type Signal_Data is private; type Notification is range Integer'First .. Integer'Last; No_Notification : constant Notification := POSIX.C.SIGEV_NONE; Signal_Notification : constant Notification := POSIX.C.SIGEV_SIGNAL; function Get_Signal (Event : Signal_Event) return Signal; procedure Set_Signal (Event : in out Signal_Event; Sig : Signal); function Get_Notification (Event : Signal_Event) return Notification; procedure Set_Notification (Event : in out Signal_Event; Notify : Notification); function Get_Data (Event : Signal_Event) return Signal_Data; procedure Set_Data (Event : in out Signal_Event; Data : Signal_Data); type Signal_Source is range Integer'First .. Integer'Last; From_Send_Signal : constant Signal_Source := POSIX.C.SI_USER; From_Queue_Signal : constant Signal_Source := POSIX.C.SI_QUEUE; From_Timer : constant Signal_Source := POSIX.C.SI_TIMER; From_Async_IO : constant Signal_Source := POSIX.C.SI_ASYNCIO; From_Message_Queue : constant Signal_Source := POSIX.C.SI_MESGQ; type Signal_Info is private; function Get_Signal (Info : Signal_Info) return Signal; procedure Set_Signal (Info : in out Signal_Info; Sig : Signal); function Get_Source (Info : Signal_Info) return Signal_Source; procedure Set_Source (Info : in out Signal_Info; Source : Signal_Source); function Has_Data (Source : Signal_Source) return Boolean; function Get_Data (Info : Signal_Info) return Signal_Data; procedure Set_Data (Info : in out Signal_Info; Data : Signal_Data); procedure Enable_Queueing (Sig : Signal); procedure Disable_Queueing (Sig : Signal); function Await_Signal (Set : Signal_Set) return Signal; function Await_Signal_Or_Timeout (Set : Signal_Set; Timeout : POSIX.Timespec) return Signal; function Await_Signal (Set : Signal_Set) return Signal_Info; function Await_Signal_Or_Timeout (Set : Signal_Set; Timeout : POSIX.Timespec) return Signal_Info; Signal_Abort_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGABRT)); Signal_Hangup_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGHUP)); Signal_Interrupt_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGINT)); Signal_Pipe_Write_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGPIPE)); Signal_Quit_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGQUIT)); Signal_Terminate_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGTERM)); Signal_User_1_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGUSR1)); Signal_User_2_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGUSR2)); Signal_Child_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGCHLD)); Signal_Continue_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGCONT)); Signal_Terminal_Stop_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGTSTP)); Signal_Terminal_Input_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGTTIN)); Signal_Terminal_Output_Ref : constant System.Address := System.Storage_Elements.To_Address (System.Storage_Elements.Integer_Address (SIGTTOU)); function Signal_Reference (Sig : Signal) return System.Address; procedure Send_Signal (Process : POSIX.Process_Identification.Process_ID; Sig : Signal); procedure Send_Signal (Group : POSIX.Process_Identification.Process_Group_ID; Sig : Signal); procedure Send_Signal (Sig : Signal); procedure Queue_Signal (Process : POSIX.Process_Identification.Process_ID; Sig : Signal; Data : Signal_Data); procedure Interrupt_Task (T : Ada.Task_Identification.Task_Id); private type Signal_Set is new Ada.Finalization.Controlled with record C : aliased POSIX.C.sigset_t; end record; procedure Initialize (Set : in out Signal_Set); procedure Finalize (Set : in out Signal_Set); -- We formerly used an explicit array, rather than the C type -- sigset_t, because: -- 1. C provides no operation to enumerate the -- members of a sigset_t, other than calling sigismember() for -- every value in the range of valid Signals. -- 2. We would have to use a controlled type to do the initialization, -- since making a sigset_t object empty requires calling sigemptyset. -- We should have put the array inside a record, to get -- default initialization, but did not -- a mistake that needed -- correcting in any case. -- 3. We thought objects of type sigset_t might involve implicitly -- allocated dynamic storage, which could lead to storage leakage, -- and would not support private-type (assignment) semantics. -- Unfortunately, using this different representation meant quite a -- bit of extra computation, to translate between the two forms, and -- that ends up with iteration over the range of valid Signals anyway. -- The current solution does assume that the sigset_t representation -- supports meaningful equality testing. type Signal_Info is new POSIX.C.siginfo_t; type Signal_Event is new POSIX.C.struct_sigevent; type Signal_Data is record Data : System.Storage_Elements.Storage_Array (1 .. POSIX.C.sigval_byte_size); end record; for Signal_Data'Alignment use POSIX.C.sigval_alignment; end POSIX.Signals; libflorist-2025.1.0/libsrc/threads/posix-timers-extensions.ads000066400000000000000000000056701473553204100243670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . T I M E R S . E X T E N S I O N S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- This file contains system-dependent (and therefore non-portable) -- extensions to POSIX.Timers. package POSIX.Timers.Extensions is function Clock_SGI_Fast return Clock_ID; -- Only available under IRIX systems. -- Return an invalid ID on non IRIX systems. -- This clock has a higher resolution than Clock_Realtime and is -- available to priviledged users only. This clock is SGI -- specific and is not portable. end POSIX.Timers.Extensions; libflorist-2025.1.0/libsrc/threads/posix-timers-extensions.gpb000066400000000000000000000054441473553204100243670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . T I M E R S . E X T E N S I O N S -- -- -- -- B o d y -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ package body POSIX.Timers.Extensions is -------------------- -- Clock_SGI_Fast -- -------------------- function Clock_SGI_Fast return Clock_ID is begin # if HAVE_IRIX_Timers then return POSIX.C.CLOCK_SGI_FAST; # else return -1; # end if; end Clock_SGI_Fast; end POSIX.Timers.Extensions; libflorist-2025.1.0/libsrc/threads/posix-timers.adb000066400000000000000000000235131473553204100221450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . T I M E R S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-1997 Florida State University -- -- Copyright (C) 1998-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Conversion, POSIX.Implementation; package body POSIX.Timers is use POSIX.C; use POSIX.Implementation; function To_int is new Ada.Unchecked_Conversion (Bits, int); function To_Struct_Sigevent is new Ada.Unchecked_Conversion (POSIX.Signals.Signal_Event, POSIX.C.struct_sigevent); Zero_Timespec : aliased constant struct_timespec := (0, 0); Zero_State : aliased constant struct_itimerspec := ((0, 0), (0, 0)); ------------------- -- Set_Initial -- ------------------- procedure Set_Initial (State : in out Timer_State; Initial : POSIX.Timespec) is begin State.State.it_value := To_Struct_Timespec (Initial); end Set_Initial; ------------------- -- Get_Initial -- ------------------- function Get_Initial (State : Timer_State) return POSIX.Timespec is begin return To_Timespec (To_Duration (State.State.it_value)); end Get_Initial; -------------------- -- Set_Interval -- -------------------- procedure Set_Interval (State : in out Timer_State; Interval : POSIX.Timespec) is begin State.State.it_interval := To_Struct_Timespec (Interval); end Set_Interval; -------------------- -- Get_Interval -- -------------------- function Get_Interval (State : Timer_State) return POSIX.Timespec is begin return To_Timespec (To_Duration (State.State.it_interval)); end Get_Interval; ----------------- -- Set_Time -- ----------------- function clock_settime (clock_id : clockid_t; tp : timespec_ptr) return int; pragma Import (C, clock_settime, clock_settime_LINKNAME); procedure Set_Time (Clock : Clock_ID; Value : POSIX.Timespec) is TS : aliased struct_timespec; begin TS := To_Struct_Timespec (Value); Check (clock_settime (clockid_t (Clock), TS'Unchecked_Access)); end Set_Time; ---------------- -- Set_Time -- ---------------- procedure Set_Time (Value : POSIX.Timespec) is TS : aliased struct_timespec; begin TS := To_Struct_Timespec (Value); Check (clock_settime (POSIX.C.CLOCK_REALTIME, TS'Unchecked_Access)); end Set_Time; ---------------- -- Get_Time -- ---------------- function clock_gettime (clock_id : clockid_t; tp : access struct_timespec) return int; pragma Import (C, clock_gettime, clock_gettime_LINKNAME); function Get_Time (Clock : Clock_ID := Clock_Realtime) return POSIX.Timespec is TS : aliased struct_timespec; begin Check (clock_gettime (clockid_t (Clock), TS'Unchecked_Access)); return To_Timespec (To_Duration (TS)); end Get_Time; ---------------------- -- Get_Resolution -- ---------------------- function Get_Resolution (Clock : Clock_ID := Clock_Realtime) return POSIX.Timespec is function clock_getres (clock_id : clockid_t; res : access struct_timespec) return int; pragma Import (C, clock_getres, clock_getres_LINKNAME); TS : aliased struct_timespec; begin Check (clock_getres (clockid_t (Clock), TS'Unchecked_Access)); return To_Timespec (To_Duration (TS)); end Get_Resolution; -------------------- -- Create_Timer -- -------------------- function Create_Timer (Clock : Clock_ID; Event : POSIX.Signals.Signal_Event) return Timer_ID is function timer_create (clock_id : clockid_t; evp : sigevent_ptr; timerid : access timer_t) return int; pragma Import (C, timer_create, timer_create_LINKNAME); -- .... Consider making Signal_Event into a tagged type -- so that we don't need to make a local copy. E : aliased POSIX.C.struct_sigevent := To_Struct_Sigevent (Event); TID : aliased timer_t; begin if E.sigev_notify = POSIX.C.SIGEV_NONE then -- make sure the other fields are valid E.sigev_signo := SIGUSR1; E.sigev_value := null_sigval; end if; Check (timer_create (clockid_t (Clock), E'Unchecked_Access, TID'Unchecked_Access)); return Timer_ID (TID); end Create_Timer; -------------------- -- Delete_Timer -- -------------------- procedure Delete_Timer (Timer : in out Timer_ID) is function timer_delete (timer_id : timer_t) return int; pragma Import (C, timer_delete, timer_delete_LINKNAME); begin Check (timer_delete (timer_t (Timer))); end Delete_Timer; ----------------- -- Arm_Timer -- ----------------- function timer_settime (timer_id : timer_t; flags : C.int; value : itimerspec_ptr; ovalue : itimerspec_ptr) return int; pragma Import (C, timer_settime, timer_settime_LINKNAME); procedure Arm_Timer (Timer : Timer_ID; Options : Timer_Options; New_State : Timer_State; Old_State : out Timer_State) is begin -- ????? Change POSIX.5b? -- The following two checks are required by .5b, but -- they are inconsistent with one another -- and they do not seem to be founded on the .1b specification. if Options = Absolute_Timer then Check (New_State.State.it_value /= Zero_Timespec, Invalid_Argument); else Check (New_State.State.it_value.tv_sec > 0, Invalid_Argument); end if; Check (timer_settime (timer_t (Timer), To_int (Option_Set (Options).Option), New_State.State'Unchecked_Access, Old_State.State'Unchecked_Access)); end Arm_Timer; ----------------- -- Arm_Timer -- ----------------- procedure Arm_Timer (Timer : Timer_ID; Options : Timer_Options; New_State : Timer_State) is begin Check (New_State.State.it_value /= Zero_Timespec, Invalid_Argument); Check (timer_settime (timer_t (Timer), To_int (Option_Set (Options).Option), New_State.State'Unchecked_Access, null)); end Arm_Timer; ----------------------- -- Get_Timer_State -- ----------------------- function Get_Timer_State (Timer : Timer_ID) return Timer_State is function timer_gettime (timer_id : timer_t; value : access struct_itimerspec) return int; pragma Import (C, timer_gettime, timer_gettime_LINKNAME); TS : Timer_State; begin Check (timer_gettime (timer_t (Timer), TS.State'Unchecked_Access)); return TS; end Get_Timer_State; -------------------- -- Disarm_Timer -- -------------------- procedure Disarm_Timer (Timer : Timer_ID) is begin Check (timer_settime (timer_t (Timer), 0, Zero_State'Unchecked_Access, null)); end Disarm_Timer; -------------------------- -- Get_Timer_Overruns -- -------------------------- function Get_Timer_Overruns (Timer : Timer_ID) return Natural is function timer_getoverrun (timer_id : timer_t) return int; pragma Import (C, timer_getoverrun, timer_getoverrun_LINKNAME); begin return Natural (Check (timer_getoverrun (timer_t (Timer)))); end Get_Timer_Overruns; end POSIX.Timers; libflorist-2025.1.0/libsrc/threads/posix-timers.ads000066400000000000000000000114131473553204100221620ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . T I M E R S -- -- -- -- S p e c -- -- -- -- -- -- This file is a component of FLORIST, an implementation of the POSIX -- -- Ada bindings for use with the GNAT Ada compiler and the FSU Gnu Ada -- -- Runtime Library (GNARL). -- -- -- -- This package specification contains some text extracted from IEEE STD -- -- 1003.5: 1990, Information Technology -- POSIX Ada Language Interfaces -- -- Part 1: Binding for System Application Program Interface, as amended -- -- by IEEE STD 1003.5b: 1996, Amendment 1: Realtime Extensions, copyright -- -- 1996 by the Institute of Electrical and Electronics Engineers, Inc. -- -- -- -- The package specifications in the IEEE standards cited above represent -- -- only a portion of the documents and are not to be interpreteted -- -- outside the context of the documents. The standards must be used in -- -- conjunction with the package specifications in order to claim -- -- conformance. The IEEE takes no responsibility for and will assume no -- -- liability for damages resulting from the reader's misinterpretation of -- -- said information resulting from its out-of-context nature. To order -- -- copies of the IEEE standards, please contact the IEEE Service Center -- -- at 445 Hoes Lane, PO Box 1331, Piscataway, NJ 08855-1331; via phone at -- -- 1-800-678-IEEE, 908-981-1393; or via fax at 908-981-9667. -- -- -- -- These package specifications are distributed in the hope that they -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- ------------------------------------------------------------------------------ with POSIX.C, POSIX.Signals; package POSIX.Timers is type Clock_ID is private; type Timer_ID is private; Clock_Realtime : constant Clock_ID; type Timer_State is private; type Timer_Options is new POSIX.Option_Set; Absolute_Timer : constant Timer_Options; procedure Set_Initial (State : in out Timer_State; Initial : POSIX.Timespec); function Get_Initial (State : Timer_State) return POSIX.Timespec; procedure Set_Interval (State : in out Timer_State; Interval : POSIX.Timespec); function Get_Interval (State : Timer_State) return POSIX.Timespec; procedure Set_Time (Clock : Clock_ID; Value : POSIX.Timespec); procedure Set_Time (Value : POSIX.Timespec); function Get_Time (Clock : Clock_ID := Clock_Realtime) return POSIX.Timespec; function Get_Resolution (Clock : Clock_ID := Clock_Realtime) return POSIX.Timespec; function Create_Timer (Clock : Clock_ID; Event : POSIX.Signals.Signal_Event) return Timer_ID; procedure Delete_Timer (Timer : in out Timer_ID); procedure Arm_Timer (Timer : Timer_ID; Options : Timer_Options; New_State : Timer_State; Old_State : out Timer_State); procedure Arm_Timer (Timer : Timer_ID; Options : Timer_Options; New_State : Timer_State); function Get_Timer_State (Timer : Timer_ID) return Timer_State; procedure Disarm_Timer (Timer : Timer_ID); function Get_Timer_Overruns (Timer : Timer_ID) return Natural; private type Clock_ID is new POSIX.C.clockid_t; Clock_Realtime : constant Clock_ID := POSIX.C.CLOCK_REALTIME; type Timer_ID is new POSIX.C.timer_t; -- We add a tag to force by-reference parameter passing. -- This allows us to pass through to the C interface pointers -- directly to the argument, thereby saving copying. type Timer_State is tagged record State : aliased POSIX.C.struct_itimerspec; end record; Absolute_Timer : constant Timer_Options := Timer_Options (Option_Set'(Option => POSIX.C.TIMER_ABSTIME)); end POSIX.Timers; libflorist-2025.1.0/libsrc/threads/posix_asynchronous_io.ads000066400000000000000000000057631473553204100241760ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ A S Y N C H R O N O U S _ I O -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Asynchronous_IO; pragma Elaborate_All (POSIX.Asynchronous_IO); package POSIX_Asynchronous_IO renames POSIX.Asynchronous_IO; libflorist-2025.1.0/libsrc/threads/posix_condition_variables.ads000066400000000000000000000060031473553204100247560ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ C O N D I T I O N _ V A R I A B L E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Condition_Variables; pragma Elaborate_All (POSIX.Condition_Variables); package POSIX_Condition_Variables renames POSIX.Condition_Variables; libflorist-2025.1.0/libsrc/threads/posix_message_queues.ads000066400000000000000000000057031473553204100237610ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ M E S S A G E _ Q U E U E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (C) 1991-1994 Florida State University -- -- Copyright (C) 1995-2014, AdaCore -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Message_Queues; package POSIX_Message_Queues renames POSIX.Message_Queues; libflorist-2025.1.0/libsrc/threads/posix_mutexes.ads000066400000000000000000000056041473553204100224400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ M U T E X E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Mutexes; pragma Elaborate_All (POSIX.Mutexes); package POSIX_Mutexes renames POSIX.Mutexes; libflorist-2025.1.0/libsrc/threads/posix_process_primitives.ads000066400000000000000000000056601473553204100247010ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ P R O C E S S _ P R I M I T I V E S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Process_Primitives; pragma Elaborate_All (POSIX.Process_Primitives); package POSIX_Process_Primitives renames POSIX.Process_Primitives; libflorist-2025.1.0/libsrc/threads/posix_signals.ads000066400000000000000000000056041473553204100224060ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ S I G N A L S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Signals; pragma Elaborate_All (POSIX.Signals); package POSIX_Signals renames POSIX.Signals; libflorist-2025.1.0/libsrc/threads/posix_timers.ads000066400000000000000000000056001473553204100222450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X _ T I M E R S -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1996 Florida State University (FSU), All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with POSIX.Timers; pragma Elaborate_All (POSIX.Timers); package POSIX_Timers renames POSIX.Timers; libflorist-2025.1.0/tests/000077500000000000000000000000001473553204100152605ustar00rootroot00000000000000libflorist-2025.1.0/tests/Makefile000066400000000000000000000233311473553204100167220ustar00rootroot00000000000000# file: Makefile for POSIX 1003.5b Test Suite # [$Revision$] # # This builds the test suite for POSIX 1003.5 and 1003.5b. # This version is for use with the GNAT Ada compiler # and the Florist implementation of POSIX 1003.5b. # .POSIX: # MASTERDIR=/part1/florist/tests PAVT_VERSION=pavt-1.4.1 # The following definitions are for using the default installed GNAT # runtime system. GNATMAKEFLAGS1 = -I../libsrc -I../libsrc/threads -I../gensrc -aL../lib # GNATMAKEFLAGS2= -cargs -gnatay -gnatwu -largs -lflorist GNATMAKEFLAGS2a= -cargs -largs -lflorist GNATPREPFLAGS = -c -r TOOLS =\ renumber.adb\ run_tests_1 DOCS =\ README\ NOTES.LINUX\ NOTES.SOLARIS\ NOTES TEST_SOURCES = \ posix_report.ads\ posix_report.adb\ test_parameters.ads\ test_parameters.adb\ p020400.adb\ p020400.ads\ p021000.adb\ p021000.ads\ p030100.adb\ p030100.ads\ p030100b.adb\ p030100b.ads\ p030101.adb\ p030101.ads\ p030101b.adb\ p030101b.ads\ p030102.adb\ p030102.ads\ p030200.adb\ p030200.ads\ p030300.adb\ p030300.ads\ p030300a.adb\ p030300a.ads\ p030301.adb\ p030301.ads\ p030301b.adb\ p030301b.ads\ p030303.adb\ p030303.ads\ p030304.adb\ p030304.ads\ p030305.adb\ p030305.ads\ p030306.adb\ p030306.ads\ p030306a.adb\ p030306a.ads\ p040100.adb\ p040100.ads\ p040101.adb\ p040101.ads\ p040300.adb\ p040300.ads\ p040301.adb\ p040301.ads\ p050100.adb\ p050100.ads\ p050200.adb\ p050200.ads\ p050300.adb\ p050300.ads\ p060100.adb\ p060100.ads\ p060200.adb\ p060200.ads\ p060300.adb\ p060300.ads\ p070200.adb\ p070200.ads\ p090100.adb\ p090100.ads\ p090200.adb\ p090200.ads\ p110100.adb\ p110100.ads\ p110101.adb\ p110101.ads\ p110200.adb\ p110200.ads\ p110201.adb\ p110201.ads\ p110300.adb\ p110300.ads\ p120100.adb\ p120100.ads\ p120101.adb\ p120101.ads\ p120200.adb\ p120200.ads\ p120300.adb\ p120300.ads\ p120400.adb\ p120400.ads\ p120500.adb\ p120500.ads\ p120501.adb\ p120501.ads\ p120502.adb\ p120502.ads\ p120502a.adb\ p120502a.ads\ p140100.adb\ p140100.ads\ p140101.adb\ p140101.ads\ p150100.adb\ p150100.ads\ p150100b.adb\ p150100b.ads\ p150101.adb\ p150101.ads\ p990000.adb\ p990000.ads\ p990001a.adb\ p990001a.ads\ p990001b.adb\ p990001b.ads\ p990001c.adb\ p990001c.ads\ p990002a.adb\ p990002a.ads\ p990002b.adb\ p990002b.ads\ p990002c.adb\ p990002c.ads\ p990002d.adb\ p990002d.ads\ p990003a.adb\ p990003a.ads\ p990003b.adb\ p990003b.ads\ p990010.adb\ p990010.ads\ p990010a.ads\ p990020.adb\ p990020.ads\ p990020a.ads\ p990030.adb\ p990030.ads\ p990030a.ads\ p990040.adb\ p990040.ads\ p990040a.ads\ p990040b.adb\ p990040b.ads\ p990050.adb\ p990050.ads\ p990050a.ads\ p990050b.adb\ p990050b.ads\ p990060.adb\ p990060.ads\ p990060a.ads\ p990070.adb\ p990070.ads\ p990070a.ads\ p990080.adb\ p990080.ads\ p990080a.ads\ p990090.adb\ p990090.ads\ p990090a.ads\ p990011.adb\ p990011.ads\ p990011a.ads\ p9900doc.ads\ p9900x0.adb\ p9900x0.ads TESTS =\ p021000\ p030100\ p030100b\ p030101\ p030101b\ p030102\ p030200\ p030301\ p030301b\ p030303\ p030304\ p030305\ p030306\ p030306a\ p040100\ p040101\ p040300\ p040301\ p050100\ p050200\ p050300\ p060100\ p060200\ p060300\ p070200\ p090100\ p090200\ p110100\ p110101\ p110200\ p110201\ p110300\ p120100\ p120101\ p120200\ p120300\ p120400\ p120500\ p120501\ p120502\ p120502a\ p140101\ p150100b\ p150101 SPECIAL_TESTS=\ p020400\ p030300\ p030300a\ p140100\ p150100\ p990010\ p990020\ p990030\ p990040\ p990040b\ p990050\ p990050b\ p990060\ p990070\ p990080\ p990090\ p990011 # .SUFFIXES: .o .c .c.o: gcc -c -g $< # tests: $(TESTS) $(SPECIAL_TESTS) # p020400: p020400.ads p020400.adb p021000: p021000.ads p021000.adb p030100: p030100.ads p030100.adb p030100b p030100b: p030100b.ads p030100b.adb p030101: p030101.ads p030101.adb p030101b: p030101b.ads p030101b.adb p030102: p030102.ads p030102.adb p030101b p030102b: p030102b.ads p030102b.adb p030200: p030200.ads p030200.adb p030300: p030300.ads p030300.adb p030300a.ads p030300a: p030300a.ads p030300a.adb p030301: p030301.ads p030301.adb p030301b p030301b: p030301b.ads p030301b.adb p030303: p030303.ads p030303.adb p030304: p030304.ads p030304.adb p030305: p030305.ads p030305.adb p030306: p030306.ads p030306.adb p030306a p030300a p030306a: p030306a.ads p030306a.adb p030300a p040100: p040100.ads p040100.adb p040101: p040101.ads p040101.adb p040300: p040300.ads p040300.adb p040301: p040301.ads p040301.adb p050100: p050100.ads p050100.adb p050200: p050200.ads p050200.adb p050300: p050300.ads p050300.adb p060100: p060100.ads p060100.adb p060200: p060200.ads p060200.adb p060300: p060300.ads p060300.adb p070200: p070200.ads p070200.adb p090100: p090100.ads p090100.adb p090200: p090200.ads p090200.adb p110100: p110100.ads p110100.adb p110101: p110101.ads p110101.adb p110200: p110200.ads p110200.adb p110201: p110201.ads p110201.adb p110300: p110300.ads p110300.adb p120100: p120100.ads p120100.adb p120101: p120101.ads p120101.adb p120200: p120200.ads p120200.adb p120300: p120300.ads p120300.adb p120400: p120400.ads p120400.adb p120500: p120500.ads p120500.adb p120501: p120501.ads p120501.adb p120502: p120502.ads p120502.adb p120502a p120502a: p120502a.ads p120502a.adb p140100: p140100.ads p140100.adb p140101: p140101.ads p140101.adb p150100: p150100.ads p150100.adb p150100b p150100b: p150100b.ads p150100b.adb p150101: p150101.ads p150101.adb p990010: p990010.ads p990010.adb\ p990010a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001a.ads p990001a.adb\ p990002a.ads p990002a.adb\ p990003a.ads p990003a.adb p990020: p990020.ads p990020.adb\ p990020a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001b.ads p990001b.adb\ p990002b.ads p990002b.adb\ p990003a.ads p990003a.adb p990030: p990030.ads p990030.adb\ p990030a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001b.ads p990001b.adb\ p990002c.ads p990002c.adb\ p990003a.ads p990003a.adb p990040: p990040.ads p990040.adb p990040b\ p990040a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001c.ads p990001c.adb\ p990002a.ads p990002a.adb\ p990003b.ads p990003b.adb p990040b: p990040b.ads p990040b.adb\ p990040a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001c.ads p990001c.adb\ p990002a.ads p990002a.adb\ p990003b.ads p990003b.adb p990050: p990050.ads p990050.adb p990050b\ p990050a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001c.ads p990001c.adb\ p990002d.ads p990002d.adb\ p990003b.ads p990003b.adb p990050b: p990050b.ads p990050b.adb\ p990050a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001c.ads p990001c.adb\ p990002d.ads p990002d.adb\ p990003b.ads p990003b.adb p990060: p990060.ads p990060.adb\ p990060a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001b.ads p990001b.adb\ p990002a.ads p990002a.adb\ p990003a.ads p990003a.adb p990070: p990070.ads p990070.adb\ p990070a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001c.ads p990001c.adb\ p990002a.ads p990002a.adb\ p990003a.ads p990003a.adb p990080: p990080.ads p990080.adb\ p990080a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001a.ads p990001a.adb\ p990002d.ads p990002d.adb\ p990003a.ads p990003a.adb p990090: p990090.ads p990090.adb\ p990090a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001a.ads p990001a.adb\ p990002b.ads p990002b.adb\ p990003a.ads p990003a.adb p990011: p990011.ads p990011.adb\ p990090a.ads\ p9900x0.ads p9900x0.adb\ p990000.ads p990000.adb\ p990001a.ads p990001a.adb\ p990002c.ads p990002c.adb\ p990003a.ads p990003a.adb testit: testit.adb $(TESTS) testit: posix_report.ads posix_report.adb\ ../lib/libflorist.a test_parameters.adb gnatmake $(GNATMAKEFLAGS1) $@ $(GNATMAKEFLAGS2) # # Due to zealousness of the "-gnaty" style-checker, # the following tests need to be compiled without "-gnaty". # $(SPECIAL_TESTS): posix_report.ads posix_report.adb\ ../lib/libflorist.a test_parameters.adb gnatmake $(GNATMAKEFLAGS1) $@ $(GNATMAKEFLAGS2a) # # Make a separate directory in which to run the tests, # so we have less chance of a wild test trashing our sources. # test.dir: mkdir test.dir ln -s .. test.dir/bin # # Compile all the tests # # Run all the tests # Some tests require that the standard error file be a terminal. run_tests: $(TESTS) $(SPECIAL_TESTS) test.dir -cd test.dir; ../run_tests_1 >> run_tests_1.log # # ----------------------------------- # Maintenance targets. # ----------------------------------- # # remove editor and compiler generated files clean: rm -f *.o *.ali a.out *# *~ $(LITTER) $(TESTS)\ $(SPECIAL_TESTS) b~*.ad* b_*.c *.log touch florist # remove all generated files realclean: rm -f *.o *.ali $(TESTS) $(SPECIAL_TESTS) \ a.out *# *~ b~*.ad* b_*.c $(GENERATED) $(LITTER) # # The following targets are only for use by the implementors. # # check all sources into RCS directory # and remove everything except "Makefile" distclean: rm -f *.o *.ali $(TESTS) $(SPECIAL_TESTS) \ a.out *# *~ b~*.ad* b_*.c $(GENERATED) $(LITTER) rm -rf test.dir -ci -m"make distclean" $(TEST_SOURCES) $(TOOLS) Makefile $(DOCS) -co Makefile # check out all sources, ready for editing neat: -co -l $(TEST_SOURCES) $(TOOLS) $(DOCS) -co -l Makefile # check out all sources, read-only checkallout: -co $(TEST_SOURCES) $(TOOLS) $(DOCS) -co Makefile rm -f $(GENERATED) # make tarfile of just the POSIX.5b validation tests distribution: make_test_links rm -f ${PAVT_VERSION}.tar.gz ./make_test_links ./${PAVT_VERSION} $(MASTERDIR) tar cvhf ${PAVT_VERSION}.tar ${PAVT_VERSION} gzip ${PAVT_VERSION}.tar rts: s-interr.adb s-intman.adb s-inmaop.adb gnatmake -a $(GNATMAKEFLAGS1) dummy $(GNATMAKEFLAGS2a) libflorist-2025.1.0/tests/README000066400000000000000000000144471473553204100161520ustar00rootroot00000000000000file: florist/tests/README [$Revision$] THIS SOFTWARE AND THE ACCOMPANYING DOCUMENTATION ARE 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 -- NOTWITHSTANDING ANY STATEMENTS MADE BELOW IN THIS FILE. POSIX.5B VALIDATION TESTS: This directory contains working drafts of validation tests for IEEE Standard 1003.5b. These test programs, which are derived from programs originally written as tests of Florist, have been developed under contract to Logicon Eagle Technologies for the U.S. Department of Defense, Defense Information Systems Agency, Center for Standards. PREREQUISITES: The tests are supposed to be 100% portable, but the procedures for compiling them and running them will depend on the environment in which you are working. The Makefile here has been used successfully in the following environment: make utility : GNU Make version 3.74 Ada compiler : GNATMAKE 3.13a POSIX.5b implementation : Florist 1.4, 31 Dec 1998 OS : Solaris 2.7 architecture : SPARCstation 20 HS14 The Makefile depends on the "make" utility, how to call the Ada compiler, and where the sources and library files associated with the implementation of POSIX.5b are installed. The Makefile in this directory is designed to work with the Gnu "make" utility. (It will probably work with other "make" utilities, except for the pattern-matching rules, which use the extended Gnu syntax.) The Makefile is set up to work with the Florist implementation of POSIX.5/.5b, and the GNAT Ada compiler. It assumes you have compiled Florist, that the sources and object library are in the directory ./floristlib. With this Makefile you can compile all the tests using the command "make tests". You can run all the tests by typing "make run_tests". The tests will be run in a subdirectory called "test.dir", and the results will be logged to the file "test.dir/run_tests_1.log". It will take quite a long time to run all the tests, even when they all pass. In particular, the "p99*" series of tests normally take a long time. There is also high probability that one of the tests may crash the test run, or "hang". In the latter case, you will need to kill the test run, and run the remaining tests in smaller groups. Try commenting the bad tests out of the script "run_tests_1", and running them individually. VERBOSITY CONTROLS: You can modify how much output the test produces, using the following command line options. -t = Terse output. This eliminates all but the first and last lines of output -v = Verbose output. This provides additional output, that may be helpful in narrowing down the nature of a test failure. The output of the default verbosity level is described below. NORMAL TEST OUTPUT: Each test will produce an initial line giving the name of the test and some version information, e.g. ,.,. p020400 POSIX Ada Validation Tests, Version 1.2 By default, the test will then produce a series of lines to indicate its progress through various internal subdivisions, like the following: ---- *-Subtest: package POSIX ---- *-Subtest: version query functions ---- *-Subtest: optional facility subtypes ---- *-Subtest: bytes and I/O counts ---- *-Subtest: Blocking_Behavior type ---- *-Subtest: Signal_Masking type ---- *-Subtest: POSIX_Character ---- *-Subtest: POSIX_String type ---- *-Subtest: POSIX_String_List type ---- *-Subtest: Option_Set type ---- *-Subtest: Error_Code type ---- *-Subtest: uname-derived functions ---- *-Subtest: Timespec type If the test passes it will then terminate and produce the message: ==== Test Completed Successfully. ORDINARY FAILURES: Any messages of the following form indicate a failure at some point within the test: !!TEST FAILED: ... If the test fails and successfully terminates, it will produce a message of the form: ==== Failed ...some number... tests. EXTREME FAILURES: Some tests may hang, or terminate without completing. We have tried to design the tests so that they can tolerate some anticipated kinds of failures and still run to completion, but the range of possible failures is practically infinite. In these cases, it may help to use the "-v" option to see more precisely how far the test got before the problem occurred. UNSUPPORTED FEATURES: Some tests will produce "Nonsupport of ......" message after the "Completed successfully" message. This indicates that the feature you are testing is not provided by the POSIX Ada binding implementation. This should only happen if it the corresponding capablity is not provided by the underlying operating system. This is not a failure, unless the implementation actually claims to support the feature, or there are other tests where the feature appears to be supported. You can use the "-v" command-line argument option when you run the test to see messages indicating each of the points where the test found a feature unsupported. PRIVILEGE FAILURES: Some tests attempt to perform operations that may require special privilege. These tests passed when we ran them on Solaris 2.6 with "root" privilege, but running strange programs with root permission is always a risky thing to do. You will need to review these tests and determine what needs to be done on your system to give them the appropriate privilege, and arrange to test them in an environment where they will do no serious harm if the run amok. TAILORABLE FEATURES: The POSIX standards provide considerable leeway for variation among implementations. For example, an implementation may impose arbitrary restrictions on the form of the name of a message queue. In order to accomodate these variations, we have attempted to parameterize the tests, and to isolate the implementation dependent constants (such as message queue names) in a single package, named Test_Parameters. You may need to edit this package to fit the implementation being tested. OTHER SETUP: Some tests require other external setup, before the test program is executed. For example, some require setting an environment variable, and some require putting an executable file in a known location. See the script "run_tests_1" for examples. STATUS: These are the final versions of the tests delivered to the Government under the POSIX.5b Test Suite project. libflorist-2025.1.0/tests/p020400.adb000066400000000000000000000511601473553204100166400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 2 0 4 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX, defined in IEEE Std 1003.5b Section 2.4. with POSIX, POSIX_Report; procedure p020400 is use POSIX, POSIX_Report; begin Header ("p020400"); Test ("package POSIX"); --------------------------------------------------------------------- Test ("Version Identification [2.4.1]"); begin Comment ("POSIX_Version = " & Integer'Image (POSIX_Version)); Comment ("POSIX_Ada_Version = " & Integer'Image (POSIX_Ada_Version)); exception when E : others => Unexpected_Exception (E, "A001"); end; --------------------------------------------------------------------- Test ("Optional Facility Subtypes [2.4.1]"); declare procedure Check_Option (First, Last : Boolean; Option : String); procedure Check_Option (First, Last : Boolean; Option : String) is begin if First = True then Comment (Option & " option is supported"); elsif Job_Control_Support'Last = False then Comment (Option & " option is not supported"); else Comment (Option & " option is indeterminate"); end if; end Check_Option; begin Check_Option (Job_Control_Support'First, Job_Control_Support'Last, "Job Control Support"); Check_Option (Saved_IDs_Support'First, Saved_IDs_Support'Last, "Saved IDs Support"); Check_Option (Change_Owner_Restriction'First, Change_Owner_Restriction'Last, "Change Owner Restriction"); Check_Option (Filename_Truncation'First, Filename_Truncation'Last, "Filename Truncation"); exception when E : others => Unexpected_Exception (E, "A002"); end; --------------------------------------------------------------------- Test ("Bytes and I/O Counts [2.4.1]"); begin if Byte_Size /= 8 then Comment ("Byte_Size = " & Integer'Image (Byte_Size)); end if; Comment ("IO_Count'Last = " & IO_Count'Image (IO_Count'Last)); Assert (IO_Count_Maxima'First = 32767, "A003"); Assert (Portable_Groups_Maximum = 0, "A004"); Assert (Portable_Groups_Maximum <= Groups_Maxima'First, "A005"); Assert (Portable_Argument_List_Maximum = 4096, "A006"); Assert (Portable_Argument_List_Maximum <= Argument_List_Maxima'First, "A007"); Assert (Portable_Child_Processes_Maximum = 6, "A008"); Assert (Child_Processes_Maxima'First >= Portable_Child_Processes_Maximum, "A009"); Assert (Portable_Open_Files_Maximum = 16, "A010"); Assert (Portable_Open_Files_Maximum <= Open_Files_Maxima'First, "A011"); Assert (Portable_Stream_Maximum = 8, "A012"); Assert (Portable_Stream_Maximum <= Stream_Maxima'First, "A013"); Assert (Portable_Time_Zone_String_Maximum = 3, "A014"); Assert (Portable_Time_Zone_String_Maximum <= Time_Zone_String_Maxima'First, "A015"); Assert (Portable_Link_Limit_Maximum = 8, "A016"); Assert (Portable_Link_Limit_Maximum <= Link_Limit_Maxima'First, "A017"); Assert (Portable_Input_Line_Limit_Maximum = 255, "A018"); Assert (Portable_Input_Line_Limit_Maximum <= Input_Line_Limit_Maxima'First, "A019"); Assert (Portable_Input_Queue_Limit_Maximum = 255, "A020"); Assert (Portable_Input_Queue_Limit_Maximum <= Input_Queue_Limit_Maxima'First, "A021"); Assert (Portable_Filename_Limit_Maximum = 14, "A022"); Assert (Portable_Filename_Limit_Maximum <= Filename_Limit_Maxima'First, "A023"); Assert (Portable_Pathname_Limit_Maximum = 255, "A024"); Assert (Portable_Pathname_Limit_Maximum <= Pathname_Limit_Maxima'First, "A025"); Assert (Portable_Pipe_Limit_Maximum = 512, "A026"); Assert (Portable_Pipe_Limit_Maximum <= Pipe_Limit_Maxima'First, "A027"); exception when E : others => Unexpected_Exception (E, "A028"); end; --------------------------------------------------------------------- Test ("Blocking_Behavior type [2.4.1]"); begin Assert (Tasks = Blocking_Behavior'First and Blocking_Behavior'Pos (Program) = 1 and Special = Blocking_Behavior'Last and Text_IO_Blocking_Behavior'First in Blocking_Behavior and IO_Blocking_Behavior in Blocking_Behavior and File_Lock_Blocking_Behavior in Blocking_Behavior and Wait_For_Child_Blocking_Behavior in Blocking_Behavior and Realtime_Blocking_Behavior'First in Blocking_Behavior, "A029"); exception when E : others => Unexpected_Exception (E, "A030"); end; --------------------------------------------------------------------- Test ("Signal_Masking type [2.4.1] "); begin Assert (No_Signals = Signal_Masking'First and Signal_Masking'Pos (RTS_Signals) = 1 and All_Signals = Signal_Masking'Last, "A031"); exception when E : others => Unexpected_Exception (E, "A032"); end; --------------------------------------------------------------------- Test ("POSIX_Character type [2.4.2]"); declare S : constant POSIX_String := " 0123456789" & "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & "abcdefghijklmnopqrstuvwxyz" & "._-/" & '"' & "#&'*)*+,:;<=>|"; begin null; exception when E : others => Unexpected_Exception (E, "A033"); end; --------------------------------------------------------------------- Test ("POSIX_String type [2.4.3]"); begin Assert (POSIX_String' (To_POSIX_String (String' ("ABCD/abcd"))) = "ABCD/abcd", "A034"); Assert (To_String ("ABCD/abcd") = "ABCD/abcd", "A035"); Assert (To_POSIX_String (To_Stream_Element_Array ("ABCD/abcd")) = "ABCD/abcd", "A036"); Assert (Is_Filename ("Legal_Filename"), "A037"); Assert (not Is_Filename ("Contains/Slash"), "A038"); Assert (Is_Portable_Filename ("ABCD"), "A039"); Assert (not Is_Portable_Filename ("ABCD!abcd"), "A040"); -- check with legal pathname Assert (Is_Pathname ("PATH/NAME"), "A041"); -- check with pathname containing NUL Assert (not Is_Pathname (To_POSIX_String ("NU" & Character'Val (0) & "LL")), "A042"); Assert (Is_Portable_Pathname ("ABCD/abcd"), "A043"); Assert (not Is_Portable_Pathname ("~/NAME"), "A044"); exception when E : others => Unexpected_Exception (E, "A045"); end; --------------------------------------------------------------------- Test ("POSIX_String_List type [2.4.4]"); declare X, Y : POSIX_String_List; N : Integer; procedure Never (Item : in POSIX_String; Quit : in out Boolean); procedure Never (Item : in POSIX_String; Quit : in out Boolean) is -- check Nonempty string list begin Fail ("A046"); Quit := True; end Never; procedure Check_Empty is new For_Every_Item (Never); function Next_Number return POSIX_String; function Next_Number return POSIX_String is begin N := N + 1; return To_POSIX_String (Integer'Image (N - 1)); end Next_Number; procedure Check (Item : in POSIX_String; Quit : in out Boolean); procedure Check (Item : in POSIX_String; Quit : in out Boolean) is begin Assert (Item = To_POSIX_String (Integer'Image (N)), "A047"); N := N + 1; if N = 5 then Quit := True; end if; end Check; procedure Check_Sequence is new For_Every_Item (Never); begin Assert (Length (Empty_String_List) = 0, "A048"); Check_Empty (X); Assert (Length (X) = 0, "A049"); N := 0; for I in 1 .. 100 loop Append (X, Next_Number); end loop; Assert (Value (X, 3) = To_POSIX_String (Integer'Image (2)), "A050"); Assert (Length (X) = 100, "A051"); Make_Empty (X); Check_Empty (X); Assert (Length (X) = 0, "A052"); begin if Value (X, 2) = "" then null; end if; Assert (False, "A053"); exception when Constraint_Error => null; when E : others => Unexpected_Exception (E, "A054"); end; exception when E : others => Unexpected_Exception (E, "A055"); end; --------------------------------------------------------------------- Test ("Option_Sets type [2.4.5]"); declare X : Option_Set; A : constant array (1 .. 31) of Option_Set := (Option_1, Option_2, Option_3, Option_4, Option_5, Option_6, Option_7, Option_8, Option_9, Option_10, Option_11, Option_12, Option_13, Option_14, Option_15, Option_16, Option_17, Option_18, Option_19, Option_20, Option_21, Option_22, Option_23, Option_24, Option_25, Option_26, Option_27, Option_28, Option_29, Option_30, Option_31); begin Assert (X = Empty_Set, "A056"); Assert (Option_1 + Option_2 - Option_1 = Option_2, "A057"); Assert (Option_1 + Option_2 > Option_1, "A058"); Assert (not (Option_1 > Option_1), "A059"); Assert (Option_1 < Option_1 + Option_2, "A060"); Assert (not (Option_1 < Option_1), "A061"); Assert (Option_1 <= Option_1 + Option_2, "A062"); Assert (Option_1 <= Option_1, "A063"); Assert (Option_1 + Option_2 >= Option_1, "A064"); Assert (Option_1 >= Option_1, "A065"); for I in A'Range loop for J in A'Range loop -- check that option set constants are distinct Assert (A (I) /= A (J) or I = J, "A066"); end loop; end loop; exception when E : others => Unexpected_Exception (E, "A067"); end; --------------------------------------------------------------------- Test ("Error_Code type [2.4.6]"); declare Uninitialized : Error_Code; pragma Warnings (Off, Uninitialized); begin declare Dummy1 : constant String := Image (Uninitialized); Dummy2 : constant String := Image (No_Error); begin null; end; Set_Error_Code (ENAMETOOLONG); Assert (Get_Error_Code = ENAMETOOLONG, "A068"); Assert (Is_POSIX_Error (ENAMETOOLONG), "A069"); Assert (not Is_POSIX_Error (99999), "A070"); Assert (Image (ENAMETOOLONG) = "FILENAME_TOO_LONG", "A071"); Assert (Is_POSIX_Error (E2BIG), "A072"); Assert (Is_POSIX_Error (Argument_List_Too_Long), "A073"); Assert (Is_POSIX_Error (EFAULT), "A074"); Assert (Is_POSIX_Error (Bad_Address), "A075"); Assert (Is_POSIX_Error (EBADF), "A076"); Assert (Is_POSIX_Error (Bad_File_Descriptor), "A077"); Assert (Is_POSIX_Error (EBADMSG), "A078"); Assert (Is_POSIX_Error (Bad_Message), "A079"); Assert (Is_POSIX_Error (EPIPE), "A080"); Assert (Is_POSIX_Error (Broken_Pipe), "A081"); Assert (Is_POSIX_Error (ENOTEMPTY), "A082"); Assert (Is_POSIX_Error (Directory_Not_Empty), "A083"); Assert (Is_POSIX_Error (ENOEXEC), "A084"); Assert (Is_POSIX_Error (Exec_Format_Error), "A085"); Assert (Is_POSIX_Error (EEXIST), "A086"); Assert (Is_POSIX_Error (File_Exists), "A087"); Assert (Is_POSIX_Error (EFBIG), "A088"); Assert (Is_POSIX_Error (File_Too_Large), "A089"); Assert (Is_POSIX_Error (ENAMETOOLONG), "A090"); Assert (Is_POSIX_Error (Filename_Too_Long), "A091"); Assert (Is_POSIX_Error (EXDEV), "A092"); Assert (Is_POSIX_Error (Improper_Link), "A093"); Assert (Is_POSIX_Error (ENOTTY), "A094"); Assert (Is_POSIX_Error (Inappropriate_IO_Control_Operation), "A095"); Assert (Is_POSIX_Error (EIO), "A096"); Assert (Is_POSIX_Error (Input_Output_Error), "A097"); Assert (Is_POSIX_Error (EINTR), "A098"); Assert (Is_POSIX_Error (Interrupted_Operation), "A099"); Assert (Is_POSIX_Error (EINVAL), "A100"); Assert (Is_POSIX_Error (Invalid_Argument), "A101"); Assert (Is_POSIX_Error (ESPIPE), "A102"); Assert (Is_POSIX_Error (Invalid_Seek), "A103"); Assert (Is_POSIX_Error (EISDIR), "A104"); Assert (Is_POSIX_Error (Is_A_Directory), "A105"); Assert (Is_POSIX_Error (EMSGSIZE), "A106"); Assert (Is_POSIX_Error (Message_Too_Long), "A107"); Assert (Is_POSIX_Error (ECHILD), "A108"); Assert (Is_POSIX_Error (No_Child_Process), "A109"); Assert (Is_POSIX_Error (ENOLCK), "A110"); Assert (Is_POSIX_Error (No_Locks_Available), "A111"); Assert (Is_POSIX_Error (ENOSPC), "A112"); Assert (Is_POSIX_Error (No_Space_Left_On_Device), "A113"); Assert (Is_POSIX_Error (ENODEV), "A114"); Assert (Is_POSIX_Error (No_Such_Operation_On_Device), "A115"); Assert (Is_POSIX_Error (ENXIO), "A116"); Assert (Is_POSIX_Error (No_Such_Device_Or_Address), "A117"); Assert (Is_POSIX_Error (ENOENT), "A118"); Assert (Is_POSIX_Error (No_Such_File_Or_Directory), "A119"); Assert (Is_POSIX_Error (ESRCH), "A120"); Assert (Is_POSIX_Error (No_Such_Process), "A121"); Assert (Is_POSIX_Error (ENOTDIR), "A122"); Assert (Is_POSIX_Error (Not_A_Directory), "A123"); Assert (Is_POSIX_Error (ENOMEM), "A124"); Assert (Is_POSIX_Error (Not_Enough_Space), "A125"); Assert (Is_POSIX_Error (ECANCELED), "A126"); Assert (Is_POSIX_Error (Operation_Canceled), "A127"); Assert (Is_POSIX_Error (EINPROGRESS), "A128"); Assert (Is_POSIX_Error (Operation_In_Progress), "A129"); Assert (Is_POSIX_Error (ENOSYS), "A130"); Assert (Is_POSIX_Error (Operation_Not_Implemented), "A131"); Assert (Is_POSIX_Error (EPERM), "A132"); Assert (Is_POSIX_Error (Operation_Not_Permitted), "A133"); Assert (Is_POSIX_Error (ENOTSUP), "A134"); Assert (Is_POSIX_Error (Operation_Not_Supported), "A135"); Assert (Is_POSIX_Error (EACCES), "A136"); Assert (Is_POSIX_Error (Permission_Denied), "A137"); Assert (Is_POSIX_Error (EROFS), "A138"); Assert (Is_POSIX_Error (Read_Only_File_System), "A139"); Assert (Is_POSIX_Error (EBUSY), "A140"); Assert (Is_POSIX_Error (Resource_Busy), "A141"); Assert (Is_POSIX_Error (EDEADLK), "A142"); Assert (Is_POSIX_Error (Resource_Deadlock_Avoided), "A143"); Assert (Is_POSIX_Error (EAGAIN), "A144"); Assert (Is_POSIX_Error (Resource_Temporarily_Unavailable), "A145"); Assert (Is_POSIX_Error (ETIMEDOUT), "A146"); Assert (Is_POSIX_Error (Timed_Out), "A147"); Assert (Is_POSIX_Error (EMLINK), "A148"); Assert (Is_POSIX_Error (Too_Many_Links), "A149"); Assert (Is_POSIX_Error (EMFILE), "A150"); Assert (Is_POSIX_Error (Too_Many_Open_Files), "A151"); Assert (Is_POSIX_Error (ENFILE), "A152"); Assert (Is_POSIX_Error (Too_Many_Open_Files_In_System), "A153"); exception when E : others => Unexpected_Exception (E, "A154"); end; --------------------------------------------------------------------- Test ("Uname-derived functions [2.4.7]"); begin Comment ("System_Name = " & To_String (System_Name)); Comment ("Node_Name = " & To_String (Node_Name)); Comment ("Release = " & To_String (Release)); Comment ("Version = " & To_String (Version)); Comment ("Machine = " & To_String (Machine)); exception when E : others => Unexpected_Exception (E, "A155"); end; --------------------------------------------------------------------- Test ("Timespec type [2.4.8]"); declare NS : Nanoseconds; S : Seconds; T : Timespec; begin Set_Seconds (T, -1); Set_Nanoseconds (T, 1); Assert (Get_Nanoseconds (T) = 1, "A156"); Set_Seconds (T, Seconds'Last); Set_Nanoseconds (T, Nanoseconds'Last); Assert (Get_Seconds (T) = Seconds'Last, "A157"); Comment ("Seconds'Last =" & Seconds'Image (Seconds'Last)); Comment ("Get_Seconds (T) =" & Seconds'Image (Get_Seconds (T))); Assert (Get_Nanoseconds (T) = Nanoseconds'Last, "A158"); Comment ("Nanoseconds'Last =" & Nanoseconds'Image (Nanoseconds'Last)); Comment ("Get_Nanoseconds (T) =" & Nanoseconds'Image (Get_Nanoseconds (T))); Split (T, S, NS); Assert (S = Get_Seconds (T), "A159"); Assert (S = Seconds'Last, "A160"); Assert (NS = Get_Nanoseconds (T), "A161"); Assert (NS = Nanoseconds'Last, "A162"); T := To_Timespec (88, 99); Assert (Get_Seconds (T) = 88, "A163"); Assert (Get_Nanoseconds (T) = 99, "A164"); T := T + To_Timespec (1, 1); Assert (Get_Seconds (T) = 89, "A165"); Assert (Get_Nanoseconds (T) = 100, "A166"); T := T + 1; Assert (Get_Seconds (T) = 89, "A167"); Assert (Get_Nanoseconds (T) = 101, "A168"); -- .... -- still need tests for wrap-arounds T := -T; Assert (Get_Seconds (T) = -90, "A169"); Assert (Get_Nanoseconds (T) = Nanoseconds'Last + 1 - 101, "A170"); T := To_Timespec (1, 2) + To_Timespec (3, 7); Assert (T = To_Timespec (4, 9), "A171"); T := To_Timespec (1, 2) + To_Timespec (3, 7); Assert (T /= To_Timespec (4, 8), "A172"); Assert (To_Timespec (1, 2) - To_Timespec (1, 2) = To_Timespec (0, 0), "A173"); -- .... -- still need tests for other arithmetic Assert (To_Duration (To_Timespec (1, 1)) = 1.000_000_001, "A174"); Assert (To_Duration (To_Timespec (1.0)) = 1.0, "A175"); Assert (To_Duration (To_Timespec (2.0)) /= 1.0, "A176"); Assert (To_Duration (To_Timespec (0, 1)) /= 0.0, "A177"); exception when E : others => Unexpected_Exception (E, "A178"); end; --------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A179"); end p020400; libflorist-2025.1.0/tests/p020400.ads000066400000000000000000000061761473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 2 0 4 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p020400; libflorist-2025.1.0/tests/p021000.adb000066400000000000000000000147751473553204100166500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 2 1 0 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with POSIX, POSIX_Limits, POSIX_Page_Alignment, POSIX_Report, POSIX_Configurable_System_Limits, System, System.Storage_Elements; procedure p021000 is use POSIX, POSIX_Page_Alignment, POSIX_Report, POSIX_Configurable_System_Limits, System, System.Storage_Elements; PageSize : POSIX_Limits.Page_Size_Range; begin Header ("p021000"); Test ("package POSIX_Page_Alignment"); ----------------------------------------------------------------------- begin Test ("Determining Page Size"); PageSize := Page_Size; Comment ("Page_Size =" & POSIX_Limits.Page_Size_Range'Image (PageSize)); -- check zero page size Assert (PageSize /= 0, "A001"); exception when E : others => Fatal_Exception (E, "A002"); end; ----------------------------------------------------------------------- declare Start_Addr, Original_Addr : System.Address; X : POSIX.POSIX_String (1 .. 5000); begin Test ("Truncate_To_Page (Address) [2.10]"); Original_Addr := X'Address; Start_Addr := Truncate_To_Page (Original_Addr); Assert ((Start_Addr <= Original_Addr) and (Start_Addr mod Storage_Offset (PageSize) = 0), "A003"); exception when E : others => Unexpected_Exception (E, "A004"); end; ----------------------------------------------------------------------- declare Start_Offset : POSIX.IO_Count; Original_Offset : POSIX.IO_Count := 45667; begin Test ("Truncate_To_Page (Offset) [2.10]"); Start_Offset := Truncate_To_Page (Original_Offset); Assert ((Start_Offset <= Original_Offset) and (Integer (Start_Offset) mod PageSize = 0), "A005"); exception when E : others => Unexpected_Exception (E, "A006"); end; ----------------------------------------------------------------------- declare Obj_Length : Storage_Offset; X : POSIX.POSIX_String (1 .. 5000); begin Test ("Adjust_Length (Address, Length) [2.10]"); Obj_Length := Adjust_Length (X'Address, X'Size / System.Storage_Unit); Assert ((Integer (Obj_Length) mod PageSize = 0) and (Obj_Length >= (X'Size / System.Storage_Unit + (X'Address - Truncate_To_Page (X'Address)))), "A007"); exception when E : others => Unexpected_Exception (E, "A008"); end; ----------------------------------------------------------------------- declare Obj_Length : Storage_Offset; Tmp, A : POSIX.IO_Count := 45667; L : Storage_Offset := 100; begin Test ("Adjust_Length (Offset, Length) [2.10]"); Obj_Length := Adjust_Length (A, L); Tmp := A - Truncate_To_Page (A); Assert ((Integer (Obj_Length) mod PageSize = 0) and (Obj_Length >= L + Storage_Offset (Tmp)), "A009"); exception when E : others => Unexpected_Exception (E, "A010"); end; ----------------------------------------------------------------------- declare Size : Natural := 5345; Result : Storage_Offset; begin Test ("Length (Size) [2.10]"); Result := Length (Size); Assert (Length (Size) >= Storage_Offset (Size / System.Storage_Unit), "A011"); exception when E : others => Unexpected_Exception (E, "A012"); end; ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A013"); end p021000; libflorist-2025.1.0/tests/p021000.ads000066400000000000000000000061761473553204100166650ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 2 1 0 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p021000; libflorist-2025.1.0/tests/p030100.adb000066400000000000000000001023011473553204100166300ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Setup: When this test is run the executable program p030300b must -- be accessible via the pathnames "./bin/p030100b" and "./p030100b". with POSIX, POSIX_Configurable_System_Limits, POSIX_Files, POSIX_Process_Environment, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, Text_IO; procedure p030100 is use POSIX, POSIX_Process_Environment, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals; -- Cases for child process: Should_Not_Start : constant := 1; Parents_Environment : constant := 2; Explicit_Environment : constant := 3; Search_Path : constant POSIX_String := ".:./bin"; Child_Filename : constant POSIX_String := "p030100b"; Child_Pathname : constant POSIX_String := "./bin/p030100b"; begin Header ("p030100"); Comment ("Pathname =" & To_String (Child_Pathname)); Comment ("Filename =" & To_String (Child_Filename)); Comment ("Search Path =" & To_String (Search_Path)); --------------------------------------------------------------------- -- Set up file and environment variable for use in tests below. declare use Text_IO; Test_File : File_Type; begin Comment ("creating test file "); Create (Test_File, Out_File, "test_file"); Put (Test_File, "01234"); Close (Test_File); Set_Environment_Variable ("ABC", "abc"); exception when E : others => Unexpected_Exception (E, "A001"); end; --------------------------------------------------------------------- Test ("Process_Template type [3.1.1]"); declare Mask : Signal_Set; Template : Process_Template; begin Add_Signal (Mask, Signal_User_1); ------------------------------------------------------------------ -- Assert: All operations detect an invalid template. begin Comment ("Set_Keep_Effective_IDs (invalid template)"); Set_Keep_Effective_IDs (Template); -- invalid template not detected Assert (False, "A002"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A003"); when E : others => Unexpected_Exception (E, "A004"); end; begin Comment ("Set_Signal_Mask (invalid template)"); Set_Signal_Mask (Template, Mask); -- invalid template not detected Assert (False, "A005"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A006"); when E : others => Unexpected_Exception (E, "A007"); end; begin Comment ("Set_Creation_Signal_Masking (invalid template)"); Set_Creation_Signal_Masking (Template, All_Signals); -- invalid template not detected Assert (False, "A008"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A009"); when E : others => Unexpected_Exception (E, "A010"); end; begin Comment ("Set_File_Action_To_Open (invalid template)"); Set_File_Action_To_Open (Template, 3, "test_file"); -- invalid template not detected Assert (False, "A011"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A012"); when E : others => Unexpected_Exception (E, "A013"); end; begin Comment ("Set_File_Action_To_Duplicate (invalid template)"); Set_File_Action_To_Duplicate (Template, 5, 3); -- invalid template not detected Assert (False, "A014"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A015"); when E : others => Unexpected_Exception (E, "A016"); end; begin Comment ("Set_File_Action_To_Close (invalid template)"); Set_File_Action_To_Close (Template, 0); -- invalid template not detected Assert (False, "A017"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A018"); when E : others => Unexpected_Exception (E, "A019"); end; ------------------------------------------------------------------ Comment ("Open_Template"); Open_Template (Template); Comment ("Close_Template"); Close_Template (Template); ------------------------------------------------------------------ -- Assert: All operations detect a closed template. begin Comment ("Set_Keep_Effective_IDs (closed template)"); Set_Keep_Effective_IDs (Template); -- closed template not detected Assert (False, "A020"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A021"); when E : others => Unexpected_Exception (E, "A022"); end; begin Comment ("Set_Signal_Mask (closed template)"); Set_Signal_Mask (Template, Mask); -- closed template not detected Assert (False, "A023"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A024"); when E : others => Unexpected_Exception (E, "A025"); end; begin Comment ("Set_Creation_Signal_Masking (closed template)"); Set_Creation_Signal_Masking (Template, All_Signals); -- closed template not detected Assert (False, "A026"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A027"); when E : others => Unexpected_Exception (E, "A028"); end; begin Comment ("Set_File_Action_To_Open (closed template)"); Set_File_Action_To_Open (Template, 3, "test_file"); -- closed template not detected Assert (False, "A029"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A030"); when E : others => Unexpected_Exception (E, "A031"); end; begin Comment ("Set_File_Action_To_Duplicate (closed template)"); Set_File_Action_To_Duplicate (Template, 5, 3); -- closed template not detected Assert (False, "A032"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A033"); when E : others => Unexpected_Exception (E, "A034"); end; begin Comment ("Set_File_Action_To_Close (closed template)"); Set_File_Action_To_Close (Template, 0); -- closed template not detected Assert (False, "A035"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A036"); when E : others => Unexpected_Exception (E, "A037"); end; ------------------------------------------------------------------ Comment ("Open_Template"); Open_Template (Template); ------------------------------------------------------------------ -- Assert: All operations return normally for an open template. Comment ("Set_Keep_Effective_IDs"); Set_Keep_Effective_IDs (Template); Comment ("Set_Signal_Mask"); Set_Signal_Mask (Template, Mask); Comment ("Set_Creation_Signal_Masking"); Set_Creation_Signal_Masking (Template, All_Signals); Comment ("Set_File_Action_To_Open"); Set_File_Action_To_Open (Template, 3, "test_file"); Comment ("Set_File_Action_To_Duplicate"); Set_File_Action_To_Duplicate (Template, 5, 3); Comment ("Set_File_Action_To_Close"); Set_File_Action_To_Close (Template, 0); ------------------------------------------------------------------ Comment ("Close_Template"); Close_Template (Template); exception when E : others => Unexpected_Exception (E, "A038"); end; --------------------------------------------------------------------- Test ("Exit_Status type [3.1.3]"); declare begin -- Checking range Assert (Exit_Status'First = 0 and Exit_Status'Last = 2**8 - 1, "A039"); -- Checking constants Assert (Normal_Exit = 0 and Failed_Creation_Exit = 41 and Unhandled_Exception_Exit = 42, "A040"); exception when E : others => Unexpected_Exception (E, "A041"); end; --------------------------------------------------------------------- Test ("Termination_Status type [3.1.4]"); declare Status : Termination_Status; begin Assert (Exited = Termination_Cause'First and Termination_Cause'Pos (Terminated_By_Signal) = 1 and Termination_Cause'Last = Stopped_By_Signal, "A042"); -- Checking initial value Assert (not Status_Available (Status), "A043"); declare Pid : Process_ID; begin Pid := Process_ID_Of (Status); -- Checking Process_ID_Of invalid status Assert (False, "A044"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A045"); when E : others => Unexpected_Exception (E, "A046"); end; declare Cause : Termination_Cause; begin Cause := Termination_Cause_Of (Status); -- Checking Termination_Cause_Of invalid status Assert (False, "A047"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A048"); when E : others => Unexpected_Exception (E, "A049"); end; declare E : Exit_Status; begin E := Exit_Status_Of (Status); -- Checking Exit_Status_Of invalid status Assert (False, "A050"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A051"); when E : others => Unexpected_Exception (E, "A052"); end; declare Sig : Signal; begin Sig := Termination_Signal_Of (Status); -- Checking Termination_Signal_Of invalid status Assert (False, "A053"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A054"); when E : others => Unexpected_Exception (E, "A055"); end; declare Sig : Signal; begin Sig := Stopping_Signal_Of (Status); -- Checking Stopping_Signal_Of invalid status Assert (False, "A056"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A057"); when E : others => Unexpected_Exception (E, "A058"); end; exception when E : others => Unexpected_Exception (E, "A059"); end; --------------------------------------------------------------------- Test ("Start_Process operations [3.1.2]"); declare Template : Process_Template; Args : POSIX_String_List; Env : Environment; Pid : Process_ID; Status : Termination_Status; begin -- Checking Args Assert (Length (Args) = 0, "A060"); POSIX.Append (Args, "-child" & To_POSIX_String (Integer'Image (Should_Not_Start))); ------------------------------------------------------------------ -- Assert: All operations detect an invalid template. begin Comment ("Start_Process (invalid template)"); Start_Process (Pid, Child_Pathname, Template, Args); -- Checking invalid template not detected Assert (False, "A061"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A062"); when E : others => Unexpected_Exception (E, "A063"); end; ------------------------------------------------------------------ begin Comment ("Start_Process with Env (invalid template)"); Start_Process (Pid, Child_Pathname, Template, Env, Args); -- Checking invalid template not detected Assert (False, "A064"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A065"); when E : others => Unexpected_Exception (E, "A066"); end; ------------------------------------------------------------------ begin Comment ("Start_Process_Search (invalid template)"); Start_Process_Search (Pid, Child_Filename, Template, Args); -- Checking invalid template not detected Assert (False, "A067"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A068"); when E : others => Unexpected_Exception (E, "A069"); end; ------------------------------------------------------------------ begin Comment ("Start_Process_Search with Env (invalid template)"); Start_Process_Search (Pid, Child_Filename, Template, Env, Args); -- Checking invalid template not detected Assert (False, "A070"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A071"); when E : others => Unexpected_Exception (E, "A072"); end; ------------------------------------------------------------------ Open_Template (Template); Close_Template (Template); ------------------------------------------------------------------ -- Assert: All operations detect a closed template. begin Comment ("Start_Process (closed template)"); Start_Process (Pid, Child_Pathname, Template, Args); -- Checking closed template not detected Assert (False, "A073"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A074"); when E : others => Unexpected_Exception (E, "A075"); end; ------------------------------------------------------------------ begin Comment ("Start_Process with Env (closed template)"); Start_Process (Pid, Child_Pathname, Template, Env, Args); -- Checking closed template not detected Assert (False, "A076"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A077"); when E : others => Unexpected_Exception (E, "A078"); end; ------------------------------------------------------------------ begin Comment ("Start_Process_Search (closed template)"); Start_Process_Search (Pid, Child_Filename, Template, Args); -- Checking closed template not detected Assert (False, "A079"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A080"); when E : others => Unexpected_Exception (E, "A081"); end; ------------------------------------------------------------------ begin Comment ("Start_Process_Search with Env (closed template)"); Start_Process_Search (Pid, Child_Filename, Template, Env, Args); -- Checking closed template not detected Assert (False, "A082"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A083"); when E : others => Unexpected_Exception (E, "A084"); end; ------------------------------------------------------------------ begin Comment ("Start_Process (closed template)"); Start_Process (Pid, Child_Pathname, Template, Args); -- Checking closed template not detected Assert (False, "A085"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A086"); when E : others => Unexpected_Exception (E, "A087"); end; ------------------------------------------------------------------ Open_Template (Template); begin Comment ("Set up argument list"); Make_Empty (Args); POSIX.Append (Args, Child_Filename); POSIX.Append (Args, "-child" & To_POSIX_String (Integer'Image (Parents_Environment))); Pass_Through_Verbosity (Args); Comment ("Set up environment"); Set_Environment_Variable (Child_Filename, "default"); Set_Environment_Variable (Child_Filename, "special", Env); Set_Environment_Variable ("PATH", Search_Path); Set_Environment_Variable ("PATH", Search_Path, Env); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A088"); when E : others => Unexpected_Exception (E, "A089"); end; ------------------------------------------------------------------ -- Assert: All operations work for an open template. begin Comment ("Start_Process"); Start_Process (Pid, Child_Pathname, Template, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, 0, "A090"); exception when E : others => Unexpected_Exception (E, "A091"); end; begin Comment ("Start_Process_Search with filename"); Start_Process (Pid, Child_Filename, Template, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, 0, "A092"); exception when E : others => Unexpected_Exception (E, "A093"); end; begin Comment ("Start_Process_Search with pathname"); Start_Process (Pid, Child_Pathname, Template, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, 0, "A094"); exception when E : others => Unexpected_Exception (E, "A095"); end; ------------------------------------------------------------------ -- Set up arguments to cause child to look at environment -- variables this time. begin Comment ("Reset argument list"); Make_Empty (Args); POSIX.Append (Args, Child_Filename); POSIX.Append (Args, "-child" & To_POSIX_String (Integer'Image (Explicit_Environment))); Pass_Through_Verbosity (Args); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A096"); when E : others => Unexpected_Exception (E, "A097"); end; ------------------------------------------------------------------ begin Comment ("Start_Process with Env"); Comment ("-1-"); Start_Process (Pid, Child_Pathname, Template, Env, Args); Comment ("-2-"); Wait_For_Child_Process (Status, Pid); Comment ("-3-"); Check_Child_Status (Status, Pid, 0, "A098"); Comment ("-4-"); exception when E : others => Unexpected_Exception (E, "A099"); end; begin Comment ("Start_Process_Search with Env and filename"); Start_Process_Search (Pid, Child_Filename, Template, Env, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, 0, "A100"); exception when E : others => Unexpected_Exception (E, "A101"); end; begin Comment ("Start_Process_Search with Env and pathname"); Start_Process_Search (Pid, Child_Pathname, Template, Env, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, 0, "A102"); exception when E : others => Unexpected_Exception (E, "A103"); end; ----------------------------------------------------------------- Close_Template (Template); exception when E : others => Unexpected_Exception (E, "A104"); end; --------------------------------------------------------------------- Test ("Start_Process operations that fail [3.1.2]"); declare Template : Process_Template; Args : POSIX_String_List; Pid : Process_ID; Status : Termination_Status; begin Assert (Length (Args) = 0, "A105"); POSIX.Append (Args, "-child" & To_POSIX_String (Integer'Image (Should_Not_Start))); Open_Template (Template); ------------------------------------------------------------------ begin Comment ("Start_Process with nonexistent program"); Start_Process (Pid, "not the name of a file", Template, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, Failed_Creation_Exit, "A106"); exception when E : others => Unexpected_Exception (E, "A107"); end; begin Comment ("Start_Process with nonexistent file to open"); Set_File_Action_To_Open (Template, 3, "not the name of a file"); Start_Process (Pid, Child_Pathname, Template, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, Failed_Creation_Exit, "A108"); exception when E : others => Unexpected_Exception (E, "A109"); end; ------------------------------------------------------------------ Close_Template (Template); exception when E : others => Unexpected_Exception (E, "A110"); end; --------------------------------------------------------------------- Test ("Wait_For_Child_Process operations [3.1.5]"); declare Template : Process_Template; Args : POSIX_String_List; Env : Environment; Pid : Process_ID; Status : Termination_Status; begin ------------------------------------------------------------------ Open_Template (Template); begin Comment ("Set up argument list"); POSIX.Append (Args, Child_Filename); POSIX.Append (Args, "-child" & To_POSIX_String (Integer'Image (Parents_Environment))); Pass_Through_Verbosity (Args); Comment ("Set up environment"); Set_Environment_Variable (Child_Filename, "default"); Set_Environment_Variable (Child_Filename, "special", Env); Set_Environment_Variable ("PATH", Search_Path); Set_Environment_Variable ("PATH", Search_Path, Env); Set_Environment_Variable ("WAIT", "YES", Env); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A111"); when E : others => Unexpected_Exception (E, "A112"); end; ------------------------------------------------------------------ Comment ("Wait_For_Child_Process with no ID"); begin Start_Process_Search (Pid, Child_Filename, Template, Env, Args); Comment ("check status of active child"); Wait_For_Child_Process (Status, Block => False); -- Checking status available Assert (not Status_Available (Status), "A113"); if POSIX_Configurable_System_Limits.Job_Control_Supported then Comment ("stop child process"); Send_Signal (Pid, Signal_Stop); -- first, ignore stopped jobs Wait_For_Child_Process (Status, Block => False, Trace_Stopped => False); -- Checking status available Assert (not Status_Available (Status), "A114"); -- now, include stopped jobs Wait_For_Child_Process (Status, Block => True, Trace_Stopped => True); -- Checking status not available Assert (Status_Available (Status), "A115"); -- Checking Pid Assert (Process_ID_Of (Status) = Pid, "A116"); -- Checking cause Assert (Termination_Cause_Of (Status) = Stopped_By_Signal, "A117"); -- Checking signal Assert (Stopping_Signal_Of (Status) = Signal_Stop, "A118"); declare E : Exit_Status; begin E := Exit_Status_Of (Status); -- Fail on exit Assert (False, "A119"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A120"); when E : others => Unexpected_Exception (E, "A121"); end; Comment ("continue child process"); Send_Signal (Pid, Signal_Continue); Wait_For_Child_Process (Status, Block => False, Trace_Stopped => True); Assert (not Status_Available (Status), "A122"); else Comment ("Job control option is not supported"); end if; Comment ("kill child process"); Send_Signal (Pid, Signal_Kill); Wait_For_Child_Process (Status, Block => True, Trace_Stopped => False); Assert (Status_Available (Status), "A123"); -- Checking pid Assert (Process_ID_Of (Status) = Pid, "A124"); -- Checking cause Assert (Termination_Cause_Of (Status) = Terminated_By_Signal, "A125"); -- Checking signal Assert (Termination_Signal_Of (Status) = Signal_Kill, "A126"); exception when E : others => Unexpected_Exception (E, "A127"); end; ------------------------------------------------------------------ Comment ("Wait_For_Child_Process with process ID"); begin Start_Process_Search (Pid, Child_Filename, Template, Env, Args); Comment ("check status of active child"); Wait_For_Child_Process (Status, Child => Pid, Block => False); Assert (not Status_Available (Status), "A128"); if POSIX_Configurable_System_Limits.Job_Control_Supported then Comment ("stop child process"); Send_Signal (Pid, Signal_Stop); -- first, ignore stopped jobs Wait_For_Child_Process (Status, Child => Pid, Block => False, Trace_Stopped => False); Assert (not Status_Available (Status), "A129"); -- now, include stopped jobs Wait_For_Child_Process (Status, Child => Pid, Block => True, Trace_Stopped => True); Assert (Status_Available (Status), "A130"); -- Checking pid Assert (Process_ID_Of (Status) = Pid, "A131"); -- Checking cause Assert (Termination_Cause_Of (Status) = Stopped_By_Signal, "A132"); -- Checking signal Assert (Stopping_Signal_Of (Status) = Signal_Stop, "A133"); declare E : Exit_Status; begin E := Exit_Status_Of (Status); Assert (False, "exited"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A134"); when E : others => Unexpected_Exception (E, "A135"); end; Comment ("continue child process"); Send_Signal (Pid, Signal_Continue); Wait_For_Child_Process (Status, Child => Pid, Block => False, Trace_Stopped => True); Assert (not Status_Available (Status), "A136"); else Comment ("Job control option is not supported"); end if; Comment ("kill child process"); Send_Signal (Pid, Signal_Kill); Wait_For_Child_Process (Status, Child => Pid, Block => True, Trace_Stopped => False); Assert (Status_Available (Status), "A137"); -- Checking pid Assert (Process_ID_Of (Status) = Pid, "A138"); -- Checking cause Assert (Termination_Cause_Of (Status) = Terminated_By_Signal, "A139"); -- Checking signal Assert (Termination_Signal_Of (Status) = Signal_Kill, "A140"); exception when E : others => Unexpected_Exception (E, "A141"); end; ------------------------------------------------------------------ Comment ("Wait_For_Child_Process with group ID"); declare Gid : Process_Group_ID := Get_Process_Group_ID; begin Start_Process_Search (Pid, Child_Filename, Template, Env, Args); Comment ("check status of active child"); Wait_For_Child_Process (Status, Group => Gid, Block => False); Assert (not Status_Available (Status), "A142"); if POSIX_Configurable_System_Limits.Job_Control_Supported then Comment ("stop child process"); Send_Signal (Pid, Signal_Stop); -- first, ignore stopped jobs Wait_For_Child_Process (Status, Group => Gid, Block => False, Trace_Stopped => False); Assert (not Status_Available (Status), "A143"); -- now, include stopped jobs Wait_For_Child_Process (Status, Group => Gid, Block => True, Trace_Stopped => True); Assert (Status_Available (Status), "A144"); -- Checking pid Assert (Process_ID_Of (Status) = Pid, "A145"); -- Checking cause Assert (Termination_Cause_Of (Status) = Stopped_By_Signal, "A146"); -- Checking signal Assert (Stopping_Signal_Of (Status) = Signal_Stop, "A147"); declare E : Exit_Status; begin E := Exit_Status_Of (Status); Assert (False, "A148"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A149"); when E : others => Unexpected_Exception (E, "A150"); end; Comment ("continue child process"); Send_Signal (Pid, Signal_Continue); Wait_For_Child_Process (Status, Group => Gid, Block => False, Trace_Stopped => True); Assert (not Status_Available (Status), "A151"); else Comment ("Job control option is not supported"); end if; Comment ("kill child process"); Send_Signal (Pid, Signal_Kill); Wait_For_Child_Process (Status, Group => Gid, Block => True, Trace_Stopped => False); Assert (Status_Available (Status), "A152"); -- Checking pid Assert (Process_ID_Of (Status) = Pid, "A153"); -- Checking cause Assert (Termination_Cause_Of (Status) = Terminated_By_Signal, "A154"); -- Checking signal Assert (Termination_Signal_Of (Status) = Signal_Kill, "A155"); exception when E : others => Unexpected_Exception (E, "A156"); end; ------------------------------------------------------------------ Close_Template (Template); exception when E : others => Unexpected_Exception (E, "A157"); end; -------------------------------------------------------------------- -- remove the file created for this test. POSIX_Files.Unlink ("test_file"); -------------------------------------------------------------------- Done; exception when E : others => POSIX_Files.Unlink ("test_file"); Fatal_Exception (E, "A158"); end p030100; libflorist-2025.1.0/tests/p030100.ads000066400000000000000000000061761473553204100166660ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030100; libflorist-2025.1.0/tests/p030100b.adb000066400000000000000000000127601473553204100170030ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 0 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with POSIX, POSIX_Process_Environment, POSIX_Report; procedure p030100b is use POSIX, POSIX_Process_Environment, POSIX_Report; -- Cases for child process: Should_Not_Start : constant := 1; Parents_Environment : constant := 2; Explicit_Environment : constant := 3; Child_Filename : constant POSIX_String := "p030100b"; Arg_Count : Integer := 0; procedure Print_Arg (S : POSIX_String; Quit : in out Boolean); procedure Print_Arg (S : POSIX_String; Quit : in out Boolean) is begin Arg_Count := Arg_Count + 1; Quit := False; Comment ("Argument (" & Integer'Image (Arg_Count) & ") = """ & To_String (S) & """"); end Print_Arg; procedure Print_Args is new For_Every_Item (Print_Arg); begin Comment ("child process for test p030100"); Comment ("child =" & Integer'Image (Child)); Print_Args (Argument_List); ------------------------------------------------------------------------- begin if Child = Should_Not_Start then -- Fail because process should not have been created Assert (False, "A001: P030100b: creation should have failed"); Done; else -- Check for bad argument(s) Assert (Value (Argument_List, 1) = "p030100b" and (Child in Parents_Environment .. Explicit_Environment), "A002: P030100b: bad arg: " & To_String (Value (Argument_List, 1))); if Child = Explicit_Environment then -- check environment variables also Assert (Environment_Value_Of (Child_Filename) = "special", "A003: P030100b: wrong env. value"); if Environment_Value_Of ("WAIT") = "YES" then Comment ("waiting for parent to send signal"); loop delay 10.0; end loop; end if; else -- Check environment variable Assert (Environment_Value_Of (Child_Filename) = "default", "A005: P030100b: wrong env. value"); end if; end if; exception when E : others => Unexpected_Exception (E, "A006"); end; ----------------------------------------------------------- Done; exception when E : others => Unexpected_Exception (E, "A007"); end p030100b; libflorist-2025.1.0/tests/p030100b.ads000066400000000000000000000061771473553204100170310ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 0 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030100b; libflorist-2025.1.0/tests/p030101.adb000066400000000000000000000114311473553204100166340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Process_Primitives, which is defined in -- Section 3.1 of IEEE Std 1003.5b, -- for consistency with package Ada.Command_Line. -- Setup: When this test is run the executable program p030301b must -- be accessible via the pathname "./bin/p030101b". with POSIX, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report; procedure p030101 is use POSIX, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report; -- Cases to be tested by child processes: Normal_Completion : constant := 1; Child_Pathname : constant POSIX_String := "./bin/p030101b"; begin Header ("p030101"); --------------------------------------------------------------------- Test ("Consistency of Ada and POSIX command line interfaces"); declare Pid : Process_ID; Status : Termination_Status; Template : Process_Template; Args : POSIX_String_List; begin Open_Template (Template); Comment ("Set up argument list"); POSIX.Append (Args, Child_Pathname); POSIX.Append (Args, "-child"); POSIX.Append (Args, To_POSIX_String (Integer'Image (Normal_Completion))); Start_Process (Pid, Child_Pathname, Template, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, Normal_Exit, "A001"); Close_Template (Template); exception when E : others => Unexpected_Exception (E, "A002"); end; -------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A003"); end p030101; libflorist-2025.1.0/tests/p030101.ads000066400000000000000000000061761473553204100166670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030101; libflorist-2025.1.0/tests/p030101b.adb000066400000000000000000000126341473553204100170040ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 1 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Process_Primitives, -- defined by IEEE Std 1003.5b Section 3.1, -- for consistency with package Ada.Command_Line. -- .... -- This test needs more work; it is presently incomplete. with Ada.Command_Line, POSIX, POSIX_Process_Environment, POSIX_Process_Primitives, POSIX_Report; procedure p030101b is use POSIX, POSIX_Process_Environment, POSIX_Process_Primitives, POSIX_Report; -- Cases to be tested by child process Normal_Completion : constant := 1; Normal_Completion_With_Ada_Status : constant := 2; Unhandled_Exception : constant := 3; POSIX_Exit_Process : constant := 4; Arg_Count : Integer := 0; procedure Print_Arg (S : POSIX_String; Quit : in out Boolean); procedure Print_Arg (S : POSIX_String; Quit : in out Boolean) is begin Quit := False; Comment ("Argument (" & Integer'Image (Arg_Count) & " =" & To_String (S)); end Print_Arg; procedure Print_Args is new For_Every_Item (Print_Arg); begin Comment ("child process for test p030101"); Print_Args (Argument_List); ------------------------------------------------------------------------- -- Check for inconsistent argument counts Assert (Ada.Command_Line.Argument_Count = Length (Argument_List) - 1, "A001"); ------------------------------------------------------------------------- begin -- Check first argument Assert (Ada.Command_Line.Command_Name = To_String (Value (Argument_List, 1)), "A002"); -- Check second argument Assert (Ada.Command_Line.Argument (1) = To_String (Value (Argument_List, 2)), "A003"); exception when E : others => Unexpected_Exception (E, "A004"); end; ----------------------------------------------------------- if Child = Normal_Completion then return; elsif Child = Normal_Completion_With_Ada_Status then Ada.Command_Line.Set_Exit_Status (77); return; elsif Child = Unhandled_Exception then raise Program_Error; elsif Child = POSIX_Exit_Process then Exit_Process (78); -- Fail if abnormal -child argument value else Fail ("A005"); end if; exception when E : others => if Child = Unhandled_Exception then raise; else Fatal_Exception (E, "A006"); end if; end p030101b; libflorist-2025.1.0/tests/p030101b.ads000066400000000000000000000061771473553204100170320ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 1 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030101b; libflorist-2025.1.0/tests/p030102.adb000066400000000000000000000213701473553204100166400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 2 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Process_Primitives, -- defined by IEEE Std 1003.5b Section 3.1, -- for consistency with package Ada.Command_Line. -- Setup: The program must be run with the executable file for -- program p030102b accessible via the pathname "./p030102b". with Ada.Command_Line, POSIX, POSIX_Process_Environment, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals; procedure p030102 is use POSIX, POSIX_Process_Environment, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals; Child_Program_Pathname : constant POSIX_String := "./p030102"; -- Cases to be tested by child processes: type Test_Cases is (Normal_Completion, Normal_Completion_With_Ada_Status, Unhandled_Exception, POSIX_Exit_Process); procedure Check_Child_Status (Status : Termination_Status; Child_ID : Process_ID; Expected : Exit_Status); procedure Check_Child_Status (Status : Termination_Status; Child_ID : Process_ID; Expected : Exit_Status) is E : Exit_Status; begin Assert (Child_ID /= Null_Process_ID, "null id"); if not Status_Available (Status) then Fail ("A001: status not available"); return; end if; Assert (Process_ID_Of (Status) = Child_ID, "child ID"); if Termination_Cause_Of (Status) /= Exited then Fail ("A002: did not exit"); return; end if; E := Exit_Status_Of (Status); if E > 0 and E < Failed_Creation_Exit then -- child process reports errors via exit status Increment_Error_Count (Integer (E)); elsif E /= Expected then Fail ("A003: unexpected exit status" & Exit_Status'Image (E)); end if; declare Sig : Signal; begin Sig := Stopping_Signal_Of (Status); Assert (False, "Stopping_Signal_Of invalid status"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A004"); when E : others => Unexpected_Exception (E, "A005"); end; declare Sig : Signal; begin Sig := Termination_Signal_Of (Status); Assert (False, "Termination_Signal_Of invalid status"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A006"); when E : others => Unexpected_Exception (E, "A007"); end; exception when E : others => Unexpected_Exception (E, "checking child status"); end Check_Child_Status; procedure p030102b; procedure p030102b is Arg_Count : Integer := 0; procedure Print_Arg (S : POSIX_String; Quit : in out Boolean); procedure Print_Arg (S : POSIX_String; Quit : in out Boolean) is begin Quit := False; Comment ("Argument (" & Integer'Image (Arg_Count) & " =" & To_String (S)); end Print_Arg; procedure Print_Args is new For_Every_Item (Print_Arg); begin Comment ("child process for test p030102"); Print_Args (Argument_List); ------------------------------------------------------------------------- Assert (Ada.Command_Line.Argument_Count = Length (Argument_List) - 1, "inconsistent argument counts"); ------------------------------------------------------------------------- begin Assert (Ada.Command_Line.Command_Name = To_String (Value (Argument_List, 1)), "inconsistent first argument"); Assert (Ada.Command_Line.Argument (1) = To_String (Value (Argument_List, 2)), "inconsistent first argument"); exception when E : others => Unexpected_Exception (E, "A008"); end; ----------------------------------------------------------- case Test_Cases'Val (Child) is when Normal_Completion => return; when Normal_Completion_With_Ada_Status => Ada.Command_Line.Set_Exit_Status (77); return; when Unhandled_Exception => raise Program_Error; when POSIX_Exit_Process => Exit_Process (78); when others => Fail ("A009: abnormal -child argument value"); end case; exception when E : others => if Test_Cases'Val (Child) = Unhandled_Exception then raise; end if; Unexpected_Exception (E, "A010"); end p030102b; begin if Child /= 0 then p030102b; Done; end if; Header ("p030102"); --------------------------------------------------------------------- for I in Test_Cases loop declare Pid : Process_ID; Status : Termination_Status; Template : Process_Template; Args : POSIX_String_List; begin Test (Test_Cases'Image (I)); Open_Template (Template); Comment ("Set up argument list"); POSIX.Append (Args, Child_Program_Pathname); POSIX.Append (Args, "-child"); POSIX.Append (Args, To_POSIX_String (Integer'Image (Test_Cases'Pos (I)))); Start_Process (Pid, Child_Program_Pathname, Template, Args); Wait_For_Child_Process (Status, Pid); Check_Child_Status (Status, Pid, Normal_Exit); Close_Template (Template); exception when E : others => Unexpected_Exception (E, "A011"); end; end loop; -------------------------------------------------------------------- Done; exception when E : others => if Child = Test_Cases'Pos (Unhandled_Exception) then raise; -- Allow child process to be terminated by unhandled exception. else Unexpected_Exception (E, "A012: child process"); end if; end p030102; libflorist-2025.1.0/tests/p030102.ads000066400000000000000000000061751473553204100166670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 1 0 2 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030102; libflorist-2025.1.0/tests/p030200.adb000066400000000000000000000123071473553204100166370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 2 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Tests package POSIX_Unsafe_Process_Primitives, -- in IEEE Std 1003.5b Section 3.2. -- This test just checks that Fork operation works and -- does not create more than one task in the child process. -- .... We still need to test the Exec operations. with POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Unsafe_Process_Primitives, POSIX_Report; procedure P030200 is use POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Unsafe_Process_Primitives; Child_Process : Process_ID := Null_Process_ID; task T; task body T is begin Comment ("internal task delays for half a second"); delay 0.5; if Child_Process = Null_Process_ID then -- Fail because there is more than one task alive in child process Fail ("A001"); end if; Comment ("internal task completes"); end T; Status : Termination_Status; begin Header ("p030200"); ------------------------------------------------------------------------- Test ("Fork operation [3.2.1]"); -- Assert: When the main thread of a process with more than one -- active task calls Fork, -- only the main thread is left in the child process. Child_Process := Fork; if Child_Process = Null_Process_ID then Comment ("child process completes"); Exit_Process (0); -- Child process cannot exit normally, without hanging, -- since it is missing the tasking runtime system. -- The problem is that we have already swapped out the -- soft links, to make it safe to fork, but exit from -- the program will try to use the tasking runtime system. else Comment ("parent process waits for child"); Wait_For_Child_Process (Status, Child_Process, True, False); Comment ("parent process detects child has terminated"); end if; -------------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A002"); end P030200; libflorist-2025.1.0/tests/p030200.ads000066400000000000000000000061761473553204100166670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 2 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure P030200; libflorist-2025.1.0/tests/p030300.adb000066400000000000000000001601121473553204100166360ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This a test of the POSIX_Signals package, and other features of -- section 3.3 of POSIX.5b. It does not test functionality that relies -- on support for multiple processes, or multiple tasks. -- Setup: Run this test in a fashion that initially all signals are unmasked -- in the process. with Ada_Task_Identification, p030300a, POSIX, POSIX_Asynchronous_IO, POSIX_Files, POSIX_IO, POSIX_Limits, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Report, POSIX_Signals, POSIX_Timers, System, System.Interrupts, System.Storage_Elements, Test_Parameters; procedure p030300 is use Ada_Task_Identification, p030300a, POSIX, POSIX_Asynchronous_IO, POSIX_Files, POSIX_IO, POSIX_Limits, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Report, POSIX_Signals, POSIX_Timers, Test_Parameters, System; Old_Mask : Signal_Set; begin Header ("p030300"); ---------------------------------------------------------------------- -- The implementation is only allowed to reserve additional signals -- that are not defined (named) in the standard. -- The implementation must reserve the signals -- that are not defined as reserved in the standard. -- An implementation shall not impose restrictions on the ability -- of an application to send, accept, block, or ignore the signals -- defined by this standard, except as specified in this standard. -- [3.3.2] -- The implementation of the tailorable functions Is_Reserved_Signal and -- Action_Cannot_Be_Set, in package Test_Parameters, must be consistent -- with the above requirements. for I in Defined_Signals'Range loop Assert (not Is_Reserved_Signal (Defined_Signals (I)) or else Is_Reserved_Defined_Signal (Defined_Signals (I)), "A001: p030300a " & Image (Defined_Signals (I)) & " is reserved"); Assert (Is_Reserved_Signal (Defined_Signals (I)) or else not Is_Reserved_Defined_Signal (Defined_Signals (I)), "A002: p030300a " & Image (Defined_Signals (I)) & " is not reserved"); end loop; for Sig in 1 .. Signal'Last loop Assert (not Action_Cannot_Be_Set (Sig) or else Is_Reserved_Signal (Sig) or else Sig = SIGKILL or else Sig = SIGSTOP, "A003: " & Image (Sig)); Assert (not Is_Reserved_Signal (Sig) or else Sig /= SIGKILL or else Sig /= SIGSTOP or else Action_Cannot_Be_Set (Sig), "A004: " & Image (Sig)); end loop; ---------------------------------------------------------------------- -- The default actions specified in Test_Parameters must be -- consistent with the requirements of the standard. declare Act, Req_Act : Signal_Action; begin for Sig in Signal loop Req_Act := Required_Default_Action (Sig); Act := Default_Action (Sig); Assert (Act /= Unspecified, "A005: " & Image (Sig)); if Req_Act /= Unspecified then Assert (Act = Req_Act, "A006: " & Image (Sig)); end if; end loop; end; ------------------------------------------------------------------------- -- "For the environment task, the initial signal mask is that specified -- for the process in 3.1.2 and 3.2.1." -- However, that only covers processes created via the Start_Process and -- Fork operations. The implementation is allowed to choose the -- masking state of the reserved signals. The following check assumes -- that the environment task starts out with all non-reserved signals -- unmasked. Since that assumption goes beyond the standard, this -- check only produces Comments as output. Test ("Environment task blocked signals [3.3.1]"); declare Set : Signal_Set; begin Set := Blocked_Signals; for Sig in Signal loop if Sig /= SIGNULL and then Is_Member (Set, Sig) then Comment ("WARNING: " & Image (Sig) & " blocked in env. task"); end if; end loop; exception when E1 : others => Unexpected_Exception (E1, "A007"); end; --------------------------------------------------------------------- -- The values of type Signal shall represent valid signals in the -- implementation. -- It should be possible to add any valid signal to a Signal_Set. Test ("Signal Type [3.3.2]"); declare Mask : Signal_Set; begin for Sig in Signal loop Delete_All_Signals (Mask); begin Add_Signal (Mask, Sig); exception when E1 : POSIX_Error => if Get_Error_Code = Invalid_Argument then Fail ("A008: " & Image (Sig) & " is invalid"); else Unexpected_Exception (E1, "A009"); end if; when E2 : others => Unexpected_Exception (E2, "A010"); end; end loop; exception when E1 : others => Unexpected_Exception (E1, "A011"); end; --------------------------------------------------------------------- -- Image and Value functions are defined for all valid signals, -- and have inverse effects. Image and Value are consistent with -- the standard signal names, for the signals named in the standard. Test ("Standard Signals [3.3.3]"); begin -------------------------------------------------------------- -- If Sig is the value of one of the signals defined by this -- standard, the value returned by Image shall be the identifier -- ... in uppercase. Assert (Image (Signal_Null) = "SIGNAL_NULL", "A012"); Assert (Image (SIGNULL) = Image (Signal_Null), "A013"); Assert (Image (Signal_Abort) = "SIGNAL_ABORT", "A014"); Assert (Image (SIGABRT) = Image (Signal_Abort), "A015"); Assert (Image (Signal_Alarm) = "SIGNAL_ALARM", "A016"); Assert (Image (SIGALRM) = Image (Signal_Alarm), "A017"); Assert (Image (Signal_Floating_Point_Error) = "SIGNAL_FLOATING_POINT_ERROR", "A018"); Assert (Image (SIGFPE) = Image (Signal_Floating_Point_Error), "A019"); Assert (Image (Signal_Hangup) = "SIGNAL_HANGUP", "A020"); Assert (Image (SIGHUP) = Image (Signal_Hangup), "A021"); Assert (Image (Signal_Illegal_Instruction) = "SIGNAL_ILLEGAL_INSTRUCTION", "A022"); Assert (Image (SIGILL) = Image (Signal_Illegal_Instruction), "A023"); Assert (Image (Signal_Interrupt) = "SIGNAL_INTERRUPT", "A024"); Assert (Image (SIGINT) = Image (Signal_Interrupt), "A025"); Assert (Image (Signal_Kill) = "SIGNAL_KILL", "A026"); Assert (Image (SIGKILL) = Image (Signal_Kill), "A027"); Assert (Image (Signal_Pipe_Write) = "SIGNAL_PIPE_WRITE", "A028"); Assert (Image (SIGPIPE) = Image (Signal_Pipe_Write), "A029"); Assert (Image (Signal_Quit) = "SIGNAL_QUIT", "A030"); Assert (Image (SIGQUIT) = Image (Signal_Quit), "A031"); Assert (Image (Signal_Segmentation_Violation) = "SIGNAL_SEGMENTATION_VIOLATION", "A032"); Assert (Image (SIGSEGV) = Image (Signal_Segmentation_Violation), "A033"); Assert (Image (Signal_Terminate) = "SIGNAL_TERMINATE", "A034"); Assert (Image (SIGTERM) = Image (Signal_Terminate), "A035"); Assert (Image (Signal_User_1) = "SIGNAL_USER_1", "A036"); Assert (Image (SIGUSR1) = Image (Signal_User_1), "A037"); Assert (Image (Signal_User_2) = "SIGNAL_USER_2", "A038"); Assert (Image (SIGUSR2) = Image (Signal_User_2), "A039"); if Is_Supported (Memory_Protection_Option) then Assert (Image (Signal_Bus_Error) = "SIGNAL_BUS_ERROR", "A040"); Assert (Image (SIGBUS) = Image (Signal_Bus_Error), "A041"); end if; if Is_Supported (Job_Control_Option) then Assert (Image (Signal_Child) = "SIGNAL_CHILD", "A042"); Assert (Image (SIGCHLD) = Image (Signal_Child), "A043"); Assert (Image (Signal_Continue) = "SIGNAL_CONTINUE", "A044"); Assert (Image (SIGCONT) = Image (Signal_Continue), "A045"); Assert (Image (Signal_Stop) = "SIGNAL_STOP", "A046"); Assert (Image (SIGSTOP) = Image (Signal_Stop), "A047"); Assert (Image (Signal_Terminal_Stop) = "SIGNAL_TERMINAL_STOP", "A048"); Assert (Image (SIGTSTP) = Image (Signal_Terminal_Stop), "A049"); Assert (Image (Signal_Terminal_Input) = "SIGNAL_TERMINAL_INPUT", "A050"); Assert (Image (SIGTTIN) = Image (Signal_Terminal_Input), "A051"); Assert (Image (Signal_Terminal_Output) = "SIGNAL_TERMINAL_OUTPUT", "A052"); Assert (Image (SIGTTOU) = Image (Signal_Terminal_Output), "A053"); end if; exception -- No exceptions shall be raised by Image. when E1 : others => Unexpected_Exception (E1, "A054"); end; begin ------------------------------------------------------------ -- If Str matches the short name or the long name of an -- identifier for a signal supported by the implementation ... -- Value shall return the corresponding signal value. Assert (Value ("Signal_Null") = Signal_Null, "A055"); Assert (Value ("SIGNULL") = Signal_Null, "A056"); Assert (Value ("Signal_Abort") = Signal_Abort, "A057"); Assert (Value ("siGnal_aBort") = Signal_Abort, "A058"); Assert (Value ("SIGABRT") = Signal_Abort, "A059"); Assert (Value ("siGabrt") = Signal_Abort, "A060"); Assert (Value (" Signal_Abort ") = Signal_Abort, "A061"); Assert (Value ("Signal_Alarm") = Signal_Alarm, "A062"); Assert (Value ("SIGALRM") = Signal_Alarm, "A063"); Assert (Value ("Signal_Floating_Point_Error") = Signal_Floating_Point_Error, "A064"); Assert (Value ("SIGFPE") = Signal_Floating_Point_Error, "A065"); Assert (Value ("Signal_Hangup") = Signal_Hangup, "A066"); Assert (Value ("SIGHUP") = Signal_Hangup, "A067"); Assert (Value ("Signal_Illegal_Instruction") = Signal_Illegal_Instruction, "A068"); Assert (Value ("SIGILL") = Signal_Illegal_Instruction, "A069"); Assert (Value ("Signal_Interrupt") = Signal_Interrupt, "A070"); Assert (Value ("SIGINT") = Signal_Interrupt, "A071"); Assert (Value ("Signal_Kill") = Signal_Kill, "A072"); Assert (Value ("SIGKILL") = Signal_Kill, "A073"); Assert (Value ("Signal_Pipe_Write") = Signal_Pipe_Write, "A074"); Assert (Value ("SIGPIPE") = Signal_Pipe_Write, "A075"); Assert (Value ("Signal_Quit") = Signal_Quit, "A076"); Assert (Value ("SIGQUIT") = Signal_Quit, "A077"); Assert (Value ("Signal_SegmeNTATION_Violation") = Signal_Segmentation_Violation, "A078"); Assert (Value ("SIGSEGV") = Signal_Segmentation_Violation, "A079"); Assert (Value ("Signal_Terminate") = Signal_Terminate, "A080"); Assert (Value ("SIGTERM") = Signal_Terminate, "A081"); Assert (Value ("Signal_User_1") = Signal_User_1, "A082"); Assert (Value ("SIGUSR1") = Signal_User_1, "A083"); Assert (Value ("Signal_User_2") = Signal_User_2, "A084"); Assert (Value ("SIGUSR2") = Signal_User_2, "A085"); if Is_Supported (Memory_Protection_Option) then Assert (Value ("Signal_Bus_ERROR") = Signal_Bus_Error, "A086"); Assert (Value ("SIGBUS") = Signal_Bus_Error, "A087"); end if; if Is_Supported (Job_Control_Option) then Assert (Value ("Signal_Child") = Signal_Child, "A088"); Assert (Value ("SIGCHLD") = Signal_Child, "A089"); Assert (Value ("Signal_Continue") = Signal_Continue, "A090"); Assert (Value ("SIGCONT") = Signal_Continue, "A091"); Assert (Value ("Signal_Stop") = Signal_Stop, "A092"); Assert (Value ("SIGSTOP") = Signal_Stop, "A093"); Assert (Value ("Signal_Terminal_Stop") = Signal_Terminal_Stop, "A094"); Assert (Value ("SIGTSTP") = Signal_Terminal_Stop, "A095"); Assert (Value ("Signal_Terminal_Input") = Signal_Terminal_Input, "A096"); Assert (Value ("SIGTTIN") = Signal_Terminal_Input, "A097"); Assert (Value ("Signal_Terminal_Output") = Signal_Terminal_Output, "A098"); Assert (Value ("SIGTTOU") = Signal_Terminal_Output, "A099"); end if; ----------------------------------------------------------------------- -- Value (Value ("S")) = S for Sig in Signal loop Assert (Value (Image (Sig)) = Sig, "A100: image/value of " & Image (Sig) & " " & Image (Sig) & " " & POSIX_Signals.Image (Value (Image (Sig)))); end loop; -------------------------------------------------------------------- -- Constraint_Error is raised by Value if Str does not match the -- image of any of the signals supported by the implementation. declare Sig : Signal; begin Sig := Value ("Garbage"); Assert (False, "A101"); exception when E1 : Constraint_Error => null; when E2 : others => Unexpected_Exception (E2, "A102"); end; exception when E1 : others => Unexpected_Exception (E1, "A103"); end; --------------------------------------------------------------------- -- For all the reserved signals, -- Await_Signal raises POSIX_Error with Invalid_Argument. [3.3.15] Test ("Await_Signal on reserved signals [3.3.15]"); for Sig in Signal loop if Is_Reserved_Signal (Sig) then declare Set : Signal_Set; Result : Signal; begin Delete_All_Signals (Set); Add_Signal (Set, Sig); Result := Await_Signal (Set); Expect_Exception ("A104: reserved " & Image (Sig)); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A105: reserved signal"); when E : others => Unexpected_Exception (E, "A106"); end; end if; end loop; --------------------------------------------------------------------- -- All the required signals shall be supported by every implementation. -- if the Job Control option is supported, the job control signals -- shall be supported. -- if the Memory Protection option is supported, the memory protection -- signal shall be supported. -- if the Realtime Signals option is supported, the realtime signals -- shall be supported. -- An implementation shall not impose restrictions on the ability of -- an application to send, accept, block, or ignore signals defined -- by this standard, except as specified in this standard. -- These and other general semantic requirements for support of -- certain signals are not tested separately, since the signals are used -- in the tests of several operations. --------------------------------------------------------------------- -- Signal_Null has the value zero. Assert (Signal_Null = 0, "A107"); --------------------------------------------------------------------- -- if the Realtime Signals option is supported, the range -- Realtime_Signal shall include at least -- Portable_Realtime_Signals_Maximum values, and shall not overlap -- with the named signals. if Is_Supported (Realtime_Signals_Option) then Assert (Integer (Realtime_Signal'Last - Realtime_Signal'First + 1) >= POSIX_Limits.Portable_Realtime_Signals_Maximum, "A108: Too few realtime signals:" & Image (Realtime_Signal'Last - Realtime_Signal'First + 1)); for Sig in Realtime_Signal'Range loop for I in Defined_Signals'Range loop Assert (Sig /= Defined_Signals (I), "A109: " & Image (Sig) & " in Realtime_Signal"); end loop; end loop; end if; --------------------------------------------------------------------- Test ("Signal Sets [3.3.7]"); declare Set, Set_2, Set_3 : Signal_Set; begin ------------------------------------------------------------------ -- Objects of type Signal_Set shall be implicitly initialized to -- include no signals. for Sig in 1 .. Signal'Last loop begin Assert (not Is_Member (Set, Sig), "A110"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A111"); when E1 : others => Unexpected_Exception (E1, "A112"); end; end loop; ------------------------------------------------------------------- -- Is_Member shall return the value True if and only if the set -- specified by the parameter Set includes the signal specified by -- the parameter Sig or the value of the parameter Sig is -- Signal_Null. Assert (Is_Member (Set, Signal_Null), "A113"); ------------------------------------------------------------- -- Add_All_Signals updates Set so that it -- includes all values of the type Signal. Add_All_Signals (Set); for Sig in 1 .. Signal'Last loop begin Assert (Is_Member (Set, Sig), "A114"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A115"); when E1 : others => Unexpected_Exception (E1, "A116"); end; end loop; --------------------------------------------------------------------- -- Signal_Set is a private type, so assignment and equality test -- must work with the standard Ada semantics. Add_All_Signals (Set_3); Set_2 := Set; Assert (Set = Set_2, "A117"); Assert (Set = Set_3, "A118"); Assert (Set_2 = Set_3, "A119"); for Sig in 1 .. Signal'Last loop begin -- Check Signal membership Assert (Is_Member (Set, Sig), "A120"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A121"); when E1 : others => Unexpected_Exception (E1, "A122"); end; end loop; --------------------------------------------------------------- -- Delete_All_Signals updates the set specified by Set -- so that it includes no signals. Delete_All_Signals (Set); for Sig in 1 .. Signal'Last loop begin Assert (not Is_Member (Set, Sig), "A123"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A124"); when E1 : others => Unexpected_Exception (E1, "A125"); end; end loop; --------------------------------------------------------------- -- Add_Signal adds the signal specified by Sig -- to the set of signals specified by Set. Any other -- members of the set remain. for Sig in 1 .. Signal'Last loop begin Add_Signal (Set, Sig); Assert (Is_Member (Set, Sig), "A126"); for Sig2 in Sig + 1 .. Signal'Last loop Assert (not Is_Member (Set, Sig2), "A127"); end loop; exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A128"); when E1 : others => Unexpected_Exception (E1, "A129"); end; end loop; -------------------------------------------------------------- -- Delete_Signal updates Set so that it does -- not include the signal specified by Sig. No other -- signals are deleted from the set. for Sig in 1 .. Signal'Last loop begin Delete_Signal (Set, Sig); Assert (not Is_Member (Set, Sig), "A130"); for Sig2 in Signal loop Assert (Sig2 = Sig or else Is_Member (Set, Sig2), "A131"); end loop; Add_Signal (Set, Sig); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A132"); when E1 : others => Unexpected_Exception (E1, "A133"); end; end loop; --------------------------------------------------------------- -- Delete_All_Signals updates the set specified by Set -- so that it includes no signals. Delete_All_Signals (Set); for Sig in 1 .. Signal'Last loop begin Assert (not Is_Member (Set, Sig), "A134"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A135"); when E1 : others => Unexpected_Exception (E1, "A136"); end; end loop; exception when E1 : others => Unexpected_Exception (E1, "A137"); end; --------------------------------------------------------------------- -- It is implemenentation-defined whether the signal mask is -- per-task or per-process. [3.3.1] -- The tests for operations related to signal blocking -- are intended to have the same outcome, regardless of -- whether the mask is per-task or per-process. -- This is achieved by never having a signal unmasked by -- more than one task at the same time. Test ("Block and Unblock Signals [3.3.8]"); declare Mask1, Mask2, Mask3, Mask4 : Signal_Set; New_Mask : Signal_Set; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is begin Comment ("Testing " & Image (Sig)); Mask1 := Blocked_Signals; Add_Signal (Mask1, Sig); Block_Signals (Mask1, Mask2); -- At this point, if Sig is not reserved, it is masked. -- Masking of other signals is not changed. Mask3 := Blocked_Signals; Assert (Cannot_Be_Blocked (Sig) or else Is_Member (Mask3, Sig), "A138: " & Image (Sig)); Unblock_Signals (Mask1, Mask2); for I in Signal loop Assert ((I = Sig) or else (Is_Member (Mask1, I) = Is_Member (Mask3, I)), "A139:" & Image (I)); end loop; -- At this point, all user-unmaskable signals are unmasked. Mask3 := Blocked_Signals; for I in Signal loop if not Is_Reserved_Signal (I) and then I /= SIGNULL then Assert (not Is_Member (Mask3, I), "A140: " & Image (I)); end if; end loop; end Test_Signal; begin ----------------------------------------------------------------- -- Set_Blocked_Signals returns in Old_Mask the value given -- by New_Mask in the previous call to Set_Blocked_Signals, -- except for reserved signals. Delete_All_Signals (Mask1); Delete_All_Signals (Mask2); Set_Blocked_Signals (Mask1, Mask2); Set_Blocked_Signals (Mask2, Mask3); for Sig in Signal loop Comment (Boolean'Image (Is_Reserved_Signal (Sig)) & ' ' & Boolean'Image (Is_Member (Mask1, Sig)) & ' ' & Boolean'Image (Is_Member (Mask2, Sig)) & ' ' & Boolean'Image (Is_Member (Mask3, Sig)) & ' ' & Image (Sig)); if not Is_Reserved_Signal (Sig) then Assert (Is_Member (Mask1, Sig) = Is_Member (Mask3, Sig), "A141: " & Image (Sig)); end if; end loop; ----------------------------------------------------------------- -- Attempting to block reserved signals, SIGKILL, or SIGSTOP -- does not raise an exception, but the masking of the signals -- is not changed. -- Blocked_Signals returns the set of signals that is blocked. Add_All_Signals (Mask1); Set_Blocked_Signals (Mask1, Mask3); Mask4 := Blocked_Signals; for Sig in Signal loop if not Is_Member (Mask4, Sig) then Fails_Blocking_Test (Sig) := True; Assert (Cannot_Be_Blocked (Sig), "A142: " & Image (Sig)); elsif Is_Reserved_Signal (Sig) then Fails_Blocking_Test (Sig) := True; -- Do not try blocking and unblocking reserved signals. end if; end loop; Mask1 := Blocked_Signals; -- At this point, all maskable signals are masked and Mask1 -- is equal to the current mask. --------------------------------------------------------- -- Set_Blocked_Signals returns the old mask in Old_Mask Set_Blocked_Signals (Mask2, Mask3); Assert (Mask1 = Mask3, "A143"); Delete_All_Signals (Mask1); Set_Blocked_Signals (Mask1, Mask3); -- at this point, -- all user-unmaskable signals should be unmasked for Sig in Signal loop if not Fails_Blocking_Test (Sig) then Test_Signal (Sig); end if; end loop; exception when E1 : others => Unexpected_Exception (E1, "A144"); end; ------------------------------------------------------------------------ Test ("Ignore Signals [3.3.9]"); declare New_Mask : Signal_Set; Not_Applicable : exception; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is begin Comment ("Testing " & Image (Sig)); --------------------------------------------------------------- -- Ignore_Signal, Unignore_Signal, or Is_Ignored raises -- POSIX_Error with Invalid_Argument if Sig is a signal for -- which the signal action is not permitted to be set by the -- application. if Action_Cannot_Be_Set (Sig) then begin if Is_Ignored (Sig) then null; end if; Expect_Exception ("A145: " & Image (Sig)); exception when E1 : POSIX_Error => Assert (Get_Error_Code = Invalid_Argument, "A146: " & Image (Sig) & " " & Image (Get_Error_Code)); end; begin Ignore_Signal (Sig); Expect_Exception ("A147: " & Image (Sig)); Unignore_Signal (Sig); Expect_Exception ("A148: " & Image (Sig)); exception when E1 : POSIX_Error => Assert (Get_Error_Code = Invalid_Argument, "A149: " & Image (Sig) & " " & Image (Get_Error_Code)); end; begin Unignore_Signal (Sig); Expect_Exception ("A150: " & Image (Sig)); exception when E1 : POSIX_Error => Assert (Get_Error_Code = Invalid_Argument, "A151: " & Image (Sig) & " " & Image (Get_Error_Code)); end; raise Not_Applicable; end if; --------------------------------------------------------------- -- If we get here the signal should be one that we expect to -- be able to ignore and unignore. Block_Signals (All_Signal_Mask, Old_Mask); --------------------------------------------------------------- -- When signal is not ignored, signals sent to the process -- can be caught using Await_Signal. begin Assert (not Is_Ignored (Sig), "A152"); Add_Signal (New_Mask, Sig); Block_Signals (New_Mask, Old_Mask); Send_Signal (Get_Process_ID, Sig); Try_Await_Signal (Sig, New_Mask, DU, No, "A153"); exception when Local_Failure => null; when E : others => Unexpected_Exception (E, "A154: " & Image (Sig)); end; -------------------------------------------------------------- -- There should be no pending occurrences of Sig at this point. -- If this check fails, it may mean that Send_Signal -- delivers the signal to ALL the threads in a process, -- rather than just one. declare Set : Signal_Set; begin Set := Pending_Signals; for Sig in Signal loop Assert (Sig = SIGNULL or not Is_Member (Set, Sig), "A155: " & Image (Sig) & " is pending"); end loop; end; --------------------------------------------------------------- -- If the action associated with a blocked signal is to ignore -- the signal, and if that signal is generated for the process -- or task it is unspecified whether the signal is discarded -- immediately upon generation or remains pending. [3.3.1] -- The effect of changing the signal action for a signal that -- is currently awaited by a task is unspecified. [3.3.1] -- The effect of a call to Await_Signal on the signal -- actions for the signals in Set is unspecified. [3.3.15] -- Therefore, task T waits until the signal has been sent, -- has been unmasked, and has been masked again, before trying -- to await it with the expection of the signal being ignored. Comment ("Should now be ignoring signals"); Ignore_Signal (Sig); Assert (Is_Ignored (Sig), "A156"); begin Add_Signal (New_Mask, Sig); Block_Signals (New_Mask, Old_Mask); Send_Signal (Get_Process_ID, Sig); -- Unblocking the signal should ensure it is discarded. Unblock_Signals (New_Mask, Old_Mask); Block_Signals (New_Mask, Old_Mask); Try_Await_Signal (Sig, New_Mask, DU, Yes, "A157"); exception when Local_Failure => null; when E : others => Unexpected_Exception (E, "A158"); end; --------------------------------------------------------------- -- When signal is unignored, signals sent to the process -- cause the default action (again). It should again be -- possible to use Await_Signal to catch the signal, if the -- default action allows the signal to be caught. Comment ("Should stop ignoring signals"); Unignore_Signal (Sig); Assert (not Is_Ignored (Sig), "A159"); begin Add_Signal (New_Mask, Sig); Block_Signals (New_Mask, Old_Mask); Send_Signal (Get_Process_ID, Sig); Comment ("Awaiting signal " & Image (Sig)); Try_Await_Signal (Sig, New_Mask, DU, No, "A160"); exception when Local_Failure => null; when E : others => Unexpected_Exception (E, "A161: " & Image (Sig)); end; -------------------------------------------------------------------- -- Now make sure any pending occurrences of the signal will be -- cleared out safely. declare Set, Old_Set : Signal_Set; begin Ignore_Signal (Sig); Add_Signal (Set, Sig); Unblock_Signals (Set, Old_Set); Block_Signals (Old_Set, Set); Unignore_Signal (Sig); exception when E : others => Unexpected_Exception (E, "A162"); end; exception when Not_Applicable => null; when E : others => Unexpected_Exception (E, "A163: " & Image (Sig)); end Test_Signal; procedure Test_Signal_2 (Sig : Signal); procedure Test_Signal_2 (Sig : Signal) is begin Comment ("Testing " & Image (Sig) & " with entry"); ---------------------------------------------------------------- -- Ensure all blockable signals are blocked -- in the environment task. Comment ("Blocking all signals"); Block_Signals (All_Signal_Mask, Old_Mask); --------------------------------------------------------------- -- When signal is not ignored, signals sent to the process -- cause the handler to execute. Comment ("Checking Is_Ignored"); Assert (not Is_Ignored (Sig), "A164"); --------------------------------------------------------------- -- For the Ignore_Signal operation if the signal is bound to -- a task entry, the effect shall be to discard any pending or -- subsequent deliveries of the that signal. The binding to -- the entry MAY remain in force. [3.3.17.2] -- Thus, signals sent to the process do not cause the handler -- to execute. Comment ("Ignoring signal"); Ignore_Signal (Sig); Assert (Is_Ignored (Sig), "A165"); --------------------------------------------------------------- -- When signal is unignored, the default action is restored. -- The effect of this on entries that are attached is not -- specified, since POSIX.5b says only that "the binding to the -- entry MAY remain in force". [3.3.17.2] -- If it is not in force, we expect the default action, which -- may be to terminate the process. Therefore, this check -- is deferred to a separate test. Comment ("Unignoring signal"); Unignore_Signal (Sig); Assert (not Is_Ignored (Sig), "A166"); -------------------------------------------------------------------- -- Now make sure any pending occurrences of the signal will be -- cleared out safely when we next unblock signals. Comment ("Ignoring signal"); Ignore_Signal (Sig); Unignore_Signal (Sig); exception when E1 : others => Unexpected_Exception (E1, "A167: " & Image (Sig)); end Test_Signal_2; begin for Sig in Signal loop begin if not Fails_Blocking_Test (Sig) then Test_Signal (Sig); end if; exception when E : others => Unexpected_Exception (E, "A168"); end; end loop; for Sig in Signal loop begin if not Action_Cannot_Be_Set (Sig) and then not Fails_Blocking_Test (Sig) then Test_Signal_2 (Sig); end if; exception when E1 : POSIX_Error => if Is_Supported (Signal_Entries_Option) and then Get_Error_Code /= Invalid_Argument then Unexpected_Exception (E1, "A169"); end if; when E2 : others => Unexpected_Exception (E2, "A170"); end; end loop; end; Unblock_Signals (All_Signal_Mask, Old_Mask); --------------------------------------------------------------------- Test ("Controlling Generation of Signal for Child Process [3.3.10]"); begin Assert (Stopped_Child_Signal_Enabled, "A171"); Set_Stopped_Child_Signal; -- by default, Enable := True Assert (Stopped_Child_Signal_Enabled, "A172"); Set_Stopped_Child_Signal (Enable => False); Assert (not Stopped_Child_Signal_Enabled, "A173"); exception when E : others => Unexpected_Exception (E, "A174"); end; -- To check that this operation actually works, a child process -- is required. In this test we avoid creating child processes, -- so that the test can still be run on systems that do not allow more -- than one process. --------------------------------------------------------------------- Test ("Pending Signals [3.3.11]"); declare Set : Signal_Set; begin Block_Signals (All_Signal_Mask, Old_Mask); ---------------------------------------------------------- -- Initially, no signals are pending, and all blockable -- signals are blocked. Set := Pending_Signals; for Sig in Signal loop Assert (Sig = SIGNULL or not Is_Member (Set, Sig), "A175: " & Image (Sig) & " is pending"); end loop; Comment ("Sending " & Image (SIGUSR1)); Send_Signal (Get_Process_ID, SIGUSR1); Comment ("Sending " & Image (SIGHUP)); Send_Signal (Get_Process_ID, SIGHUP); ----------------------------------------------------------- -- Signals sent to the current process are pending, -- but no others. Set := Pending_Signals; for Sig in Signal loop if Sig = SIGUSR1 or Sig = SIGHUP or Sig = SIGNULL then Assert (Is_Member (Set, Sig), "A176"); else Assert (not Is_Member (Set, Sig), "A177: " & Image (Sig) & " is pending"); end if; end loop; -------------------------------------------------------------------- -- Now make sure any pending occurrences of the signal will be -- cleared out safely. Clear_Signal (SIGUSR1, "A178"); Clear_Signal (SIGHUP, "A179"); exception when E : others => Unexpected_Exception (E, "A180"); end; Unblock_Signals (All_Signal_Mask, Old_Mask); --------------------------------------------------------------------- Test ("Signal Event Notification [3.3.12]"); declare procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is Int_Data : constant Signal_Scalar := 10; Sig_E : Signal_Event; Sig_D : Signal_Data := +Int_Data; Sig_N : Notification := Signal_Notification; begin Set_Signal (Sig_E, Sig); Set_Notification (Sig_E, No_Notification); Set_Notification (Sig_E, Sig_N); Set_Data (Sig_E, Sig_D); Assert (Sig = Get_Signal (Sig_E), "A181"); Assert (Signal_Notification = Get_Notification (Sig_E), "A182"); Assert (Int_Data = +(Get_Data (Sig_E)), "A183"); exception when E1 : others => Unexpected_Exception (E1, "A184"); end Test_Signal; begin Assert (Signal_Notification /= No_Notification, "A185"); for Sig in Signal loop Test_Signal (Sig); end loop; end; ------------------------------------------------------------------ -- Unchecked_Conversion between Signal_Data and System.Address, -- Standard.Integer, and POSIX_Timers.Timer_ID. [3.3.12] declare I : Signal_Scalar := 999; A : System.Address := I'Address; S : Signal_Data; begin S := +I; Assert (+S = I and +I = S, "A186"); S := +A; Assert (+S = A and +A = S, "A187"); declare T : POSIX_Timers.Timer_ID; Event : Signal_Event; begin Set_Notification (Event, No_Notification); T := Create_Timer (Clock_Realtime, Event); S := +T; Assert (+S = T and +T = S, "A188"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then if Get_Error_Code = Operation_Not_Supported then Set_Error_Code (Operation_Not_Implemented); end if; -- POSIX.5b erroneously specifies OPERATION_NOT_SUPPORTED -- for Create/Delete_Timer. That is inconsistent with -- POSIX.1b. Therefore, we allow Operation_Not_Implemented -- as well as Operation_Not_Supported. Optional (Timers_Option, Operation_Not_Implemented, E1, "A189"); end if; when E2 : others => Unexpected_Exception (E2, "A190"); end; exception when E : others => Unexpected_Exception (E, "A191"); end; -- .... Functional testing of signal notification is done separately, -- in the tests for each of the interfaces (e.g., message queues) -- that use it. --------------------------------------------------------------------- Test ("Signal Information [3.3.13]"); declare Signal_Sources : constant array (1 .. 5) of Signal_Source := (From_Send_Signal, From_Queue_Signal, From_Timer, From_Async_IO, From_Message_Queue); procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is Sig_I : Signal_Info; begin Set_Signal (Sig_I, Sig); Set_Source (Sig_I, From_Timer); Set_Data (Sig_I, Signal_Data'(+10)); Assert (Sig = Get_Signal (Sig_I), "A192"); Assert (From_Timer = Get_Source (Sig_I), "A193"); Assert (+10 = Get_Data (Sig_I), "A194"); exception when E1 : POSIX_Error => -- delivery until the signal is unmasked. Optional (Realtime_Signals_Option, Operation_Not_Supported, E1, "A195"); when E2 : others => Unexpected_Exception (E2, "A196"); end Test_Signal; begin for I in Signal_Sources'Range loop for J in Signal_Sources'Range loop Assert ((I = J) = (Signal_Sources (I) = Signal_Sources (J)), "A197" & Integer'Image (I) & " " & Integer'Image (J)); end loop; if Signal_Sources (I) = From_Send_Signal then Assert (not Has_Data (Signal_Sources (I)), "A198: source" & Integer'Image (I) & " has no data"); else Assert (Has_Data (Signal_Sources (I)), "A199" & Integer'Image (I)); end if; end loop; for Sig in Signal loop Test_Signal (Sig); end loop; end; --------------------------------------------------------------------- Test ("Control Signal Queueing [3.3.14]"); declare N : constant Signal_Scalar := Signal_Scalar (POSIX_Limits.Portable_Queued_Signals_Maximum); subtype Test_Range is Signal_Scalar range 700 .. 700 + N - 1; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is Timeout : Duration := 2 * DU; Info : Signal_Info; Set : Signal_Set; Installed_Empty_Handler : Boolean := False; begin Comment ("Testing " & Image (Sig)); Add_Signal (Set, Sig); Block_Signals (All_Signal_Mask, Old_Mask); Set_Signal (Info, Sig); Set_Source (Info, From_Timer); Set_Data (Info, Signal_Data'(+10)); Assert (Is_Member (Pending_Signals, Sig) = (Sig = SIGNULL), "A200"); if Sig /= SIGNULL then Comment ("Enable queueing"); if Try_Install_Empty_Handler (Sig) then Installed_Empty_Handler := True; end if; Enable_Queueing (Sig); end if; for I in Test_Range loop Comment ("Queue_Signal " & Image (Sig) & " :" & Signal_Scalar'Image (I)); Queue_Signal (Get_Process_ID, Sig, +I); end loop; --------------------------------------------------------------- -- If the parameter Sig is equal to Signal_Null, no signal -- shall be queued, but error checking shall be performed. -- [3.3.19] if Sig = Signal_Null then Comment ("Expect to timeout on SIGNULL"); begin Info := Try_Await_Signal (Sig, Set, Timeout, Yes, "A201"); exception when Local_Failure => null; when E1 : POSIX_Error => Comment ("TIMED OUT waiting for " & Image (Sig) & " (OK)"); Check_Error_Code (EAGAIN, "A202: " & Image (Sig)); when E2 : others => Unexpected_Exception (E2, "A203"); end; return; end if; Comment ("Await signals"); begin for I in Test_Range loop if Installed_Empty_Handler then Info := Try_Await_Signal (Sig, Set, Timeout, No, "A204"); else Info := Try_Await_Signal (Sig, Set, Timeout, Maybe, "A205"); end if; Assert (Get_Signal (Info) = Sig, "A206"); Assert (Get_Source (Info) = From_Queue_Signal, "A207: " & Image (Sig) & ' ' & Signal_Source'Image (Get_Source (Info))); Assert (Get_Data (Info) = +I, "A208: " & Image (Sig) & ' ' & Signal_Scalar'Image (+Get_Data (Info))); Comment ("Get_Data (Info) = " & Signal_Scalar'Image (+Get_Data (Info))); end loop; exception when Local_Failure => null; when E : others => Unexpected_Exception (E, "A209"); Clear_Signal (Sig, "A210"); end; Comment ("Disable queueing"); Disable_Queueing (Sig); -- Data may still be queued, even if queuing is disabled. -- Either way, we should get at least one of the signals. for I in Test_Range loop Comment ("Queue_Signal " & Image (Sig) & " :" & Signal_Scalar'Image (I)); Queue_Signal (Get_Process_ID, Sig, +I); end loop; for I in Test_Range loop Set_Source (Info, From_Timer); Set_Data (Info, +0); begin if I = Test_Range'First and Installed_Empty_Handler then Info := Try_Await_Signal (Sig, Set, Timeout, No, "A211"); else Info := Try_Await_Signal (Sig, Set, Timeout, Maybe, "A212"); end if; Comment ("received signal: " & Signal_Scalar'Image (I)); Assert (Get_Signal (Info) = Sig, "A213"); Assert (Get_Source (Info) = From_Queue_Signal or Get_Source (Info) = From_Timer, "A214"); ---------------------------------------------------------- -- If queueing is not enabled the Data attribute -- is undefined. [3.3.16.2] exception when Local_Failure => null; when E : others => Unexpected_Exception (E, "A215"); end; end loop; if Installed_Empty_Handler then Unignore_Signal (Sig); end if; exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Implemented, E1, "A216: " & Image (Sig)); when E2 : others => Unexpected_Exception (E2, "A217"); end Test_Signal; begin for Sig in 1 .. Signal'Last loop if not Fails_Blocking_Test (Sig) and then Default_Action (Sig) not in Ignore .. Stop then Test_Signal (Sig); -- Clear out any signals possibly left if test failed. Clear_Signal (Sig, "A218"); -- Repeat the test, to make sure resources can be reused. Test_Signal (Sig); -- Clear out any signals possibly left if test failed. Clear_Signal (Sig, "A219"); end if; end loop; exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Supported, E1, "A220"); when E2 : others => Unexpected_Exception (E2, "A221"); end; Unblock_Signals (All_Signal_Mask, Old_Mask); --------------------------------------------------------------------- -- .... It would be good to also check the behavior if queuing -- is not enabled. --------------------------------------------------------------------- -- The POSIX.5 standard does not specify whether a signal entry -- may have parameters. The interpretation here is that at least -- parameterless entries must be supported, if the Signal Entries -- option is supported at all. Test ("Signal Entries [3.3.17]"); declare procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is begin Comment ("testing " & Image (Sig)); begin case Sig is when Signal_Abort => Assert (Signal_Abort_Ref = Signal_Reference (SIGABRT), "A222"); when Signal_Hangup => Assert (Signal_Hangup_Ref = Signal_Reference (SIGHUP), "A223"); when Signal_Interrupt => Assert (Signal_Interrupt_Ref = Signal_Reference (SIGINT), "A224"); when Signal_Pipe_Write => Assert (Signal_Pipe_Write_Ref = Signal_Reference (SIGPIPE), "A225"); when Signal_Quit => Assert (Signal_Quit_Ref = Signal_Reference (SIGQUIT), "A226"); when Signal_Terminate => Assert (Signal_Terminate_Ref = Signal_Reference (SIGTERM), "A227"); when Signal_User_1 => Assert (Signal_User_1_Ref = Signal_Reference (SIGUSR1), "A228"); when Signal_User_2 => Assert (Signal_User_2_Ref = Signal_Reference (SIGUSR2), "A229"); when Signal_Child => Assert (Signal_Child_Ref = Signal_Reference (SIGCHLD), "A230"); when Signal_Continue => Assert (Signal_Continue_Ref = Signal_Reference (SIGCONT), "A231"); when Signal_Terminal_Stop => Assert (Signal_Terminal_Stop_Ref = Signal_Reference (SIGTSTP), "A232"); when Signal_Terminal_Input => Assert (Signal_Terminal_Input_Ref = Signal_Reference (SIGTTIN), "A233"); when Signal_Terminal_Output => Assert (Signal_Terminal_Output_Ref = Signal_Reference (SIGTTOU), "A234"); when others => null; end case; exception when E1 : POSIX_Error => if Is_Reserved_Signal (Sig) then Check_Error_Code (Invalid_Argument, "A235"); else Unexpected_Exception (E1, "A236: " & Image (Sig)); end if; when E2 : others => Unexpected_Exception (E2, "A237"); end; exception when E1 : POSIX_Error => if Is_Supported (Signal_Entries_Option) and then Get_Error_Code /= Invalid_Argument then Unexpected_Exception (E1, "A238"); end if; when E2 : others => Unexpected_Exception (E2, "A239"); end Test_Signal; begin for Sig in Signal loop if not Fails_Blocking_Test (Sig) then Test_Signal (Sig); end if; end loop; exception when E : others => Unexpected_Exception (E, "A240"); end; -- Active tests of signal entries are in other programs. --------------------------------------------------------------------- Test ("Send a Signal [3.3.18]"); -- This interface is tested already above, for a process sending -- a signal to itself. declare Uninitialized_Process_ID : Process_ID; Uninitialized_Group_ID : Process_ID; pragma Warnings (Off, Uninitialized_Process_ID); pragma Warnings (Off, Uninitialized_Group_ID); begin ----------------------------------------------------------------- -- Sending Signal_Null can be used to check the validity of -- a process ID or process group ID. -- This setup is not 100% reliable. With finite probability, -- the garbage might be the ID of the current process, -- killing the current process. -- If that happens, run the test again. begin Comment ("sending "); Send_Signal (Uninitialized_Process_ID, Signal_Null); Comment ("UNLIKELY: garbage ID is killable process?"); exception when E1 : POSIX_Error => if Get_Error_Code = Operation_Not_Permitted then Comment ("UNLIKELY: garbage ID is real process?"); else Check_Error_Code (No_Such_Process, "A241"); end if; when E : others => Unexpected_Exception (E, "A242"); end; -- This setup is not 100% reliable. With finite probability, -- the garbage might be the ID of the current process group, -- killing the current process. -- If that happens, run the test again. begin Comment ("sending "); Send_Signal (Uninitialized_Group_ID, Signal_Null); Comment ("UNLIKELY: garbage ID is killable group?"); exception when E1 : POSIX_Error => if Get_Error_Code = Operation_Not_Permitted then Comment ("UNLIKELY: garbage ID is real group?"); else Check_Error_Code (No_Such_Process, "A243"); end if; when E : others => Unexpected_Exception (E, "A244"); end; exception when E : others => Unexpected_Exception (E, "A245"); end; -- Active tests of Send_Signal are in other programs. --------------------------------------------------------------------- Test ("Interrupt a Task [3.3.20]"); -- The following is risky, since the error is not required to be -- detected, and if it is not detected the effect is undefined. declare Uninitialized_Task_ID : Task_Id; begin if not Is_Callable (Uninitialized_Task_ID) then Interrupt_Task (Uninitialized_Task_ID); end if; exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A246"); when Program_Error => Comment ("raised Program_Error (correctly)"); when E : others => Unexpected_Exception (E, "A247"); end; -- Active tests of Interrupt_Task are in other programs. --------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A248"); end p030300; libflorist-2025.1.0/tests/p030300.ads000066400000000000000000000061761473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030300; libflorist-2025.1.0/tests/p030300a.adb000066400000000000000000000251341473553204100170030ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 0 a -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Common declarations used by tests of package POSIX_Signals. with Ada.Command_Line; with POSIX, POSIX_Report; package body p030300a is use POSIX_Report; use Ada.Command_Line; -- Reserved_Signals contains the signals that are reserved. function Arg_Sig return Signal is begin for I in 1 .. Argument_Count loop if Argument (I)'Length >= 4 and then Argument (I)(Argument (I)'First .. Argument (I)'First + 3) = "-sig" then declare Arg : constant String := Argument (I); J : Integer := Arg'First + 4; Tmp : Integer := 0; begin while J <= Arg'Last and then Arg (J) = ' ' loop J := J + 1; end loop; while J <= Arg'Last and then Arg (J) in '0' .. '9' loop Tmp := Tmp * 10 + Character'Pos (Arg (J)) - Character'Pos ('0'); J := J + 1; end loop; while J <= Arg'Last and then Arg (J) = ' ' loop J := J + 1; end loop; if J /= Arg'Last + 1 then return 1; else return Signal (Tmp); end if; exception when others => Fail ("bad command-line argument"); end; end if; end loop; return Signal_Null; end Arg_Sig; -- Clear_Signal clears out any pending occurrences of Sig. procedure Clear_Signal (Sig : Signal; Msg : String) is Set, Old_Set : Signal_Set; begin if Sig = SIGNULL then return; end if; Add_Signal (Set, Sig); Ignore_Signal (Sig); Unblock_Signals (Set, Old_Set); Block_Signals (Old_Set, Set); Unignore_Signal (Sig); exception when E : others => Unexpected_Exception (E, Msg & ": " & Image (Sig)); end Clear_Signal; procedure Check_Time (Expect_Timeout : Yes_No_Maybe; Start_Time : POSIX.Timespec; Timeout : POSIX.Timespec; Msg : String); procedure Check_Time (Expect_Timeout : Yes_No_Maybe; Start_Time : POSIX.Timespec; Timeout : POSIX.Timespec; Msg : String) is Elapsed_Time : POSIX.Timespec; use POSIX; begin if Start_Time /= POSIX.To_Timespec (0.0) then Elapsed_Time := Get_Time (Clock_Realtime) - Start_Time; if Elapsed_Time > Timeout then Comment ("time delay", Elapsed_Time); if Expect_Timeout = Yes then Assert (Elapsed_Time > Timeout, Msg & "(a)"); end if; end if; end if; end Check_Time; procedure Try_Await_Signal (Sig : Signal; -- the signal we are expecting New_Mask : Signal_Set; -- the set of signals to await Timeout : Duration; -- how long to wait before timing out Expect_Timeout : Yes_No_Maybe; -- whether we expect to time out Msg : String) is use POSIX; Expect_Timeout_Local : Yes_No_Maybe := Expect_Timeout; Installed_Empty_Handler : Boolean; Result : Signal; Start_Time : POSIX.Timespec := POSIX.To_Timespec (0.0); begin Assert ((Expect_Timeout /= No) or not Is_Ignored (Sig), Msg & "(b)"); begin Start_Time := Get_Time (Clock_Realtime); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, Msg & "(c)"); when E2 : others => Unexpected_Exception (E2, Msg & "(d)"); end; if Default_Action (Sig) in Ignore .. Stop and then not Is_Ignored (Sig) then if Try_Install_Empty_Handler (Sig) then Comment ("Installed empty handler for " & Image (Sig)); Installed_Empty_Handler := True; else -- We expect the signal, if any, to be ignored. Expect_Timeout_Local := No; end if; end if; Result := Await_Signal_Or_Timeout (New_Mask, To_Timespec (Timeout)); if Installed_Empty_Handler then Unignore_Signal (Sig); end if; Check_Time (No, Start_Time, To_Timespec (Timeout), Msg); if Expect_Timeout_Local = Yes then Expect_Exception (Msg & "(e): " & Image (Sig)); raise Local_Failure; else Assert (Result = Sig, Msg & "(f): " & Image (Result)); end if; exception when Local_Failure => raise; when E1 : POSIX_Error => if Expect_Timeout_Local = No then Unexpected_Exception (E1, Msg & "(g)"); raise Local_Failure; end if; if Get_Error_Code = EAGAIN then Check_Time (Expect_Timeout_Local, Start_Time, To_Timespec (Timeout), Msg); else Check_Error_Code (EAGAIN, Msg & "(h): " & Image (Sig)); raise Local_Failure; end if; when E2 : others => Unexpected_Exception (E2, Msg & "(i)"); raise Local_Failure; end Try_Await_Signal; function Try_Await_Signal (Sig : Signal; New_Mask : Signal_Set; Timeout : Duration; Expect_Timeout : Yes_No_Maybe; Msg : String) return Signal_Info is use POSIX; Expect_Timeout_Local : Yes_No_Maybe := Expect_Timeout; Installed_Empty_Handler : Boolean; Start_Time : POSIX.Timespec := POSIX.To_Timespec (0.0); Info : Signal_Info; begin Assert ((Expect_Timeout /= No) or not Is_Ignored (Sig), Msg & "(b)"); begin Start_Time := Get_Time (Clock_Realtime); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, Msg & "(c)"); when E2 : others => Unexpected_Exception (E2, Msg & "(d)"); end; if Default_Action (Sig) in Ignore .. Stop and then not Is_Ignored (Sig) then if Try_Install_Empty_Handler (Sig) then Comment ("Installed empty handler for " & Image (Sig)); Installed_Empty_Handler := True; else -- We expect the signal, if any, to be ignored. Expect_Timeout_Local := No; end if; end if; Info := Await_Signal_Or_Timeout (New_Mask, To_Timespec (Timeout)); if Installed_Empty_Handler then Unignore_Signal (Sig); end if; Check_Time (No, Start_Time, To_Timespec (Timeout), Msg); if Expect_Timeout_Local = Yes then Expect_Exception (Msg & "(e): " & Image (Sig)); raise Local_Failure; else Assert (POSIX_Signals.Get_Signal (Info) = Sig, Msg & "(f): " & Image (POSIX_Signals.Get_Signal (Info))); end if; return Info; exception when Local_Failure => raise; when E1 : POSIX_Error => if Expect_Timeout_Local = No then Unexpected_Exception (E1, Msg & "(g)"); raise Local_Failure; end if; if Get_Error_Code = EAGAIN then Check_Time (Expect_Timeout_Local, Start_Time, To_Timespec (Timeout), Msg); return Info; else Check_Error_Code (EAGAIN, Msg & "(h): " & Image (Sig)); raise Local_Failure; end if; when E2 : others => Unexpected_Exception (E2, Msg & "(i)"); raise Local_Failure; end Try_Await_Signal; begin Add_All_Signals (All_Signal_Mask); for Sig in Realtime_Signal loop Required_Default_Action (Sig) := Termination; end loop; for Sig in Signal loop Cannot_Be_Blocked (Sig) := Is_Reserved_Signal (Sig) or Sig = SIGKILL or Sig = SIGSTOP; end loop; end p030300a; libflorist-2025.1.0/tests/p030300a.ads000066400000000000000000000207101473553204100170170ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Common declarations used by tests of package POSIX_Signals. with POSIX_Signals, POSIX_Timers, POSIX.C, System, Test_Parameters, Unchecked_Conversion; package p030300a is pragma Elaborate_Body; use POSIX_Signals, POSIX_Timers, Test_Parameters; type Signal_Scalar is mod 2 ** (POSIX.C.sigval_byte_size * System.Storage_Unit); function "+" is new Unchecked_Conversion (Signal_Scalar, Signal_Data); function "+" is new Unchecked_Conversion (Signal_Data, Signal_Scalar); function "+" is new Unchecked_Conversion (System.Address, Signal_Data); function "+" is new Unchecked_Conversion (Signal_Data, System.Address); function "+" is new Unchecked_Conversion (Timer_ID, Signal_Data); function "+" is new Unchecked_Conversion (Signal_Data, Timer_ID); type Signal_List is array (Positive range <>) of Signal; -- These special classes of signals are all defined in 3.3.3.1. Defined_Signals : Signal_List := (SIGABRT, SIGALRM, SIGBUS, SIGFPE, SIGHUP, SIGILL, SIGINT, SIGKILL, SIGPIPE, SIGQUIT, SIGSEGV, SIGTERM, SIGUSR1, SIGUSR2, SIGCHLD, SIGCONT, SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU); Is_Reserved_Defined_Signal : constant array (Signal) of Boolean := (SIGILL | SIGABRT | SIGFPE | SIGBUS | SIGSEGV | SIGALRM => True, others => False); -- Cannot_Be_Blocked is initialized in the package body to the -- set of signals for which the standard permits the blocking and -- unblocking operations to have no effect. Cannot_Be_Blocked : array (Signal) of Boolean; ----------------------------------------------------------------------- -- The signals SIGABRT, SIGARLM, SIGFPR, SIGILL, SIGSEGV, and SIGBUS -- are reserved. The implementation may reserve other signals whose -- names are not defined by the standard. [2.2.2.117]. Job_Control_Signals : constant Signal_List := (SIGCHLD, SIGCONT, SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU); Required_Default_Action : array (Signal) of Signal_Action := (SIGCHLD => Ignore, SIGCONT => Continue, SIGSTOP | SIGTSTP | SIGTTIN | SIGTTOU => Stop, SIGHUP | SIGINT | SIGKILL | SIGPIPE | SIGQUIT | SIGTERM | SIGUSR1 | SIGUSR2 => Termination, others => Unspecified); -- Default action for Realtime_Signal cannot be specified -- in aggregate, in case the range happens to be null. -- Hence this table is updated in the subprogram body. All_Signal_Mask : Signal_Set; -- All_Signals contains all the values of type Signal. DU : constant Duration := Test_Parameters.Delay_Unit; -- DU is a common unit of delay duration. LDU : constant Duration := Test_Parameters.New_Process_Startup; -- LDU is enough time for a new process to load and start up function Arg_Sig return Signal; -- Arg_Sig returns the value NNN if there is a command-line -- argument of the form "-sig NNN". type Child_Action is (Not_Specified, Delay_Then_Exit, Block_And_Await, Block_And_Await_With_Info, Block_And_Await_With_No_Info, Unblock_And_Ignore, Block_Unignore_And_Await, Unblock_And_Unignore); -- Not_Initially_Masked is a set of signals that a test -- discovers are not initially masked in all tasks, and so -- certain further tests cannot safely use these signals. -- It is up to the individual test to populate this set, if -- the test uses it. Not_Initially_Masked : Signal_Set; -- Fails_Blocking_Test is used to reduce the cascade of error -- messages or terminated process that would occur if we perform -- tests on a signal that is not reserved but which we -- are unable to block. In practice, failure of the initial -- test of block-ability means the implementation has reserved -- a signal that the POSIX.5/5b standards do not permit the -- implementation to reserve. -- It is up to the individual test to populate this set, if -- the test uses it. Fails_Blocking_Test : array (Signal) of Boolean := (others => False); -- It is up to the individual test to populate Do_Not_Test, -- if it uses it. Do_Not_Test : array (Signal) of Boolean := (others => False); Local_Failure : exception; type Yes_No_Maybe is ( Yes, -- expect to time out No, -- expect to not time out Maybe -- either is OK ); procedure Try_Await_Signal (Sig : Signal; New_Mask : Signal_Set; Timeout : Duration; Expect_Timeout : Yes_No_Maybe; Msg : String); -- Try_Await_Signal calls Await_Signal_With_Timeout. -- If the default action for Sig is to ignore it, it tries -- to first install an empty handler, and afterward remove it. -- If installing the empty handler does not work, it expects -- to time out. -- It also checks for early timeouts. -- Raises Local_Failure if the unexpected happens. function Try_Await_Signal (Sig : Signal; New_Mask : Signal_Set; Timeout : Duration; Expect_Timeout : Yes_No_Maybe; Msg : String) return Signal_Info; -- Same effect as above, but returns Signal_Info. procedure Clear_Signal (Sig : Signal; Msg : String); -- Clear_Signal clears out any pending occurrences of Sig. end p030300a; libflorist-2025.1.0/tests/p030301.adb000066400000000000000000000722371473553204100166510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 2000-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test interactions of package POSIX_Signals with other packages, -- including POSIX_Message_Queues, POSIX_Timers, and -- POSIX_Asychronous_IO. -- Setup: The program must be run with the executable file for -- program p030301b accessible via the pathname "./p030301b". with Ada.Streams, Ada_Task_Identification, POSIX, POSIX_Asynchronous_IO, POSIX.C, POSIX_Files, POSIX_IO, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, POSIX_Timers, p030300a, System, Test_Parameters, Unchecked_Conversion; procedure p030301 is use Ada.Streams, Ada_Task_Identification, POSIX, POSIX_Asynchronous_IO, POSIX_Files, POSIX_IO, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, POSIX_Timers, p030300a, Test_Parameters; type Signal_Scalar is mod 2 ** (C.sigval_byte_size * System.Storage_Unit); function To_Signal_Data is new Unchecked_Conversion (Signal_Scalar, Signal_Data); function To_Integer is new Unchecked_Conversion (Signal_Data, Signal_Scalar); Old_Mask : Signal_Set; Signals : constant array (1 .. 3) of Signal := (SIGHUP, SIGUSR1, SIGUSR2); Valid_MQ_Name : constant POSIX.POSIX_String := "/test_mq"; Valid_AIO_File_Name : constant POSIX.POSIX_String := "aio_test_file"; Child_Pathname : POSIX_String := "./p030301b"; Child_Name : POSIX_String := "p030301b"; Queueing_Is_Enabled : Boolean := False; -- It would be nice if this were a standard function. procedure Try_Enable_Queueing (Sig : Signal; Msg : String); procedure Try_Disable_Queueing (Sig : Signal); procedure Try_Enable_Queueing (Sig : Signal; Msg : String) is begin Enable_Queueing (Sig); Queueing_Is_Enabled := True; exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Supported, E1, Msg & 'a'); when E2 : others => Unexpected_Exception (E2, Msg & 'b'); end Try_Enable_Queueing; procedure Try_Disable_Queueing (Sig : Signal) is begin if Queueing_Is_Enabled then Disable_Queueing (Sig); Queueing_Is_Enabled := False; end if; end Try_Disable_Queueing; begin Header ("p030301"); Test ("Validity of Signals used for this test "); declare Mask : Signal_Set; begin for I in Signals'Range loop Delete_All_Signals (Mask); begin Add_Signal (Mask, Signals (I)); exception when E1 : POSIX_Error => Comment (Image (Signals (I)) & " is not a valid signal"); Fatal_Exception (E1, "A001:" & Image (Signals (I))); when E2 : others => Unexpected_Exception (E2, "A002: " & Image (Signals (I))); end; end loop; end; --------------------------------------------------------------------- -- Set_Stopped_Child_Signal shall control the generation of the -- Signal_Child signal, if the implementation supports the -- Signal_Child signal. -- If the default action is to stop the process, the execution of -- that process (including all tasks within it) shall be -- temporarily suspended. When a process stops, a Signal_Child -- signal shall be generated for its parent process, unless the -- parent process has disabled this feature, by calling -- Set_Stopped_Child_Signal with parameter Enable set to False. -- [3.3.4] -- Stopped_Child_Signal_Enabled shall return True if and only if -- the signal specified by Signal_Child will be generated for the -- calling process whenever any of its child processes stop. Test ("Set_Stopped_Child_Signal [3.3.10]"); declare New_Mask : Signal_Set; Child_ID : Process_ID; Template : Process_Template; Args : POSIX_String_List; Status : Termination_Status; procedure Do_Test (Expect_Timeout : Yes_No_Maybe; Msg : String); procedure Do_Test (Expect_Timeout : Yes_No_Maybe; Msg : String) is begin Comment ("Starting child process"); Start_Process (Child_ID, Child_Pathname, Template, Args); Wait_For_Child_Process (Status, Child_ID, Block => False); Assert (not Status_Available (Status), "A003: " & Msg); Comment ("Parent: stopping child"); Send_Signal (Child_ID, SIGSTOP); Comment ("Parent: awaiting SIGCHLD"); begin Try_Await_Signal (SIGCHLD, New_Mask, 3.0, Expect_Timeout, "A004: " & Msg); exception when Local_Failure => null; when E : others => Unexpected_Exception (E, "A005: " & Msg); end; Comment ("Parent: continuing child"); Send_Signal (Child_ID, SIGCONT); Wait_For_Child_Process (Status, Child_ID); Check_Child_Status (Status, Child_ID, 0, "A006: " & Msg); end Do_Test; begin Open_Template (Template); Make_Empty (Args); POSIX.Append (Args, Child_Name); POSIX.Append (Args, "-child"); Pass_Through_Verbosity (Args); ------------------------------------------------------------------ -- The initial state of the process has the generation of -- SIGCHLD enabled for stopped child processes. begin Assert (Stopped_Child_Signal_Enabled, "A007"); exception when E : others => Unexpected_Exception (E, "A008"); end; ------------------------------------------------------------------ -- If the parameter Enable has the value True, the -- Signal_Child signal shall be generated for the calling -- process whenever any of its child processes stop. Comment ("Setting Stopped_Child_Signal to True"); begin Set_Stopped_Child_Signal (True); Assert (Stopped_Child_Signal_Enabled, "A009"); exception when E : others => Unexpected_Exception (E, "A010"); end; Delete_All_Signals (New_Mask); Add_Signal (New_Mask, SIGCHLD); Comment ("Blocking SIGCHLD"); Block_Signals (New_Mask, Old_Mask); Do_Test (No, "initial task"); ------------------------------------------------------------------ -- Redo the test case above, where the task awaiting the -- child is not the initial task of the process. declare task T; task body T is begin Do_Test (No, "subsidiary task"); end T; begin null; end; ------------------------------------------------------------------ -- If Enable is False, the implementation shall not generate -- the Signal_Child signal in this way. Comment ("Setting Stopped_Child_Signal to False"); Set_Stopped_Child_Signal (False); Assert (not Stopped_Child_Signal_Enabled, "A011"); Do_Test (Yes, "initial task, no child signal"); exception when E1 : POSIX_Error => Optional (Job_Control_Option, Invalid_Argument, E1, "A012"); when E2 : others => Unexpected_Exception (E2, "A013"); end; --------------------------------------------------------------------- -- If a signal is sent to a process while the signal is masked -- for all tasks in the process, the signal remains pending, and -- can be detected via a call to Pending_Signals. -- As soon as the pending signal is cleared, it is no longer -- detected by Pending_Signals. Test ("Pending_Signals [3.3.11]"); declare New_Mask : Signal_Set; begin for I in Signals'Range loop Delete_All_Signals (New_Mask); Add_Signal (New_Mask, Signals (I)); Comment ("Blocking signal"); Block_Signals (New_Mask, Old_Mask); Comment ("Sending signal to self"); Send_Signal (POSIX_Process_Identification.Get_Process_ID, Signals (I)); Assert (Is_Member (Pending_Signals, Signals (I)), "A014"); Comment ("Discarding signal"); Ignore_Signal (Signals (I)); Unblock_Signals (New_Mask, Old_Mask); Assert (not Is_Member (Pending_Signals, Signals (I)), "A015"); Unignore_Signal (Signals (I)); end loop; exception when E1 : others => Unexpected_Exception (E1, "A016"); end; --------------------------------------------------------------------- Test ("Await_Signal without info [3.3.15]"); declare Old_Sig : Signal; Old_Mask : Signal_Set; New_Mask : Signal_Set; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is begin Comment ("Testing Await_Signal on signal " & Image (Sig)); Delete_All_Signals (New_Mask); Add_Signal (New_Mask, Sig); Block_Signals (New_Mask, Old_Mask); Comment ("Sending self " & Image (Sig)); Send_Signal (POSIX_Process_Identification.Get_Process_ID, Sig); Comment ("Awaiting signal " & Image (Sig)); Old_Sig := Await_Signal (New_Mask); -- This should return immediately since there is a signal pending Assert (Old_Sig = Sig, "A017"); Send_Signal (POSIX_Process_Identification.Get_Process_ID, Sig); Comment ("Awaiting " & Image (Sig)); begin Old_Sig := Await_Signal_Or_Timeout (New_Mask, To_Timespec (1, 0)); -- This should return immediately since there is a signal pending. Assert (Old_Sig = Sig, "A018"); exception when E1 : others => Unexpected_Exception (E1, "A019"); end; Comment ("Sending self " & Image (Sig)); Send_Signal (POSIX_Process_Identification.Get_Process_ID, Sig); Comment ("Awaiting " & Image (Sig)); begin Old_Sig := Await_Signal_Or_Timeout (New_Mask, To_Timespec (1, 0)); -- This should return immediately since there is a signal pending. Assert (Old_Sig = Sig, "A020"); exception when E1 : others => Unexpected_Exception (E1, "A021"); end; Comment ("Awaiting " & Image (Sig)); begin Old_Sig := Await_Signal_Or_Timeout (New_Mask, To_Timespec (1, 0)); -- This should raise POSIX_Error when the time expires, -- since there should no longer be an instance of the signal -- pending. Expect_Exception ("A022"); exception when POSIX_Error => Check_Error_Code (Resource_Temporarily_Unavailable, "A023"); when E1 : others => Unexpected_Exception (E1, "A024"); end; Unblock_Signals (New_Mask, Old_Mask); exception when E1 : others => Unexpected_Exception (E1, "A025"); end Test_Signal; begin for I in Signals'Range loop Test_Signal (Signals (I)); end loop; exception when E : others => Unexpected_Exception (E, "A026"); end; --------------------------------------------------------------------- Test ("Await_Signal with info [3.3.16]"); declare New_Mask : Signal_Set; Sig_Info : Signal_Info; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is begin Comment ("Testing Await_Signal with info on signal " & Image (Sig)); Delete_All_Signals (New_Mask); Add_Signal (New_Mask, Sig); Block_Signals (New_Mask, Old_Mask); Send_Signal (POSIX_Process_Identification.Get_Process_ID, Sig); Sig_Info := Await_Signal (New_Mask); Assert (Get_Signal (Sig_Info) = Sig, "A027"); -- This should return immediately since there is a signal pending Send_Signal (POSIX_Process_Identification.Get_Process_ID, Sig); begin Sig_Info := Await_Signal_Or_Timeout (New_Mask, To_Timespec (1, 0)); -- This should return immediately since there is a signal pending Assert (Get_Signal (Sig_Info) = Sig, "A028"); exception when E1 : others => Unexpected_Exception (E1, "A029"); end; begin Sig_Info := Await_Signal_Or_Timeout (New_Mask, To_Timespec (1, 0)); -- This should not return with signal catching. Instead it -- should return a POSIX_Error when the time expires. Expect_Exception ("A030"); exception when POSIX_Error => Check_Error_Code (Resource_Temporarily_Unavailable, "A031"); when E1 : others => Unexpected_Exception (E1, "A032"); end; Unblock_Signals (New_Mask, Old_Mask); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Implemented, E1, "A033"); when E2 : others => Unexpected_Exception (E2, "A034"); end Test_Signal; begin for I in Signals'Range loop Test_Signal (Signals (I)); end loop; exception when E : others => Unexpected_Exception (E, "A035"); end; --------------------------------------------------------------------- Test ("Interrupt_Task [3.3.20]"); declare task Blocked_Task is entry Get_ID (ID : out Task_Id); end Blocked_Task; task body Blocked_Task is Buf_1 : POSIX_String (1 .. 4); Last : IO_Count; begin accept Get_ID (ID : out Task_Id) do ID := Current_Task; end Get_ID; POSIX_IO.Read (POSIX_IO.Standard_Input, Buf_1, Last); exception when POSIX_Error => Check_Error_Code (Interrupted_Operation, "A036"); when E1 : others => Unexpected_Exception (E1, "A037"); end Blocked_Task; T_ID : Task_Id; begin Blocked_Task.Get_ID (T_ID); delay 0.1; Interrupt_Task (T_ID); end; --------------------------------------------------------------------- Test ("Queue_Signal [3.3.19]"); declare New_Mask : Signal_Set; Sig_Info : Signal_Info; Sig_D : Signal_Data := To_Signal_Data (10); begin for I in Signals'Range loop Delete_All_Signals (New_Mask); Add_Signal (New_Mask, Signals (I)); Block_Signals (New_Mask, Old_Mask); Try_Enable_Queueing (Signals (I), "A038"); delay 0.1; Queue_Signal (POSIX_Process_Identification.Get_Process_ID, Signals (I), Sig_D); Sig_Info := Await_Signal (New_Mask); Assert (Get_Data (Sig_Info) = Sig_D, "A039: signal data = " & Signal_Scalar'Image (To_Integer (Get_Data (Sig_Info)))); Try_Disable_Queueing (Signals (I)); Unblock_Signals (New_Mask, New_Mask); end loop; exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Implemented, E1, "A040"); when E2 : others => Unexpected_Exception (E2, "A041"); end; --------------------------------------------------------------------- Test ("Signal notification with message queue [3.3.13.2]"); declare New_Mask : Signal_Set; Sig_Info : Signal_Info; Sig_D : Signal_Data := To_Signal_Data (20); Sig_E : Signal_Event; MQ : Message_Queue_Descriptor; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is Received_Signal : Boolean := False; pragma Volatile (Received_Signal); task Watchdog; task body Watchdog is begin delay 2.0; if not Received_Signal then Comment ("Watchdog time out"); Send_Signal (Get_Process_ID, Sig); end if; end Watchdog; begin Comment ("Testing " & Image (Sig)); Comment ("Checking that no residual message queue exists."); begin Unlink_Message_Queue (Valid_MQ_Name); exception when E1 : POSIX_Error => if Get_Error_Code /= No_Such_File_Or_Directory then Optional (Realtime_Signals_Option, Operation_Not_Implemented, E1, "A042"); end if; when E2 : others => Unexpected_Exception (E2, "A043"); end; Comment ("Creating message queue"); MQ := Open_Or_Create (Valid_MQ_Name, Read_Write, Owner_Permission_Set); Set_Signal (Sig_E, Sig); Set_Notification (Sig_E, Signal_Notification); Set_Data (Sig_E, Sig_D); Comment ("Requesting notification"); Request_Notify (MQ, Sig_E); Delete_All_Signals (New_Mask); Add_Signal (New_Mask, Sig); Comment ("Blocking signals"); Block_Signals (New_Mask, Old_Mask); Comment ("Checking blocked signals"); Assert (Is_Member (Blocked_Signals, Sig), "A044"); Try_Enable_Queueing (Sig, "A045"); Comment ("Sending message"); Send (MQ, To_Stream_Element_Array ("Hello....."), 1); Comment ("Checking pending signals"); Assert (Is_Member (Pending_Signals, Sig), "A046"); Comment ("Delaying"); delay 0.1; Comment ("Awaiting signal"); Sig_Info := Await_Signal (New_Mask); Received_Signal := True; Assert (Get_Signal (Sig_Info) = Sig, "A047: signal = " & Signal'Image (Get_Signal (Sig_Info))); Assert (Get_Data (Sig_Info) = Sig_D, "A048: signal data = " & Signal_Scalar'Image (To_Integer (Get_Data (Sig_Info)))); Try_Disable_Queueing (Sig); Comment ("Unblocking signals"); Unblock_Signals (New_Mask, New_Mask); Comment ("Closing MQ"); Close (MQ); Comment ("Unlinking MQ"); Unlink_Message_Queue (Valid_MQ_Name); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Message_Queues_Option, Operation_Not_Implemented, E1, "A049"); when E2 : others => Unexpected_Exception (E2, "A050"); end Test_Signal; begin for I in Signals'Range loop if not Is_Reserved_Signal (Signals (I)) then Test_Signal (Signals (I)); end if; end loop; end; --------------------------------------------------------------------- Test ("Signal notification with async. I/O"); declare New_Mask : Signal_Set; Sig_Info : Signal_Info; Sig_D : Signal_Data := To_Signal_Data (40); Sig_E : Signal_Event; AD_1 : AIO_Descriptor; AD_2 : AIO_Descriptor; FD : File_Descriptor; Buf_1 : IO_Array_Pointer := new Stream_Element_Array (1 .. 10); Buf_2 : IO_Array_Pointer := new Stream_Element_Array (1 .. 10); List : AIO_Descriptor_List (1 .. 1); Count : Natural := 0; Received_Signals : array (Signals'Range) of Boolean := (others => False); pragma Volatile_Components (Received_Signals); task Watchdog; task body Watchdog is begin delay 2.0; if not Received_Signals (2) then Send_Signal (Get_Process_ID, Signals (2)); end if; delay 2.0; if not Received_Signals (3) then Send_Signal (Get_Process_ID, Signals (3)); end if; end Watchdog; begin Delete_All_Signals (New_Mask); Add_Signal (New_Mask, Signals (2)); Add_Signal (New_Mask, Signals (3)); Comment ("Blocking signals"); Block_Signals (New_Mask, Old_Mask); Try_Enable_Queueing (Signals (3), "A051"); AD_1 := Create_AIO_Control_Block; Comment ("Setting buffer"); Set_Buffer (AD_1, Buf_1); Buf_1.all := To_Stream_Element_Array ("hello....1"); Set_Length (AD_1, 6); AD_2 := Create_AIO_Control_Block; Comment ("Setting buffer"); Set_Buffer (AD_2, Buf_2); Buf_2.all := To_Stream_Element_Array ("hello....2"); Set_Length (AD_2, 6); Comment ("Setting signal"); Set_Signal (Sig_E, Signals (2)); Set_Data (Sig_E, Sig_D); Set_Notification (Sig_E, Signal_Notification); Comment ("Setting event"); Set_Event (AD_1, Sig_E); Comment ("Setting signal"); Set_Signal (Sig_E, Signals (3)); Set_Data (Sig_E, Sig_D); Set_Notification (Sig_E, Signal_Notification); Comment ("Setting event"); Set_Event (AD_2, Sig_E); Comment ("Opening file"); FD := Open_Or_Create (Valid_AIO_File_Name, Read_Write, Owner_Permission_Set); Set_File (AD_1, FD); Set_Operation (AD_1, Write); Set_File (AD_2, FD); Set_Operation (AD_2, Write); List (1) := AD_1; Comment ("List_IO_No_Wait call"); List_IO_No_Wait (List, Sig_E); Comment ("Write call"); Write (AD_2); Comment ("Delaying"); delay 1.0; Delete_Signal (New_Mask, Signals (3)); Assert (not Is_Member (New_Mask, Signals (3)), "A052"); Assert (Is_Member (New_Mask, Signals (2)), "A053"); Comment ("Awaiting Signal (2)"); Sig_Info := Await_Signal (New_Mask); Received_Signals (2) := True; Assert (Get_Signal (Sig_Info) = Signals (2), "A054: signal = " & Signal'Image (Get_Signal (Sig_Info))); Assert (Get_Data (Sig_Info) = Sig_D, "A055: signal data = " & Signal_Scalar'Image (To_Integer (Get_Data (Sig_Info)))); Assert (not Is_Member (Pending_Signals, Signals (2)), "A056"); Assert (Is_Member (Pending_Signals, Signals (3)), "A057"); Delete_Signal (New_Mask, Signals (2)); Add_Signal (New_Mask, Signals (3)); Assert (not Is_Member (New_Mask, Signals (2)), "A058"); Assert (Is_Member (New_Mask, Signals (3)), "A059"); Comment ("Awaiting Signal (3)"); Sig_Info := Await_Signal (New_Mask); Received_Signals (3) := True; Assert (Get_Signal (Sig_Info) = Signals (3), "A060: signal = " & Signal'Image (Get_Signal (Sig_Info))); Assert (Get_Data (Sig_Info) = Sig_D, "A061: signal data = " & Signal_Scalar'Image (To_Integer (Get_Data (Sig_Info)))); Assert (not Is_Member (Pending_Signals, Signals (2)), "A062"); Count := 1; while Is_Member (Pending_Signals, Signals (3)) and Count < 100 loop Count := Count + 1; end loop; Assert (Count = 1, "A063: Count =" & Integer'Image (Count)); Comment ("Ignoring signals"); Ignore_Signal (Signals (2)); Ignore_Signal (Signals (3)); Comment ("Unignoring signals"); Unignore_Signal (Signals (2)); Unignore_Signal (Signals (3)); Assert (not Is_Member (Pending_Signals, Signals (3)), "A064"); Assert (not Is_Member (Pending_Signals, Signals (2)), "A065"); Try_Disable_Queueing (Signals (3)); Comment ("Unblocking signals"); Add_Signal (New_Mask, Signals (2)); Unblock_Signals (New_Mask, New_Mask); Comment ("Closing aio test file"); Close (FD); Comment ("Unlinking aio test file"); Unlink (Valid_AIO_File_Name); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A066"); when E2 : others => Unexpected_Exception (E2, "A067"); end; --------------------------------------------------------------------- Test ("Signal notification with timers"); declare New_Mask : Signal_Set; Sig_Info : Signal_Info; Sig_D : Signal_Data := To_Signal_Data (30); Sig_E : Signal_Event; Tid : Timer_ID; New_State : Timer_State; Initial : Timespec; Interval : Timespec; Count : Natural := 0; begin Comment ("Creating timer"); Set_Signal (Sig_E, Signals (3)); Set_Data (Sig_E, Sig_D); Set_Notification (Sig_E, Signal_Notification); Tid := Create_Timer (Clock_Realtime, Sig_E); Comment ("Blocking signal"); Delete_All_Signals (New_Mask); Add_Signal (New_Mask, Signals (3)); Block_Signals (New_Mask, Old_Mask); Try_Enable_Queueing (Signals (3), "A068"); Comment ("Setting up timer"); POSIX.Set_Seconds (Initial, 1); POSIX.Set_Nanoseconds (Initial, 1); POSIX.Set_Seconds (Interval, 0); POSIX.Set_Nanoseconds (Interval, 0); Set_Initial (New_State, Initial); Set_Interval (New_State, Interval); -- Since Absolute_Timer is specified, timer is set to expire to -- Epoch+1 seconds, so it will generate a signal immediately. -- Interval = 0, thus it only generates the signal once. Arm_Timer (Tid, Absolute_Timer, New_State); Comment ("Delaying"); delay 0.1; Comment ("Awaiting signal"); Sig_Info := Await_Signal (New_Mask); Assert (not Is_Member (Pending_Signals, Signals (3)), "A069"); Assert (Get_Signal (Sig_Info) = Signals (3), "A070: signal = " & Signal'Image (Get_Signal (Sig_Info))); Assert (Get_Data (Sig_Info) = Sig_D, "A071: signal data = " & Signal_Scalar'Image (To_Integer (Get_Data (Sig_Info)))); Count := 1; while Is_Member (Pending_Signals, Signals (3)) and Count < 100 loop Count := Count + 1; end loop; Assert (Count = 1, "A072: Count =" & Integer'Image (Count)); Try_Disable_Queueing (Signals (3)); Comment ("Ignoring signals"); Ignore_Signal (Signals (2)); Ignore_Signal (Signals (3)); Comment ("Unignoring signals"); Unignore_Signal (Signals (2)); Unignore_Signal (Signals (3)); Assert (not Is_Member (Pending_Signals, Signals (3)), "A073"); Unblock_Signals (New_Mask, New_Mask); Delete_Timer (Tid); exception when E1 : POSIX_Error => if Get_Error_Code = Operation_Not_Supported then Set_Error_Code (Operation_Not_Implemented); end if; -- POSIX.5b erroneously specifies OPERATION_NOT_SUPPORTED for -- Create/Delete_Timer. That is inconsistent with POSIX.1b. -- Therefore, we allow Operation_Not_Implemented as well as -- Operation_Not_Supported. Optional (Realtime_Signals_Option, Timers_Option, Operation_Not_Implemented, E1, "A074"); when E2 : others => Unexpected_Exception (E2, "A075"); end; Done; exception when E : others => Fatal_Exception (E, "A076"); end p030301; libflorist-2025.1.0/tests/p030301.ads000066400000000000000000000061751473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030301; libflorist-2025.1.0/tests/p030301b.adb000066400000000000000000000066021473553204100170040ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 1 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Child process for support of test p030301. with POSIX_Report; procedure p030301b is use POSIX_Report; begin Comment ("Child: delaying"); delay 1.0; Comment ("Child: exiting"); Done; exception when E : others => Fatal_Exception (E, "A006"); end p030301b; libflorist-2025.1.0/tests/p030301b.ads000066400000000000000000000062561473553204100170320ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 1 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Child process for support of test p030301. procedure p030301b; libflorist-2025.1.0/tests/p030302.adb000066400000000000000000000172721473553204100166500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 2 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This a test of the POSIX_Signals package, and other features of -- section 3.3 of POSIX.5b. This test focusses on requirements that -- involve more than one process. with Ada.Streams, Ada_Task_Identification, POSIX, POSIX_Asynchronous_IO, POSIX_Files, POSIX_IO, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, POSIX_Timers, POSIX_Unsafe_Process_Primitives, System, System.Storage_Elements, Unchecked_Conversion; procedure p030302 is use Ada.Streams, Ada_Task_Identification, POSIX, POSIX_Asynchronous_IO, POSIX_Files, POSIX_IO, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, POSIX_Timers, POSIX_Unsafe_Process_Primitives, System; function To_Signal_Data is new Unchecked_Conversion (Integer, Signal_Data); function To_Integer is new Unchecked_Conversion (Signal_Data, Integer); begin Header ("p030302"); --------------------------------------------------------------------- -- [3.1.2] The initial mask of the environment task -- shall be the set specified by the Signal Mask attribute of -- the process template. --------------------------------------------------------------------- -- [3.3.1] When any stop signal (Signal_Stop, -- Signal_Terminal_Stop, Signal_Terminal_Input, -- Signal_Terminal_Output) is generated for a process, any -- pending Signal_Continue signals for that process shall be -- discarded. Conversely, when Signal_Continue is generated for -- a process, all pending stop signals for that process shall be -- discarded. When Signal_Continue is generated for a process -- that is stopped, the process shall be continued, even if the -- Signal_Continue is blocked or ignored. If Signal_Continue is -- blocked and not ignored, it shall remain pending until it is -- either unblocked or a stop signal is generated for the -- process. --------------------------------------------------------------------- -- When multiple unblocked signals, all in the range -- Realtime_Signal are pending, the behavior shall be as if the -- implementation delivers the pending, unblocked signal with the -- lowest signal number within that range. No other ordering of -- signal delivery is specified. --------------------------------------------------------------------- -- [3.3.4] The default action for the required signals that are not -- reserved is to terminate the process abnormally. -- The required non-reserved signals are: -- SIGHUP, SIGINT, SIGKILL, SIGPIPE, SIGQUIT, SIGTERM, SIGUSR1, -- SIGUSR2, SIGCHLD -- If the Job Control option is supported the following also are -- required: -- SIGCONT, SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU -- If the Realtime Signals option is supported, the realtime signals -- are required to be supported. --------------------------------------------------------------------- -- [3.3.4] The default action for Signal_Child is to ignore it. --------------------------------------------------------------------- -- [3.3.4] The default action for Signal_Continue is to continue. --------------------------------------------------------------------- -- [3.3.4] The default action for Signal_Stop, Signal_Terminal_Stop, -- Signal_Terminal_Input, and Signal_Terminal_Output is to stop the -- process. --------------------------------------------------------------------- -- [3.3.6] Signals that are ignored shall not affect the behavior of -- any operation. --------------------------------------------------------------------- -- [3.3.6] Signals that are blocked shall not affect the behavior of -- any operation until they are delivered. (This cannot literally be -- true, since they must affect the value returned by Pending_Signals. --------------------------------------------------------------------- -- [3.3.6] Return from a call to an interruptible POSIX operation -- shall be an abort completion point. --------------------------------------------------------------------- -- [3.3.6] When a task is blocked in an interruptible operation with -- masking No_Signals or RTS_Signals, abort of the task shall cause -- the operation to be interrupted. Done; exception when E : others => Fatal_Exception (E, "A000"); end p030302; libflorist-2025.1.0/tests/p030302.ads000066400000000000000000000062021473553204100166600ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 2 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030302; libflorist-2025.1.0/tests/p030303.adb000066400000000000000000000113021473553204100166350ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 3 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This a test of the POSIX_Signals package, and other features of -- section 3.3 of POSIX.5b. This test focusses on setups that are -- likely to kill the program if the test fails. with POSIX_Process_Identification, POSIX_Report, POSIX_Signals; procedure p030303 is use POSIX_Process_Identification, POSIX_Report, POSIX_Signals; begin Header ("p030303"); --------------------------------------------------------------------- -- Any occurrences of SIGSEGV that are not identifiable as -- corresponding to checks that require some other exception to be -- raised are mapped to Program_Error, with Exception_Message -- "Signal_Segmentation_Violation". Test ("SIGSEGV treatment [3.3.2]"); begin Send_Signal (Get_Process_ID, SIGSEGV); Expect_Exception ("A001"); exception when E1 : Program_Error => Check_Message (E1, "Signal_Segmentation_Violation", "A002"); when E2 : others => Unexpected_Exception (E2, "A003"); end; --------------------------------------------------------------------- -- SIGBUS is translated to Program_Error, with Exception_Message -- "Signal_Bus_Error". Test ("SIGBUS treatment [3.3.2]"); begin Send_Signal (Get_Process_ID, SIGBUS); Expect_Exception ("A004"); exception when E1 : Program_Error => Check_Message (E1, "Signal_Bus_Error", "A005"); when E2 : others => Unexpected_Exception (E2, "A006"); end; --------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A007"); end p030303; libflorist-2025.1.0/tests/p030303.ads000066400000000000000000000061761473553204100166730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 3 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030303; libflorist-2025.1.0/tests/p030304.adb000066400000000000000000000467431473553204100166570ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 4 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This a test of the POSIX_Signals package, and other features of -- section 3.3 of POSIX.5b. It does not test functionality that relies -- on support for multiple processes. -- This test contains checks originally contained in p030300, which involve -- a task awaiting a signal that is sent by another task. The test has -- been broken out, to shorten the running time of test p030300, and to -- make isolating failures easier. with p030300a, POSIX, POSIX_IO, POSIX_Process_Identification, POSIX_Report, POSIX_Signals, Test_Parameters; procedure p030304 is use p030300a, POSIX, POSIX_Process_Identification, POSIX_Report, POSIX_Signals, Test_Parameters; Mask, Old_Mask : Signal_Set; procedure Clear_Signal (Sig : Signal); procedure Clear_Signal (Sig : Signal) is Set, Old_Set : Signal_Set; begin Add_Signal (Set, Sig); Ignore_Signal (Sig); Unblock_Signals (Set, Old_Set); Block_Signals (Old_Set, Set); Unignore_Signal (Sig); exception when E : others => Unexpected_Exception (E, "A001: " & Image (Sig)); end Clear_Signal; begin Header ("p030304"); --------------------------------------------------------------------- -- It is implemenentation-defined whether the signal mask is -- per-task or per-process. [3.3.1] -- The tests for operations related to signal blocking -- are intended to have the same outcome, regardless of -- whether the mask is per-task or per-process. -- This is achieved by never having a signal unmasked by -- more than one task at the same time. Block_Signals (All_Signal_Mask, Old_Mask); Mask := Blocked_Signals; for Sig in Signal loop if not Cannot_Be_Blocked (Sig) then if not Is_Member (Mask, Sig) then Fails_Blocking_Test (Sig) := True; Assert (False, "A002: " & Image (Sig)); end if; end if; end loop; ----------------------------------------------------------------------- -- For all other tasks, the initial signal mask shall include all the -- signals that are not reserved signals and are not bound to entries -- of the task. -- If the signal mask is per process, this requirement is in conflict -- with the requirement that the initial signal mask of the environment -- task is that specified for the process, so this test is conditional -- on not Signal_Mask_Is_Process_Wide. Test ("Initial signal mask of a task [3.3.1]"); declare task T; task body T is Set : Signal_Set := Blocked_Signals; begin for Sig in Signal loop if not Cannot_Be_Blocked (Sig) and then not Is_Member (Set, Sig) and then not Signal_Mask_Is_Process_Wide then Add_Signal (Not_Initially_Masked, Sig); Fail ("A003: " & Image (Sig) & " not initially blocked"); end if; end loop; end T; begin null; exception when E1 : others => Unexpected_Exception (E1, "A004"); end; Test ("Block and Unblock Signals [3.3.8]"); declare New_Mask : Signal_Set; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is pragma Unreferenced (Sig); begin -- New_Mask is initially empty. Set_Blocked_Signals (New_Mask, Old_Mask); declare task T; task body T is begin --------------------------------------------------------------- -- POSIX_Error may be raised with Operation_Not_Permitted when -- an attempt is made to unblock a signal that was already -- unblocked by another task in the same process. [3.3.8] Set_Blocked_Signals (New_Mask, New_Mask); exception when POSIX_Error => Check_Error_Code (Operation_Not_Permitted, "A005"); when E1 : others => Unexpected_Exception (E1, "A006"); end T; begin null; exception when E : others => Unexpected_Exception (E, "A007"); end; Set_Blocked_Signals (Old_Mask, New_Mask); end Test_Signal; begin for Sig in Signal loop Test_Signal (Sig); end loop; exception when E1 : others => Unexpected_Exception (E1, "A008"); end; ------------------------------------------------------------------------ Test ("Ignore Signals [3.3.9]"); for Sig in Signal loop if Default_Action (Sig) /= Termination or else Action_Cannot_Be_Set (Sig) or else Is_Member (Not_Initially_Masked, Sig) or else Fails_Blocking_Test (Sig) or else Is_Reserved_Signal (Sig) then Do_Not_Test (Sig) := True; end if; end loop; declare N : constant Integer := 3; New_Mask : Signal_Set; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is Count : Integer := 0; pragma Volatile (Count); task T is entry Sync; entry Expect_Signal; end T; task body T is The_Sig : Signal; New_Mask, Old_Mask : Signal_Set; Timeout : constant Timespec := To_Timespec (5 * DU); begin if not Do_Not_Test (Sig) then Add_Signal (New_Mask, Sig); Block_Signals (New_Mask, Old_Mask); loop select accept Sync; or accept Expect_Signal; begin The_Sig := Await_Signal_Or_Timeout (New_Mask, Timeout); Comment ("received " & Image (Sig)); Assert (The_Sig = Sig, "A009"); Count := Count + 1; exception when POSIX_Error => Comment ("TIMED OUT waiting for " & Image (Sig)); Check_Error_Code (EAGAIN, "A010: " & Image (Sig)); when E : others => Unexpected_Exception (E, "A011"); end; or terminate; end select; end loop; end if; exception when E : others => Unexpected_Exception (E, "A012: " & Image (Sig)); end T; begin Comment ("testing " & Image (Sig)); Block_Signals (All_Signal_Mask, Old_Mask); --------------------------------------------------------------- -- When signal is not ignored, signals sent to the process -- can be caught using Await_Signal. Assert (not Is_Ignored (Sig), "A013"); if Action_Cannot_Be_Set (Sig) then Expect_Exception ("A014: " & Image (Sig)); Set_Error_Code (Invalid_Argument); raise POSIX_Error; end if; if not Do_Not_Test (Sig) then Count := 0; for I in 1 .. N loop T.Expect_Signal; -- Give T a chance to execute Await_Signal. delay DU; Comment ("sending " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); end loop; -- Give T a chance to increment Count. T.Sync; Assert (Count = N, "A015: only" & Integer'Image (Count) & " signals received"); else Comment ("not sending " & Image (Sig)); end if; -------------------------------------------------------------- -- N signals were sent and N were received, so there should -- be no more pending occurrences of Sig at this point. -- If this check fails, it may mean that Send_Signal -- delivers the signal to ALL the threads in a process, -- rather than just one. declare Set : Signal_Set; begin Set := Pending_Signals; for Sig in Signal loop Assert (Sig = SIGNULL or not Is_Member (Set, Sig), "A016: " & Image (Sig) & " is pending"); end loop; end; --------------------------------------------------------------- -- If the action associated with a blocked signal is to ignore -- the signal, and if that signal is generated for the process -- or task it is unspecified whether the signal is discarded -- immediately upon generation or remains pending. [3.3.1] -- The effect of changing the signal action for a signal that -- is currently awaited by a task is unspecified. [3.3.1] -- The effect of a call to Await_Signal on the signal -- actions for the signals in Set is unspecified. [3.3.15] -- Therefore, task T waits until the signal has been sent, -- has been unmasked, and has been masked again, before trying -- to await it. Comment ("should now be ignoring signals"); Ignore_Signal (Sig); Assert (Is_Ignored (Sig), "A017"); if not Do_Not_Test (Sig) then Count := 0; Comment ("sending " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); Add_Signal (New_Mask, Sig); Unblock_Signals (New_Mask, Old_Mask); Block_Signals (New_Mask, Old_Mask); T.Expect_Signal; -- T should time out, without receiving the signal. T.Sync; Assert (Count = 0, "A018: " & Integer'Image (Count) & " signals received"); else Comment ("not sending " & Image (Sig)); end if; --------------------------------------------------------------- -- When signal is unignored, signals sent to the process -- cause the default action (again). It should again be -- possible to use Await_Signal to catch the signal, if the -- default action allows the signal to be caught. Comment ("should stop ignoring signals"); Unignore_Signal (Sig); Assert (not Is_Ignored (Sig), "A019"); if not Do_Not_Test (Sig) then Count := 0; for I in 1 .. N loop T.Expect_Signal; -- give T a chance to execute Await_Signal delay DU; Comment ("sending " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); end loop; T.Sync; Assert (Count = N, "A020: only" & Integer'Image (Count) & " signals received"); else Comment ("not sending " & Image (Sig)); end if; -------------------------------------------------------------------- -- Now make sure any pending occurrences of the signal will be -- cleared out safely. Clear_Signal (Sig); exception when POSIX_Error => Assert (Get_Error_Code = Invalid_Argument and Action_Cannot_Be_Set (Sig), "A021: " & Image (Sig) & " " & Image (Get_Error_Code)); when E : others => Unexpected_Exception (E, "A022"); end Test_Signal; begin for Sig in Signal loop if Default_Action (Sig) /= Termination or else Action_Cannot_Be_Set (Sig) or else Is_Member (Not_Initially_Masked, Sig) or else Is_Reserved_Signal (Sig) then Do_Not_Test (Sig) := True; end if; end loop; for Sig in Signal loop begin if not Do_Not_Test (Sig) then Test_Signal (Sig); end if; exception when E : others => Unexpected_Exception (E, "A023"); end; end loop; end; --------------------------------------------------------------------- Test ("Wait for Signal [3.3.15]"); -- This interface is mostly covered by other tests. -- Here, we repeat some of the checks above, but with the -- signal being sent to the environment task by another task. declare procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is The_Sig : Signal; Mask : Signal_Set; Timeout : constant Timespec := To_Timespec (5 * DU); task T; task body T is begin Comment ("sending signal " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); exception when E : others => Unexpected_Exception (E, "A024: " & Image (Sig)); end T; begin Comment ("testing " & Image (Sig)); Add_Signal (Mask, Sig); Comment ("awaiting " & Image (Sig)); The_Sig := Await_Signal_Or_Timeout (Mask, Timeout); Comment ("received " & Image (Sig)); Assert (The_Sig = Sig, "A025: " & Image (The_Sig)); exception when E : others => Unexpected_Exception (E, "A026: " & Image (Sig)); end Test_Signal; begin for Sig in Signal loop if not Do_Not_Test (Sig) then Test_Signal (Sig); end if; end loop; exception when E1 : others => Unexpected_Exception (E1, "A027"); end; --------------------------------------------------------------------- Test ("Wait for Signal with Information [3.3.16]"); -- This interface is mostly covered by other tests. -- Here, we repeat some of the checks above, but with the -- signal being sent to the environment task by another task. declare procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is Mask : Signal_Set; Timeout : constant Timespec := To_Timespec (5 * DU); Info : Signal_Info; I : Signal_Scalar := 999; task T; task body T is begin Comment ("sending signal " & Image (Sig)); Queue_Signal (Get_Process_ID, Sig, +I); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Implemented, E1, "A028"); when E2 : others => Unexpected_Exception (E2, "A029"); end T; begin Comment ("testing " & Image (Sig)); Enable_Queueing (Sig); Add_Signal (Mask, Sig); Info := Await_Signal_Or_Timeout (Mask, Timeout); Comment ("received " & Image (Sig)); Assert (Get_Signal (Info) = Sig, "A030"); Assert (Get_Source (Info) = From_Queue_Signal, "A031"); Assert (Get_Data (Info) = +I, "A032"); Disable_Queueing (Sig); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Implemented, E1, "A033"); when E2 : others => Unexpected_Exception (E2, "A034"); end Test_Signal; begin for Sig in Signal loop if not Do_Not_Test (Sig) then Test_Signal (Sig); end if; end loop; exception when E : others => Unexpected_Exception (E, "A035"); end; -- Queue_Signal is partly covered above. -- More extensive testing of Queue_Signal requires the use of -- multiple processes, and so is in a separate program. --------------------------------------------------------------------- -- If the task is executing an interruptible operation -- the operation is interrupted by Interrupt_Task. -- In this case, if the task is not interrupted the read operation -- will hang. Test ("Interrupt a Task [3.3.20]"); declare task T; task body T is Buffer : POSIX_String (1 .. 3); Last : IO_Count; begin -- This assumes that the standard input file does not -- have any input ready. Comment ("making blocking system call (will hang if fails)"); POSIX_IO.Read (POSIX_IO.Standard_Input, Buffer, Last); Comment ("system call aborted OK"); exception when POSIX_Error => Check_Error_Code (Interrupted_Operation, "A036"); when E : others => Unexpected_Exception (E, "A037"); end T; begin delay 3 * DU; Comment ("interrupting task"); Interrupt_Task (T'Identity); exception when E : others => Unexpected_Exception (E, "A038"); end; --------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A039"); end p030304; libflorist-2025.1.0/tests/p030304.ads000066400000000000000000000061751473553204100166730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 4 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030304; libflorist-2025.1.0/tests/p030305.adb000066400000000000000000000365741473553204100166610ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 5 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This a test of the POSIX_Signals package, and other features of -- section 3.3 of POSIX.5b. It does not test functionality that relies -- on support for multiple processes. -- This test contains checks originally contained in p030300, which involve -- a task accepting a signal that is sent by another task. The test has -- been broken out, to shorten the running time of test p030300, and -- make isolating failures easier. -- Consider splitting this test further, to separate checks that -- require signal entries from those that do not. with p030300a, POSIX, POSIX_IO, POSIX_Process_Identification, POSIX_Report, POSIX_Signals, System, Test_Parameters; procedure p030305 is use p030300a, POSIX, POSIX_Process_Identification, POSIX_Report, POSIX_Signals, Test_Parameters, System; Old_Mask : Signal_Set; begin Header ("p030305"); --------------------------------------------------------------------- -- It is implemenentation-defined whether the signal mask is -- per-task or per-process. [3.3.1] -- The tests for operations related to signal blocking -- are intended to have the same outcome, regardless of -- whether the mask is per-task or per-process. -- This is achieved by never having a signal unmasked by -- more than one task at the same time. Block_Signals (All_Signal_Mask, Old_Mask); ----------------------------------------------------------------------- -- For all other tasks, the initial signal mask shall include all the -- signals that are not reserved signals and are not bound to entries -- of the task. -- If the signal mask is per process, this requirement is in conflict -- with the requirement that the initial signal mask of the environment -- task is that specified for the process, so this test is conditional -- on not Signal_Mask_Is_Process_Wide. Test ("Initial signal mask of a task [3.3.1]"); declare task T; task body T is Set : Signal_Set := Blocked_Signals; begin for Sig in Signal loop if not Cannot_Be_Blocked (Sig) and then not Is_Member (Set, Sig) and then not Signal_Mask_Is_Process_Wide then Add_Signal (Not_Initially_Masked, Sig); Fail ("A001: " & Image (Sig) & " not initially blocked"); end if; end loop; end T; begin null; exception when E1 : others => Unexpected_Exception (E1, "A002"); end; Test ("Block and Unblock Signals [3.3.8]"); declare New_Mask : Signal_Set; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is pragma Unreferenced (Sig); begin -- New_Mask is initially empty. Set_Blocked_Signals (New_Mask, Old_Mask); declare task T; task body T is begin --------------------------------------------------------------- -- POSIX_Error may be raised with Operation_Not_Permitted when -- an attempt is made to unblock a signal that was already -- unblocked by another task in the same process. [3.3.8] Set_Blocked_Signals (New_Mask, New_Mask); exception when POSIX_Error => Check_Error_Code (Operation_Not_Permitted, "A003"); when E1 : others => Unexpected_Exception (E1, "A004"); end T; begin null; exception when E : others => Unexpected_Exception (E, "A005"); end; Set_Blocked_Signals (Old_Mask, New_Mask); end Test_Signal; begin for Sig in Signal loop Test_Signal (Sig); end loop; exception when E1 : others => Unexpected_Exception (E1, "A006"); end; ------------------------------------------------------------------------ Test ("Ignore Signals [3.3.9]"); for Sig in Signal loop if Default_Action (Sig) /= Termination or else Action_Cannot_Be_Set (Sig) or else Is_Member (Not_Initially_Masked, Sig) or else Is_Reserved_Signal (Sig) then Do_Not_Test (Sig) := True; end if; end loop; declare N : constant Integer := 3; procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is Sig_Ref : constant System.Address := Signal_Reference (Sig); Ret : Integer; task T is entry Reset_Count; entry Current_Count (X : out Integer); entry Signal; for Signal use at Sig_Ref; end T; task body T is Count : Integer := 0; begin if not Do_Not_Test (Sig) then loop select accept Signal do Count := Count + 1; Comment ("received " & Image (Sig)); end Signal; or accept Reset_Count do Count := 0; end Reset_Count; or accept Current_Count (X : out Integer) do X := Count; end Current_Count; or terminate; end select; end loop; end if; exception when E : others => Unexpected_Exception (E, "A007"); end T; begin Comment ("testing " & Image (Sig) & " with entry"); ---------------------------------------------------------------- -- Ensure all blockable signals are blocked -- in the environment task. Block_Signals (All_Signal_Mask, Old_Mask); --------------------------------------------------------------- -- When signal is not ignored, signals sent to the process -- cause the handler to execute. Assert (not Is_Ignored (Sig), "A008"); if not Do_Not_Test (Sig) then T.Reset_Count; for I in 1 .. N loop -- give T a chance to accept the signal delay DU; Comment ("sending " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); end loop; delay DU; T.Current_Count (Ret); Assert (Ret = N, "A009: " & Image (Sig) & " received" & Integer'Image (Ret) & " times"); else Comment ("not sending " & Image (Sig)); end if; --------------------------------------------------------------- -- For the Ignore_Signal operation if the signal is bound to -- a task entry, the effect shall be to discard any pending or -- subsequent deliveries of the that signal. The binding to -- the entry MAY remain in force. [3.3.17.2] -- Thus, signals sent to the process do not cause the handler -- to execute. Ignore_Signal (Sig); Assert (Is_Ignored (Sig), "A010"); if not Do_Not_Test (Sig) then T.Reset_Count; for I in 1 .. N loop -- give T a chance to accept the signal delay DU; Comment ("sending " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); end loop; delay DU; T.Current_Count (Ret); Assert (Ret = 0, "A011: Ret =" & Integer'Image (Ret)); else Comment ("not sending " & Image (Sig)); end if; --------------------------------------------------------------- -- When signal is unignored, the default action is restored. -- The effect of this on entries that are attached is not -- specified, since POSIX.5b says only that "the binding to the -- entry MAY remain in force". [3.3.17.2] -- If it is not in force, we expect the default action, which -- may be to terminate the process. Therefore, this check -- is deferred to a separate test. Unignore_Signal (Sig); Assert (not Is_Ignored (Sig), "A012"); -------------------------------------------------------------------- -- Clear out any pending occurrences of the signal. Clear_Signal (Sig, "A013"); exception when E1 : others => Unexpected_Exception (E1, "A014"); end Test_Signal; begin for Sig in Signal loop begin Test_Signal (Sig); exception when E1 : POSIX_Error => if Is_Supported (Signal_Entries_Option) and then Get_Error_Code /= Invalid_Argument then Unexpected_Exception (E1, "A015"); end if; when E2 : others => Unexpected_Exception (E2, "A016"); end; end loop; end; --------------------------------------------------------------------- Test ("Signal Entries [3.3.17]"); -- This is also a test of several other operations, including -- signal sending. declare procedure Test_Signal (Sig : Signal); procedure Test_Signal (Sig : Signal) is begin declare Sig_Ref : constant System.Address := Signal_Reference (Sig); task T is entry E1; entry E2; for E2 use at Sig_Ref; end T; task body T is begin Block_Signals (All_Signal_Mask, Old_Mask); -- At this point, Sig is masked, but that does not -- prevent delivery of the signal to a task entry. -- Try to arrange for signal to arrive after the accept. select accept E2; or delay DU; Fail ("A017: " & Image (Sig)); end select; -- Then arrange for signal to arrive before the accept. accept E1; delay 2 * DU; select accept E2; or delay DU; Fail ("A018: " & Image (Sig)); end select; exception when E : others => Unexpected_Exception (E, "A019"); end T; begin Block_Signals (All_Signal_Mask, Old_Mask); Comment ("sending " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); T.E1; Comment ("sending " & Image (Sig)); Send_Signal (Get_Process_ID, Sig); end; exception when E1 : POSIX_Error => Optional (Option => Signal_Entries_Option, Expected_If_Not_Supported => Invalid_Argument, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A020"); when E2 : others => Unexpected_Exception (E2, "A021"); end Test_Signal; begin for Sig in Signal loop if not Default_Is_Ignore (Sig) then Test_Signal (Sig); end if; end loop; exception when E : others => Unexpected_Exception (E, "A022"); end; --------------------------------------------------------------------- -- If the task is executing an interruptible operation -- the operation is interrupted by Interrupt_Task. -- In this case, if the task is not interrupted the read operation -- will hang. Test ("Interrupt a Task [3.3.20]"); declare task T; task body T is Buffer : POSIX_String (1 .. 3); Last : IO_Count; begin -- This assumes that the standard input file does not -- have any input ready. Comment ("making blocking system call (will hang if fails)"); POSIX_IO.Read (POSIX_IO.Standard_Input, Buffer, Last); Comment ("system call aborted OK"); exception when POSIX_Error => Check_Error_Code (Interrupted_Operation, "A023"); when E : others => Unexpected_Exception (E, "A024"); end T; begin delay 3 * DU; Comment ("interrupting task"); Interrupt_Task (T'Identity); exception when E : others => Unexpected_Exception (E, "A025"); end; --------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A026"); end p030305; libflorist-2025.1.0/tests/p030305.ads000066400000000000000000000061751473553204100166740ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 5 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030305; libflorist-2025.1.0/tests/p030306.adb000066400000000000000000000330331473553204100166450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 6 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 2000-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This a test of the POSIX_Signals package, and other features of -- section 3.3 of POSIX.5b. It does not test functionality that relies -- on support for multiple processes. -- This test contains checks originally contained in p030300, which involve -- a task awaiting a signal that is sent by another task. The test has -- been broken out, to shorten the running time of test p030300, and to -- make isolating failures easier. -- Setup: This program must be run with the executable file for -- program p030306a accessible via pathname "./p030306a". with p030300a, POSIX, POSIX_Configurable_System_Limits, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, Test_Parameters; procedure p030306 is use p030300a, POSIX, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, Test_Parameters; Child_Pathname : constant POSIX_String := "./p030306a"; procedure Test_Signal (Sig : Signal); procedure Await_Normal_Child_Termination (Child_ID : Process_ID; Sig : Signal; Action : Child_Action; Default : Boolean := False); procedure Assert_L (B : Boolean; Msg : String; Action : Child_Action); procedure Assert_L (B : Boolean; Msg : String; Action : Child_Action) is begin Assert (B, Msg & ": " & Child_Action'Image (Action)); end Assert_L; procedure Await_Normal_Child_Termination (Child_ID : Process_ID; Sig : Signal; Action : Child_Action; Default : Boolean := False) is Status : Termination_Status; begin -- Delay long enough for child to receive signal or -- terminate. 5 * DU should be long enough, even if -- signal is not received, since child internal -- timeout is 2 * DU. delay 5 * LDU; if Default and then Default_Action (Sig) = Stop then -- Verify that child is stopped. Comment ("verifying that child has stopped"); Wait_For_Child_Process (Status => Status, Block => False, Trace_Stopped => True); Assert_L (Status_Available (Status), "A001", Action); Assert_L (Process_ID_Of (Status) = Child_ID, "A002", Action); Assert_L (Termination_Cause_Of (Status) = Stopped_By_Signal, "A003", Action); Assert_L (Stopping_Signal_Of (Status) = Sig, "A004", Action); -- Allow child to continue. Send_Signal (Child_ID, Signal_Continue); -- Allow time for child to terminate. delay DU; end if; -- Kill child if it has not terminated normally. Send_Signal (Child_ID, Signal_Kill); -- Wait for child to terminate. delay DU; -- Should not block here, since time delays should have -- arranged for child to terminate by now. Wait_For_Child_Process (Status, Child_ID); if Default then case Default_Action (Sig) is when Unspecified => null; when Ignore | Continue | Stop => Check_Child_Status (Status, Child_ID, 0, "A005: " & Image (Sig)); when Termination => if not Status_Available (Status) then -- Fail when status not available Fail ("A006: no status available"); return; end if; Assert_L (Process_ID_Of (Status) = Child_ID, "A007: wrong child", Action); if Termination_Cause_Of (Status) /= Terminated_By_Signal then -- Fail when did not exit Assert_L (False, "A008: not terminated by signal", Action); return; end if; declare The_Sig : Signal; begin The_Sig := Termination_Signal_Of (Status); Assert_L (Sig = The_Sig, "A009", Action); exception when E : others => Unexpected_Exception (E, "A010"); end; end case; else Check_Child_Status (Status, Child_ID, 0, "A011: " & Image (Sig) & ' ' & Child_Action'Image (Action)); end if; exception when E : others => Unexpected_Exception (E, "A012"); end Await_Normal_Child_Termination; procedure Test_Signal (Sig : Signal) is Template : Process_Template; Mask : Signal_Set; -- initially empty Args : POSIX_String_List; -- initially empty Child_ID : Process_ID; begin Comment ("Testing " & Image (Sig)); Open_Template (Template); Add_Signal (Mask, Sig); Set_Signal_Mask (Template, Mask); if Sig = Signal_Null then ------------------------------------------------------------- -- If the paramter Sig is equal to the value Signal_Null, -- no signal shall be sent, but error checking -- shall be performed. Make_Empty (Args); Append (Args, Child_Pathname); Append (Args, "-child" & To_POSIX_String (Integer'Image (Child_Action'Pos (Delay_Then_Exit)))); Append (Args, "-sig" & To_POSIX_String (Signal'Image (Sig))); Pass_Through_Verbosity (Args); Start_Process (Child => Child_ID, Pathname => Child_Pathname, Template => Template, Arg_List => Args); -- Wait long enough for the child process to load from -- disk and start up. delay LDU; Comment ("parent: sending " & Image (Sig)); Send_Signal (Child_ID, Sig); Comment ("parent: awaiting child termination"); Await_Normal_Child_Termination (Child_ID, Sig, Delay_Then_Exit, Default => False); begin Comment ("parent: sending " & Image (Sig) & " again"); Send_Signal (Child_ID, Sig); exception when POSIX_Error => Check_Error_Code (No_Such_Process, "A013"); when E : others => Unexpected_Exception (E, "A014"); end; return; end if; for I in Block_And_Await .. Unblock_And_Unignore loop Make_Empty (Args); Append (Args, Child_Pathname); Append (Args, "-child" & To_POSIX_String (Integer'Image (Child_Action'Pos (I)))); Append (Args, "-sig" & To_POSIX_String (Signal'Image (Sig))); Pass_Through_Verbosity (Args); Start_Process (Child => Child_ID, Pathname => Child_Pathname, Template => Template, Arg_List => Args); -- Wait long enough for the child process to load from -- disk and start up. delay LDU; case I is when Block_And_Await => -- Child will wait for Sig, with just Sig blocked; -- expecting to receive signal and then exit normally. -- Wait for child to get ready to receive signal. Comment ("parent: sending " & Image (Sig)); Send_Signal (Child_ID, Sig); Comment ("parent: awaiting child termination"); Await_Normal_Child_Termination (Child_ID, Sig, I, Default => False); when Block_And_Await_With_Info => -- Child will wait for Sig, with just Sig blocked; -- expecting to receive signal with info and then exit normally. -- Wait for child to get ready to receive signal. begin Queue_Signal (Child_ID, Sig, +999); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Implemented, E1, "A015"); when E2 : others => Unexpected_Exception (E2, "A016"); end; Await_Normal_Child_Termination (Child_ID, Sig, I, Default => False); when Block_And_Await_With_No_Info => -- Child will wait for Sig, with just Sig blocked; -- expecting to receive signal with no info -- and then exit normally. -- Wait for child to get ready to receive signal. Send_Signal (Child_ID, Sig); Await_Normal_Child_Termination (Child_ID, Sig, I, Default => False); when Unblock_And_Ignore => -- Child will delay, with all signals unblocked; -- expecting to time out without receiving signal -- and then exit normally. -- Wait for child to get ready to receive signal. Send_Signal (Child_ID, Sig); Await_Normal_Child_Termination (Child_ID, Sig, I, Default => False); when Block_Unignore_And_Await => -- Child will wait for Sig, with just Sig blocked; -- expecting to receive signal and then exit normally. -- Wait for child to get ready to receive signal. Send_Signal (Child_ID, Sig); Await_Normal_Child_Termination (Child_ID, Sig, I, Default => False); when Unblock_And_Unignore => -- Child will delay, with all signals unblocked; -- expecting to receive signal and perform default action. -- Wait for child to get ready to receive signal. Send_Signal (Child_ID, Sig); Await_Normal_Child_Termination (Child_ID, Sig, I, Default => True); when others => Fatal ("A017: invalid child action"); end case; end loop; Close_Template (Template); exception when E : others => Unexpected_Exception (E, "A018"); end Test_Signal; begin Header ("p030306"); ---------------------------------------------------------------------- for Sig in Signal loop -- Do_Not_Test should be initially empty. Assert (not Do_Not_Test (Sig), "A019"); if Action_Cannot_Be_Set (Sig) or else Is_Reserved_Signal (Sig) or else Default_Action (Sig) = Unspecified then Do_Not_Test (Sig) := True; end if; end loop; if not POSIX_Configurable_System_Limits.Job_Control_Is_Supported then for I in Job_Control_Signals'Range loop Do_Not_Test (Job_Control_Signals (I)) := True; end loop; end if; for Sig in Signal loop if not Do_Not_Test (Sig) then Test_Signal (Sig); end if; end loop; --------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A020"); end p030306; libflorist-2025.1.0/tests/p030306.ads000066400000000000000000000061751473553204100166750ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 6 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p030306; libflorist-2025.1.0/tests/p030306a.adb000066400000000000000000000176761473553204100170250ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 6 a -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Child process for test p030306. with POSIX, p030300a, POSIX_Report, POSIX_Signals, Test_Parameters; procedure p030306a is use POSIX, p030300a, POSIX_Report, POSIX_Signals, Test_Parameters; Mask, Old_Mask : aliased Signal_Set; Sig : Signal; Info : Signal_Info; begin -- Argument Child is a signal number passed to this -- process by its parent. Sig := Arg_Sig; Comment ("child: starting " & Child_Action'Image (Child_Action'Val (Child)) & " for " & Signal'Image (Sig)); --------------------------------------------------------------- -- The initial signal mask of the child process shall -- be the set specified by the Signal Mask attribute of the -- process template. For this test, the parent process should -- have specified that only Sig is masked. Mask := Blocked_Signals; if not Is_Member (Mask, Sig) then Assert (False, "A001: p030306a " & Image (Sig)); Add_Signal (Mask, Sig); Assert (Is_Member (Mask, Sig), "A002: p030306a"); end if; for I in Signal loop if I /= Sig and then I /= SIGNULL and then not Is_Reserved_Signal (I) then Assert (not Is_Member (Mask, I), "A003: p030306a " & Image (I)); end if; end loop; Delete_All_Signals (Mask); case Child_Action'Val (Child) is when Delay_Then_Exit => -- Delay long enough for the parent to notice we are here. delay 2 * LDU; when Block_And_Await => -- Wait for Sig, with just Sig blocked; -- expect to receive signal and then exit normally. Add_Signal (Mask, Sig); Set_Blocked_Signals (Mask, Old_Mask); Comment ("child: waiting for " & Image (Sig)); Try_Await_Signal (Sig, Mask, 2 * LDU, No, "A004: p030306a"); when Block_And_Await_With_Info => -- Wait for Sig, with just Sig blocked; -- expect to receive signal with info and then exit normally. Add_Signal (Mask, Sig); Set_Blocked_Signals (Mask, Old_Mask); Comment ("child: waiting for " & Image (Sig)); begin Enable_Queueing (Sig); Info := Try_Await_Signal (Sig, Mask, 2 * LDU, No, "A005: p030306a"); Comment ("child: received " & Image (Sig) & " (OK)"); Assert (Get_Signal (Info) = Sig, "A006: p030306a"); Assert (Get_Source (Info) = From_Queue_Signal, "A007: p030306a"); Assert (Get_Data (Info) = +999, "A008: p030306a"); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Supported, E1, "A009: p030306a"); -- If Enable_Queueing succeeds, then Await_Signal is not -- allowed to fail with Operation_Not_Implemented. when E2 : others => Unexpected_Exception (E2, "A010: p030306a"); end; when Block_And_Await_With_No_Info => -- Wait for Sig, with just Sig blocked; -- expect to receive signal with no info and then exit normally. Add_Signal (Mask, Sig); Set_Blocked_Signals (Mask, Old_Mask); Comment ("child: waiting for " & Image (Sig)); begin Enable_Queueing (Sig); Info := Try_Await_Signal (Sig, Mask, 2 * LDU, No, "A011: p030306a"); Comment ("child: received " & Image (Sig) & " (OK)"); Assert (Get_Source (Info) = From_Send_Signal, "A012: p030306a"); exception when E1 : POSIX_Error => Optional (Realtime_Signals_Option, Operation_Not_Supported, E1, "A013: p030306a"); when E2 : others => Unexpected_Exception (E2, "A014: p030306a"); end; -- If Enable_Queueing succeeds, then Await_Signal is not -- allowed to fail with Operation_Not_Implemented. when Unblock_And_Ignore => -- Delay, with all signals unblocked; -- expect to time out without receiving signal -- and then exit normally. Ignore_Signal (Sig); Set_Blocked_Signals (Mask, Old_Mask); -- Delay long enough for parent to send signal. delay 2 * LDU; when Block_Unignore_And_Await => -- Wait for Sig, with just Sig blocked; -- expect to receive signal and then exit normally. Unignore_Signal (Sig); Add_Signal (Mask, Sig); Set_Blocked_Signals (Mask, Old_Mask); Try_Await_Signal (Sig, Mask, 2 * LDU, No, "A016: p030306a"); when Unblock_And_Unignore => -- Delay, with all signals unblocked; -- expect to receive signal and perform default action. Unignore_Signal (Sig); Set_Blocked_Signals (Mask, Old_Mask); -- Delay long enough for parent to send signal. delay 2 * LDU; when others => Fatal ("A017: invalid child action"); end case; ----------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A018: p030306a"); end p030306a; libflorist-2025.1.0/tests/p030306a.ads000066400000000000000000000062431473553204100170320ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 3 0 3 0 6 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Child process for test p030306. procedure p030306a; libflorist-2025.1.0/tests/p040100.adb000066400000000000000000000145211473553204100166370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- .... A legacy test, not in real-time area; could be improved. with POSIX, POSIX_Process_Identification, POSIX_Report; procedure p040100 is use POSIX, POSIX_Process_Identification, POSIX_Report; begin Header ("p040100"); Test ("package POSIX_Process_Identification"); ----------------------------------------------------------- declare Uid : User_ID; Gid : Group_ID; begin Test ("User Identification [4.1.3]"); Comment ("Get_Real_User_ID"); Uid := Get_Real_User_ID; Comment ("Get_Effective_User_ID"); Assert (Uid = Get_Effective_User_ID, "A001"); Comment ("Image and Value of User_ID"); declare I : String := Image (Uid); begin Assert (I'First = 1, "A002"); Assert (Value (I) = Uid, "A003"); exception when E : others => Unexpected_Exception (E, "A004"); end; -- Validity Of user And Group Ids Are Further tested As Part Of The -- test Of Get_File_Status. Comment ("Set_User_ID"); Set_User_ID (Uid); Comment ("Set_User_ID to root"); begin Set_User_ID (Value ("0")); Expect_Exception ("A005"); exception when E1 : POSIX_Error => Check_Error_Code (Operation_Not_Permitted, E1, "A006"); when E2 : others => Unexpected_Exception (E2, "A007"); end; ----------------------------------------------------------- Test ("Group Identification [4.1.4]"); Comment ("Get_Real_Group_ID"); Gid := Get_Real_Group_ID; Comment ("Get_Effective_Group_ID"); Assert (Gid = Get_Effective_Group_ID, "A008"); Comment ("Image and Value on Group_ID"); declare I : String := Image (Gid); begin -- Assert (I'First = 1); -- Do not understand the intent of the above test. -- Why should we make sure that the Group ID starts with 1? Assert (Value (I) = Gid, "A009"); exception when E : others => Unexpected_Exception (E, "A010"); end; Comment ("Set_Group_ID"); Set_Group_ID (Gid); Comment ("Set_Group_ID without permission"); declare Newgid : Group_ID; begin -- use "Image" And "Value" To Define Newgid := Gid + 1; Newgid := Value (Integer'Image (Integer'Value (Image (Gid)) + 1)); Set_Group_ID (Newgid); Expect_Exception ("A011"); exception when E1 : POSIX_Error => Check_Error_Code (Operation_Not_Permitted, E1, "A012"); when E2 : others => Unexpected_Exception (E2, "A013"); end; Comment ("Image and Value on Group_List"); declare List : Group_List := Get_Groups; begin Comment ("Groups :"); for I in List'Range loop Comment (Image (List (I))); end loop; exception when E : others => Unexpected_Exception (E, "A014"); end; -- Testing Of process IDs and process groups is covered under -- the testing of package POSIX_Process_Primitives. exception when E : others => Unexpected_Exception (E, "A015"); end; ------------------------------------------------------------------ Done; exception when E : others => Fatal_Exception (E, "A016"); end p040100; libflorist-2025.1.0/tests/p040100.ads000066400000000000000000000061761473553204100166670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p040100; libflorist-2025.1.0/tests/p040101.adb000066400000000000000000000164311473553204100166420ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 1 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Process_Identification. with POSIX; with POSIX_Process_Identification; with POSIX_Report; procedure p040101 is use POSIX; use POSIX_Process_Identification; use POSIX_Report; begin Header ("p040101"); Test ("package POSIX_Process_Identification [4.1]"); ----------------------------------------------------------- Test ("Process Identification Functions [4.1.1]"); begin Comment ("current process ID = " & Image (Get_Process_ID)); Comment ("parent process ID = " & Image (Get_Parent_Process_ID)); Assert (Value (Image (Get_Process_ID)) = Get_Process_ID, "A001"); Assert (Value (Image (Get_Parent_Process_ID)) = Get_Parent_Process_ID, "A002"); exception when E : others => Unexpected_Exception (E, "A003"); end; ----------------------------------------------------------- Test ("Process Group Identification [4.1.2]"); begin Comment ("process group ID = " & Image (Get_Process_Group_ID)); Assert (Value (Image (Get_Process_Group_ID)) = Get_Process_Group_ID, "A004"); Assert (Value (Image (Get_Parent_Process_ID)) = Get_Parent_Process_ID, "A005"); exception when E : others => Unexpected_Exception (E, "A006"); end; ----------------------------------------------------------- Test ("Set_Process_Group_ID [4.1.2]]"); begin Set_Process_Group_ID (Get_Process_ID, Get_Process_Group_ID); exception when E : others => Unexpected_Exception (E, "A007"); end; ----------------------------------------------------------- Test ("Create_Process_Group [4.1.2]"); declare Group : Process_Group_ID; begin Create_Process_Group (Get_Process_ID, Group); Assert (Get_Process_Group_ID = Group, "A008"); Assert (Value (Image (Group)) = Group, "A009"); exception when E1 : POSIX_Error => Optional (Job_Control_Option, ENOSYS, E1, "A010"); when E2 : others => Unexpected_Exception (E2, "A011"); end; -- we are now leader of a new process group in the same session ----------------------------------------------------------- Test ("Create_Session [4.1.2]"); declare Group : Process_Group_ID; begin Create_Session (Group); -- should fail since we are already a process group leader Assert (False, "A012"); exception when E1 : POSIX_Error => Check_Error_Code (Operation_Not_Permitted, E1, "A013"); when E2 : others => Unexpected_Exception (E2, "A014"); end; ----------------------------------------------------------- Test ("operations on User_ID [4.1.3]"); begin Assert (Value (Image (Get_Real_User_ID)) = Get_Real_User_ID, "A015"); Comment ("real user ID =" & Image (Get_Real_User_ID)); Assert (Value (Image (Get_Effective_User_ID)) = Get_Effective_User_ID, "A016"); Comment ("effective user ID =" & Image (Get_Effective_User_ID)); Set_User_ID (Get_Effective_User_ID); exception when E : others => Unexpected_Exception (E, "A017"); end; ----------------------------------------------------------- Test ("operations on Group_ID [4.1.4]"); begin Assert (Value (Image (Get_Real_Group_ID)) = Get_Real_Group_ID, "A018"); Comment ("real group ID =" & Image (Get_Real_Group_ID)); Assert (Value (Image (Get_Effective_Group_ID)) = Get_Effective_Group_ID, "A019"); Comment ("effective group ID =" & Image (Get_Effective_Group_ID)); Set_Group_ID (Get_Effective_Group_ID); exception when E : others => Unexpected_Exception (E, "A020"); end; ----------------------------------------------------------- Test ("operations on Group_List [4.1.4]"); begin declare Groups : constant Group_List := Get_Groups; begin for I in Groups'Range loop Comment ("Groups(" & Group_List_Index'Image (I) & ") =" & Image (Groups (I))); Assert (Value (Image (Groups (I))) = Groups (I), "A021"); end loop; end; exception when E : others => Unexpected_Exception (E, "A022"); end; ----------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A023"); end p040101; libflorist-2025.1.0/tests/p040101.ads000066400000000000000000000061761473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 1 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p040101; libflorist-2025.1.0/tests/p040300.adb000066400000000000000000000321231473553204100166370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 3 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 1999-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Process_Environment and operations on -- current working directory. -- Setup: Run this test with envionment variable PWD set to ".". -- If you are using "sh": "PWD=`pwd`; export PWD". with POSIX, POSIX_Files, POSIX_Process_Environment, POSIX_Report; procedure p040300 is use POSIX, POSIX_Files, POSIX_Process_Environment, POSIX_Report; begin Header ("p040300"); Test ("package POSIX_Process_Environment [4.3]"); Test ("Process Working Directory [4.3.3]"); declare Owd : POSIX_String := Get_Working_Directory; begin Assert (Owd'First = 1, "A001"); Comment ("working directory = " & To_String (Owd)); -- Check that PWD is exported Assert (Owd = Environment_Value_Of ("PWD"), "A002"); Comment ("PWD = " & To_String (Environment_Value_Of ("PWD"))); Create_Directory ("testdir", (others => True)); Assert (Is_Directory ("testdir"), "A003"); Change_Working_Directory ("testdir"); Assert (not Is_Directory ("testdir"), "A004"); begin Change_Working_Directory ("Nonexistent_Directory"); Expect_Exception ("A005"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A006"); end; declare Newcwd : POSIX_String := Get_Working_Directory; begin Assert (Newcwd'First = 1, "A007"); Comment ("working directory = " & To_String (Newcwd)); Assert (Newcwd = Owd & "/testdir", "A008"); end; Change_Working_Directory (".."); Remove_Directory ("testdir"); exception when E : others => Unexpected_Exception (E, "A009"); end; Test ("Environment Variables [4.3.2]"); declare type POSIX_String_Ptr is access all POSIX_String; type Env_Val is record Name : POSIX_String_Ptr; Value : POSIX_String_Ptr; end record; type Env_Vals is array (Positive range <>) of Env_Val; -- Try A String Whose Lower Bound is Not One. Skxsjl : aliased POSIX_String := "Skxsjl"; -- Note : The Following Hack is Necessary Because Gnat 2.00 Doesn'T -- Like New' (""). We Should Verify That The Problem is Gone In 2.02. Empty_String : aliased POSIX_String := ""; Data : constant Env_Vals := ( (new POSIX_String'("Xxx"), new POSIX_String'("Value Of Xxx")), (new POSIX_String'("Abcdefg"), new POSIX_String'("Value Of Abcdefg")), (new POSIX_String'("Empty_Value"), Empty_String'Access), (Skxsjl'Access, Skxsjl'Access), (new POSIX_String'("Long_Name_with_A_Very_Long_Value"), new POSIX_String'("This is The Value Associated with The Very Lo" & "ng Name. I Expect That The Length Of The Name And Value is Rea" & "lly Irrelevant, But It Can'T Hurt To Stress The Size Limits A B" & "it.")), (new POSIX_String'("Last_Name"), new POSIX_String'("Xxx"))); procedure Add_Vals (Vals : Env_Vals; Env : in out Environment); procedure Add_Vals (Vals : Env_Vals; Env : in out Environment) is begin for I in Vals'Range loop Set_Environment_Variable (Vals (I).Name.all, Vals (I).Value.all, Env); end loop; end Add_Vals; procedure Check_Vals (Vals : Env_Vals; Env : in out Environment); procedure Check_Vals (Vals : Env_Vals; Env : in out Environment) is begin for I in Vals'Range loop if not Is_Environment_Variable (Vals (I).Name.all, Env) then -- Vals (I).Name.all is Missing From Environment Fail ("A010"); end if; -- Check Vals of I Assert (Environment_Value_Of (Vals (I).Name.all, Env) = Vals (I).Value.all, "A011"); end loop; end Check_Vals; procedure Print_Val (Name : POSIX_String; Value : POSIX_String; Quit : in out Boolean); procedure Print_Val (Name : POSIX_String; Value : POSIX_String; Quit : in out Boolean) is pragma Unreferenced (Quit); begin Comment (To_String (Name) & "=" & To_String (Value)); Assert (Name'First = 1, "A012"); Assert (Value'First = 1, "A013"); end Print_Val; procedure Print_Env is new For_Every_Environment_Variable (Print_Val); Env1, Env2, Env3 : Environment; Initial_Env : Environment; begin -- First Verify Basic Sanity. Set_Environment_Variable ("ABC", "abc"); Assert (Environment_Value_Of ("ABC") = "abc", "A014"); Assert (Environment_Value_Of ("undefined_variable") = "", "A015"); Assert (Environment_Value_Of ("undefined_variable", "XXX") = "XXX", "A016"); Assert (Is_Environment_Variable ("ABC"), "A017"); Assert (not Is_Environment_Variable ("undefined_variable"), "A018"); Assert (Length (Env1) = 0, "A019"); Assert (not Is_Environment_Variable ("ABC", Env1), "A020"); Add_Vals (Data, Env1); Print_Env (Env1); Assert (Length (Env1) = Data'Length, "A021"); Check_Vals (Data, Env1); Copy_Environment (Env1, Env2); Assert (Length (Env2) = Data'Length, "A022"); Check_Vals (Data, Env2); Check_Vals (Data, Env1); Assert (Is_Environment_Variable ("Abcdefg", Env1), "A023"); Delete_Environment_Variable ("Abcdefg", Env1); Print_Env (Env1); Assert (Length (Env1) = Data'Length - 1, "A024"); Assert (not Is_Environment_Variable ("Abcdefg", Env1), "A025"); Assert (Environment_Value_Of ("Abcdefg", Env1, "X") = "X", "A026"); Delete_Environment_Variable ("Abcdefg", Env1); Print_Env (Env1); Assert (Length (Env1) = Data'Length - 1, "A027"); Add_Vals (Data, Env1); Print_Env (Env1); Assert (Length (Env1) = Data'Length, "A028"); Check_Vals (Data, Env1); Clear_Environment (Env1); Assert (Length (Env1) = 0, "A029"); Assert (not Is_Environment_Variable ("Abcdefg", Env1), "A030"); Copy_From_Current_Environment (Initial_Env); Assert (Is_Environment_Variable ("ABC", Initial_Env), "A031"); Assert (Environment_Value_Of ("ABC", Initial_Env) = "abc", "A032"); Add_Vals (Data, Env1); Copy_Environment (Initial_Env, Env1); Assert (Environment_Value_Of ("ABC", Env1) = "abc", "A033"); Assert (not Is_Environment_Variable ("Abcdefg", Env1), "A034"); Add_Vals (Data, Env1); Check_Vals (Data, Env1); Assert (Environment_Value_Of ("ABC", Env1) = "abc", "A035"); Clear_Environment; Assert (POSIX_Process_Environment.Length = 0, "A036"); Add_Vals (Data, Env3); Assert (Length (Env3) = Data'Length, "A037"); Check_Vals (Data, Env3); Set_Environment_Variable ("Aaa", "Bbb"); Assert (Environment_Value_Of ("Aaa") = "Bbb", "A038"); -- Copy_To_Current_Environment (env3); -- test died here strangly. need to check later. Delete_Environment_Variable ("Aaa"); Set_Environment_Variable ("Xxx", "Value of Xxx"); Set_Environment_Variable ("Abcdefg", "Value of Abcdefg"); Set_Environment_Variable ("Empty_Value", ""); Set_Environment_Variable ("Sjkrls", "Value Of Sjkrls"); Set_Environment_Variable ("Skxsjl", "Skxsjl"); Set_Environment_Variable ("Long_Name_with_A_Very_Long_Value", "This is The Value Associated with The Very Long" & " Name. I Expect That The Length Of The Name And Value is Really " & "Irrelevant, But It Can'T Hurt To Stress The Size Limits A Bit"); Set_Environment_Variable ("Last_Name", "Xxx"); Assert (Is_Environment_Variable (Skxsjl), "A039"); Delete_Environment_Variable (Skxsjl); Assert (not Is_Environment_Variable (Skxsjl), "A040"); Comment ("iterator on environment"); declare Found : Boolean := False; procedure Check_Abcdefg (Name : POSIX_String; Value : POSIX_String; Quit : in out Boolean); procedure Check_Abcdefg (Name : POSIX_String; Value : POSIX_String; Quit : in out Boolean) is pragma Unreferenced (Value); begin if Found then -- Quit didn't work Fail ("A041"); end if; if Name = "Abcdefg" then Found := True; Quit := True; end if; end Check_Abcdefg; procedure Check is new For_Every_Current_Environment_Variable (Check_Abcdefg); begin Check; Assert (Found, "A042"); end; Comment ("variable name containing ="); begin if Environment_Value_Of ("A=B") = "" then Fail ("A043"); end if; Expect_Exception ("A044"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A045"); end; Comment ("variable name containing NUL"); declare Nul : POSIX_Character := POSIX_Character'Val (0); begin Set_Environment_Variable ("A" & Nul, "Xxx"); Expect_Exception ("A046"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A047"); end; Comment ("variable name containing ="); begin Delete_Environment_Variable ("A=B"); Expect_Exception ("A048"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A049"); end; Comment ("null string as variable"); begin Delete_Environment_Variable (""); Expect_Exception ("A050"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A051"); end; Comment ("Copy_To_Current_Environment"); Copy_To_Current_Environment (Initial_Env); Assert (Environment_Value_Of ("ABC") = "abc", "A052"); Assert (POSIX_Process_Environment.Length = Length (Initial_Env), "A053"); exception when E : others => Unexpected_Exception (E, "A054"); end; Done; exception when E : others => Fatal_Exception (E, "A055"); end p040300; libflorist-2025.1.0/tests/p040300.ads000066400000000000000000000061761473553204100166710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 3 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p040300; libflorist-2025.1.0/tests/p040301.adb000066400000000000000000000456211473553204100166470ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 3 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Process_Environment and operations on -- current working directory. -- Setup: Before running this test set PWD to the current working -- directory, (PWD=`pwd`) and export PWD. with POSIX, POSIX_Files, POSIX_Permissions, POSIX_Process_Environment, POSIX_Report, POSIX_Configurable_File_Limits, Ada.Command_Line; procedure p040301 is use POSIX, POSIX_Files, POSIX_Permissions, POSIX_Process_Environment, POSIX_Report; begin Header ("p040301"); Test ("package POSIX_Process_Environment [4.3]"); Test ("Argument_List [4.3.1]"); begin for I in 1 .. Length (Argument_List) loop Comment ("Argument " & Natural'Image (I) & " = " & To_String ( Value (Argument_List, I))); if I > 1 then Assert (To_String (Value (Argument_List, I)) = Ada.Command_Line. Argument (I - 1), "A001." & Natural'Image (I)); Comment ("Ada.Command_Line.Argument" & "(" & Natural'Image ( I - 1) & ") " & " returns " & Ada.Command_Line.Argument (I - 1)); end if; end loop; Comment ("Verify Ada.Command_Line.Argument_Count = POSIX Length" & "(" & "Argument_List" & ")" & "-1"); Comment ("Ada.Command_Line.Argument_Count=" & Natural'Image ( Ada.Command_Line.Argument_Count)); Comment ("POSIX Length(Argument_List)=" & Natural'Image (Length ( Argument_List))); Assert (Ada.Command_Line.Argument_Count = Length (Argument_List) - 1, "A002"); Comment ("Ada.Comman_Line.Command_Name = " & Ada.Command_Line. Command_Name); end; ----------------------------------------------------------------------- Test ("Environment Variables [4.3.2]"); declare EnvA, EnvB : Environment; Test_Str : POSIX_String := "Test_Str_Value"; -- Instantiation of generic procedure Action in the standard procedure Check_Variable_Value (Variable : POSIX_String; Value : POSIX_String; Quit : in out Boolean); procedure Check_Variable_Value (Variable : POSIX_String; Value : POSIX_String; Quit : in out Boolean) is begin if not (To_String (Environment_Value_Of (Variable)) = To_String (Value)) then Fail ("for """ & To_String (Variable) & """ found """ & To_String (Environment_Value_Of (Variable)) & """ /= """ & To_String (Value) & """"); end if; end Check_Variable_Value; procedure Check_All_Table is new For_Every_Environment_Variable ( Check_Variable_Value); procedure Check_All_Current_Table is new For_Every_Current_Environment_Variable (Check_Variable_Value); procedure Check_Action_Quit (Variable : POSIX_String; Value : POSIX_String; Quit : in out Boolean); procedure Check_Action_Quit (Variable : POSIX_String; Value : POSIX_String; Quit : in out Boolean) is begin if Quit then Fail ("Either 'Quit' is initialized as False or it does not work"); elsif Variable = "PATH" then Quit := True; elsif Variable = "Quit_Trigger" then Quit := True; end if; end Check_Action_Quit; procedure Check_Table_Action_Quit is new For_Every_Environment_Variable (Check_Action_Quit); procedure Check_Current_Table_Action_Quit is new For_Every_Current_Environment_Variable (Check_Action_Quit); begin Comment ("Testing Check_All_Current_Table"); Check_All_Current_Table; Comment ("Testing Copy_From_Current_Environment(EnvA: Environment)"); Copy_From_Current_Environment (EnvA); Comment ("Testing Check_All_Table_A also verify copy is done all right"); Check_All_Table (EnvA); Comment ("Clear_Environment since we have a backup EnvA now"); Clear_Environment; Comment ("Copy_To_Current_Environment(EnvA)"); Copy_To_Current_Environment (EnvA); Comment ("After copy EnvA to current then Check_All_Table (EnvA)"); Check_All_Table (EnvA); Comment ("Testing Copy_Environment(EnvA, EnvB)"); Copy_Environment (EnvA, EnvB); Comment ("Testing EnvB has the right copy using Check_All_Table(EnvB)"); Check_All_Table (EnvB); Comment ("Testing Environment_Value_Of(an undefined env variable)"); Assert (Environment_Value_Of ("Undefined_Env_Var", EnvA, "Undefined_Value") = "Undefined_Value", "A003"); Assert (Environment_Value_Of ("Undefined_Env_Var", EnvA) = "", "A004"); Assert (Environment_Value_Of ("Undefined_Env_Var", "Undefined_Value") = "Undefined_Value", "A005"); Assert (Environment_Value_Of ("Undefined_Env_Var") = "", "A006"); Comment ("Testing Is_Environment_Variable(an undefined env variable)"); Assert (Is_Environment_Variable ("Undefined_Env_Var", EnvA) = False, "A007"); Assert (Is_Environment_Variable ("Undefined_Env_Var") = False, "A008"); Set_Environment_Variable ("Undefined_Env_Var", "Defined_Now", EnvA); Set_Environment_Variable ("Undefined_Env_Var", "Defined_Now"); Assert (Is_Environment_Variable ("Undefined_Env_Var", EnvA) = True, "A009"); Assert (Is_Environment_Variable ("Undefined_Env_Var") = True, "A010"); Comment ("Testing case significance of environment variables"); -- Test the case of characters in the environment variable name -- are significant Assert (Is_Environment_Variable ("undefined_env_var", EnvA) = False, "A011"); Assert (Is_Environment_Variable ("undefined_env_var") = False, "A012"); Assert (Environment_Value_Of ("undefined_env_var", EnvA) = "", "A013"); Assert (Environment_Value_Of ("undefined_env_var", " ") = " ", "A014"); Clear_Environment (EnvA); Comment ("Testing validity of a null environment"); Assert (Is_Environment_Variable ("Undefined_Env_Var", EnvA) = False, "A015"); Comment ("Clear_Environment"); Clear_Environment; Assert (Is_Environment_Variable ("Undefined_Env_Var") = False, "A016"); Comment ("Copy_To_Current_Environment (EnvB)"); Copy_To_Current_Environment (EnvB); Assert (Environment_Value_Of ("New_Variable_For_Test", EnvA) = "", "A017"); Assert (Environment_Value_Of ("New_Variable_For_Test", EnvA, "Undefined_Value") = "Undefined_Value", "A018"); Set_Environment_Variable ("New_Variable_For_Test", "New_Variable=Value", EnvA); Assert (Environment_Value_Of ("New_Variable_For_Test", EnvA) = "New_Variable=Value", "A019"); Set_Environment_Variable ("New_Variable_For_Test", "New_Variable=Value"); Assert (Environment_Value_Of ("New_Variable_For_Test") = "New_Variable=Value", "A020"); Delete_Environment_Variable ("New_Variable_For_Test", EnvA); Assert (Is_Environment_Variable ("New_Variable_For_Test", EnvA) = False, "A021"); Delete_Environment_Variable ("New_Variable_For_Test"); Assert (Is_Environment_Variable ("New_Variable_For_Test") = False, "A022"); Copy_Environment (EnvB, EnvA); Assert (Length (EnvB) = Length (EnvA), "A023"); Assert (Length (EnvA) = Length, "A024"); Set_Environment_Variable ("Quit_Trigger", "Trigger_Value"); Set_Environment_Variable ("Quit_Trailer", "Trailer_Value"); Set_Environment_Variable ("quit_trailer", "Trailer_value"); Assert (Length (EnvA) = Length - 3, "A025"); Copy_From_Current_Environment (EnvA); Check_Table_Action_Quit (EnvA); Check_Current_Table_Action_Quit; Copy_To_Current_Environment (EnvB); Clear_Environment (EnvA); Clear_Environment (EnvB); -- Following lines help verify whether empty env is valid Copy_Environment (EnvA, EnvB); Assert (Length (EnvB) = 0, "A026"); ---------------------------------------------------------------- Test ("Error Handling for Environment Variables [4.3.2]"); Comment ("Testing Error Handling For Environment_Value_Of"); begin Test_Str := Environment_Value_Of ("", EnvA); Assert (False, "A027"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A028"); end; begin Test_Str := Environment_Value_Of (""); Assert (False, "A029"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A030"); end; begin Test_Str := Environment_Value_Of ("Contain=Symbol", EnvA); Assert (False, "A031"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A032"); end; begin Test_Str := Environment_Value_Of ("Contain=Symbol"); Assert (False, "A033"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A034"); end; Comment ("Testing Error Handling for Is_Environment_Variable"); begin if Is_Environment_Variable ("", EnvA) = False then Assert (False, "A035"); end if; Assert (False, "A036"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A037"); end; begin if Is_Environment_Variable ("") = False then Assert (False, "A038"); end if; Assert (False, "A039"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A040"); end; begin if Is_Environment_Variable ("Contain=Symbol", EnvA) = False then Assert (False, "A041"); end if; Assert (False, "A042"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A043"); end; begin if Is_Environment_Variable ("Contain=Symbol") = False then Assert (False, "A044"); end if; Assert (False, "A045"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A046"); end; begin Set_Environment_Variable ("", "Invalid", EnvA); Assert (False, "A047"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A048"); end; Comment ("Testing Error Handling for Set_Environment_Variable"); begin Set_Environment_Variable ("", "Invalid"); Assert (False, "A049"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A050"); end; begin Set_Environment_Variable ("Contain=Symbol", "Invalid", EnvA); Assert (False, "A051"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A052"); end; begin Set_Environment_Variable ("Contain=Symbol", "Invalid"); Assert (False, "A053"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A054"); end; declare Nul : POSIX_Character := POSIX_Character'Val (0); begin Set_Environment_Variable ("Contain_Null_Symbol" & Nul, "Invalid", EnvA); Assert (False, "A055"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A056"); end; declare Nul : POSIX_Character := POSIX_Character'Val (0); begin Set_Environment_Variable ("Contain_Null_Symbol" & Nul, "Invalid"); Assert (False, "A057"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A058"); end; Comment ("Testing Error Handling for Delete_Environment_Variable"); begin Delete_Environment_Variable ("", EnvA); Assert (False, "A059"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A060"); end; begin Delete_Environment_Variable (""); Assert (False, "A061"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A062"); end; begin Delete_Environment_Variable ("Contain=Symbol", EnvA); Assert (False, "A063"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A064"); end; begin Delete_Environment_Variable ("Contain=Symbol"); Assert (False, "A065"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A066"); end; exception when E : others => Unexpected_Exception (E, "A067"); end; -------------------------------------------------------------------- Test ("Process Working Directory [4.3.3]"); declare DirA : POSIX_String := Get_Working_Directory; begin Comment ("Testing Get_Working_Directory"); Assert (DirA'First = 1, "A068"); Comment ("Get_Working_Directory returns " & To_String (DirA)); Create_Directory ("Unlikely_Exist_Dir", (others => True)); Comment ("Testing Change_Working_Directory"); Change_Working_Directory ("Unlikely_Exist_Dir"); Assert (Get_Working_Directory = DirA & "/Unlikely_Exist_Dir", "A069"); Change_Working_Directory (".."); Assert (Get_Working_Directory = DirA, "A070"); Remove_Directory ("Unlikely_Exist_Dir"); -------------------------------------------------------------------- Test ("Error Handling for Process Working Directory [4.3.3]"); Comment ("Testing Handling of Permission_Denied"); begin Create_Directory ("Unlikely_Exist_Dir", (Owner_Write => True, others => False)); Change_Working_Directory ("Unlikely_Exist_Dir"); Assert (False, "A071"); exception when POSIX_Error => Check_Error_Code (Permission_Denied, "A072"); end; Remove_Directory ("Unlikely_Exist_Dir"); Comment ("Testing Handling of Filename_Too_Long"); declare Long_Name_Limit : Integer := Integer (POSIX_Configurable_File_Limits.Pathname_Maximum ( Get_Working_Directory)); type String_Access is access String; Over_Long_Name : String_Access; begin Over_Long_Name := new String'("L"); Comment ("Pathname_Maximum" & "(" & To_String (Get_Working_Directory) & ")" & " is " & Integer'Image (Long_Name_Limit)); for I in 1 .. Long_Name_Limit loop Over_Long_Name := new String'(Over_Long_Name.all & "L"); end loop; Change_Working_Directory (To_POSIX_String (Over_Long_Name.all)); Assert (False, "A073"); exception when POSIX_Error => Check_Error_Code (Filename_Too_Long, "A074"); end; Comment ("Testing Handling of Not_A_Directory "); begin Create_FIFO ("FIFO_Not_A_Directory", (others => True)); Change_Working_Directory ("FIFO_Not_A_Directory"); Assert (False, "A075"); exception when POSIX_Error => Check_Error_Code (Not_A_Directory, "A076"); end; Unlink ("FIFO_Not_A_Directory"); Comment ("Testing Handling of No_Such_File_Or_Directory"); begin Change_Working_Directory ("Unlikely_Exist_Dir"); Assert (False, "A077"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A078"); end; end; Done; exception when E : others => Fatal_Exception (E, "A079"); end p040301; libflorist-2025.1.0/tests/p040301.ads000066400000000000000000000061761473553204100166720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 4 0 3 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p040301; libflorist-2025.1.0/tests/p050100.adb000066400000000000000000000201641473553204100166400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 5 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Permissions, -- defined in IEEE Std 1003.5b Section 5.1. -- This test covers only features that depend only on -- the package itself. -- See other tests for uses of this package in combination -- with other features. -- .... some ideas for additional tests: -- Compare the value returned by an initial call -- to Get_Allowed_Process_Permissions against the umask -- inherited by a process from its parent. with POSIX_Permissions, POSIX_Report; procedure p050100 is use POSIX_Permissions, POSIX_Report; begin Header ("p050100"); ------------------------------------------------ Test ("Permissions_Set constants [5.1.1]"); declare -- The type Permission shall list the standard POSIX file modes. All_Permissions : constant Permission_Set := (Others_Execute | Others_Write | Others_Read | Group_Execute | Group_Write | Group_Read | Owner_Execute | Owner_Write | Owner_Read | Set_Group_ID | Set_User_ID => True); Owner_Permissions : constant Permission_Set := (Owner_Read | Owner_Write | Owner_Execute => True, others => False); Group_Permissions : constant Permission_Set := (Group_Read | Group_Write | Group_Execute => True, others => False); Others_Permissions : constant Permission_Set := (Others_Read | Others_Write | Others_Execute => True, others => False); Access_Permissions : constant Permission_Set := (Owner_Read | Owner_Write | Owner_Execute => True, Group_Read | Group_Write | Group_Execute => True, Others_Read | Others_Write | Others_Execute => True, others => False); Set_Group_IDs : constant Permission_Set := (Set_Group_ID => True, others => False); Set_User_IDs : constant Permission_Set := (Set_User_ID => True, others => False); begin -- The constants sets in have the correct members. Assert (All_Permissions = All_Permissions, "A001"); Assert (Owner_Permissions = Owner_Permission_Set, "A002"); Assert (Group_Permissions = Group_Permission_Set, "A003"); Assert (Others_Permissions = Others_Permission_Set, "A004"); Assert (Access_Permissions = Access_Permission_Set, "A005"); Assert (Set_Group_IDs = Set_Group_ID_Set, "A006"); Assert (Set_User_IDs = Set_User_ID_Set, "A007"); exception when E : others => Unexpected_Exception (E, "A008"); end; ------------------------------------------------ Test ("Get_Allowed_Process_Permissions [5.1.2]"); declare Permissions : Permission_Set; begin -- Get_Allowed_Process_Permissions can be called, -- the result contains only file access permissions, -- and it does not raise any exception. Permissions := Get_Allowed_Process_Permissions; for I in Permissions'Range loop -- Check file access permissions Assert (Permissions (I) <= Access_Permission_Set (I), "A009"); end loop; exception when E : others => Unexpected_Exception (E, "A010"); end; ------------------------------------------------ Test ("Set_Allowed_Process_Permissions w/two params [5.1.2]"); declare All_Permissions : constant Permission_Set := (Others_Execute | Others_Write | Others_Read | Group_Execute | Group_Write | Group_Read | Owner_Execute | Owner_Write | Owner_Read | Set_Group_ID | Set_User_ID => True); Old_Permissions : Permission_Set; Permissions : Permission_Set; begin Old_Permissions := Get_Allowed_Process_Permissions; -- Set_Allowed_Process_Permissions can be called, -- does not raise any exception, -- and returns a value consistent with Get_Allowed_Process_Permissions. Set_Allowed_Process_Permissions (All_Permissions, Permissions); Assert (Permissions = Old_Permissions, "A011"); -- Get_Allowed_Process_Permissions returns a result -- consistent with what was last set. Assert (Get_Allowed_Process_Permissions = Access_Permission_Set, "A012"); exception when E : others => Unexpected_Exception (E, "A013"); end; ------------------------------------------------ Test ("Set_Allowed_Process_Permissions w/one param [5.1.2]"); declare Some_Permissions : constant Permission_Set := (Others_Execute | Others_Write | Others_Read | Group_Execute | Group_Write | Group_Read => True, others => False); begin -- Set_Allowed_Process_Permissions can be called, -- and does not raise any exception. Set_Allowed_Process_Permissions (Some_Permissions); -- Get_Allowed_Process_Permissions returns a result -- consistent with what was last set. Assert (Get_Allowed_Process_Permissions = Some_Permissions, "A014"); exception when E : others => Unexpected_Exception (E, "A015"); end; ------------------------------------------------ Done; exception when E : others => Fatal_Exception (E, "A016"); end p050100; libflorist-2025.1.0/tests/p050100.ads000066400000000000000000000061761473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 5 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p050100; libflorist-2025.1.0/tests/p050200.adb000066400000000000000000001041331473553204100166400ustar00rootroot00000000000000----------------------------------------------------------------------------- -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 5 0 2 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This is a test of package POSIX_Files. -- It is far from comprehensive, since the package is outside the scope -- of the POSIX realtime extensions. with POSIX, POSIX_Calendar, POSIX_Files, POSIX_File_Status, POSIX_Permissions, POSIX_Process_Environment, POSIX_Process_Identification, POSIX_Report, POSIX_Configurable_File_Limits, Test_Parameters, Text_IO; procedure p050200 is use POSIX, POSIX_Calendar, POSIX_Files, POSIX_File_Status, POSIX_Permissions, POSIX_Process_Environment, POSIX_Process_Identification, POSIX_Report, POSIX_Configurable_File_Limits, Test_Parameters, Text_IO; Default_Permission_Set : constant Permission_Set := (Owner_Read | Owner_Write | Owner_Execute | Group_Read | Group_Execute | Others_Read | Others_Execute => True, others => False); type File_Types is (Unknown, Directory, Regular, FIFO, Character_Special, Block_Special); type Time_Stamps is (None, Last_Status_Change, Last_Access, Last_Modification); Status_A, Status_B : Status; SC_Time_1, Mod_Time_1, SC_Time_2, Mod_Time_2 : POSIX_Time := POSIX_Calendar.Clock; procedure Check_Status (S : Status; Expected_Type : File_Types; Compare_Time : POSIX_Time; Time_Check_Type : Time_Stamps); procedure Check_Equal (T1, T2 : POSIX_Time; Msg : String); procedure Check_Precedes (T1, T2 : POSIX_Time; Msg : String); function Image (T : POSIX_Time) return String; procedure Check_Status (S : Status; Expected_Type : File_Types; Compare_Time : POSIX_Time; Time_Check_Type : Time_Stamps) is Found_Type : File_Types; Now : POSIX_Time; begin if Is_Directory (S) then Found_Type := Directory; elsif Is_Regular_File (S) then Found_Type := Regular; elsif Is_FIFO (S) then Found_Type := FIFO; elsif Is_Character_Special_File (S) then Found_Type := Character_Special; elsif Is_Block_Special_File (S) then Found_Type := Block_Special; else Found_Type := Unknown; end if; Assert (Found_Type = Expected_Type, "File type not as declared: " & File_Types'Image (Found_Type)); Now := Clock; Assert (Last_Status_Change_Time_Of (S) <= Now and then Last_Access_Time_Of (S) <= Now and then Last_Modification_Time_Of (S) <= Now, "A001: time stamp on this file is newer than current time"); case Time_Check_Type is when Last_Status_Change => Assert (Last_Status_Change_Time_Of (S) /= Compare_Time, "A002: Last_Status_Change_Time did not change"); when Last_Access => Assert (Last_Access_Time_Of (S) /= Compare_Time, "A003: Last_Access_Time did not change"); when Last_Modification => Assert (Last_Modification_Time_Of (S) /= Compare_Time, "A004: Last_Modification_Time did not change"); when others => null; end case; exception when E : others => Unexpected_Exception (E, "A005"); end Check_Status; type Months is (NAM, Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec); function Image (T : POSIX_Time) return String is Year : Year_Number; Month : Month_Number; Day : Day_Number; Seconds : Duration; begin Split (T, Year, Month, Day, Seconds); if Duration (Integer (Seconds)) /= Seconds then return Year_Number'Image (Year) & " " & Months'Image (Months'Val (Month)) & Day_Number'Image (Day) & Integer'Image (Integer (Seconds)) & "+ ..."; else return Year_Number'Image (Year) & " " & Months'Image (Months'Val (Month)) & Day_Number'Image (Day) & Integer'Image (Integer (Seconds)); end if; end Image; procedure Check_Equal (T1, T2 : POSIX_Time; Msg : String) is begin if T1 = T2 then return; end if; if abs (T1 - T2) < 1.0 then -- Fail times off, but by less than one second Fail (Msg & ": times unequal by " & Integer'Image (Integer ((T1 - T2) * 1_000_000)) & "us"); else -- Fail times off by more than one second Fail (Msg & ": times unequal by " & Integer'Image (Integer ((T1 - T2))) & "s"); end if; exception when E : others => Unexpected_Exception (E, Msg); end Check_Equal; procedure Check_Precedes (T1, T2 : POSIX_Time; Msg : String) is begin if T1 <= T2 then return; end if; if T1 - T2 < 1.0 then -- Fail times out of order, but by less than one second Fail (Msg & ": times out of order by " & Integer'Image (Integer ((T1 - T2) * 1_000_000)) & "us"); else -- Fail times out of order by more than one second Fail (Msg & ": times out of order by " & Integer'Image (Integer ((T1 - T2))) & "s"); end if; exception when E : others => Unexpected_Exception (E, Msg); end Check_Precedes; task Watchdog; task body Watchdog is begin delay Short_Watchdog_Timeout; Fatal ("A006: watchdog timeout"); end Watchdog; begin Header ("p050201"); Test ("package POSIX_Files [5.2]"); ------------------------------------------------------------------------- Test ("Create and Remove Files [5.2.1]"); Comment ("Create_Directory (A_New_Directory)"); Create_Directory ("A_New_Directory", Access_Permission_Set); Comment ("Get_File_Status (A_New_Directory)"); Status_B := Get_File_Status ("A_New_Directory"); Comment ("Verify A_New_Directory is a directory"); Check_Status (Status_B, Directory, SC_Time_1, None); Comment ("Verify the permission set of A_New_Directory is as default"); Assert (Permission_Set_Of (Status_B) (Owner_Read .. Others_Execute) = Default_Permission_Set (Owner_Read .. Others_Execute), "A007"); Comment ("Create_FIFO A_New_FIFO"); Create_FIFO ("A_New_FIFO", Access_Permission_Set); Status_B := Get_File_Status ("A_New_FIFO"); Comment ("Verify A_New_FIFO is a FIFO"); Check_Status (Status_B, FIFO, SC_Time_1, None); Comment ("Verify the permission set of the new FIFO is as default"); Assert (Permission_Set_Of (Status_B) (Owner_Read .. Others_Execute) = Default_Permission_Set (Owner_Read .. Others_Execute), "A008"); Comment ("Unlink A_New_FIFO"); Unlink ("A_New_FIFO"); Comment ("Verify A_New_FIFO is removed by unlinking again"); begin Unlink ("A_New_FIFO"); Expect_Exception ("A009"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A010"); end; Comment ("Remove A_New_Directory"); Remove_Directory ("A_New_Directory"); Comment ("Verify A_New_Directory is removed by removing again"); begin Remove_Directory ("A_New_Directory"); Expect_Exception ("A011"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A012"); end; --------------------------------------------------------------------------- Test ("Create and Remove Files [5.2.1]"); Comment ("Testing Error Handling for Permission_Denied"); Comment ("Create A_New_Directory with only Owner_Write access"); Create_Directory ("A_New_Directory", (Owner_Write => True, others => False)); Comment ("Try Create_Directory under A_New_Directory"); begin Create_Directory ("A_New_Directory/Sub_Directory", Access_Permission_Set); exception when POSIX_Error => Check_Error_Code (Permission_Denied, "A013"); end; Comment ("Try Create_FIFO under A_New_Directory"); begin Create_Directory ("A_New_Directory/A_FIFO", Access_Permission_Set); exception when POSIX_Error => Check_Error_Code (Permission_Denied, "A014"); end; Remove_Directory ("A_New_Directory"); -- .... Revisit the tests below to see how they are affected by -- filename truncation, as reported by -- POSIX_Configurable_File_Limits.Filename_Is_Truncated. Comment ("Testing Handling of Filename_Too_Long"); declare Long_Path_Limit : Integer := Integer (Pathname_Maximum (Get_Working_Directory)); type String_Access is access String; Over_Long_Name : String_Access; begin Over_Long_Name := new String'("L"); Comment ("Pathname_Maximum(" & To_String (Get_Working_Directory) & ")=" & Integer'Image (Long_Path_Limit)); for I in 1 .. Long_Path_Limit loop Over_Long_Name := new String'(Over_Long_Name.all & "L"); end loop; begin Create_Directory (To_POSIX_String (Over_Long_Name.all), Access_Permission_Set); Expect_Exception ("A015"); exception when POSIX_Error => Check_Error_Code (Filename_Too_Long, "A016"); end; begin Create_FIFO (To_POSIX_String (Over_Long_Name.all), Access_Permission_Set); Expect_Exception ("A017"); exception when POSIX_Error => Check_Error_Code (Filename_Too_Long, "A018"); end; begin Unlink (To_POSIX_String (Over_Long_Name.all)); Expect_Exception ("A019"); exception when POSIX_Error => Check_Error_Code (Filename_Too_Long, "A020"); end; begin Remove_Directory (To_POSIX_String (Over_Long_Name.all)); Expect_Exception ("A021"); exception when POSIX_Error => Check_Error_Code (Filename_Too_Long, "A022"); end; end; Comment ("Testing Error Handling for File_Exists"); Comment ("Create a directory A_New_Directory"); Create_Directory ("A_New_Directory", Access_Permission_Set); Comment ("Try create A_New_Directory again, should fail"); begin Create_Directory ("A_New_Directory", Access_Permission_Set); Expect_Exception ("A023"); exception when POSIX_Error => Check_Error_Code (File_Exists, "A024"); end; Comment ("Remove A_New_Directory"); Remove_Directory ("A_New_Directory"); Comment ("Create a directory A_New_Directory with owner write only"); Create_Directory ("A_New_Directory", (Owner_Write => True, others => False)); Comment ("Try create A_New_Directory again, should fail"); begin Create_Directory ("A_New_Directory", Access_Permission_Set); Expect_Exception ("A025"); exception when POSIX_Error => Check_Error_Code (File_Exists, "A026"); end; Comment ("Remove A_New_Directory"); Remove_Directory ("A_New_Directory"); Comment ("Create a FIFO A_New_FIFO"); Create_FIFO ("A_New_FIFO", Access_Permission_Set); Comment ("Try create A_New_FIFO again, should fail"); begin Create_FIFO ("A_New_FIFO", Access_Permission_Set); Expect_Exception ("A027"); exception when POSIX_Error => Check_Error_Code (File_Exists, "A028"); end; Unlink ("A_New_FIFO"); -- .... Consider testing error handling for Too_Many_Links. -- Comment ("Testing error handling for Too_Many_Links"); -- Comment (string (Links_Maximum (Current_Working_Directory))); Comment ("Testing error handling for No_Such_File_Or_Directory"); Comment ("Try create a directory with a nonexistent pathname component"); begin Create_Directory (Valid_Nonexistent_File_Name & "/Test", Access_Permission_Set); Expect_Exception ("A029"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A030"); end; Comment ("Try creating a directory with name as null string"); begin Create_Directory ("", Access_Permission_Set); Expect_Exception ("A031"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A032"); end; Comment ("Try create a FIFO with a nonexistent pathname component"); begin Create_FIFO (Valid_Nonexistent_File_Name & "/Test", Access_Permission_Set); Expect_Exception ("A033"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A034"); end; Comment ("Try create a FIFO with name as null string"); begin Create_FIFO ("", Access_Permission_Set); Expect_Exception ("A035"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A036"); end; Comment ("Try remove a directory with a nonexistent pathname"); begin Remove_Directory (Valid_Nonexistent_File_Name); Expect_Exception ("A037"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A038"); end; Comment ("Try remove a directory with name as a null string "); begin Remove_Directory (""); Expect_Exception ("A039"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A040"); end; Comment ("Try unlink a file with a nonexistent pathname"); begin Unlink (Valid_Nonexistent_File_Name); Expect_Exception ("A041"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A042"); end; Comment ("Try unlink a file with name as a null string "); begin Remove_Directory (""); Expect_Exception ("A043"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A044"); end; -- .... No_Space_Left_On_Device is not practical to test. -- .... Read_Only_File_System might be testable, but will Check -- an addition to Test_Parameters, to specify the name of a file that is -- in a read-only filesystem, if one exists. Comment ("Testing handling of Not_A_Directory"); Comment ("Create A_FIFO, then try to treat A_FIFO as a directory"); Create_FIFO ("A_FIFO", Access_Permission_Set); begin Create_Directory ("A_FIFO/Dir", Access_Permission_Set); Expect_Exception ("A045"); exception when POSIX_Error => Check_Error_Code (Not_A_Directory, "A046"); end; begin Create_FIFO ("A_FIFO/FIFO", Access_Permission_Set); Expect_Exception ("A047"); exception when POSIX_Error => Check_Error_Code (Not_A_Directory, "A048"); end; begin Unlink ("A_FIFO/File"); Expect_Exception ("A049"); exception when POSIX_Error => Check_Error_Code (Not_A_Directory, "A050"); end; Comment ("Unlink A_FIFO generated for test"); Unlink ("A_FIFO"); -- .... Resource_Busy is implementation related, -- and so is not tested here Comment ("Testing handling of Directory_Not_Empty"); begin Comment ("Create a Not_Empty_Directory with a FIFO in it"); Create_Directory ("Not_Empty_Directory", Access_Permission_Set); Create_FIFO ("Not_Empty_Directory/A_FIFO", Access_Permission_Set); Comment ("Try to remove Not_Empty_Directory"); Remove_Directory ("Not_Empty_Directory"); Expect_Exception ("A051"); exception when POSIX_Error => if POSIX.Get_Error_Code = Directory_Not_Empty then Comment ("Correctly returned error code Directory_Not_Empty"); else Check_Error_Code (File_Exists, "A052"); end if; end; Comment ("Now delete the FIFO first"); Unlink ("Not_Empty_Directory/A_FIFO"); Comment ("Then remove the directory"); Remove_Directory ("Not_Empty_Directory"); ----------------------------------------------------------------------- Test ("Inquiries on File Types [5.2.2]"); Comment ("Create a small file A_Test_File"); declare A_File : Text_IO.File_Type; begin Create (A_File, Out_File, "A_Test_File"); Put (A_File, "small"); Close (A_File); exception when E : others => Fatal_Exception (E, "A053"); end; Comment ("Create a small FIFO"); Create_FIFO ("A_Test_FIFO", Access_Permission_Set); begin Comment ("Testing Is_File on A_Test_File"); Assert (Is_File ("A_Test_File"), "A054"); Comment ("Testing Is_File on A_Test_FIFO"); Assert (not Is_File ("A_Test_FIFO"), "A055"); Comment ("Testing Is_File on a nonexistent file"); Assert (not Is_File (Valid_Nonexistent_File_Name), "A056"); Comment ("Testing Is_File on a null string"); Assert (not Is_File (""), "A057"); Assert (not Is_File ("///"), "A058"); Comment ("Testing Is_File on current directory"); Assert (not Is_File ("."), "A059"); Comment ("Testing Is_Directory on Get_Working_Directory"); Assert (Is_Directory (Get_Working_Directory), "A060"); Comment ("Testing Is_Directory on A_Test_File"); Assert (not Is_Directory ("A_Test_File"), "A061"); Comment ("Testing Is_Directory on a nonexistent pathname"); Assert (not Is_Directory (Valid_Nonexistent_File_Name), "A062"); Comment ("Testing Is_Directory on a null string"); Assert (not Is_Directory (""), "A063"); Comment ("Testing Is_Directory on a not qualified pathname"); Assert (Is_Directory ("."), "A064"); Comment ("Testing Is_Directory on current directory"); Comment ("Tesing Is_FIFO on A_Test_FIFO"); Assert (Is_FIFO ("A_Test_FIFO"), "A065"); Comment ("Testing Is_FIFO on A_Test_File"); Assert (not Is_FIFO ("A_Test_File"), "A066"); Comment ("Testing Is_FIFO on a nonexistent file"); Assert (not Is_FIFO (Valid_Nonexistent_File_Name), "A067"); Comment ("Testing Is_FIFO on a null string"); Assert (not Is_FIFO (""), "A068"); Comment ("Testing Is_FIFO on a not qualified filename"); Assert (not Is_FIFO ("///"), "A069"); Comment ("Testing Is_Character_Special_File on valid name"); Assert (Is_Character_Special_File (Valid_Character_Special_File_Name), "A070"); Comment ("Testing Is_Character_Special_File on A_Test_File"); Assert (not Is_Character_Special_File ("A_Test_File"), "A071"); Comment ("Testing Is_Character_Special_File on a nonexistent file"); Assert (not Is_Character_Special_File (Valid_Nonexistent_File_Name), "A072"); Comment ("Testing Is_Character_Special_File on a null string"); Assert (not Is_Character_Special_File (""), "A073"); Comment ("Testing Is_Character_Special_File on a not valid filename"); Assert (not Is_Character_Special_File ("///"), "A074"); Comment ("Testing Is_Block_Special_File on a block device"); Assert (Is_Block_Special_File (Valid_Block_Device_Name), "A075"); Comment ("Testing Is_Block_Special_File on A_Test_File"); Assert (not Is_Block_Special_File ("A_Test_File"), "A076"); Comment ("Testing Is_Block_Special_File on a nonexistent file"); Assert (not Is_Block_Special_File (Valid_Nonexistent_File_Name), "A077"); Comment ("Testing Is_Block_Special_File on a null string"); Assert (not Is_Block_Special_File (""), "A078"); Comment ("Testing Is_Block_Special_File on a not qualified filename"); Assert (not Is_Block_Special_File ("///"), "A079"); Comment ("No exceptions returned by above inquiry funtions"); Assert (Is_File_Present ("A_Test_File"), "A080"); Assert (Is_File_Present ("."), "A081"); Assert (not Is_File_Present (Valid_Nonexistent_File_Name), "A082"); Assert (Existence ("A_Test_File") = No_Error, "A083"); Assert (Is_File_Present ("."), "A084"); Assert (Existence (Valid_Nonexistent_File_Name) = No_Such_File_Or_Directory, "A085"); exception when E : others => Unexpected_Exception (E, "A086"); end; ----------------------------------------------------------------------- Test ("Modify File Pathnames [5.2.3]"); Comment ("Create A_New_FIFO as a test file"); Status_A := Get_File_Status (Get_Working_Directory); Create_FIFO ("A_New_FIFO", Access_Permission_Set); Status_B := Get_File_Status ("A_New_FIFO"); SC_Time_1 := Last_Status_Change_Time_Of (Status_B); Mod_Time_1 := Last_Modification_Time_Of (Status_A); SC_Time_2 := Last_Status_Change_Time_Of (Status_A); Comment ("Pause a second for testing purpose"); Comment ("current time", To_Timespec (Clock)); delay 1.0; Comment ("current time", To_Timespec (Clock)); Comment ("Link A_New_FIFO_Link to A_New_FIFO"); Link ("A_New_FIFO", "A_New_FIFO_Link"); Status_B := Get_File_Status ("A_New_FIFO"); Comment ("Verify the Link_Count_Of (A_New_FIFO) = 2"); Assert (Link_Count_Of (Status_B) = 2, "A087"); Comment ("Verify time stamps of the file and parent directory is changed"); Check_Status (Status_B, FIFO, SC_Time_1, Last_Status_Change); Status_A := Get_File_Status (Get_Working_Directory); Check_Status (Status_A, Directory, Mod_Time_1, Last_Modification); Check_Status (Status_A, Directory, SC_Time_2, Last_Status_Change); begin Comment ("Try linking current working directory to A_New_FIFO"); Link ("A_New_FIFO", Get_Working_Directory); Expect_Exception ("A088"); exception when POSIX_Error => Check_Error_Code (File_Exists, "A089"); end; Status_B := Get_File_Status ("A_New_FIFO"); Comment ("Verify the Link_Count remains unchanged if Link fails"); Assert (Link_Count_Of (Status_B) = 2, "A090"); Comment ("Testing linking directories"); begin Comment ("First create A_New_Directory_1"); Create_Directory ("A_New_Directory_1", Access_Permission_Set); Comment ("Then link A_New_Directory_Link to A_New_Directory_1"); Link ("A_New_Directory_1", "A_New_Directory_Link"); Comment ("System support links between directories"); Comment ("Remove A_New_Directory_Link"); Remove_Directory ("A_New_Directory_Link"); exception when POSIX_Error => Comment ("System does not support links between directories"); Comment ("or process does not have appropriate privileges"); end; Comment ("Testing procedure Rename"); Comment ("Rename A_New_FIFO to A_Renamed_FIFO under A_FIFO_Dir"); Create_Directory ("A_FIFO_Dir", Access_Permission_Set); Status_B := Get_File_Status ("A_FIFO_Dir"); Status_A := Get_File_Status (Get_Working_Directory); SC_Time_1 := Last_Status_Change_Time_Of (Status_B); Mod_Time_1 := Last_Modification_Time_Of (Status_B); SC_Time_2 := Last_Status_Change_Time_Of (Status_A); Mod_Time_2 := Last_Modification_Time_Of (Status_A); delay 1.0; Rename ("A_New_FIFO", "A_FIFO_Dir/A_Renamed_FIFO"); Assert (not Is_FIFO ("A_New_FIFO"), "A091"); Assert (Is_FIFO ("A_FIFO_Dir/A_Renamed_FIFO"), "A092"); begin Comment ("Try renaming a nonexistent file"); Rename (Valid_Nonexistent_File_Name, "Valid_File_Name"); Expect_Exception ("A093"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A094"); end; ------------------------------------------------------------------ -- .... A more thorough test would check the effects on open -- files, for the so-called "last close" semantics. ----------------------------------------------------------- -- The link count of a directory includes one downward link -- plus one upward link from itself (.) -- plus one upward link for each subdirectory (..). -- In this case, A_FIFO_Dir has no subdirectories, -- so the link count is 2. Status_B := Get_File_Status ("A_FIFO_Dir"); Assert (Link_Count_Of (Status_B) = 2, "A095: " & Integer'Image (Link_Count_Of (Status_B))); Check_Status (Status_B, Directory, SC_Time_1, Last_Status_Change); Check_Status (Status_B, Directory, Mod_Time_1, Last_Modification); Status_A := Get_File_Status (Get_Working_Directory); Check_Status (Status_A, Directory, SC_Time_2, Last_Status_Change); Check_Status (Status_A, Directory, Mod_Time_2, Last_Modification); ---------------------------------------------------------------------- -- If the two pathnames both refer to links to the same existing -- file, Rename returns successfully and performs no other action. Comment ("A_New_FIFO_Link is the link to previous A_New_FIFO"); Assert (Is_FIFO ("A_New_FIFO_Link"), "A096"); Comment ("Rename A_FIFO_Dir/A_Renamed_FIFO to A_New_FIFO_Link"); Rename ("A_FIFO_Dir/A_Renamed_FIFO", "A_New_FIFO_Link"); Status_B := Get_File_Status ("A_New_FIFO_Link"); Assert (Link_Count_Of (Status_B) = 2, "A097"); Unlink ("A_New_FIFO_Link"); begin Unlink ("A_FIFO_Dir/A_Renamed_FIFO"); exception when POSIX_Error => null; end; Remove_Directory ("A_FIFO_Dir"); Comment ("Create A_New_Directory_2"); Comment ("Rename A_New_Directory_1 to A_New_Directory_2"); begin Rename ("A_New_Directory_1", "A_New_Directory_2"); Comment ("Remove A_New_Directory_2"); Remove_Directory ("A_New_Directory_2"); exception when E : POSIX_Error => Unexpected_Exception (E, "A098: Renaming failed"); Comment ("Remove both A_New_Directory_1 and A_New_Directory_2"); Remove_Directory ("A_New_Directory_1"); Remove_Directory ("A_New_Directory_2"); end; begin Test ("Directory Iteration [5.2.4]"); declare Saw_test_File : Boolean := False; procedure Check_One_File (D : Directory_Entry; Quit : in out Boolean); procedure Check_One_File (D : Directory_Entry; Quit : in out Boolean) is Name : constant POSIX_String := Filename_Of (D); begin Assert (Name'First = 1, "A099"); if Name = "A_Test_File" then -- Check if test_file occurs more than once Assert (Saw_test_File = False, "A100"); Saw_test_File := True; end if; end Check_One_File; procedure Iterate is new For_Every_Directory_Entry (Check_One_File); begin Test ("Directory iterator"); Iterate ("."); end; declare First_Call : Boolean := True; procedure Check_One_File (D : Directory_Entry; Quit : in out Boolean); procedure Check_One_File (D : Directory_Entry; Quit : in out Boolean) is begin Assert (First_Call = True, "A101"); First_Call := False; Quit := True; end Check_One_File; procedure Iterate is new For_Every_Directory_Entry (Check_One_File); begin Iterate ("."); First_Call := True; Iterate (".."); end; declare My_exception : exception; First_Call : Boolean := True; procedure Check_One_File (D : Directory_Entry; Quit : in out Boolean); procedure Check_One_File (D : Directory_Entry; Quit : in out Boolean) is begin Assert (First_Call = True, "A102"); First_Call := False; raise My_exception; end Check_One_File; procedure Iterate is new For_Every_Directory_Entry (Check_One_File); begin Iterate ("."); Expect_Exception ("A103"); exception when My_exception => null; end; Test ("Change_Owner_And_Group [5.2.5]"); Create_Directory ("A_New_Directory", Access_Permission_Set); Change_Owner_And_Group ("A_Test_File", Get_Real_User_ID, Get_Real_Group_ID); -- File Should Be Unchanged. begin Change_Owner_And_Group (Valid_Nonexistent_File_Name, Get_Real_User_ID, Get_Real_Group_ID); Expect_Exception ("A104"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A105"); end; Test ("Change_Permissions [5.2.5]"); Change_Permissions ("A_New_Directory", Access_Permission_Set); Status_B := Get_File_Status ("A_New_Directory"); Check_Status (Status_B, Directory, SC_Time_1, None); Assert (Permission_Set_Of (Status_B) = Access_Permission_Set, "A106"); begin Change_Permissions (Valid_Nonexistent_File_Name, Access_Permission_Set); Expect_Exception ("A107"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A108"); end; Remove_Directory ("A_New_Directory"); exception when E : others => Unexpected_Exception (E, "A109"); end; ---------------------------------------------------------------- -- The following tests will fail if the representation -- of type POSIX_Calendar.Time and the value returned by -- POSIX_Calendar.Clock are more precise than the -- representation of file times. -- On pragmatic grounds, it is debatable whether this is truly -- an error, since a user may actually want this capability. begin Create_Directory ("A_New_Directory", Access_Permission_Set); Test ("Set_File_Times [5.2.5]"); declare Access_Time : POSIX_Time; Mod_Time : POSIX_Time; Now : POSIX_Time := Clock; begin Comment ("Now =" & Image (Now)); Access_Time := Now - 3600.0; Comment ("Access_Time =" & Image (Access_Time)); Mod_Time := Access_Time + 1800.0; Comment ("Mod_Time =" & Image (Mod_Time)); Set_File_Times ("A_New_Directory", Access_Time, Mod_Time); Status_B := Get_File_Status ("A_New_Directory"); Check_Equal (Last_Access_Time_Of (Status_B), Access_Time, "A110"); Check_Equal (Last_Modification_Time_Of (Status_B), Mod_Time, "A111"); end; Test ("Set_File_Times, defaults [5.2.5]"); declare Before : POSIX_Time := Clock; After : POSIX_Time; begin Comment ("Before =" & Image (Before)); Set_File_Times ("A_New_Directory"); After := Clock; Comment ("After =" & Image (After)); Status_B := Get_File_Status ("A_New_Directory"); Comment ("Last_Access_Time =" & Image (Last_Access_Time_Of (Status_B))); Comment ("Last_Modification =" & Image (Last_Modification_Time_Of (Status_B))); Check_Precedes (Before, Last_Access_Time_Of (Status_B), "A112"); Check_Precedes (Last_Access_Time_Of (Status_B), After, "A113"); Check_Precedes (Before, Last_Modification_Time_Of (Status_B), "A114"); Check_Precedes (Last_Modification_Time_Of (Status_B), After, "A115"); end; Test ("Set_File_Times, nonexistent file [5.2.5]"); declare Access_Time : POSIX_Time; Mod_Time : POSIX_Time; begin Access_Time := Clock; Mod_Time := Clock; Comment ("Mod_Time =" & Image (Mod_Time)); Set_File_Times (Valid_Nonexistent_File_Name, Access_Time, Mod_Time); Expect_Exception ("A116"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A117"); end; Test ("Set_File_Times, defaults, nonexistent file"); begin Set_File_Times (Valid_Nonexistent_File_Name); Expect_Exception ("A118"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A119"); end; Remove_Directory ("A_New_Directory"); exception when E : others => Unexpected_Exception (E, "A120"); end; ----------------------------------------------------------------------- Assert (Is_File_Present ("A_Test_File"), "A121"); Unlink ("A_Test_File"); Assert (Is_File_Present ("A_Test_FIFO"), "A122"); Unlink ("A_Test_FIFO"); abort Watchdog; ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A123"); end p050200; libflorist-2025.1.0/tests/p050200.ads000066400000000000000000000061761473553204100166710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 5 0 2 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p050200; libflorist-2025.1.0/tests/p050300.adb000066400000000000000000000230251473553204100166410ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 5 0 3 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Setup: This test should be run with umask "022", i.e., -- POSIX_Permissions.Get_Allowed_Process_Permissions" should -- return (Owner_Read | Owner_Write | Owner_Execute | -- Group_Read | Others_Read => True, others => False); with POSIX, POSIX_Calendar, POSIX_Files, POSIX_File_Status, POSIX_Permissions, POSIX_Process_Identification, POSIX_Report, Test_Parameters, Text_IO; procedure p050300 is use POSIX, POSIX_Calendar, POSIX_Files, POSIX_File_Status, POSIX_Permissions, POSIX_Process_Identification, POSIX_Report, Test_Parameters, Text_IO; type File_Types is (Unknown, Directory, Regular, FIFO, Character_Special, Block_Special); The_Status : Status; procedure Check_Status (S : Status; Expected_Type : File_Types); procedure Check_Status (S : Status; Expected_Type : File_Types) is Found_Type : File_Types; Now : POSIX_Time; begin if Is_Directory (S) then Found_Type := Directory; elsif Is_Regular_File (S) then Found_Type := Regular; elsif Is_FIFO (S) then Found_Type := FIFO; elsif Is_Character_Special_File (S) then Found_Type := Character_Special; elsif Is_Block_Special_File (S) then Found_Type := Block_Special; else Found_Type := Unknown; end if; Assert (Found_Type = Expected_Type, "File type not as declared: " & File_Types'Image (Found_Type)); Now := Clock; Assert (Last_Status_Change_Time_Of (S) <= Now and then Last_Access_Time_Of (S) <= Now and then Last_Modification_Time_Of (S) <= Now, "A001: time stamp on this file is newer than current time"); exception when E : others => Unexpected_Exception (E, "A002"); end Check_Status; begin Header ("p050300"); Test ("package POSIX_File_Status [5.3]"); --------------------------------------------------------------------- if POSIX_Permissions.Get_Allowed_Process_Permissions /= POSIX_Permissions.Permission_Set' (Owner_Read | Owner_Write | Owner_Execute | Group_Read | Others_Read => True, others => False) then Fatal ("A003: Incorrect test setup"); end if; declare -- Tests require us to have a file called "The_Test_File" with -- a file permission of 4700. -- We generate the file here. Test_File : Text_IO.File_Type; Test_File_Perm : constant Permission_Set := (Owner_Read | Owner_Write | Owner_Execute | Set_User_ID => True, others => False); begin Create (Test_File, Out_File, "The_Test_File"); Put (Test_File, "hello"); Close (Test_File); Change_Permissions ("The_Test_File", Test_File_Perm); end; --------------------------------------------------------------------- declare My_Uid : constant User_ID := Get_Real_User_ID; My_Gid : constant Group_ID := Get_Real_Group_ID; Dev : Device_ID; Ino : File_ID; Size : IO_Count; Test_File_Perm : constant Permission_Set := (Owner_Read | Owner_Write | Owner_Execute | Set_User_ID => True, others => False); begin Comment ("status of regular file"); The_Status := Get_File_Status ("The_Test_File"); Comment ("Device/File_ID_Of regular file"); Check_Status (The_Status, Regular); Dev := Device_ID_Of (The_Status); Ino := File_ID_Of (The_Status); -- Check if permissions are 4700 Assert (Permission_Set_Of (The_Status) = Test_File_Perm, "A004"); -- Check if Link count is 1 Assert (Link_Count_Of (The_Status) = 1, "A005"); -- Check Uid Assert (Owner_Of (The_Status) = My_Uid, "A006"); -- Check Gid Assert (Group_Of (The_Status) = My_Gid, "A007"); -- Check Size is 6 Assert (Size_Of (The_Status) = 6, "A008"); --------------------------------------------------------------------- Test ("Last_Access/Modification/Status_Change_Time_Of"); -- Test versions that return Ada.Calendar.Time instead of POSIX_Time. -- Check access time Assert (Last_Access_Time_Of (The_Status) = To_POSIX_Time (To_Time (Last_Access_Time_Of (The_Status))), "A009"); -- Check mod time Assert (Last_Modification_Time_Of (The_Status) = To_POSIX_Time (To_Time (Last_Modification_Time_Of (The_Status))), "A010"); -- Check change time Assert (Last_Status_Change_Time_Of (The_Status) = To_POSIX_Time (To_Time (Last_Status_Change_Time_Of (The_Status))), "A011"); --------------------------------------------------------------------- Comment ("Get_File_Status"); The_Status := Get_File_Status ("."); --------------------------------------------------------------------- Comment ("Size_Of directory"); Check_Status (The_Status, Directory); begin Size := Size_Of (The_Status); Expect_Exception ("A012"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A013"); end; Assert (Dev /= Device_ID_Of (The_Status) or Ino /= File_ID_Of (The_Status), "A014"); --------------------------------------------------------------------- Comment ("status of character special file"); The_Status := Get_File_Status (Valid_Character_Special_File_Name); Check_Status (The_Status, Character_Special); --------------------------------------------------------------------- Comment ("status of block special device"); begin The_Status := Get_File_Status (Valid_Block_Device_Name); Check_Status (The_Status, Block_Special); exception when E : POSIX_Error => Unexpected_Exception (E, "A015"); end; --------------------------------------------------------------------- Comment ("status of nonexistent file"); begin The_Status := Get_File_Status (Valid_Nonexistent_File_Name); Expect_Exception ("A016"); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A017"); end; exception when E : others => Unexpected_Exception (E, "A018"); end; -- remove the file created for this test. Unlink ("The_Test_File"); --------------------------------------------------------------------- Done; exception when E : others => Unlink ("The_Test_File"); Fatal_Exception (E, "A019"); end p050300; libflorist-2025.1.0/tests/p050300.ads000066400000000000000000000061761473553204100166720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 5 0 3 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p050300; libflorist-2025.1.0/tests/p060100.adb000066400000000000000000000533731473553204100166510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 6 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test POSIX_IO Package. -- Setup: When running this test make sure Standard_Error corresponds -- to a terminal device. with IO_Exceptions, POSIX, POSIX_IO, POSIX_Files, POSIX_File_Status, POSIX_Permissions, POSIX_Report; procedure p060100 is use POSIX, POSIX_IO, POSIX_Files, POSIX_File_Status, POSIX_Permissions, POSIX_Report; Test_fd, Out_Fd, In_Fd, Fd : File_Descriptor; NL : constant POSIX_Character := POSIX_Character'Val (10); Read_Write_Perms : constant Permission_Set := (Owner_Read | Owner_Write => True, Group_Read | Group_Write => True, Others_Read | Others_Write => True, others => False); begin Header ("p060100"); Test ("package POSIX_IO [6.1]"); ------------------------------------------------------------------- Test ("Standard File Descriptors [6.1.1]"); Assert (POSIX_IO.Standard_Input = 0, "A001"); Assert (POSIX_IO.Standard_Output = 1, "A002"); Assert (POSIX_IO.Standard_Error = 2, "A003"); ------------------------------------------------------------------- Test ("Operations on Open_Option_Set [6.1.1]"); declare O1, O2 : Open_Option_Set; Empty : constant Open_Option_Set := Open_Option_Set (POSIX.Empty_Set); begin Assert (O1 = Empty, "A004"); Assert (O2 = Empty, "A005"); Assert (O1 + O2 = Empty, "A006"); Assert (O1 - O2 = Empty, "A007"); O1 := POSIX_IO.Append + Non_Blocking; O2 := POSIX_IO.Append + Truncate; Assert (O1 + O2 = POSIX_IO.Append + Non_Blocking + Truncate, "A008"); Assert (O1 - O2 = Non_Blocking, "A009"); exception when E : others => Unexpected_Exception (E, "A010"); end; ------------------------------------------------------------------- Test ("file creation [6.1.1]"); declare Last : IO_Count; begin if Is_File_Present ("test_file") then Unlink ("test_file"); end if; Test_fd := Open_Or_Create ("test_file", Write_Only, Read_Write_Perms, Exclusive + Truncate); Assert (File_Size (Test_fd) = 0, "A011: file_size before write=" & IO_Count'Image (File_Size (Test_fd))); Write (Test_fd, "hello" & NL, Last); Assert (File_Size (Test_fd) = 6, "A012: file_size after write=" & IO_Count'Image (File_Size (Test_fd))); Assert (Last = 6, "A013: last=" & IO_Count'Image (Last)); Close (Test_fd); exception when E : others => Fatal_Exception (E, "A014"); end; ------------------------------------------------------------------- Test ("file status [6.1.1]"); declare St1, St2 : Status; begin Test_fd := Open ("test_file", Read_Write); St1 := Get_File_Status (Test_fd); St2 := Get_File_Status ("test_file"); Assert (St1 = St2, "A015"); Close (Test_fd); exception when E : others => Unexpected_Exception (E, "A016"); end; ------------------------------------------------------------------- Test ("status of closed file descriptor [6.1.1]"); declare St1 : Status; begin St1 := Get_File_Status (Test_fd); Assert (False, "A017"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A018"); when E2 : others => Unexpected_Exception (E2, "A019"); end; ------------------------------------------------------------------- Test ("re-close of closed file descriptor [6.1.1]"); begin Assert (not Is_Open (Test_fd), "A020: is not open"); Close (Test_fd); Assert (False, "A021"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A022"); when E2 : others => Unexpected_Exception (E2, "A023"); end; ------------------------------------------------------------------- Test ("open nonexistent file [6.1.1]"); begin if Is_File_Present ("Nonexistent_File") then Unlink ("test_file"); end if; Fd := Open ("Nonexistent_File", Read_Only); Assert (False, "A024"); exception when E1 : POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, E1, "A025"); when E2 : others => Unexpected_Exception (E2, "A026"); end; ------------------------------------------------------------------- Test ("open, truncate, size_of [6.1.1]"); declare St1, St2 : Status; begin Out_Fd := Open_Or_Create ("Outfile", Write_Only, Read_Write_Perms); Truncate_File (Out_Fd, 0); St1 := Get_File_Status ("Outfile"); Assert (Is_Regular_File (St1), "A027"); Assert (Size_Of (St1) = 0, "A028"); Assert (Permission_Set_Of (St1) = Permission_Set' (Owner_Read | Owner_Write | Group_Read | Others_Read => True, others => False), "A029"); St2 := Get_File_Status (Out_Fd); Assert (St2 = St1, "A030: Status Structures Differ"); exception when E : others => Unexpected_Exception (E, "A031"); end; ------------------------------------------------------------------- Test ("try to read write-only file [6.1.1]"); declare Buf : POSIX_String (1 .. 4); Last : IO_Count; begin Read (Out_Fd, Buf, Last); Assert (False, "A032"); exception when POSIX_Error => Check_Error_Code (Bad_File_Descriptor, "A033"); when E : others => Unexpected_Exception (E, "A034"); end; ------------------------------------------------------------------- Test ("try to re-create existing file [6.1.1]"); declare Fd : File_Descriptor; begin Fd := Open_Or_Create ("Outfile", Write_Only, Read_Write_Perms, Exclusive); Assert (False, "A035"); exception when E1 : POSIX_Error => Check_Error_Code (File_Exists, E1, "A036"); when E2 : others => Unexpected_Exception (E2, "A037"); end; ------------------------------------------------------------------- Test ("reading [6.1.3]"); declare Buf_1 : POSIX_String (1 .. 4); Buf_2 : POSIX_String (101 .. 104); Last : IO_Count; begin Test_fd := Open ("test_file", Read_Only); Read (Test_fd, Buf_1, Last); Assert (Buf_1 (1 .. Integer (Last)) = "hell", "A038"); Read (Test_fd, Buf_2, Last); Assert (Last = 102, "A039: wrong number of characters: " & IO_Count'Image (Last)); Assert (Buf_2 (101 .. 102) = ('o' & NL), "A040: wrong data"); exception when E : others => Unexpected_Exception (E, "A041"); end; ------------------------------------------------------------------- Test ("read past end of file [6.1.3]"); declare Buf : POSIX_String (1 .. 4); Last : IO_Count; begin Read (Test_fd, Buf, Last); Assert (False, "A042"); exception when IO_Exceptions.End_Error => null; when E : others => Unexpected_Exception (E, "A043"); end; ------------------------------------------------------------------- Test ("write ten characters [6.1.4]"); declare Last : IO_Count; St1 : Status; begin Write (Out_Fd, "0123456789", Last); Assert (Last = 10, "A044"); St1 := Get_File_Status (Out_Fd); Assert (Size_Of (St1) = 10, "A045"); exception when E : others => Unexpected_Exception (E, "A046"); end; ------------------------------------------------------------------- Test ("write to read-only file [6.1.4]"); declare Buf : POSIX_String := "Xxx"; Last : IO_Count; begin Write (Test_fd, Buf, Last); Assert (False, "A047"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A048"); Assert (File_Size (Test_fd) = 6, "A049: file_size=" & IO_Count'Image (File_Size (Out_Fd))); when E2 : others => Unexpected_Exception (E2, "A050"); end; ------------------------------------------------------------------- Test ("File Sizes [6.1.5]"); Assert (File_Size (Test_fd) = 6, "A051"); Assert (File_Size (Out_Fd) = 10, "A052"); ------------------------------------------------------------------- Test ("File Position [6.1.5]"); Assert (File_Position (Test_fd) = 6, "A053"); ------------------------------------------------------------------- Test ("seek and read [6.1.5]"); declare Buf : POSIX_String (1 .. 1); Last : IO_Count; Offset : IO_Offset; begin Seek (Test_fd, 1, Offset, From_Beginning); Assert (Offset = 1, "A054"); Read (Test_fd, Buf, Last); Assert (Last = 1, "A055"); Assert (Buf (1) = 'e', "A056"); Assert (File_Position (Test_fd) = 2, "A057"); exception when E : others => Unexpected_Exception (E, "A058"); end; ------------------------------------------------------------------- Test ("seek from current position [6.1.5]"); declare Offset : IO_Offset; begin Seek (Test_fd, 1, Offset, From_Current_Position); Assert (Offset = 3, "A059"); Assert (File_Position (Test_fd) = 3, "A060"); exception when E : others => Unexpected_Exception (E, "A061"); end; ------------------------------------------------------------------- Test ("seek from end [6.1.5]"); declare Offset : IO_Offset; begin Seek (Test_fd, -1, Offset, From_End_Of_File); Assert (Offset = 5, "A062"); Assert (File_Position (Test_fd) = 5, "A063"); exception when E : others => Unexpected_Exception (E, "A064"); end; ------------------------------------------------------------------- Test ("close test_file [6.1.5]"); begin Close (Test_fd); exception when E : others => Unexpected_Exception (E, "A065"); end; ------------------------------------------------------------------- Test ("seek on closed file [6.1.5]"); declare Offset : IO_Offset; begin Seek (Test_fd, 1, Offset, From_Beginning); Assert (False, "A066"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A067"); when E2 : others => Unexpected_Exception (E2, "A068"); end; ------------------------------------------------------------------- declare Old_Options, New_Options : Open_Option_Set; Io_Mode : POSIX_IO.File_Mode; Offset : IO_Offset; Buf : POSIX_String (3 .. 3) := "a"; Last : IO_Count; begin Test ("Get File Control [6.1.7]"); Get_File_Control (Out_Fd, Io_Mode, Old_Options); Assert (Io_Mode = Write_Only, "A069: Assert correct mode"); ------------------------------------------------------------------- Test ("set append [6.1.7]"); Set_File_Control (Out_Fd, Old_Options + POSIX_IO.Append); ------------------------------------------------------------------- Test ("get file control again 6.1.7]"); Get_File_Control (Out_Fd, Io_Mode, New_Options); Assert (New_Options = Old_Options + POSIX_IO.Append, "A070: mode"); ------------------------------------------------------------------- Test ("seek to start [6.1.7]"); Assert (File_Size (Out_Fd) = 10, "A071: file_size=" & IO_Count'Image (File_Size (Out_Fd))); Seek (Out_Fd, 0, Offset, From_Beginning); Write (Out_Fd, Buf, Last); Assert (File_Size (Out_Fd) = 11, "A072: file_size=" & IO_Count'Image (File_Size (Out_Fd))); Assert (Last = IO_Count (Buf'Last), "A073: last"); Assert (File_Position (Out_Fd) = 11, "A074: position=" & IO_Offset'Image (File_Position (Out_Fd))); exception when E : others => Unexpected_Exception (E, "A075"); end; ------------------------------------------------------------------- Test ("check file control [6.1.7]"); declare Options : Open_Option_Set; Io_Mode : POSIX_IO.File_Mode; begin Get_File_Control (Out_Fd, Io_Mode, Options); Assert (Io_Mode = Write_Only, "A076: io_mode"); Assert (Options >= POSIX_IO.Append, "A077: options"); exception when E : others => Unexpected_Exception (E, "A078"); end; ------------------------------------------------------------------- Test ("close out file descriptor [6.1.7]"); begin Assert (Is_Open (Out_Fd), "A079"); Close (Out_Fd); -- Cause Subsequent Operations To fail exception when E : others => Unexpected_Exception (E, "A080"); end; ------------------------------------------------------------------- Test ("file control on closed file descriptor 6.1.7]"); declare Options : Open_Option_Set; Io_Mode : POSIX_IO.File_Mode; begin Get_File_Control (Out_Fd, Io_Mode, Options); Assert (False, "A081"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A082"); when E2 : others => Unexpected_Exception (E2, "A083"); end; ------------------------------------------------------------------- Test ("set file control on closed file descriptor [6.1.7]"); begin Set_File_Control (Out_Fd, Open_Option_Set (POSIX.Empty_Set)); Assert (False, "A084"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A085"); when E2 : others => Unexpected_Exception (E2, "A086"); end; ------------------------------------------------------------------- Test ("get close on exec on closed file descriptor [6.1.7]"); declare Flag : Boolean; begin Flag := Get_Close_On_Exec (Out_Fd); Assert (False, "A087"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A088"); when E2 : others => Unexpected_Exception (E2, "A089"); end; ------------------------------------------------------------------- Test ("set close on exec on closed file descriptor [6.1.7]"); begin Set_Close_On_Exec (Out_Fd, False); Assert (False, "A090"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A091"); when E2 : others => Unexpected_Exception (E2, "A092"); end; ------------------------------------------------------------------- Test ("check files not open [6.1.1]"); begin Assert (Is_Open (Out_Fd) = False, "A093: out_fd"); Assert (Is_Open (Test_fd) = False, "A094: test_fd"); exception when E : others => Unexpected_Exception (E, "A095"); end; ------------------------------------------------------------------- Test ("open and check file control [6.1.7]"); declare Options : Open_Option_Set; Io_Mode : POSIX_IO.File_Mode; begin Out_Fd := Open ("Outfile", Read_Write); Get_File_Control (Out_Fd, Io_Mode, Options); Assert (Io_Mode = Read_Write, "A096"); exception when E : others => Unexpected_Exception (E, "A097"); end; ------------------------------------------------------------------- Test ("duplicate [6.1.6]"); declare St1, St2 : aliased Status; begin Test_fd := Open ("test_file", Read_Only); Comment ("get status via test_fd"); St2 := Get_File_Status (Test_fd); Fd := Duplicate (Test_fd); Assert (Fd /= Test_fd, "A098"); Comment ("get status via fd " & File_Descriptor'Image (Fd)); St1 := Get_File_Status (Fd); Comment ("get status via test_fd"); St2 := Get_File_Status (Test_fd); Assert (File_ID_Of (St1) = File_ID_Of (St2), "A099: file id"); Assert (Device_ID_Of (St1) = Device_ID_Of (St2), "A100: device id"); exception when E : others => Unexpected_Exception (E, "A101"); end; ------------------------------------------------------------------- Test ("duplicate and close [6.1.1]"); declare St1, St2 : Status; begin if Duplicate_and_Close (Out_Fd, Fd) /= Fd then Fail ("A102: Wrong Duplicate"); end if; Comment ("get status via fd"); St1 := Get_File_Status (Fd); Comment ("get status via out_fd"); St2 := Get_File_Status (Out_Fd); Assert (File_ID_Of (St1) = File_ID_Of (St2), "A103: file id"); Assert (Device_ID_Of (St1) = Device_ID_Of (St2), "A104: device id"); Comment ("close fd"); Close (Fd); Comment ("close out_fd"); Close (Out_Fd); exception when E : others => Unexpected_Exception (E, "A105"); end; ------------------------------------------------------------------- Test ("Create Pipe [6.1.1]"); begin Create_Pipe (In_Fd, Out_Fd); exception when E : others => Unexpected_Exception (E, "A106"); end; ------------------------------------------------------------------- Test ("write then read pipe[6.1.3][6.1.4]"); declare Outbuf : POSIX_String := "Ab"; Inbuf : POSIX_String (1 .. 2); Last : IO_Count; begin Write (Out_Fd, Outbuf, Last); Assert (Last = 2, "A107"); Read (In_Fd, Inbuf, Last); Assert (Last = 2, "A108"); Assert (Inbuf = Outbuf, "A109"); exception when E : others => Unexpected_Exception (E, "A110"); end; ------------------------------------------------------------------- Test ("nonblocking read [6.1.3]"); declare Buf : POSIX_String (1 .. 2); Last : IO_Count; begin Set_File_Control (In_Fd, Non_Blocking); Read (In_Fd, Buf, Last); Assert (False, "A111"); exception when E1 : POSIX_Error => Check_Error_Code (Resource_Temporarily_Unavailable, E1, "A112"); when E2 : others => Unexpected_Exception (E2, "A113"); end; ------------------------------------------------------------------- Test ("invalid seek [6.1.5]"); declare Offset : IO_Offset; begin Seek (In_Fd, 1, Offset, From_Beginning); Assert (False, "A114"); exception when E1 : POSIX_Error => Check_Error_Code (Invalid_Seek, E1, "A115"); when E2 : others => Unexpected_Exception (E2, "A116"); end; Close (In_Fd); Close (Out_Fd); ------------------------------------------------------------------- Test ("test_file is not a terminal [6.1.6]"); Assert (not Is_A_Terminal (Test_fd), "A117"); -- Tests o82 require that the environment variable -- "TTY_NAME" be set to the "stderr" device (for example /dev/pts/5). ------------------------------------------------------------------- Test ("is_a_terminal [6.1.6]"); begin if Is_A_Terminal (POSIX_IO.Standard_Error) then declare Tty_Name : POSIX_String := Get_Terminal_Name (POSIX_IO.Standard_Error); begin Comment ("tty_name = " & To_String (Tty_Name)); end; else Fail ("A118: Standard_Error should be a terminal device"); end if; Close (Test_fd); end; -- remove the file created for this Test. Unlink ("test_file"); ------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A119"); end p060100; libflorist-2025.1.0/tests/p060100.ads000066400000000000000000000061761473553204100166710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 6 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p060100; libflorist-2025.1.0/tests/p060200.adb000066400000000000000000000324571473553204100166520ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 6 0 2 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test file locking operations. with Ada.Text_IO, POSIX, POSIX_Files, POSIX_File_Locking, POSIX_IO, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, POSIX_Unsafe_Process_Primitives; use Ada.Text_IO, POSIX, POSIX_Files, POSIX_File_Locking, POSIX_IO, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, POSIX_Unsafe_Process_Primitives; procedure p060200 is Test_fd : File_Descriptor; -- for test_file Child : Process_ID; -- The Pause procedure Can Be Rewritten As An Infinite loop if Necessary. procedure Pause; procedure C_Pause; pragma Import (C, C_Pause, "pause"); procedure Pause is begin loop C_Pause; end loop; end Pause; begin Header ("p060200"); Test ("package POSIX_File_Locking [6.2]"); --------------------------------------------------------- -- Test requires us to have a file called "test_file" with a -- content of 6 characters. For example, hello(NEWLINE). Comment ("create test_file"); declare Test_File : File_Type; begin Create (Test_File, Out_File, "test_file"); Put (Test_File, "hello"); Close (Test_File); end; --------------------------------------------------------- Test ("create child process to hold lock"); declare Read_Fd, -- one end of pipe Write_Fd : File_Descriptor; -- other end of pipe Last : IO_Count; Buf : POSIX_String (1 .. 5); begin Test_fd := Open ("test_file", Read_Write); Create_Pipe (Read_Fd, Write_Fd); Child := Fork; if Child = Null_Process_ID then Set_Lock (Test_fd, (Whole_File => False, Lock => Read_Lock, Starting_Point => From_Beginning, Start => 3, Length => 2)); Comment ("child has read lock on 3..4"); Close (Read_Fd); Write (Write_Fd, "Ready", Last, No_Signals); Close (Write_Fd); Pause; -- Fail because of a runaway child Fail ("A001"); Exit_Process (0); end if; Close (Write_Fd); -- should block until child process has locked 3..4 Read (Read_Fd, Buf, Last, No_Signals); Close (Read_Fd); Assert (Buf (1 .. Integer (Last)) = "Ready", "A002"); -- Now The File Has A Read Lock. exception when E : others => Fatal_Exception (E, "A003"); end; --------------------------------------------------------- Test ("no write lock conflict on 0..2 from beginning"); begin Set_Lock (Test_fd, (False, Write_Lock, From_Beginning, 0, 3)); exception when E : others => Unexpected_Exception (E, "A004"); end; --------------------------------------------------------- Test ("no write lock conflict on 0..2 from end"); begin Set_Lock (Test_fd, (False, Write_Lock, From_End_Of_File, -6, 3)); exception when E : others => Unexpected_Exception (E, "A005"); end; --------------------------------------------------------- Test ("no write lock conflict on 5..5 from beginning"); begin Set_Lock (Test_fd, (False, Write_Lock, From_Beginning, 5, 1)); exception when E : others => Unexpected_Exception (E, "A006"); end; --------------------------------------------------------- Test ("no write lock conflict on 5..5 from end"); begin Set_Lock (Test_fd, (False, Write_Lock, From_End_Of_File, -1, 1)); exception when E : others => Unexpected_Exception (E, "A007"); end; --------------------------------------------------------- Test ("write lock conflict on 3..4 from end"); declare EC : Error_Code; begin Set_Lock (Test_fd, (False, Write_Lock, From_End_Of_File, -3, 2)); Assert (False, "A008"); exception when E1 : POSIX.POSIX_Error => -- P1003.1c says either EACCES (Permission_Denied) or -- EAGAIN (Resource_Temporarily_Unavailable) may be returned. -- .... Change POSIX.5? EC := POSIX.Get_Error_Code; if EC /= Resource_Temporarily_Unavailable and EC /= Permission_Denied then -- Fail because expected EACCES or EAGAIN Unexpected_Exception (E1, "A009"); end if; when E2 : others => Unexpected_Exception (E2, "A010"); end; --------------------------------------------------------- Test ("write lock conflict on 3..4 from beginning"); declare EC : Error_Code; begin Set_Lock (Test_fd, (False, Write_Lock, From_Beginning, 3, 2)); Assert (False, "A011"); exception when E1 : POSIX_Error => EC := POSIX.Get_Error_Code; if EC /= Resource_Temporarily_Unavailable and EC /= Permission_Denied then -- Fail because expected EACCES or EAGAIN Unexpected_Exception (E1, "A012"); end if; when E2 : others => Unexpected_Exception (E2, "A013"); end; --------------------------------------------------------- Test ("info about write lock conflict on 3..3"); declare Locker : Process_ID; Lock1 : File_Lock; begin Get_Lock (Test_fd, (False, Write_Lock, From_End_Of_File, -3, 1), Lock1, Locker); if Locker = Null_Process_ID then Fail ("No Lock Found"); else -- Checking Locking Process Assert (Locker = Child, "A014"); -- Checking Read Lock Assert (Lock1.Lock = Read_Lock, "A015"); if Lock1.Whole_File then Fail ("Whole File Locked"); elsif Lock1.Starting_Point /= From_Beginning or Lock1.Start /= 3 or Lock1.Length /= 2 then Fail ("A016"); end if; end if; exception when E : others => Unexpected_Exception (E, "A017"); end; --------------------------------------------------------- Test ("no read lock conflict on 3..3"); declare Locker : Process_ID; Lock1 : File_Lock; begin Get_Lock (Test_fd, (False, Read_Lock, From_End_Of_File, -3, 1), Lock1, Locker); Assert (Locker = Null_Process_ID, "A018"); exception when E : others => Unexpected_Exception (E, "A019"); end; --------------------------------------------------------- Test ("no read lock conflict on 3..4 from beginning"); begin Set_Lock (Test_fd, (False, Read_Lock, From_Beginning, 3, 2)); exception when E : others => Unexpected_Exception (E, "A020"); end; --------------------------------------------------------- Test ("no read lock conflict on whole file"); begin Set_Lock (Test_fd, (True, Read_Lock)); exception when E : others => Unexpected_Exception (E, "A021"); end; --------------------------------------------------------- Test ("write lock conflict for whole file"); declare EC : Error_Code; begin Set_Lock (Test_fd, (True, Write_Lock)); Assert (False, "A022"); exception when E1 : POSIX_Error => EC := POSIX.Get_Error_Code; if EC /= Resource_Temporarily_Unavailable and EC /= Permission_Denied then -- Fail because expected EACCES or EAGAIN Unexpected_Exception (E1, "A023"); end if; when E2 : others => Unexpected_Exception (E2, "A024"); end; --------------------------------------------------------- Test ("release read lock on whole file"); begin Set_Lock (Test_fd, (True, Unlock)); exception when E : others => Unexpected_Exception (E, "A025"); end; --------------------------------------------------------- Test ("kill child holding read lock"); declare Status : Termination_Status; begin Send_Signal (Child, Signal_Kill); Wait_For_Child_Process (Status, Child); Assert (Termination_Cause_Of (Status) = Terminated_By_Signal, "A026"); Assert (Termination_Signal_Of (Status) = Signal_Kill, "A027"); exception when E : others => Unexpected_Exception (E, "A028"); end; --------------------------------------------------------- Test ("no conflict for write lock on whole file"); begin Set_Lock (Test_fd, (True, Write_Lock)); exception when E : others => Unexpected_Exception (E, "A029"); end; --------------------------------------------------------- Test ("new child must wait to lock file"); declare Status : Termination_Status; begin Child := Fork; if Child = Null_Process_ID then Comment ("child waiting for write lock on 3..4"); Wait_To_Set_Lock (Test_fd, (True, Write_Lock)); Exit_Process (0); end if; -- give child time to try to lock the file Comment ("we just hope the child gets time to run"); delay 0.1; -- make sure the child is still there Comment ("checking child status"); Wait_For_Child_Process (Status, Child, Block => False); Comment ("got child status"); Assert (not Status_Available (Status), "A030"); exception when E : others => Unexpected_Exception (E, "A031"); end; --------------------------------------------------------- Test ("release whole-file lock"); begin Set_Lock (Test_fd, (True, Unlock)); exception when E : others => Unexpected_Exception (E, "A032"); end; --------------------------------------------------------- Test ("child can now get lock and exit"); declare Status : Termination_Status; begin Wait_For_Child_Process (Status, Child); Assert (Termination_Cause_Of (Status) = Exited, "A033"); Assert (Exit_Status_Of (Status) = 0, "A034"); exception when E : others => Unexpected_Exception (E, "A035"); end; --------------------------------------------------------- Close (Test_fd); --------------------------------------------------------- Test ("cannot lock with stale file descriptor"); declare Locker : Process_ID; Lock1 : File_Lock; begin Get_Lock (Test_fd, (True, Write_Lock), Lock1, Locker); Assert (False, "A036"); exception when E1 : POSIX_Error => Check_Error_Code (Bad_File_Descriptor, E1, "A037"); when E2 : others => Unexpected_Exception (E2, "A038"); end; -- remove the file created for this test. Unlink ("test_file"); --------------------------------------------------------- Done; exception when E : others => Unlink ("test_file"); Fatal_Exception (E, "A039"); end p060200; libflorist-2025.1.0/tests/p060200.ads000066400000000000000000000061761473553204100166720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 6 0 2 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p060200; libflorist-2025.1.0/tests/p060300.adb000066400000000000000000000603461473553204100166510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 6 0 3 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test for POSIX_Asynchronous_IO package -- ... this is a superficial test -- It does not test much more than whether the interfaces can -- be called. A more complete test is desirable. with Ada.Calendar, Ada.Streams, POSIX, POSIX_Asynchronous_IO, POSIX_Configurable_File_Limits, POSIX_IO, POSIX_Permissions, POSIX_Report, POSIX_Signals; procedure p060300 is use Ada.Streams, POSIX, POSIX_Asynchronous_IO, POSIX_IO, POSIX_Permissions, POSIX_Report, POSIX_Signals; FD : File_Descriptor; Buf : IO_Array_Pointer := new Stream_Element_Array (1 .. 10); Status : AIO_Status; -- set by Check_Status Valid_AIO_Filename : constant POSIX_String := "test_io_filename"; procedure Setup (AD : in out AIO_Descriptor); procedure Cleanup (AD : in out AIO_Descriptor); procedure Check_Status (AD : AIO_Descriptor); procedure Setup (AD : in out AIO_Descriptor) is Event : Signal_Event; begin AD := Create_AIO_Control_Block; Set_Buffer (AD, Buf); Buf.all := To_Stream_Element_Array ("hello....."); Set_Length (AD, 6); Set_Notification (Event, No_Notification); Set_Event (AD, Event); exception when E : others => Fatal_Exception (E, "A001"); end Setup; procedure Cleanup (AD : in out AIO_Descriptor) is use Ada.Calendar; Start_Time : constant Ada.Calendar.Time := Clock; begin while Get_AIO_Status (AD) = In_Progress loop if Clock - Start_Time > 1.0 then Fail ("A002: IO operation apparently hung"); exit; end if; end loop; Destroy_AIO_Control_Block (AD); Close (FD); exception when E : others => Fatal_Exception (E, "A003"); end Cleanup; procedure Check_Status (AD : AIO_Descriptor) is Err1, Err2 : Error_Code := No_Error; begin --------------------------------------------------- -- Get_AIO_Status( ) shall raise POSIX_Error, with -- the Status Code of the request as error code, if -- the request has failed and Get_Byte_Transferred -- has not yet been called for AD. If the request -- has not failed and Get_Bytes_Transferred has not -- yet been called for AD, the function shall return -- the value of type AIO_Status value corresponding -- to the Status Code, according to the following table: -- Status Code Value AIO_Status Value -- Operation_In_Progress In_Process -- No_Error Completed_Successfully -- Operation_Canceled Canceled -- During the lifetime of an asychronous I/O request, -- if the operation has not failed, the Status Code -- shall be as In_Progress, Completed_Successfully, -- or Cancelled. -- The AIO descriptor originally specified in the call -- that requests initiation of an asynchronous I/O -- operation can be used, thereafter, as a handle -- for retrieving the status of the I/O request. -- It shall remain valid for this purpose during its -- lifetime. If the operation has not failed, the Status -- code shall be In_Progress, Completed_Successfully, -- or Cancelled. --------------------------------------------------- -- Get_AIO_Error_Code shall -- return the Status Code of asychronous I/O request -- specified by AD, if Get_Bytes_Transferred has not -- yet been called for AD. Err1 := Get_AIO_Error_Code (AD); begin Status := Get_AIO_Status (AD); if Status = In_Progress then Assert (Err1 = Operation_In_Progress, "A004"); Comment ("delaying to await I/O completion"); delay 1.0; Status := Get_AIO_Status (AD); Assert (Status /= In_Progress, "A005"); elsif Is_Supported (Asynchronous_IO_Option) then Assert (Status = Completed_Successfully, "A006"); end if; Comment ("Status=" & AIO_Status'Image (Status)); exception when E1 : POSIX_Error => Err2 := Get_Error_Code; Assert (Err2 /= No_Error, "A007"); Unexpected_Exception (E1, "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; if Err2 /= No_Error then Assert (Err1 = Err2, "A010"); else if Err1 = Operation_Canceled then Assert (Status = Canceled, "A011"); else Assert (Err1 = No_Error or Err1 = Operation_In_Progress, "A012"); end if; end if; exception when E : others => Fatal_Exception (E, "A013"); end Check_Status; procedure Check_Cancelation (AD : in out AIO_Descriptor); procedure Check_Cancelation (AD : in out AIO_Descriptor) is Ret : Cancelation_Status; begin Ret := Cancel (AD); Comment ("Cancelation_Status=" & Cancelation_Status'Image (Ret)); exception when E : others => Fatal_Exception (E, "A014"); end Check_Cancelation; begin Header ("p060300"); declare AD : AIO_Descriptor; begin Test ("Create/Destroy_AIO_Control_Block [6.3.1]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); AD := Create_AIO_Control_Block; ------------------------------------------------------------------- -- Create_AIO_Control_Block( ) shall allocate a control block, -- and return a value of type AIO_Descriptor that refers to it. -- Since Create_AIO_Control_Block is a function, the -- implementation shall be such that the value returned can be -- assigned to a variable of type AIO_Descriptor. -- Destroy_AIO_Control_Block( ) shall deallocate the control block -- to which the AD parameter refers, and destroy the reference, -- unless the object corresponds to an asynchronous I/O request -- that is still being processed. Assert (True, "A015"); Destroy_AIO_Control_Block (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A016: Synchronize_Data"); when E2 : others => Unexpected_Exception (E2, "A017: Synchronize_Data"); end; ---------------------------------------------------------------------- declare AD : AIO_Descriptor; FD : File_Descriptor; FD2 : File_Descriptor; begin Test ("Set/Get_File [6.3.2]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); FD2 := Get_File (AD); ------------------------------------------------------------------ -- Set_File( ) shall set the file attribute of the object specified -- by the first argument to the value specified by the second -- argument. -- Get_File( ) shall return the value of the file attribute of the -- argument. -- The file descriptor on which the asynchronous I/O operation -- is to be performed. Assert (FD2 = FD, "A018"); Check_Status (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A019: Synchronize_Data"); when E2 : others => Unexpected_Exception (E2, "A020: Synchronize_Data"); end; ----------------------------------------------------------------------- -- Stream_Element'Size should be equal to POSIX_Character'Size. Assert (Stream_Element'Size = POSIX_Character'Size, "A021"); ---------------------------------------------------------- -- The Read operation allows the calling process to read -- the number of bytes specified by the Length attribute -- Of AD from the ifle specified by the File attribute, -- into the buffer designated by the Buffer attribute. ------------------------------------------------------------ -- The Write operation allows the calling process to write Length -- bytes to the file associated with File from the buffer -- pointed to Buffer (see POSIX_IO.Write), where Length, -- File and Buffer are attributes of AD. declare AD : AIO_Descriptor; begin Test ("Read and Write [6.3.3] & [6.3.4]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Comment ("Write"); Write (AD); -- write to file from buf Check_Status (AD); Comment ("Read"); Read (AD); -- read to buffer from file Check_Status (AD); Assert (Get_Buffer (AD) = Buf, "A022"); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A023"); when E2 : others => Unexpected_Exception (E2, "A024"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; List : AIO_Descriptor_List (1 .. 1); Event : Signal_Event; begin Test ("List_IO_No_Wait [6.3.5]"); Setup (AD); Set_Notification (Event, No_Notification); Set_Event (AD, Event); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Set_Operation (AD, Write); List (1) := AD; List_IO_No_Wait (List, Event); Check_Status (List (1)); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A025"); when E2 : others => Unexpected_Exception (E2, "A026"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; List : AIO_Descriptor_List (1 .. 1); begin Test ("List_IO_Wait [6.3.5]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Set_Operation (AD, Write); List (1) := AD; List_IO_Wait (List); Check_Status (List (1)); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A027"); when E2 : others => Unexpected_Exception (E2, "A028"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; Err1 : Error_Code := No_Error; begin Test ("Get_AIO_Status (1) [6.3.6]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Set_Operation (AD, Write); Write (AD); Err1 := Get_AIO_Error_Code (AD); begin Status := Get_AIO_Status (AD); if Status = In_Progress then Assert (Err1 = Operation_In_Progress, "A029"); Comment ("delaying to await I/O completion"); delay 1.0; Status := Get_AIO_Status (AD); Assert (Status /= In_Progress, "A030"); else Assert (Status = Completed_Successfully, "A031"); end if; Comment ("Status=" & AIO_Status'Image (Status)); end; Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A032"); when E2 : others => Unexpected_Exception (E2, "A033"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; List : AIO_Descriptor_List (1 .. 1); begin Test ("Get_AIO_Status (2) [6.3.6]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Set_Operation (AD, Write); List (1) := AD; Write (AD); Check_Status (AD); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A034"); when E2 : others => Unexpected_Exception (E2, "A035"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; begin Test ("Get_Bytes_Transferred [6.3.7]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Write (AD); Check_Status (AD); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A036"); when E2 : others => Unexpected_Exception (E2, "A037"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; begin Test ("Cancel (1) [6.3.8]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Write (AD); Check_Cancelation (AD); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A038"); when E2 : others => Unexpected_Exception (E2, "A039"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; FD : File_Descriptor; Ret : Cancelation_Status; begin Test ("Cancel (2) [6.3.8]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Write (AD); begin Ret := Cancel (FD); Comment ("Cancelation_Status=" & Cancelation_Status'Image (Ret)); end; Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A040: Synchronize_Data"); when E2 : others => Unexpected_Exception (E2, "A041: Synchronize_Data"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; begin Test ("Await_IO (1) [6.3.9]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Write (AD); Await_IO (AD); Check_Status (AD); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A042"); when E2 : others => Unexpected_Exception (E2, "A043"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; List : AIO_Descriptor_List (1 .. 1); begin Test ("Await_IO (2) [6.3.9]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Set_Operation (AD, Write); List (1) := AD; List_IO_Wait (List); Await_IO (List); Check_Status (AD); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A044"); when E2 : others => Unexpected_Exception (E2, "A045"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; Timeout : Timespec; begin Test ("Await_IO_Or_Timeout (1) [6.3.9]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Write (AD); Set_Seconds (Timeout, Seconds (1)); Set_Nanoseconds (Timeout, Nanoseconds (1)); Await_IO_Or_Timeout (AD, Timeout); -- If time expires, should have raised POSIX_Error Check_Status (AD); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A046"); when E2 : others => Unexpected_Exception (E2, "A047"); end; ----------------------------------------------------------------------- declare AD : AIO_Descriptor; List : AIO_Descriptor_List (1 .. 1); Timeout : Timespec; begin Test ("Await_IO_Or_Timeout (2) [6.3.9]"); Setup (AD); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Set_Operation (AD, Write); List (1) := AD; List_IO_Wait (List); Set_Seconds (Timeout, Seconds (1)); Set_Nanoseconds (Timeout, Nanoseconds (1)); Await_IO_Or_Timeout (List, Timeout); Check_Status (AD); Cleanup (AD); exception when E1 : POSIX_Error => Optional (Asynchronous_IO_Option, Operation_Not_Implemented, E1, "A048"); when E2 : others => Unexpected_Exception (E2, "A049"); end; ----------------------------------------------------------------------- -- Synchronize_File( ) asynchronously forces all I/O requests -- associated with the file specified by the AD parameter -- and queued at the time of the call to the synchronized -- completion state. The procedure call to Synchronize_File -- shall return when the synchronization request has been -- initiated or queued to the file or device (even when the -- data cannot be synchronized immediately). -- If Synchronize_File or Synchronize_Data succeeds, then -- it is only the I/O that was queued at the time of -- the call to Synchronize_File that is guaranteed to be -- forced to the relevant completion state. The completion of -- subsequent I/O on the file descriptor is not guaranted to -- be completed in a synchronized fashion. -- If the Synchronize_File procedure fails or there is an -- error condition associated with AD, data is not guaranteed -- to have been successfulIy transferred. declare AD : AIO_Descriptor; AD2 : AIO_Descriptor; begin Test ("Synchronize_File [6.3.10]"); Setup (AD); Setup (AD2); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Write (AD); delay 1.0; Comment ("Synchronizing file"); Synchronize_File (AD2); Check_Status (AD); Check_Status (AD2); Cleanup (AD2); Destroy_AIO_Control_Block (AD); exception when E1 : POSIX_Error => if Get_Error_Code = Invalid_Argument then Assert (not POSIX_Configurable_File_Limits. Synchronized_IO_Is_Supported (Valid_AIO_Filename), "A050"); else Optional (Asynchronous_IO_Option, Synchronized_IO_Option, Operation_Not_Implemented, E1, "A051"); end if; when E2 : others => Unexpected_Exception (E2, "A052"); end; ----------------------------------------------------------------------- -- Synchronize_Data( ) asynchronously forces all I/O requests -- associated with the file specified by the AD parameter -- and queued at the time of the call to the synchronized -- completion state. The procedure call to Synchronize_Data -- shall return when the synchronization request has been -- initiated or queued to the file or device (even when the -- data cannot be synchronized immediately). -- If Synchronize_Data or Synchronize_Data succeeds, then -- it is only the I/O that was queued at the time of -- the call to Synchronize_Data that is guaranteed to be -- forced to the relevant completion state. The completion of -- subsequent I/O on the file descriptor is not guaranteed to -- be completed in a synchronized fashion. -- If the Synchronize_Data procedure fails or there is an -- error condition associated with AD, data is not guaranteed -- to have been successfulIy transferred. declare AD : AIO_Descriptor; AD2 : AIO_Descriptor; begin Test ("Synchronize_Data [6.3.10]"); Setup (AD); Setup (AD2); FD := Open_Or_Create (Valid_AIO_Filename, Read_Write, Owner_Permission_Set); Set_File (AD, FD); Write (AD); delay 1.0; Set_File (AD2, FD); Comment ("Synchronizing data"); Synchronize_Data (AD2); Cleanup (AD2); Destroy_AIO_Control_Block (AD); exception when E1 : POSIX_Error => if Get_Error_Code = Invalid_Argument then Assert (not POSIX_Configurable_File_Limits. Synchronized_IO_Is_Supported (Valid_AIO_Filename), "A053"); else Optional (Asynchronous_IO_Option, Synchronized_IO_Option, Operation_Not_Implemented, E1, "A054"); end if; when E2 : others => Unexpected_Exception (E2, "A055"); end; -------------------------------------------------------------------------- Test ("Set_Offset [6.3.2]"); -- This interface is coverd by procedure Setup -- .... -------------------------------------------------------------------------- Test ("Set_Buffer [6.3.2]"); -- This interface is covered by procedure SetUp -- .... -------------------------------------------------------------------------- Test ("Set_Length [6.3.2]"); -- This interface is covered by procedure Check_Status -- .... ------------------------------------------------------------------------- Test ("Get_AIO_Error_Code [6.3.6]"); -- This interface is covered by procedure Check_Status -- .... ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A056"); end p060300; libflorist-2025.1.0/tests/p060300.ads000066400000000000000000000061761473553204100166730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 6 0 3 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p060300; libflorist-2025.1.0/tests/p070200.adb000066400000000000000000000265771473553204100166610ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 7 0 2 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Setup: This test requires that Standard_Error correspond to a -- terminal device, and it must be run interactively, not in background. -- Otherwise, it will hang waiting for output to be permitted. with POSIX, POSIX_Files, POSIX_IO, POSIX_Process_Identification, POSIX_Report, POSIX_Terminal_Functions, Text_IO; procedure p070200 is use POSIX, POSIX_Files, POSIX_IO, POSIX_Process_Identification, POSIX_Report, POSIX_Terminal_Functions; begin Header ("p070200"); Test ("package POSIX_Terminal_Functions [7.2]"); declare original_Tc : Terminal_Characteristics; Tc : Terminal_Characteristics; New_Tc : Terminal_Characteristics; Modes : Terminal_Modes_Set; New_Modes : Terminal_Modes_Set; test_Fd : File_Descriptor; y : POSIX.POSIX_Character; z : Baud_Rate; w : Bits_Per_Character; begin declare -- Tests require us to have a file called "test_file." -- We generate the file here. Test_File : Text_IO.File_Type; begin Text_IO.Create (Test_File, Text_IO.Out_File, "The_Test_File"); Text_IO.Put (Test_File, "hello"); Text_IO.Close (Test_File); end; Comment ("Get_Terminal_Characteristics"); original_Tc := Get_Terminal_Characteristics (POSIX_IO.Standard_Error); Comment ("Terminal_Modes_Of"); Tc := original_Tc; Modes := Terminal_Modes_Of (Tc); Assert (Modes = Terminal_Modes_Of (original_Tc), "A001"); Comment ("Enable_Signals"); Assert (Modes (Enable_Signals) = True, "A002"); Comment ("more Modes"); Modes (Ignore_Break) := True; Modes (Mark_Parity_Errors) := True; Modes (Perform_Output_Processing) := True; Modes (Echo_Kill) := True; Modes (No_Flush) := True; Define_Terminal_Modes (Tc, Modes); Comment ("Set_Terminal_Characteristics"); Set_Terminal_Characteristics (POSIX_IO.Standard_Error, Tc, After_Output); Comment ("Get_Terminal_Characteristics"); New_Tc := Get_Terminal_Characteristics (POSIX_IO.Standard_Error); New_Modes := Terminal_Modes_Of (New_Tc); Assert (New_Modes = Modes, "A003"); Comment ("set terminal characteristics"); Modes (Ignore_Break) := False; Modes (Mark_Parity_Errors) := False; -- Modes (Perform_Output_Processing) := False; -- Setting this to false can mess up the screen output; -- taking it out should not matter much. Modes (Echo_Kill) := False; Modes (No_Flush) := False; Define_Terminal_Modes (New_Tc, Modes); Set_Terminal_Characteristics (POSIX_IO.Standard_Error, New_Tc); Comment ("check terminal characteristics"); Tc := New_Tc; New_Tc := Get_Terminal_Characteristics (POSIX_IO.Standard_Error); New_Modes := Terminal_Modes_Of (New_Tc); Assert (New_Modes = Modes, "A004"); Comment ("try setting terminal characteristics"); Define_Minimum_Input_Count (Tc, 17); -- Check for correct input count Assert (Minimum_Input_Count_Of (Tc) = 17, "A005"); Define_Input_Time (Tc, 0.5); -- Check for correct input time Assert (Input_Time_Of (Tc) = 0.5, "A006"); Set_Terminal_Characteristics (POSIX_IO.Standard_Error, Tc, After_Output_And_Input); Comment ("check results"); New_Tc := Get_Terminal_Characteristics (POSIX_IO.Standard_Error); New_Modes := Terminal_Modes_Of (New_Tc); -- Check for correct modes Assert (New_Modes = Modes, "A007"); -- Check for correct count Assert (Minimum_Input_Count_Of (New_Tc) = Minimum_Input_Count_Of (Tc), "A008"); -- Check for correct time Assert (Input_Time_Of (New_Tc) = Input_Time_Of (Tc), "A009"); Comment ("set to invalid value"); declare Uninitialized : Terminal_Characteristics; begin Set_Terminal_Characteristics (POSIX_IO.Standard_Error, Uninitialized); Expect_Exception ("A010"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A011"); end; Comment ("set invalid Input_Count"); begin Define_Minimum_Input_Count (Tc, 30000); Expect_Exception ("A012"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A013"); end; Assert (Minimum_Input_Count_Of (Tc) = 17, "A014"); Comment ("set invalid Input_Time"); begin Define_Input_Time (Tc, 100.0); Expect_Exception ("A015"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A016"); end; Assert (Input_Time_Of (Tc) = 0.5, "A017"); Comment ("try to set characteristics of regular file"); test_Fd := Open ("The_Test_File", Read_Write); begin Set_Terminal_Characteristics (test_Fd, Tc); Expect_Exception ("A018"); exception when POSIX_Error => Check_Error_Code (Inappropriate_IO_Control_Operation, "A019"); end; Comment ("try to getd characteristics of regular file"); begin Tc := Get_Terminal_Characteristics (test_Fd); Expect_Exception ("A020"); exception when POSIX_Error => Check_Error_Code (Inappropriate_IO_Control_Operation, "A021"); end; Close (test_Fd); Comment ("special control character"); begin y := Special_Control_Character_Of (Tc, Interrupt_Char); Disable_Control_Character (Tc, Interrupt_Char); Assert (y /= Special_Control_Character_Of (Tc, Interrupt_Char), "A022"); Define_Special_Control_Character (Tc, Interrupt_Char, y); Assert (y = Special_Control_Character_Of (Tc, Interrupt_Char), "A023"); end; Comment ("input baud rate"); begin Tc := Get_Terminal_Characteristics (POSIX_IO.Standard_Error); z := Input_Baud_Rate_Of (Tc); Comment ("z = " & Baud_Rate'Image (z)); Define_Input_Baud_Rate (Tc, B9600); Assert (Input_Baud_Rate_Of (Tc) = B9600, "A024"); Define_Input_Baud_Rate (Tc, z); Comment ("z = " & Baud_Rate'Image (z)); Comment ("Input_Baud_Rate_Of (Tc) = " & Baud_Rate'Image (Input_Baud_Rate_Of (Tc))); -- .... -- The Assert below is disabled because it apparently exceeds the -- POSIX.1 specifications. We asked for an interpretation on this. -- Apparently, the OS is allowed to treat zero as a special case. -- Assert (Input_Baud_Rate_Of (Tc) = z, "Baud Rate Wrong 2"); end; Comment ("output baud rate"); begin Tc := Get_Terminal_Characteristics (POSIX_IO.Standard_Error); z := Output_Baud_Rate_Of (Tc); Define_Output_Baud_Rate (Tc, B9600); Assert (Output_Baud_Rate_Of (Tc) = B9600, "A025"); Define_Output_Baud_Rate (Tc, z); Assert (Output_Baud_Rate_Of (Tc) = z, "A026"); end; Comment ("bits per character"); begin Tc := Get_Terminal_Characteristics (POSIX_IO.Standard_Error); w := Bits_Per_Character_Of (Tc); Define_Bits_Per_Character (Tc, 8); Assert (Bits_Per_Character_Of (Tc) = 8, "A027"); Define_Bits_Per_Character (Tc, w); Assert (Bits_Per_Character_Of (Tc) = w, "A028"); end; Comment ("controlling terminal name"); begin Comment ("Controlling Terminal Name is " & POSIX.To_String (Get_Controlling_Terminal_Name)); end; Comment ("process group ID"); declare GID : POSIX_Process_Identification.Process_Group_ID; begin GID := Get_Process_Group_ID (POSIX_IO.Standard_Error); Comment ("Process group ID is " & POSIX_Process_Identification.Image (GID)); end; Comment ("Drain"); begin Drain (POSIX_IO.Standard_Error); end; Comment ("restore characteristics"); Set_Terminal_Characteristics (POSIX_IO.Standard_Error, original_Tc); exception when E : others => Unexpected_Exception (E, "A029"); end; -- remove the file created for this test. Unlink ("The_Test_File"); Done; exception when E : others => -- remove the file created for this test. Unlink ("The_Test_File"); Fatal_Exception (E, "A030"); end p070200; libflorist-2025.1.0/tests/p070200.ads000066400000000000000000000061761473553204100166730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 7 0 2 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p070200; libflorist-2025.1.0/tests/p090100.adb000066400000000000000000000152121473553204100166420ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 9 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_User_Database, -- in IEEE Standard 1003.5b, Section 9.1. -- The test verifies that each of the subprograms can be called -- with correct parameters, and that the results are consistent -- with one another. -- It assumes that the login name and real user ID of the current -- process correspond, so the function Get_Login_Name will return the -- name of the user ID that is returned by Get_Real_User_ID. with POSIX, POSIX_Process_Identification, POSIX_Report, POSIX_User_Database; procedure p090100 is use POSIX, POSIX_Process_Identification, POSIX_Report, POSIX_User_Database; Current_User : User_ID; User_ID, User_Name : User_Database_Item; begin Header ("p090100"); ----------------------------------------------------------------- Test ("Get_Login_Name in [4.1.3]"); declare Login_Name : POSIX_String := Get_Login_Name; begin ----------------------------------------------------------------- Test ("Get_Real_User_ID in [4.1.3]"); begin Current_User := Get_Real_User_ID; exception when E : others => Unexpected_Exception (E, "A001"); end; ----------------------------------------------------------------- Test ("Get_User_Database_Item [9.1.2]"); begin User_ID := Get_User_Database_Item (Current_User); User_Name := Get_User_Database_Item (Login_Name); exception when E : others => Unexpected_Exception (E, "A002"); end; ----------------------------------------------------------------- Test ("User_Name_Of [9.1.1]"); begin -- Check that user names of current user and login names match Assert (User_Name_Of (User_ID) = User_Name_Of (User_Name), "A003"); exception when E : others => Unexpected_Exception (E, "A004"); end; ----------------------------------------------------------------- Test ("User_ID_Of [9.1.1]"); begin -- Check that user IDs of current user and login name match Assert (User_ID_Of (User_ID) = User_ID_Of (User_Name), "A005"); exception when E : others => Unexpected_Exception (E, "A006"); end; ----------------------------------------------------------------- Test ("Group_ID_Of [9.1.1]"); begin -- Check that group IDs of user ID and login name match Assert (Group_ID_Of (User_ID) = Group_ID_Of (User_Name), "A007"); exception when E : others => Unexpected_Exception (E, "A008"); end; ----------------------------------------------------------------- Test ("Initial_Directory_Of [9.1.1]"); begin -- Check that initial directories of user ID and login name match Assert (Initial_Directory_Of (User_ID) = Initial_Directory_Of (User_Name), "A009"); exception when E : others => Unexpected_Exception (E, "A010"); end; ----------------------------------------------------------------- Test ("Initial_Program_Of [9.1.1]"); begin -- Check that initial programs of user ID and login name match Assert (Initial_Program_Of (User_ID) = Initial_Program_Of (User_Name), "A011"); exception when E : others => Unexpected_Exception (E, "A012"); end; exception when E : others => Unexpected_Exception (E, "A013"); end; ----------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A014"); end p090100; libflorist-2025.1.0/tests/p090100.ads000066400000000000000000000061761473553204100166740ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 9 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p090100; libflorist-2025.1.0/tests/p090200.adb000066400000000000000000000204771473553204100166540ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 9 0 2 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with POSIX, POSIX_Group_Database, POSIX_Process_Identification, POSIX_Report, Test_Parameters, Text_IO, Unchecked_Deallocation; procedure p090200 is use POSIX, POSIX_Group_Database, POSIX_Process_Identification, POSIX_Report, Test_Parameters; begin Header ("p090200"); Test ("package POSIX_Group_Database [9.2]"); declare function Int_to_Gid (X : Integer) return Group_ID; function Int_to_Gid (X : Integer) return Group_ID is begin return Value (Integer'Image (X)); end Int_to_Gid; Dummy_GID : Group_ID; Dummy_Name : POSIX_String (1 .. 2); Gd_gid : Group_Database_Item; Gd_name : Group_Database_Item; Dummy_Gd : Group_Database_Item; Uninitialized_Gd : Group_Database_Item; procedure Print_ID (ID : in POSIX.POSIX_String; Quit : in out Boolean); procedure Print_ID (ID : in POSIX.POSIX_String; Quit : in out Boolean) is begin Text_IO.Put (POSIX.To_String (ID) & " "); end Print_ID; function "=" (L, R : Group_ID_List) return Boolean; -- Predefined "=" may fail, because the type is private -- and no special "=" is specfied by the standard. -- Therefore, we have to define a proper equality test -- here. -- .... Fix POSIX 1003.5? -- It would be easier to implement a proper "=" in the -- package body, and friendlier. Perhaps the standard should -- be revised to require that. type POSIX_String_Ptr is access POSIX_String; procedure Free is new Unchecked_Deallocation (POSIX_String, POSIX_String_Ptr); function "=" (L, R : Group_ID_List) return Boolean is List : array (Integer'(1) .. Length (L)) of POSIX_String_Ptr; Next : Integer := 1; Equal : Boolean := True; procedure Copy_One (S : POSIX_String; Quit : in out Boolean); procedure Copy_One (S : POSIX_String; Quit : in out Boolean) is begin List (Next) := new POSIX_String'(S); Next := Next + 1; end Copy_One; procedure Copy_List is new For_Every_Member (Copy_One); procedure Compare_One (S : POSIX_String; Quit : in out Boolean); procedure Compare_One (S : POSIX_String; Quit : in out Boolean) is begin if List (Next).all /= S then Equal := False; end if; Free (List (Next)); Next := Next + 1; end Compare_One; procedure Compare_Lists is new For_Every_Member (Compare_One); begin if Length (L) /= Length (R) then return False; end if; Copy_List (L); Next := 0; Compare_Lists (R); return Equal; end "="; begin Comment ("Get_Group_Database_Item"); Gd_gid := Get_Group_Database_Item (Get_Real_Group_ID); Gd_name := Get_Group_Database_Item (Group_Name_Of (Gd_gid)); Comment ("Group_Name_Of"); Assert (Group_Name_Of (Gd_gid) = Group_Name_Of (Gd_name), "A001"); Comment ("Group_ID_Of"); Assert (Group_ID_Of (Gd_gid) = Group_ID_Of (Gd_name), "A002"); Comment ("Length"); Assert (Length (Group_ID_List_Of (Gd_gid)) = Length (Group_ID_List_Of (Gd_name)), "A003"); Comment ("equality"); -- Check equality on Group_ID_List Assert (Group_ID_List_Of (Gd_gid) = Group_ID_List_Of (Gd_name), "A004"); Comment ("find unused group ID value"); -- try to find a group id that is not used in this system for I in 1 .. Integer'Last loop begin Dummy_Gd := Get_Group_Database_Item (Int_to_Gid (I)); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A005"); exit; when E : others => Unexpected_Exception (E, "A006"); exit; end; Assert (I /= Integer'Last, "A007: no free group ID"); end loop; Comment ("Group_ID_Of non-member"); begin -- Uninitialized_Gd should be non-valid since it not aquired using -- Get_Group_Database_Item. Test will raise exception. Dummy_GID := Group_ID_Of (Uninitialized_Gd); Expect_Exception ("A008"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A009"); end; Comment ("Get_Group_Database_Item of invalid group name"); declare Gd : Group_Database_Item; begin -- try to find a group name that will not be used in most system. Gd := Get_Group_Database_Item (Unused_Group_Name); Expect_Exception ("A010"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A011"); end; Comment ("Group_Name_Of invalid item"); begin -- Uninitialized_Gd should be a non-valid one. -- Test will raise exception. Dummy_Name := Group_Name_Of (Uninitialized_Gd); Expect_Exception ("A012"); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, "A013"); end; exception when E : others => Unexpected_Exception (E, "A014"); end; ------------------------------------------------------------------ Done; exception when E : others => Fatal_Exception (E, "A015"); end p090200; libflorist-2025.1.0/tests/p090200.ads000066400000000000000000000061761473553204100166750ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 0 9 0 2 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p090200; libflorist-2025.1.0/tests/p110100.adb000066400000000000000000000404471473553204100166430ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Semaphores, -- in IEEE Std 1003.5b Section 11.1. with POSIX, POSIX_Report, POSIX_Configurable_System_Limits, POSIX_Permissions, POSIX_IO, POSIX_Semaphores, Test_Parameters; procedure p110100 is use POSIX, POSIX_Report, POSIX_Configurable_System_Limits, POSIX_Permissions, POSIX_IO, POSIX_Semaphores, Test_Parameters; begin Header ("p110100"); ---------------------------------------------------------------------- -- 1.1.1 -- There should be a test that type Semaphore is limited, i.e., there -- is no assignment or "=" operator on it, but that would need to be -- a compile-time check, so it must be done in a separate test. ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- Tests of anonymous semaphores ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- Semaphore can be created and used with normal arguments. declare Sem : Semaphore; Semd : Semaphore_Descriptor; begin Test ("Initialize for Valid_Arguments [11.2.2]"); Initialize (Sem, 0); Semd := Descriptor_Of (Sem); Assert (Get_Value (Semd) = 0, "A001"); Assert (not Try_Wait (Semd), "A002"); Post (Semd); Assert (Get_Value (Semd) = 1, "A003"); Post (Semd); Assert (Get_Value (Semd) = 2, "A004"); Assert (Try_Wait (Semd), "A005"); Assert (Get_Value (Semd) = 1, "A006"); Wait (Semd); Assert (Get_Value (Semd) = 0, "A007"); Finalize (Sem); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected => Operation_Not_Implemented, E => E1, Message => "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; ----------------------------------------------------------------------- declare Sem : Semaphore; Semd : Semaphore_Descriptor; Sem_Value_Max : Integer := 0; begin Test ("Initialize with an over-large value [11.2.2]"); Sem_Value_Max := POSIX_Configurable_System_Limits.Semaphores_Value_Maximum; if Sem_Value_Max < Natural'Last then Initialize (Sem, Sem_Value_Max + 1); Expect_Exception ("A010"); Finalize (Sem); else begin Initialize (Sem, Natural'Last); Semd := Descriptor_Of (Sem); Assert (Get_Value (Semd) = Natural'Last, "A011"); Finalize (Sem); Comment ("Natural'Last is a valid semaphore value"); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected => Operation_Not_Implemented, E => E1, Message => "A012"); when E2 : others => Unexpected_Exception (E2, "A013"); end; end if; exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A014"); when E2 : others => Unexpected_Exception (E2, "A015"); end; ----------------------------------------------------------------------- declare Sem : Semaphore; begin Test ("Initialize with Is_Shared => True [11.2.2]"); Initialize (Sem, 1, True); Finalize (Sem); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected => Operation_Not_Implemented, E => E1, Message => "A016"); when E2 : others => Unexpected_Exception (E2, "A017"); end; ---------------------------------------------------------------------- declare Sem : Semaphore; begin Test ("Initialize with Is_Shared =>False [11.2.2]"); Initialize (Sem, 1, False); Finalize (Sem); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected => Operation_Not_Implemented, E => E1, Message => "A018"); when E2 : others => Unexpected_Exception (E2, "A019"); end; --------------------------------------------------------------------- declare Sem_A : Semaphore; Sem_B : Semaphore; Semd_A : Semaphore_Descriptor; Semd_B : Semaphore_Descriptor; begin Test ("Descriptor_Of [11.2.2]"); Initialize (Sem_A, 1); Initialize (Sem_B, 2); Semd_A := Descriptor_Of (Sem_A); Semd_B := Descriptor_Of (Sem_B); Assert (Semd_A /= Semd_B, "A020"); Finalize (Sem_A); Finalize (Sem_B); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected => Operation_Not_Implemented, E => E1, Message => "A021"); when E2 : others => Unexpected_Exception (E2, "A022"); end; ----------------------------------------------------------------------- -- The following error cases are not tested, because we -- could not think of a portable way of testing them: -- No_Space_Left_On_Device ---------------------------------------------------------------------- declare Uninitialized_Descriptor : Semaphore_Descriptor; begin Test ("Wait for an invalid argument [11.1.7]"); Wait (Uninitialized_Descriptor, No_Signals); Assert (False, "A023"); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A024"); when E2 : others => Unexpected_Exception (E2, "A025"); end; ---------------------------------------------------------------------- declare Uninitialized_Descriptor : Semaphore_Descriptor; Result : Boolean; begin Test ("Try_Wait for an invalid argument [11.1.7]"); Result := Try_Wait (Uninitialized_Descriptor); Expect_Exception ("A026"); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A027"); when E2 : others => Unexpected_Exception (E2, "A028"); end; ---------------------------------------------------------------------- -- Post raises POSIX_Error with EINVAL if argument does not refer -- to a valid semaphore. declare Uninitialized_Descriptor : Semaphore_Descriptor; begin Test ("Post for invalid argument [11.1.8]"); Post (Uninitialized_Descriptor); Expect_Exception ("A029"); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A030"); when E2 : others => Unexpected_Exception (E2, "A031"); end; ---------------------------------------------------------------------- -- Get_Value raises POSIX_Error with EINVAL if argument does not refer -- to a valid semaphore. declare Uninitialized_Descriptor : Semaphore_Descriptor; Temp_Int : Integer; begin Test ("Get_Value for Invalid_Argument [11.1.9]"); Temp_Int := Get_Value (Uninitialized_Descriptor); Expect_Exception ("A032"); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A033"); when E2 : others => Unexpected_Exception (E2, "A034"); end; ---------------------------------------------------------------------- -- Tests of named semaphores ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- Clear out any junk semaphores left from previous tests. for I in 1 .. 5 loop begin Comment ("Unlinking Semaphore"); Unlink_Semaphore (Valid_Semaphore_Name (I)); Comment ("Cleared out semaphore " & To_String (Valid_Semaphore_Name (I))); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => No_Such_File_Or_Directory, E => E1, Message => "A033"); when E2 : others => Unexpected_Exception (E2, "A036"); end; end loop; ---------------------------------------------------------------------- -- Create a named semaphore that does previously exist, use it, -- close it, and then unlink it. declare Name : POSIX_String := Valid_Semaphore_Name (1); Semd : Semaphore_Descriptor; begin Test ("Create a nonexistent semaphore [11.1.4]"); Semd := Open_Or_Create (Name, Owner_Permission_Set, 1, Exclusive, No_Signals); Assert (Get_Value (Semd) = 1, "A037"); Post (Semd); -- should set value to 2 Assert (Get_Value (Semd) = 2, "A038"); Wait (Semd); -- should not block Assert (Get_Value (Semd) = 1, "A039"); Assert (Try_Wait (Semd), "A040"); Assert (Get_Value (Semd) = 0, "A041"); Assert (not Try_Wait (Semd), "A042"); Close (Semd); Unlink_Semaphore (Name); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected => Operation_Not_Implemented, E => E1, Message => "A043"); when E2 : others => Unexpected_Exception (E2, "A044"); end; ---------------------------------------------------------------------- -- Try to open a nonexistent semaphore. declare Name : POSIX_String := Valid_Semaphore_Name (2); Semd : Semaphore_Descriptor; begin Test ("Open of nonexistent semaphore [11.1.4]"); Semd := Open (Name, No_Signals); Expect_Exception ("A045"); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => No_Such_File_Or_Directory, E => E1, Message => "A046"); when E2 : others => Unexpected_Exception (E2, "A047"); end; ---------------------------------------------------------------------- -- Try to open a named semaphore that is already open. -- If a process makes multiple calls (even from different -- tasks within the same process) to Open or Open_Or_Create -- with the same value for Name, the same Semaphore_Descriptor -- value shall be returned for each such call ... [11.1.4] declare Name : POSIX_String := Valid_Semaphore_Name (3); Semd_1, Semd_2 : Semaphore_Descriptor; begin Test ("Open of already-open semaphore [11.1.4]"); Semd_1 := Open_Or_Create (Name, Owner_Permission_Set, 1, Exclusive, No_Signals); Semd_2 := Open (Name, No_Signals); Assert (Semd_1 = Semd_2, "A048"); Close (Semd_1); Unlink_Semaphore (Name); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected => Operation_Not_Implemented, E => E1, Message => "A049"); when E2 : others => Unexpected_Exception (E2, "A050"); end; ---------------------------------------------------------------------- -- Try to create a named semaphore that already exists. -- First, create a semaphore; then, create another with the same name. -- The second create should fail, with error code File_Exists. declare Name : POSIX_String := Valid_Semaphore_Name (4); Semd_1, Semd_2 : Semaphore_Descriptor; begin Test ("Create of existing semaphore [11.1.4]"); Semd_1 := Open_Or_Create (Name, Owner_Permission_Set, 1, Exclusive, No_Signals); Semd_2 := Open_Or_Create (Name, Owner_Permission_Set, 1, Exclusive, No_Signals); Expect_Exception ("A051"); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => File_Exists, E => E1, Message => "A052"); -- Clean up first semaphore begin Close (Semd_1); Unlink_Semaphore (Name); exception when others => null; end; when E2 : others => Unexpected_Exception (E2, "A053"); end; ---------------------------------------------------------------------- -- Try to create a named semaphore with an invalid name. declare Name : POSIX_String := Invalid_Semaphore_Name (5); Semd : Semaphore_Descriptor; begin Test ("Create of semaphore with invalid name [11.1.4]"); Semd := Open_Or_Create (Name, Owner_Permission_Set, 1, Exclusive, No_Signals); Expect_Exception ("A054"); Comment ("Invalid name not detected"); Close (Semd); Unlink_Semaphore (Name); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A055"); when E2 : others => Unexpected_Exception (E2, "A056"); end; Done; exception when E : others => Fatal_Exception (E, "A057"); end p110100; libflorist-2025.1.0/tests/p110100.ads000066400000000000000000000062031473553204100166540ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p110100; libflorist-2025.1.0/tests/p110101.adb000066400000000000000000000251521473553204100166400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 1 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Semaphores, -- in IEEE Std 1003.5b Section 11.1. -- This test is of unnamed semaphores. -- The basic concept of the test is to simulate a bank, -- via a set of "client" tasks and a -- smaller set of "teller" tasks (i.e., servers). -- Each client requires one service. -- (The clients and tellers are collectively termed the "players".) -- Semaphores are used to enforce an orderly service discipline, -- so that each teller serves one client at at time. with POSIX, POSIX_Report, POSIX_Semaphores; procedure p110101 is use POSIX, POSIX_Report, POSIX_Semaphores; Masking : constant Signal_Masking := No_Signals; Wait_Count : Semaphore; -- value is count of number of tellers available, if positive -- value is count of number of customers waiting, if negative Master_Lock : Semaphore; -- Master_Lock protects the table of tellers -- and the count of players. -- value is 1 if table is unlocked -- value is count of number of tasks waiting to access the table, -- if negative Num_Clients : constant := 100; Num_Tellers : constant := 5; Clients_Alive : Natural := 0; -- tells how many players may still be alive -- protected by Master_Lock Main_Wait : Semaphore; -- used by main program to wait for players to terminate Null_Player : constant := 0; Num_Players : constant := Num_Clients + Num_Tellers + 1; type Player_ID is range Null_Player .. Num_Players; Main_Program : constant Player_ID := 1; subtype Teller_ID is Player_ID range Main_Program + 1 .. Num_Tellers; subtype Client_ID is Player_ID range Teller_ID'Last + 1 .. Player_ID'Last; task type Client is entry Start (Self : Client_ID); end Client; task type Teller is entry Start (Self : Teller_ID); end Teller; Current_Client : array (Teller_ID) of Player_ID := (others => Null_Player); -- Current_Client tells who each teller is serving, if anybody. -- The state is protected by Master_Lock. Tellers : array (Teller_ID) of Teller; Clients : array (Client_ID) of Client; Player_Waits : array (Teller_ID'First .. Client_ID'Last) of Semaphore; -------------- -- Shutdown -- -------------- -- Shut down all the Client and Teller tasks. procedure Shutdown (Self : Player_ID); procedure Shutdown (Self : Player_ID) is begin for I in Client_ID loop if Self /= I then abort Clients (I); end if; end loop; for I in Teller_ID loop if Self /= I then abort Tellers (I); end if; end loop; if Self in Teller_ID then abort Tellers (Self); elsif Self in Client_ID then abort Clients (Self); end if; Post (Descriptor_Of (Main_Wait)); end Shutdown; task body Client is Self : Player_ID; My_Teller : Player_ID := Null_Player; My_Wait_Ref : Semaphore_Descriptor; begin -- Wait to be told our ID. accept Start (Self : Client_ID) do Client.Self := Self; end Start; My_Wait_Ref := Descriptor_Of (Player_Waits (Self)); -- Wait for an available teller. Wait (Descriptor_Of (Wait_Count), Masking); -- choose a specific teller and claim him Wait (Descriptor_Of (Master_Lock), Masking); for I in Teller_ID loop if Current_Client (I) = Null_Player then My_Teller := I; end if; end loop; if My_Teller = Null_Player then -- This should never happen. Post (Descriptor_Of (Master_Lock)); -- Fail because no teller available Fail ("A001"); Shutdown (Self); else Current_Client (My_Teller) := Self; Post (Descriptor_Of (Master_Lock)); end if; -- Wake up the teller. Post (Descriptor_Of (Player_Waits (My_Teller))); -- wait for the teller to perform service Wait (My_Wait_Ref, Masking); -- The service is done; -- indicate to main program that we are done. Wait (Descriptor_Of (Master_Lock), Masking); Clients_Alive := Clients_Alive - 1; if Clients_Alive = 0 then Post (Descriptor_Of (Main_Wait)); end if; Post (Descriptor_Of (Master_Lock)); exception when E : others => Unexpected_Exception (E, "A002"); Shutdown (Self); end Client; task body Teller is Self : Player_ID; My_Wait_Ref : Semaphore_Descriptor; begin -- Wait to be told our ID. accept Start (Self : Teller_ID) do Teller.Self := Self; end Start; My_Wait_Ref := Descriptor_Of (Player_Waits (Self)); loop -- Indicate that we are open for business. Post (Descriptor_Of (Wait_Count)); -- Wait for a customer to wake us up. Wait (My_Wait_Ref, Masking); exit when Current_Client (Self) = Null_Player; -- Serve the customer. delay Duration (Self) * Duration'(0.001); -- Wake up the customer. Post (Descriptor_Of (Player_Waits (Current_Client (Self)))); -- Indicate that we are free again. Current_Client (Self) := Null_Player; end loop; exception when E : others => Unexpected_Exception (E, "A003"); Shutdown (Self); end Teller; begin Header ("p110101"); ----------------------------------------------------------------------- Test ("Use unnamed semaphores to synchronize Ada tasks"); begin Comment ("Initializing semaphores"); Initialize (Wait_Count, 0); Initialize (Master_Lock, 1); Initialize (Main_Wait, 0); for I in Player_Waits'Range loop Initialize (Player_Waits (I), 0); end loop; exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A004"); when E2 : others => Unexpected_Exception (E2, "A005"); Shutdown (Main_Program); end; ----------------------------------------------------------------------- begin Comment ("Starting clients and tellers"); Wait (Descriptor_Of (Master_Lock), Masking); for I in Clients'Range loop Clients (I).Start (I); Clients_Alive := Clients_Alive + 1; end loop; for I in Tellers'Range loop Tellers (I).Start (I); end loop; Post (Descriptor_Of (Master_Lock)); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A006"); when E2 : others => Unexpected_Exception (E2, "A007"); Shutdown (Main_Program); end; ----------------------------------------------------------------------- begin Comment ("Waiting for all players to finish"); Wait (Descriptor_Of (Main_Wait), Masking); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); Shutdown (Main_Program); end; ----------------------------------------------------------------------- begin Comment ("Waking up tellers to exit"); for I in Tellers'Range loop Post (Descriptor_Of (Player_Waits (I))); end loop; exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A010"); when E2 : others => Unexpected_Exception (E2, "A011"); Shutdown (Main_Program); end; ----------------------------------------------------------------------- Done; exception when E : others => Shutdown (Main_Program); Fatal_Exception (E, "A012"); end p110101; libflorist-2025.1.0/tests/p110101.ads000066400000000000000000000061761473553204100166660ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 1 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p110101; libflorist-2025.1.0/tests/p110200.adb000066400000000000000000000224211473553204100166340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 2 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Mutexes. -- This is a very superficial test. -- It essentially only tests that the interfaces can be called. with POSIX, POSIX_Mutexes, POSIX_Report; procedure p110200 is use POSIX, POSIX_Mutexes, POSIX_Report; begin Header ("p110200"); -- This entire test depends on support for the Mutex Option. ----------------------------------------------------------------------- -- If the Process Shared Option is supported, it is possible -- to create a mutex with that option, and use the mutex with all -- of the mutex operations. [11.2.4] declare M : Mutex; MD : Mutex_Descriptor; Attr : Attributes; begin Test ("Process Shared option"); Initialize (Attr); Set_Process_Shared (Attr, True); Assert (Get_Process_Shared (Attr), "A001: process_shared"); Initialize (M, Attr); Finalize (Attr); MD := Descriptor_Of (M); Lock (MD); Unlock (MD); Assert (Try_Lock (MD), "A002: try_lock"); Unlock (MD); Finalize (M); exception when E1 : POSIX_Error => Optional (Mutex_Option, Process_Shared_Option, Operation_Not_Implemented, E1, "A003"); when E2 : others => Unexpected_Exception (E2, "A004"); end; ----------------------------------------------------------------------- -- If the Mutex Priority Inheritance Option or the Mutex Priority -- Ceiling Option is supported, it is possible to create a mutex with -- the No_Priority_Inheritance policy, and to use this mutex with -- the Lock, Unlock, and Finalize operations. [11.2.5] declare M : Mutex; MD : Mutex_Descriptor; Attr : Attributes; begin Test ("no priority inheritance "); Initialize (Attr); Set_Locking_Policy (Attr, No_Priority_Inheritance); Assert (Get_Locking_Policy (Attr) = No_Priority_Inheritance, "A005: (1)"); Initialize (M, Attr); Finalize (Attr); MD := Descriptor_Of (M); Lock (MD); Unlock (MD); Assert (Try_Lock (MD), "A006: try_lock"); Unlock (MD); Finalize (M); exception when E1 : POSIX_Error => if (Is_Supported (Mutex_Option)) then Optional (Mutex_Priority_Ceiling_Option, Mutex_Priority_Inheritance_Option, Operation_Not_Implemented, E1, "A007"); else Optional (Mutex_Option, Operation_Not_Implemented, E1, "A008"); end if; when E2 : others => Unexpected_Exception (E2, "A009"); end; ----------------------------------------------------------------------- -- If the Mutex Priority Inheritance Option is supported, -- it is possible to create a mutex with -- the Highest_Blocked_Task policy, and to use this mutex with -- the Lock, Unlock, and Finalize operations. [11.2.5] declare M : Mutex; MD : Mutex_Descriptor; Attr : Attributes; begin Test ("Mutex Priority Inheritance option"); Initialize (Attr); Set_Locking_Policy (Attr, Highest_Blocked_Task); Assert (Get_Locking_Policy (Attr) = Highest_Blocked_Task, "A010: (2)"); Initialize (M, Attr); Finalize (Attr); MD := Descriptor_Of (M); Lock (MD); Unlock (MD); Assert (Try_Lock (MD), "A011: try_lock"); Unlock (MD); Finalize (M); exception when E1 : POSIX_Error => Optional (Mutex_Option, Mutex_Priority_Inheritance_Option, Operation_Not_Implemented, E1, "A012"); when E2 : others => Unexpected_Exception (E2, "A013"); end; ----------------------------------------------------------------------- -- If the Mutex Priority Inheritance Option is supported, -- it is possible to create a mutex with -- the Highest_Ceiling_Priority policy, and to use this mutex with -- the Lock, Unlock, and Finalize operations. [11.2.5] declare M : Mutex; MD : Mutex_Descriptor; Attr : Attributes; begin Test ("Mutex Priority Ceiling option, "); Initialize (Attr); Set_Locking_Policy (Attr, Highest_Ceiling_Priority); Assert (Get_Locking_Policy (Attr) = Highest_Ceiling_Priority, "A014: (3)"); Initialize (M, Attr); Finalize (Attr); MD := Descriptor_Of (M); Lock (MD); Unlock (MD); Assert (Try_Lock (MD), "A015: try_lock"); Unlock (MD); Finalize (M); exception when E1 : POSIX_Error => Optional (Mutex_Option, Mutex_Priority_Ceiling_Option, Operation_Not_Implemented, E1, "A016"); when E2 : others => Unexpected_Exception (E2, "A017"); end; ----------------------------------------------------------------------- declare M : Mutex; MD : Mutex_Descriptor; Attr : Attributes; begin Test ("get/set ceiling priority of attribute [11.2.7]"); Initialize (Attr); Set_Ceiling_Priority (Attr, 2); Assert (Get_Ceiling_Priority (Attr) = 2, "A018"); Finalize (Attr); MD := Descriptor_Of (M); Lock (MD); Unlock (MD); Assert (Try_Lock (MD), "A019: try_lock"); Unlock (MD); Finalize (M); exception when E1 : POSIX_Error => Optional (Mutex_Option, Mutex_Priority_Ceiling_Option, Operation_Not_Implemented, E1, "A020"); when E2 : others => Unexpected_Exception (E2, "A021"); end; ------------------------------------------------------------------- declare M : Mutex; MD : Mutex_Descriptor; New_Ceil, Old_Ceil : Ceiling_Priority; Attr : Attributes; begin Test ("get/set ceiling priority of mutex"); Initialize (Attr); Set_Ceiling_Priority (Attr, 2); Initialize (M, Attr); Finalize (Attr); MD := Descriptor_Of (M); New_Ceil := 3; Set_Ceiling_Priority (MD, New_Ceil, Old_Ceil); Assert (Get_Ceiling_Priority (MD) = New_Ceil, "A022"); Finalize (M); exception when E1 : POSIX_Error => Optional (Mutex_Option, Mutex_Priority_Ceiling_Option, Operation_Not_Implemented, E1, "A023"); when E2 : others => Unexpected_Exception (E2, "A024"); end; ------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A025"); end p110200; libflorist-2025.1.0/tests/p110200.ads000066400000000000000000000061761473553204100166660ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 2 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p110200; libflorist-2025.1.0/tests/p110201.adb000066400000000000000000000140261473553204100166370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 2 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- -------------------------------------------------------------------------- -- [$Revision$] -- Test for POSIX_Mutexes package -- There are four tasks. Inside each task is a critical section, -- enclosed by mutex lock and unlock calls, which sets the value of -- a protected variable then calls a delay, to allow the other tasks -- to run, then checks to see that the variable is still set properly. with POSIX, POSIX_Mutexes, POSIX_Report, Test_Parameters; procedure p110201 is use POSIX, POSIX_Mutexes, POSIX_Report, Test_Parameters; task type Shared_Mutex_Task (Task_Number : Integer) is entry Start_Running; end Shared_Mutex_Task; Task1 : Shared_Mutex_Task (Task_Number => 1); Task2 : Shared_Mutex_Task (Task_Number => 2); Task3 : Shared_Mutex_Task (Task_Number => 3); Task4 : Shared_Mutex_Task (Task_Number => 4); M : Mutex; MD : Mutex_Descriptor; Attr : Attributes; Shared_Var : Integer; task body Shared_Mutex_Task is Count : Integer := 0; begin accept Start_Running; while Count <= 20 loop Lock (MD); Count := Count + 1; Shared_Var := Task_Number; delay Delay_Unit; Comment ("task" & Integer'Image (Task_Number) & " in critical section:" & Integer'Image (Count)); if (Shared_Var /= Task_Number) then Unlock (MD); Fail ("A001: failure of mutual exclusion"); exit; end if; Unlock (MD); delay Delay_Unit * Task_Number; end loop; Comment ("task" & Integer'Image (Task_Number) & " exiting"); exception when E1 : POSIX_Error => Optional (Mutex_Option, Operation_Not_Implemented, E1, "A002"); when E2 : others => Unexpected_Exception (E2, "A003"); end Shared_Mutex_Task; begin Header ("p110201", True); Shared_Var := 0; Initialize (Attr); -- ... It would be better to write a separate test, that uses -- multiple processes and shared memory to really test the -- process-shared option for mutexes. begin Set_Process_Shared (Attr, Is_Shared => True); exception when E1 : POSIX_Error => Optional (Process_Shared_Option, Operation_Not_Implemented, E1, "A004"); when E2 : others => Unexpected_Exception (E2, "A005"); end; Initialize (M, Attr); Finalize (Attr); MD := Descriptor_Of (M); Comment ("This test may take some time to run."); begin Task1.Start_Running; Task2.Start_Running; Task3.Start_Running; Task4.Start_Running; while not (Task1'Terminated and Task2'Terminated and Task3'Terminated and Task4'Terminated) loop delay 0.2; end loop; Comment ("all tasks terminated"); end; Finalize (M); Done; exception when E1 : POSIX_Error => Optional (Mutex_Option, Operation_Not_Implemented, E1, "A004"); abort Task1, Task2, Task3, Task4; when E2 : others => Unexpected_Exception (E2, "A005"); abort Task1, Task2, Task3, Task4; end p110201; libflorist-2025.1.0/tests/p110201.ads000066400000000000000000000061711473553204100166620ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 2 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- -------------------------------------------------------------------------- -- [$Revision$] procedure p110201; libflorist-2025.1.0/tests/p110300.adb000066400000000000000000000203641473553204100166410ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 3 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Condition_Variables -- This is a very superficial test. -- It essentially only tests that the interfaces can be called. -- A better test needs to be written. with Ada.Calendar, POSIX, POSIX_Calendar, POSIX_Condition_Variables, POSIX_Mutexes, POSIX_Report; procedure p110300 is use Ada.Calendar, POSIX, POSIX_Calendar, POSIX_Condition_Variables, POSIX_Mutexes, POSIX_Report; Md : POSIX_Mutexes.Mutex_Descriptor; M : POSIX_Mutexes.Mutex; Cond1, Cond2 : Condition; Producer_Cond : Condition_Descriptor; Consumer_Cond : Condition_Descriptor; -- number inside critical section Inside : Integer := 0; pragma Atomic (Inside); -- number of last unit consumed C_Count : Integer := 0; pragma Atomic (C_Count); -- number of last unit produced P_Count : Integer := 0; pragma Atomic (P_Count); -- maximum difference between P_Count and C_Count Buf_Limit : constant Integer := 3; -- total number of units to produce and consume Limit : constant Integer := 20; Timeout : POSIX.Timespec; begin Header ("p110300"); Test ("Package POSIX_Condition_Variables [11.3]"); Initialize (Cond1); Initialize (Cond2); POSIX_Mutexes.Initialize (M); Md := POSIX_Mutexes.Descriptor_Of (M); Producer_Cond := Descriptor_Of (Cond1); Consumer_Cond := Descriptor_Of (Cond2); Timeout := To_Timespec (To_POSIX_Time (Ada.Calendar.Clock + 1.0)); ----------------------------------------------------------------------- declare task Consumer; task body Consumer is begin Comment ("Consumer starts"); loop POSIX_Mutexes.Lock (Md); Comment ("Consumer gets mutex"); Assert (Inside = 0, "A001"); Inside := Inside + 1; Assert (P_Count >= C_Count and P_Count - C_Count <= Buf_Limit and P_Count <= Limit, "A002"); while C_Count = P_Count loop Comment ("Consumer does timed_wait for condition"); Inside := Inside - 1; Assert (Inside = 0, "A003"); -- wait for producer signal Timed_Wait (Consumer_Cond, Md, Timeout); Assert (Inside = 0, "A004"); Inside := Inside + 1; end loop; C_Count := C_Count + 1; Comment ("Consumer consumes unit" & Integer'Image (C_Count)); Comment ("Consumer releases mutex"); Inside := Inside - 1; Assert (Inside = 0, "A005"); POSIX_Mutexes.Unlock (Md); Comment ("Consumer signals producer"); Signal (Producer_Cond); end loop; -- Fail because consumer should exit via timeout Fail ("A006"); exception when E : POSIX.POSIX_Error => if POSIX.Get_Error_Code = Timed_Out then Comment ("Consumer times out on wait"); Assert (Inside = 0, "A007"); Assert (P_Count = Limit and C_Count = Limit, "A008"); P_Count := Limit; C_Count := Limit; Signal (Producer_Cond); Comment ("Consumer releases mutex"); POSIX_Mutexes.Unlock (Md); Comment ("Consumer exits"); else Signal (Producer_Cond); Unexpected_Exception (E, "A009"); end if; end Consumer; task producer; task body producer is Exited : Boolean := False; begin while P_Count < Limit loop POSIX_Mutexes.Lock (Md); Comment ("Producer gets mutex"); Assert (Inside = 0, "A010"); Inside := Inside + 1; P_Count := P_Count + 1; Comment ("Producer produces unit" & Integer'Image (P_Count)); Comment ("Producer signals consumer"); Signal (Consumer_Cond); Assert (P_Count >= C_Count and P_Count - C_Count <= Buf_Limit and P_Count <= Limit, "A011"); while P_Count - C_Count = Buf_Limit loop Comment ("Producer waits for condition"); Inside := Inside - 1; Assert (Inside = 0, "A012"); Wait (Producer_Cond, Md); Assert (Inside = 0, "A013"); Inside := Inside + 1; end loop; Comment ("Producer releases mutex"); Inside := Inside - 1; Assert (Inside = 0, "A014"); POSIX_Mutexes.Unlock (Md); end loop; Comment ("Producer exits"); exception when E : POSIX.POSIX_Error => Unexpected_Exception (E, "A015"); end producer; begin Comment ("Main block completes"); exception when E1 : POSIX_Error => Optional (Mutex_Option, Operation_Not_Implemented, E1, "A016"); abort producer, Consumer; when E2 : others => Unexpected_Exception (E2, "A017"); abort producer, Consumer; end; ----------------------------------------------------------------------- POSIX_Mutexes.Finalize (M); Finalize (Cond1); Finalize (Cond2); Done; exception when E : others => Fatal_Exception (E, "A018"); end p110300; libflorist-2025.1.0/tests/p110300.ads000066400000000000000000000061761473553204100166670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 1 0 3 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p110300; libflorist-2025.1.0/tests/p120100.adb000066400000000000000000000145671473553204100166500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Some aspects of POSIX_Memory_Mapping are tested in another program, -- p120101. P120101 also contains testing for some claimed "Untested Aspects" -- by VSRT assertions. We make separate programs to improve portability. with POSIX, POSIX_Memory_Locking, POSIX_Report; procedure p120100 is use POSIX, POSIX_Memory_Locking, POSIX_Report; begin Header ("p120100", Root_OK => True); Test ("package POSIX_Memory_Locking [12.1]"); ----------------------------------------------------------------------- begin Test ("Lock_All (Current_Pages) [12.1.1]"); Lock_All (Current_Pages); exception when E1 : POSIX.POSIX_Error => -- since this is the first lock operation, we -- assume there is no capacity limit Privileged (Memory_Locking_Privilege, Memory_Locking_Option, Operation_Not_Implemented, E1, "A001"); when E2 : others => Unexpected_Exception (E2, "A002"); end; ----------------------------------------------------------------------- begin Test ("Unlock_All [12.1.1]"); Unlock_All; exception when E1 : POSIX.POSIX_Error => Privileged (Memory_Locking_Privilege, Memory_Locking_Option, Operation_Not_Implemented, E1, "A003"); when E2 : others => Unexpected_Exception (E2, "A004"); end; ----------------------------------------------------------------------- begin Test ("Lock_All (Future_Pages) [12.1.1]"); Lock_All (Future_Pages); exception when E1 : POSIX.POSIX_Error => -- Since this is the first lock operation, we -- assume there is no capacity limit error. Privileged (Memory_Locking_Privilege, Memory_Locking_Option, Operation_Not_Implemented, E1, "A005"); when E2 : others => Unexpected_Exception (E2, "A006"); end; ----------------------------------------------------------------------- begin Test ("Unlock_All [12.1.1]"); Unlock_All; exception when E1 : POSIX.POSIX_Error => Privileged (Memory_Locking_Privilege, Memory_Locking_Option, Operation_Not_Implemented, E1, "A007"); when E2 : others => Unexpected_Exception (E2, "A008"); end; ----------------------------------------------------------------------- begin Test ("Unlock memory that hasn't been locked [12.1.1]"); Unlock_All; exception when E1 : POSIX.POSIX_Error => Privileged (Memory_Locking_Privilege, Memory_Locking_Option, Operation_Not_Implemented, E1, "A009"); when E2 : others => Unexpected_Exception (E2, "A010"); end; ----------------------------------------------------------------------- declare Options : Memory_Locking_Options := Memory_Locking_Options (POSIX.Empty_Set); begin Test ("Lock_All (Empty_Set [12.1.1])"); Lock_All (Options); Expect_Exception ("A011"); exception when E1 : POSIX.POSIX_Error => if Get_Error_Code /= Invalid_Argument then Privileged (Memory_Locking_Privilege, Memory_Locking_Option, Operation_Not_Implemented, E1, "A012"); end if; when E2 : others => Unexpected_Exception (E2, "A013"); end; ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A014"); end p120100; libflorist-2025.1.0/tests/p120100.ads000066400000000000000000000061761473553204100166660ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120100; libflorist-2025.1.0/tests/p120101.adb000066400000000000000000000412251473553204100166400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 1 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This test is on POSIX_Memory_Locking. The test generate memory-bound -- processes, and get performance results on memory access with lock and -- without. Thus this test tries to covers the following "Untestable Aspects" -- in the VSRT: -- rt.os/mlock/mlockall/Untestable_Aspects/1: -- A call to mlockall() when flags contains MCL_CURRENT shall cause all of -- the pages currently mapped by the address space of a process to be -- memory resident. -- rt.os/mlock/munlockall/Untestable_Aspects/1 -- A call to munlockall() shall unlock all currently mapped pages of the -- address space of the process -- Setup: This program requires that its own executable be accessible -- via pathname "./p120101", in order create a child process. -- The test strategy is to measure the difference in performance of -- the main process doing a memory-intensive computation both with and -- without memory locking. If the performance is better with memory -- locking, that indicates it had some effect. If the performance is -- unchanged, the result is inconclusive. -- For the test to work well you will need a machine with limited -- real memory and will need to run it with unlimited "ulimit" values. with Ada.Calendar, POSIX, POSIX_Limits, POSIX_Memory_Locking, POSIX_Process_Environment, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Signals, POSIX_Report, Unchecked_Deallocation; procedure p120101 is use Ada.Calendar, POSIX, POSIX_Memory_Locking, POSIX_Report; Array_Size : Natural := POSIX_Limits.Page_Size_Range'Last / Natural'Size; type Array_Type is array (1 .. Array_Size) of Natural; type Record_Type; type Pointer_Type is access Record_Type; type Record_Type is record Item : Integer; Pad : Array_Type; Next : Pointer_Type; end record; Head : Pointer_Type; Delay_Time : constant Duration := 10.0; -- enough time for other processes to access their entire -- lists, causing the pages to be brought into local memory My_Path : POSIX.POSIX_String := "./p120101"; Num_Processes : Natural := 5; type Process_Record is record Child : POSIX_Process_Identification.Process_ID; Pathname : POSIX.Pathname (1 .. My_Path'Length) := My_Path; Template : POSIX_Process_Primitives.Process_Template; Arg_List : POSIX.POSIX_String_List; end record; Process_Array : array (1 .. Num_Processes) of Process_Record; List_Size : Integer := 1024; We_Are_The_Child : Boolean := False; procedure Free is new Unchecked_Deallocation (Record_Type, Pointer_Type); -------------------------- -- Time_Big_List_Access -- -------------------------- function Time_Big_List_Access (Size : Natural) return Duration; -- Compute the average amount of time it takes to access a -- linked list of Size integers. function Time_Big_List_Access (Size : Natural) return Duration is Head : Pointer_Type; P1 : Pointer_Type; Sum : Duration := 0.0; Reps : constant Integer := 1; Time1, Time2 : Ada.Calendar.Time; Dur : Duration; begin Comment ("Time_Big_List_Access " & Integer'Image (Size)); Head := new Record_Type; P1 := Head; for K in 2 .. Size loop P1.Next := new Record_Type; P1 := P1.Next; end loop; for J in 1 .. Reps loop P1 := Head; Time1 := Ada.Calendar.Clock; -- This loop should not need to bring the list back from secondary -- storage, unless it was too big to fit into primary memory. while P1 /= null loop P1.Item := 1; P1 := P1.Next; end loop; Time2 := Ada.Calendar.Clock; Sum := Sum + (Time2 - Time1); end loop; Dur := Sum / Reps; Comment ("Duration: " & Integer'Image (Integer (Dur * 1_000_000)) & "us"); while Head /= null loop P1 := Head; Head := P1.Next; Free (P1); end loop; return Dur; exception when Storage_Error => while Head /= null loop P1 := Head; Head := P1.Next; Free (P1); end loop; raise; when E : others => Unexpected_Exception (E, "Time_Big_List_Access"); return Dur; end Time_Big_List_Access; ------------------- -- Traverse_List -- ------------------- procedure Traverse_List; procedure Traverse_List is P1 : Pointer_Type; begin P1 := Head; while P1 /= null loop P1.Item := 1; P1 := P1.Next; end loop; end Traverse_List; --------------------------- -- Time_Test_List_Access -- --------------------------- -- Compute the average amount of time it takes to traverse a -- given linked list of integers. function Time_Test_List_Access (Head : Pointer_Type; N : Integer) return Duration; function Time_Test_List_Access (Head : Pointer_Type; N : Integer) return Duration is Sum : Duration := 0.0; Reps : constant Integer := 1; D : Duration; Time1, Time2 : Ada.Calendar.Time; begin Comment ("Time_Test_List_Access " & Integer'Image (N)); for J in 1 .. Reps loop Time1 := Ada.Calendar.Clock; -- The following loop will access the nodes of this list. The -- nodes should not be in secondary storage, unless the list was -- too big to fit into primary memory. Traverse_List; Time2 := Ada.Calendar.Clock; Sum := Sum + (Time2 - Time1); end loop; D := Sum / Reps; Comment ("Duration: " & Integer'Image (Integer (D * 1_000_000)) & "us"); return D; end Time_Test_List_Access; ---------------- -- Check_Arg -- ---------------- procedure Check_Arg (Item : in POSIX_String; Quit : in out Boolean); procedure Check_Arg (Item : in POSIX_String; Quit : in out Boolean) is begin if Item = "-b" then We_Are_The_Child := True; Quit := True; end if; end Check_Arg; procedure Check_Args is new For_Every_Item (Check_Arg); ------------------- -- Set_List_Size -- ------------------- procedure Set_List_Size (List_Size : in out Integer); procedure Set_List_Size (List_Size : in out Integer) is D1, D2 : Duration; begin if not We_Are_The_Child then Comment ("Estimate size needed to force paging behavior"); end if; Outer : loop begin D1 := Time_Big_List_Access (List_Size); loop D2 := Time_Big_List_Access (List_Size * 3 / 2); if D2 > 5.0 then Comment ("Giving up: no slowdown at 5 seconds"); return; end if; if List_Size > Integer'Last / 2 then Comment ("giving up: list reached limit of type Integer"); return; end if; List_Size := List_Size * 3 / 2; exit when D2 > D1 * 2; D1 := D2; end loop; return; exception when Storage_Error => Comment ("Reducing list size due to Storage_Error"); loop begin D1 := Time_Big_List_Access (List_Size); exit Outer; exception when Storage_Error => null; if List_Size = 0 then Fatal ("A001: Storage_Error for zero list size"); end if; end; List_Size := List_Size * 7 / 8; end loop; when E : others => Unexpected_Exception (E, "exception estimating size needed" & "for paging"); end; end loop Outer; end Set_List_Size; ----------------- -- Create_List -- ----------------- procedure Create_List; procedure Create_List is P : Pointer_Type := Head; begin if not We_Are_The_Child then Comment ("Creating list of size " & Integer'Image (List_Size)); end if; Head := new Record_Type; P := Head; for I in 2 .. List_Size loop P.Next := new Record_Type; P := P.Next; end loop; end Create_List; -------------------- -- Randomize_List -- -------------------- procedure Randomize_List; procedure Randomize_List is -- Try to sufficiently randomize the list so that we minimize the -- pre-paging effects of the system. P1, P2, Tmp1, Tmp2, Last : Pointer_Type; begin for K in 1 .. 7 loop if not We_Are_The_Child then Comment ("Starting shuffle number " & Integer'Image (K) & "."); end if; P1 := Head; P2 := Head; for J in 1 .. List_Size / 2 loop Last := P2; P2 := P2.Next; end loop; Last.Next := null; while P1 /= null and P2 /= null loop Tmp1 := P1.Next; P1.Next := P2; Tmp2 := P2.Next; P2.Next := Tmp1; P1 := Tmp1; P2 := Tmp2; end loop; end loop; end Randomize_List; begin -- Scan for appropriate arguments, and begin doing background work -- to keep memory busy if we are not the primary process. Check_Args (POSIX_Process_Environment.Argument_List); if not We_Are_The_Child then Header ("p120101", Root_OK => True); Test ("Memory_Locking Performance Test"); end if; Optional (Memory_Locking_Option, ""); -- Find a list size that seems to provoke paging, if that is -- possible within the operative process resource limits. Set_List_Size (List_Size); -- Create a list of that size. Create_List; -- Randomize the order of items in the list, to reduce the -- benefits of any prepaging that the sytem might do. Randomize_List; if We_Are_The_Child then -- We are a child process, who is supposed to keep the -- system busy with memory accesses. -- This loop does not need to terminate, because our -- parent will kill us when the test is done. loop Traverse_List; end loop; end if; -- If we get this far, we are the primary process for this test. Comment ("Starting other processes."); begin for P in 1 .. Num_Processes loop Append (Process_Array (P).Arg_List, My_Path); Append (Process_Array (P).Arg_List, "-b"); POSIX_Process_Primitives.Open_Template (Process_Array (P).Template); POSIX_Process_Primitives.Start_Process (Process_Array (P).Child, Process_Array (P).Pathname, Process_Array (P).Template, Process_Array (P).Arg_List); Comment ("Process " & Integer'Image (P) & " started."); end loop; exception when E : POSIX_Error => -- If the system can't allow us to have another process, we will -- go on with what we have. if Get_Error_Code = Resource_Temporarily_Unavailable or Get_Error_Code = Not_Enough_Space or Get_Error_Code = Operation_Not_Supported then Comment ("Unable to start process. Continuing."); else Unexpected_Exception (E, "A002"); end if; end; -- Time the list accesses, both with memory locked and with memory -- unlocked. Compare the results, and report to the user. declare Locked_Duration, Unlocked_Duration, Ratio : Duration; begin delay Delay_Time; Comment ("Time the list access with memory unlocked."); Unlocked_Duration := Time_Test_List_Access (Head, List_Size); -- Do it again, because the first time may have had extra -- overhead to initialize the pages. Unlocked_Duration := Time_Test_List_Access (Head, List_Size); Lock_All (Current_Pages); delay Delay_Time; Comment ("Time the list access with memory locked."); Locked_Duration := Time_Test_List_Access (Head, List_Size); -- This should take less time if locking memory saved us any -- page faults. Ratio := Unlocked_Duration / Locked_Duration; if Ratio > 4.0 then Comment ("Performance indicates that memory was locked."); else Comment ("Performance does not indicate expected effect."); end if; Unlock_All; delay Delay_Time; Comment ("Time the list access again with the memory unlocked."); Unlocked_Duration := Time_Test_List_Access (Head, List_Size); -- This should take more time if unlocking memory caused us -- to have page faults. Ratio := Unlocked_Duration / Locked_Duration; if Ratio > 4.0 then Comment ("Performance indicates that memory was unlocked."); else Comment ("Performance does not indicate expected effect."); end if; end; -- Kill the child processes. declare Status : POSIX_Process_Primitives.Termination_Status; begin for Q in 1 .. Num_Processes loop POSIX_Signals.Send_Signal (Process_Array (Q).Child, POSIX_Signals.Signal_Kill); POSIX_Process_Primitives.Wait_For_Child_Process (Status, Process_Array (Q).Child); end loop; end; Done; exception when E1 : POSIX.POSIX_Error => -- Since there is only one lock operation, we -- assume there is no capacity limit, so any failures can only -- be due to lack of support or lack of privilege. if Get_Error_Code = Resource_Temporarily_Unavailable then Comment ("The system was not able to lock the memory."); else Privileged (Memory_Locking_Privilege, Memory_Locking_Option, Operation_Not_Implemented, E1, "A003"); end if; Done; when E2 : others => Unexpected_Exception (E2, "A004"); end p120101; libflorist-2025.1.0/tests/p120101.ads000066400000000000000000000061761473553204100166670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 1 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120101; libflorist-2025.1.0/tests/p120200.adb000066400000000000000000000111511473553204100166330ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 2 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This test does not check that the operation has any effect; -- just that it can be called. with POSIX, POSIX_Memory_Range_Locking, POSIX_Page_Alignment, POSIX_Report, System.Storage_Elements; procedure p120200 is use POSIX, POSIX_Memory_Range_Locking, POSIX_Report, System.Storage_Elements; X : Integer := 10; Addr : System.Address := POSIX_Page_Alignment.Truncate_To_Page (X'Address); Len : System.Storage_Elements.Storage_Offset := 100; begin Header ("p120200", Root_OK => True); ----------------------------------------------------------------------- begin Test ("Lock_Range (Options) [12.2.1]"); Lock_Range (Addr, Len); -- should not have resource problem exception when E1 : POSIX.POSIX_Error => Privileged (Memory_Locking_Privilege, Memory_Range_Locking_Option, Operation_Not_Implemented, E1, "A001"); when E2 : others => Unexpected_Exception (E2, "A002"); end; ----------------------------------------------------------------------- begin Test ("Unlock_Range [12.2.1]"); Unlock_Range (Addr, Len); exception when E1 : POSIX.POSIX_Error => Privileged (Memory_Locking_Privilege, Memory_Range_Locking_Option, Operation_Not_Implemented, E1, "A003"); when E2 : others => Unexpected_Exception (E2, "A004"); end; ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A005"); end p120200; libflorist-2025.1.0/tests/p120200.ads000066400000000000000000000061761473553204100166670ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 2 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120200; libflorist-2025.1.0/tests/p120300.adb000066400000000000000000000473411473553204100166460ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 3 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test for Memory_Mapping package -- This is a pretty minimal test. It needs expansion. -- The test should check the protection, by trying some legal and -- illegal accesses, and catching the possible exceptions -- (Storage_Error, Program_Error, Constraint_Error). -- The test should also check for error cases, such as overlapping -- regions. with POSIX, POSIX_Files, POSIX_IO, POSIX_Memory_Mapping, POSIX_Page_Alignment, POSIX_Permissions, POSIX_Report, System, System_Storage_Elements; procedure p120300 is use POSIX, POSIX_IO, POSIX_Memory_Mapping, POSIX_Page_Alignment, POSIX_Permissions, POSIX_Report, System, System_Storage_Elements; Read_Write_Perms : constant Permission_Set := (Owner_Read | Owner_Write => True, Group_Read | Group_Write => True, Others_Read | Others_Write => True, others => False); begin Header ("p120300"); ----------------------------------------------------------------------- Test ("Map_Memory, Unmap_Memory (default address) [12.3.1]"); declare Test_fd : POSIX_IO.File_Descriptor; Last : POSIX.IO_Count; Start_Addr : System.Address; Len : constant System_Storage_Elements.Storage_Offset := 5; -- We are going to deal with strings of length 5. Offset : constant IO_Count := Truncate_To_Page (1000); New_Offset : IO_Offset; begin Test_fd := Open_Or_Create ("test_file", Read_Write, Read_Write_Perms); -- set the file size -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Map the memory which is allocated by the OS. Start_Addr := Map_Memory (Len, Allow_Read, Map_Shared, Test_fd, Offset); Assert (Start_Addr /= To_Address (-1), "A001"); -- should not have failed, since this was the first one; declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; begin -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Write something to the file Write (Test_fd, "hello", Last); -- Is the previous write reflected to S? Assert (S = "hello", "A002: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); -- Map_Memory with Allow_Write option Start_Addr := Map_Memory (Len, Allow_Write, Map_Shared, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; Out_Str : POSIX_String (1 .. Integer (Len)); begin S := "Good!"; -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Read (Test_fd, Out_Str, Last); -- Is the previous memory update reflected to the file? Assert (Out_Str = "Good!", "A003: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); -- Map_Memory with Allow_Read + Allow_Write option Start_Addr := Map_Memory (Len, Allow_Read + Allow_Write, Map_Shared, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; Out_Str : POSIX_String (1 .. Integer (Len)); begin S := "First"; -- Wrote this -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Read (Test_fd, Out_Str, Last); -- File should have "First" Assert (Out_Str = "First", "A004: mapped string does not match"); -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Write (Test_fd, "Good!", Last); -- Memory should have "Good!" Assert (S = "Good!", "A005: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); -- Map_Memory with Empty_Set option Start_Addr := Map_Memory (Len, Empty_Set, Map_Shared, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; begin if Is_Supported (Memory_Protection_Option) then S := "First"; -- Wrote this -- If Memory_Protection_Option is supported this should raise an -- exception Expect_Exception ("A006"); end if; exception when others => null; end; Unmap_Memory (Start_Addr, Len); -- Map_Memory with Allow_Execute option -- This test need to be further elaborated. Right now we just -- check whether Map/Unmap_Memory returns with no error. Start_Addr := Map_Memory (Len, Allow_Execute, Map_Shared, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; begin null; end; Unmap_Memory (Start_Addr, Len); exception when E1 : POSIX.POSIX_Error => Optional (Memory_Mapped_Files_Option, Operation_Not_Implemented, E1, "A007"); when E2 : others => Unexpected_Exception (E2, "A008"); end; ----------------------------------------------------------------------- Test ("Map_Memory, Unmap_Memory (Nearby_Address) [12.3.2]"); declare Test_fd : POSIX_IO.File_Descriptor; Last : POSIX.IO_Count; Test_Str : POSIX_String := "hello"; Start_Addr : System.Address; First : System.Address := Truncate_To_Page (Test_Str'Address); Len : constant System_Storage_Elements.Storage_Offset := 5; -- We are going to deal with strings of length 5. Offset : constant IO_Count := Truncate_To_Page (1000); New_Offset : IO_Offset; begin Test_fd := Open_Or_Create ("test_file", Read_Write, Read_Write_Perms); -- set the file size -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Map the memory which is allocated by the OS to the nearest -- address specified. begin Start_Addr := Map_Memory (First, Len, Allow_Read, Map_Shared, Nearby_Address, Test_fd, Offset); -- On some systems the above call will fail, -- because the OS does not let us to specify Addr (First). -- In such case, let's use a system allocated page -- by providing Null_Address for First. exception when others => First := System.Null_Address; Start_Addr := Map_Memory (First, Len, Allow_Read, Map_Shared, Nearby_Address, Test_fd, Offset); end; declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; begin -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Write something to the file Write (Test_fd, "hello", Last); -- Is the previous write reflected to S? Assert (S = "hello", "A009: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); -- Map_Memory with Allow_Write option Start_Addr := Map_Memory (First, Len, Allow_Write, Map_Shared, Nearby_Address, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; Out_Str : POSIX_String (1 .. Integer (Len)); begin S := "Good!"; -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Read (Test_fd, Out_Str, Last); -- Is the previous memory update reflected to the file? Assert (Out_Str = "Good!", "A010: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); -- Map_Memory with Allow_Read + Allow_Write option Start_Addr := Map_Memory (First, Len, Allow_Read + Allow_Write, Map_Shared, Nearby_Address, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; Out_Str : POSIX_String (1 .. Integer (Len)); begin S := "First"; -- Wrote this -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Read (Test_fd, Out_Str, Last); -- File should have "First" Assert (Out_Str = "First", "A011: mapped string does not match"); -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Write (Test_fd, "Good!", Last); -- Memory should have "Good!" Assert (S = "Good!", "A012: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); -- Map_Memory with Empty_Set option Comment ("Map_Memory"); Start_Addr := Map_Memory (First, Len, Empty_Set, Map_Shared, Nearby_Address, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; begin if Is_Supported (Memory_Protection_Option) then Comment ("Assignment to variable in read-only memory"); S := "First"; -- Wrote this -- If Memory_Protection_Option is supported the -- above should raise an exception. Expect_Exception ("A013"); end if; exception when others => null; end; Comment ("Unmap memory"); Unmap_Memory (Start_Addr, Len); -- Map_Memory with Allow_Execute option -- This test need to be further elaborated. Right now we just -- check whether Map/Unmap_Memory returns with no error. Start_Addr := Map_Memory (First, Len, Allow_Execute, Map_Shared, Nearby_Address, Test_fd, Offset); -- should not fail, since this is the first one, declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; begin null; end; Unmap_Memory (Start_Addr, Len); exception when E1 : POSIX.POSIX_Error => Optional (Memory_Mapped_Files_Option, Operation_Not_Implemented, E1, "A014"); when E2 : others => Unexpected_Exception (E2, "A015"); end; ----------------------------------------------------------------------- Test ("Change_Protection [12.3.3]"); declare Test_fd : POSIX_IO.File_Descriptor; Last : POSIX.IO_Count; Start_Addr : System.Address; Len : constant System_Storage_Elements.Storage_Offset := 5; -- We are going to deal with strings of length 5. Offset : constant IO_Count := Truncate_To_Page (1000); New_Offset : IO_Offset; begin Test_fd := Open_Or_Create ("test_file", Read_Write, Read_Write_Perms); -- set the file size -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Map the memory which is allocated by the OS. Start_Addr := Map_Memory (Len, Allow_Read, Map_Shared, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; begin -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Write something to the file Write (Test_fd, "hello", Last); -- Is the previous write reflected to S? Assert (S = "hello", "A016: mapped string does not match"); S := "Good!"; -- This should raise an exception. Expect_Exception ("A017"); exception when others => null; end; -- We change the memory protection to Read/Write. Change_Protection (Start_Addr, Len, Allow_Read + Allow_Write); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; Out_Str : POSIX_String (1 .. Integer (Len)); begin -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Write something to the file Write (Test_fd, "hello", Last); -- Is the previous write reflected to S? Assert (S = "hello", "A018: mapped string does not match"); S := "Good!"; Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Read (Test_fd, Out_Str, Last); -- Is the previous memory update reflected to the file? Assert (Out_Str = "Good!", "A019: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); exception when E1 : POSIX.POSIX_Error => Optional (Memory_Mapped_Files_Option, Operation_Not_Implemented, E1, "A020"); when E2 : others => Unexpected_Exception (E2, "A021"); end; ----------------------------------------------------------------------- Test ("Synchronize_Memory"); -- Test this only if Memory_Mapped_Files_Option and -- Synchronized_IO_Option is supported. declare Test_fd : POSIX_IO.File_Descriptor; Last : POSIX.IO_Count; Start_Addr : System.Address; Len : constant System_Storage_Elements.Storage_Offset := 5; -- We are going to deal with strings of length 5. Offset : constant IO_Count := Truncate_To_Page (1000); New_Offset : IO_Offset; begin Test_fd := Open_Or_Create ("test_file", Read_Write, Read_Write_Perms); -- set the file size -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); -- Map the memory which is allocated by the OS. Start_Addr := Map_Memory (Len, Allow_Read + Allow_Write, Map_Shared, Test_fd, Offset); declare C_Addr : constant System.Address := Start_Addr; S : POSIX_String (1 .. Integer (Len)); for S'Address use C_Addr; Out_Str : POSIX_String (1 .. Integer (Len)); begin S := "hello"; Synchronize_Memory (Start_Addr, Len, Wait_For_Completion); -- Move the file pointer to the beginning of the nearest -- page in the file. Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Read (Test_fd, Out_Str, Last); -- Is the previous memory update reflected to the file? Assert (Out_Str = "hello", "A022: mapped string does not match"); S := "Good!"; Synchronize_Memory (Start_Addr, Len, Invalidate_Cached_Data); Seek (Test_fd, IO_Offset (Offset), New_Offset, From_Beginning); Read (Test_fd, Out_Str, Last); -- Is the previous memory update reflected to the file? Assert (Out_Str = "Good!", "A023: mapped string does not match"); end; Unmap_Memory (Start_Addr, Len); exception when E1 : POSIX.POSIX_Error => Optional (Memory_Mapped_Files_Option, Synchronized_IO_Option, Operation_Not_Implemented, E1, "A024"); when E2 : others => Unexpected_Exception (E2, "A025"); end; ----------------------------------------------------------------------- -- remove the file created for this test. POSIX_Files.Unlink ("test_file"); Done; exception when E : others => Fatal_Exception (E, "A026"); end p120300; libflorist-2025.1.0/tests/p120300.ads000066400000000000000000000061761473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 3 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120300; libflorist-2025.1.0/tests/p120400.adb000066400000000000000000000310671473553204100166450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 4 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Shared_Memory, -- in IEEE STd 1003.5b Section 12.4. with POSIX, POSIX_File_Status, POSIX_IO, POSIX_Permissions, POSIX_Process_Identification, POSIX_Report, POSIX_Shared_Memory_Objects, Test_Parameters; procedure p120400 is use POSIX, POSIX_File_Status, POSIX_IO, POSIX_Permissions, POSIX_Process_Identification, POSIX_Report, POSIX_Shared_Memory_Objects; Valid_Name_1 : constant POSIX_String := Test_Parameters.Valid_Shared_Memory_Object_Name (1); begin Header ("p120400", Root_OK => True); ------------------------------------------------------------------ -- Trying to open non-existent shared memory object -- should result in POSIX_Error with No_Such_File_Or_Directory. declare test_mode : POSIX_IO.File_Mode := Read_Only; shmd : POSIX_IO.File_Descriptor; begin Test ("cannot open non-existent shared memory object"); shmd := Open_Shared_Memory (Valid_Name_1, test_mode); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, No_Such_File_Or_Directory, E1, "A001"); when E2 : others => Unexpected_Exception (E2, "A002"); end; ------------------------------------------------------------------ -- Trying to unlink non-existent shared memory object -- should result in POSIX_Error with No_Such_File_Or_Directory. begin Test ("cannot unlink non-existent shared memory object"); Unlink_Shared_Memory (Valid_Name_1); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, No_Such_File_Or_Directory, E1, "A001"); when E2 : others => Unexpected_Exception (E2, "A005"); end; ------------------------------------------------------------------ -- It should be possible to open a single shared memory object -- with more than one file descriptor concurrently, and to -- open distinct shared memory objects serially with a single -- file descriptor. -- An open object should persist after being unlinked, -- and if open with more than one file descriptor it should -- persist until the last close. -- Meanwhile, it should be possible to create a new object using -- the name of the unlinked object. -- .... This test would be better if some use were made of the -- shared memory objects, to verify that indeed they persist and -- the new one is distinct from the old one of the same name. declare test_mode : POSIX_IO.File_Mode := Read_Write; test_perm : Permission_Set := Owner_Permission_Set; shmd : POSIX_IO.File_Descriptor; shmd1 : POSIX_IO.File_Descriptor; opt1 : POSIX_IO.Open_Option_Set := POSIX_IO.Exclusive + POSIX_IO.Truncate; begin Test ("Open_Or_Create_Shared_Memory [12.4.1]"); Comment ("opening with first descriptor"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm, POSIX_IO.Exclusive); Comment ("opening with second descriptor"); shmd1 := Open_Shared_Memory (Valid_Name_1, test_mode); Comment ("unlinking original object"); Unlink_Shared_Memory (Valid_Name_1); Comment ("closing first descripplactor"); Close (shmd); Comment ("creating second object with original descriptor and name"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm, POSIX_IO.Truncate); Comment ("unlinking second object"); Unlink_Shared_Memory (Valid_Name_1); Comment ("creating third shared object"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm, opt1); Comment ("opening third shared object with another descriptor"); shmd1 := Open_Shared_Memory (Valid_Name_1, test_mode); Comment ("unlinking third shared object"); Unlink_Shared_Memory (Valid_Name_1); Close (shmd); Close (shmd1); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A006"); when E2 : others => Unexpected_Exception (E2, "A007"); end; ----------------------------------------------------------------------- -- Once an object is unlinked it should be possible to create -- another object with the same name. declare test_mode : POSIX_IO.File_Mode := Read_Write; test_perm : Permission_Set := Owner_Permission_Set; shmd1, shmd2 : POSIX_IO.File_Descriptor; begin Test ("Unlink_Shared_Memory [12.4.2]"); shmd1 := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm); Comment ("creating first shared object"); Unlink_Shared_Memory (Valid_Name_1); shmd2 := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm); Comment ("creating second shared object"); Unlink_Shared_Memory (Valid_Name_1); Close (shmd1); Close (shmd2); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; ----------------------------------------------------------------------- -- The user and group ID of the shared Object should be inherited -- from the process that created it. declare test_mode : POSIX_IO.File_Mode := Read_Write; test_perm : Permission_Set := Owner_Permission_Set; shmd : POSIX_IO.File_Descriptor; file_status : Status; userID : User_ID; groupID : Group_ID; object_userID : User_ID; object_groupID : Group_ID; object_permissions : Permission_Set; begin Test ("Shared_Memory_object Owner"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm); userID := Get_Real_User_ID; groupID := Get_Real_Group_ID; file_status := Get_File_Status (shmd); object_userID := Owner_Of (file_status); object_groupID := Group_Of (file_status); object_permissions := Permission_Set_Of (file_status); Assert (userID = object_userID, "A010"); Assert (groupID = object_groupID, "A011"); Assert (test_perm = object_permissions, "A012"); Unlink_Shared_Memory (Valid_Name_1); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A013"); when E2 : others => Unexpected_Exception (E2, "A014"); end; ----------------------------------------------------------------------- -- It should be possible to use the Exclusive and Truncate options, -- in all combinations. declare test_mode : POSIX_IO.File_Mode := Read_Write; test_perm : Permission_Set := Owner_Permission_Set; shmd : POSIX_IO.File_Descriptor; opt1 : POSIX_IO.Open_Option_Set := POSIX_IO.Exclusive + POSIX_IO.Truncate; begin Test ("Open_Or_Create_Shared_Memory [12.4.1]"); Comment ("creating with exclusive"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm, POSIX_IO.Exclusive); Close (shmd); Comment ("unlinking"); Unlink_Shared_Memory (Valid_Name_1); Comment ("creating with truncate"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm, POSIX_IO.Truncate); Close (shmd); Comment ("unlinking"); Unlink_Shared_Memory (Valid_Name_1); Comment ("creating with exclusive and truncate"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm, opt1); Close (shmd); Comment ("opening with default options"); shmd := Open_Shared_Memory (Valid_Name_1, test_mode); Close (shmd); Comment ("unlinking"); Unlink_Shared_Memory (Valid_Name_1); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A015"); when E2 : others => Unexpected_Exception (E2, "A016"); end; ----------------------------------------------------------------------- -- After an object is unlinked and last closed, -- it is no longer be possible to open it. declare test_mode : POSIX_IO.File_Mode := Read_Write; test_perm : Permission_Set := Owner_Permission_Set; shmd : POSIX_IO.File_Descriptor; begin Test ("Unlink_Shared_Memory [12.4.2]"); Comment ("creating with default options"); shmd := Open_Or_Create_Shared_Memory (Valid_Name_1, test_mode, test_perm); Close (shmd); Comment ("unlinking"); Unlink_Shared_Memory (Valid_Name_1); begin Comment ("trying to open after unlink"); shmd := Open_Shared_Memory (Valid_Name_1, test_mode); Assert (False, "should have raised POSIX_Error"); exception when E1 : POSIX_Error => if Get_Error_Code /= No_Such_File_Or_Directory then Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A017"); end if; when E2 : others => Unexpected_Exception (E2, "A018"); end; exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A019"); when E2 : others => Unexpected_Exception (E2, "A020"); end; ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A021"); end p120400; libflorist-2025.1.0/tests/p120400.ads000066400000000000000000000061761473553204100166710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 4 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120400; libflorist-2025.1.0/tests/p120500.adb000066400000000000000000000266451473553204100166540ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test of package POSIX_Generic_Shared_Memory with POSIX, POSIX_IO, POSIX_Generic_Shared_Memory, POSIX_Memory_Mapping, POSIX_Permissions, POSIX_Shared_Memory_Objects, POSIX_Report, Test_Parameters; procedure p120500 is use POSIX, POSIX_Permissions, POSIX_IO, POSIX_Memory_Mapping, POSIX_Shared_Memory_Objects, POSIX_Report; package TP renames Test_Parameters; subtype String10 is String (1 .. 10); package GT is new POSIX_Generic_Shared_Memory (String10); use GT; Object_Name : constant POSIX_String := TP.Valid_Shared_Memory_Object_Name (1); Local_Failure : exception; begin Header ("p120500", True); ------------------------------------------------------------------------ -- A shared memory object can be created. -- If the value of Protection is set to Allow_Write, -- Mode is Read_Write. declare Shmd : File_Descriptor; Test_perm : Permission_Set := Owner_Permission_Set; Mode : File_Mode; Option : Open_Option_Set; begin Test ("Open_Or_Create_And_Map_Shared_Memory [12.5.1]"); begin Shmd := Open_Or_Create_And_Map_Shared_Memory (Object_Name, Allow_Write, Test_perm); exception when E1 : POSIX_Error => if POSIX.Get_Error_Code = No_Space_Left_On_Device then Comment ("insufficient space left to create a new object"); elsif POSIX.Get_Error_Code = Not_Enough_Space then Comment ("insufficient room to effect mapping"); elsif POSIX.Get_Error_Code = Operation_Not_Implemented then Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A001"); else Unexpected_Exception (E1, "A002"); end if; raise Local_Failure; when E2 : others => Unexpected_Exception (E2, "A003"); raise Local_Failure; end; Get_File_Control (Shmd, Mode, Option); Assert (Mode = Read_Write, "A004"); ------------------------------------------------------------- -- If Exclusive is set, Open_Or_Create_And_Map_Shared_Memory -- shall fail if the shared memory object exists, and -- POSIX_Error is raised with File_Exists. begin Shmd := Open_Or_Create_And_Map_Shared_Memory (Object_Name, Allow_Write, Test_perm, Exclusive); Fail ("A005: Exclusive option improperly implemented"); exception when E1 : POSIX_Error => Check_Error_Code (File_Exists, E1, "A006"); when E2 : others => Unexpected_Exception (E2, "A007"); end; ------------------------------------------------------------- -- After the shared memory object is unmapped, closed, -- and unlinked, it no longer exists. Unmap_And_Close_Shared_Memory (Shmd); Unlink_Shared_Memory (Object_Name); exception when Local_Failure => null; when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; ----------------------------------------------------------------------- -- After a shared memory object is created, mapped, -- unmapped and closed, it can be reopened and mapped again. -- If it was possible to do the mapping once before without -- encountering permission or resource limits, it should be -- possible to do it once again. declare Shmd : File_Descriptor; Option : Open_Option_Set; Test_perm : Permission_Set := Owner_Permission_Set; Mode : File_Mode; begin Test ("Open_And_Map_Shared_Memory [12.5.1]"); Shmd := Open_Or_Create_And_Map_Shared_Memory (Object_Name, Allow_Write, Test_perm); Unmap_And_Close_Shared_Memory (Shmd); begin Shmd := Open_And_Map_Shared_Memory (Object_Name, Allow_Write); exception when E1 : POSIX_Error => if POSIX.Get_Error_Code = No_Space_Left_On_Device then Unexpected_Exception (E1, "A010"); elsif POSIX.Get_Error_Code = Not_Enough_Space then Unexpected_Exception (E1, "A011"); else Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A012"); end if; when E2 : others => Unexpected_Exception (E2, "A013"); end; Get_File_Control (Shmd, Mode, Option); Assert (Mode = Read_Write, "A014"); Unmap_And_Close_Shared_Memory (Shmd); Unlink_Shared_Memory (Object_Name); exception when Local_Failure => null; when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A015"); when E2 : others => Unexpected_Exception (E2, "A016"); end; ----------------------------------------------------------------------- -- Attempting to create a shared memory object with an invalid name -- raises POSIX_Error with Invalid_Argument. declare Shmd : File_Descriptor; Test_perm : Permission_Set := Owner_Permission_Set; begin Test ("creation with invalid name"); Shmd := Open_Or_Create_And_Map_Shared_Memory (TP.Invalid_Shared_Memory_Object_Name (1), Allow_Write, Test_perm); Unmap_And_Close_Shared_Memory (Shmd); Unlink_Shared_Memory (Object_Name); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, Invalid_Argument, E1, "A017"); when E2 : others => Unexpected_Exception (E2, "A018"); end; ----------------------------------------------------------------------- -- Access_Shared_Memory can be called and returns normally, -- for an open and mapped shared memory object. declare Shmd : File_Descriptor; acc : Shared_Access; begin Test ("Access Shared Memory [12.5.2]"); Shmd := Open_Or_Create_And_Map_Shared_Memory (Object_Name, Allow_Write, Owner_Permission_Set); begin acc := Access_Shared_Memory (Shmd); exception when E1 : POSIX_Error => if POSIX.Get_Error_Code = Bad_File_Descriptor then Unexpected_Exception (E1, "A019"); end if; when E2 : others => Unexpected_Exception (E2, "A020"); end; Test ("Close Shared Memory [12.5.3]"); Unmap_And_Close_Shared_Memory (Shmd); Test ("Remove Shared Memory [12.5.4]"); Unlink_Shared_Memory (Object_Name); exception when Local_Failure => null; when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A021"); when E2 : others => Unexpected_Exception (E2, "A022"); end; ----------------------------------------------------------------------- -- With appropriate privilege, a shared memory object can be locked. -- Once locked, it can be unlocked. declare Shmd : File_Descriptor; begin Test ("Lock/Unlock_Shared_Memory [12.5.5]"); Shmd := Open_Or_Create_And_Map_Shared_Memory (Object_Name, Allow_Write, Owner_Permission_Set); begin Lock_Shared_Memory (Shmd); begin Unlock_Shared_Memory (Shmd); exception when E : others => Unexpected_Exception (E, "A023"); end; exception when E1 : POSIX_Error => if POSIX.Get_Error_Code = Not_Enough_Space then Comment ("insufficient room to effect mapping"); elsif POSIX.Get_Error_Code = Operation_Not_Permitted then Privileged (Memory_Locking_Privilege, E1, "A024"); else Optional (Shared_Memory_Objects_Option, Memory_Range_Locking_Option, Operation_Not_Implemented, E1, "A025"); end if; when E2 : others => Unexpected_Exception (E2, "A026"); end; Unmap_And_Close_Shared_Memory (Shmd); Unlink_Shared_Memory (Object_Name); exception when Local_Failure => null; when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A027"); when E2 : others => Unexpected_Exception (E2, "A028"); end; ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A029"); end p120500; libflorist-2025.1.0/tests/p120500.ads000066400000000000000000000061761473553204100166720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120500; libflorist-2025.1.0/tests/p120501.adb000066400000000000000000000243141473553204100166440ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test for POSIX_Generic_Shared_Memory_Test package -- Four tasks communicate through a shared memory object -- containing four counters. Each task increments its own -- counter, and then waits until the other task's counter -- has caught up. They quit after a fixed number of -- iterations. -- ..... -- This test detected an error in the Florist implementation, -- that the operations for opening and creating a shared memory object -- were not atomic. The problem was intermittent, depending on the -- timing. Since those operations are only called once here -- by each task, the chance of interleaving are small, especially if -- this is run on a single processor. It would be good to either modify -- this test to cycle through the operations in each task, or (better?) -- to write a new test that concentrates on just that. with POSIX, POSIX_IO, POSIX_Generic_Shared_Memory, POSIX_Memory_Mapping, POSIX_Permissions, POSIX_Shared_Memory_Objects, POSIX_Report, Test_Parameters; procedure p120501 is use POSIX, POSIX_Permissions, POSIX_IO, POSIX_Memory_Mapping, POSIX_Shared_Memory_Objects, POSIX_Report; package TP renames Test_Parameters; type Window is record A : Integer; B : Integer; C : Integer; D : Integer; Done : Integer; pragma Volatile (A); pragma Volatile (B); pragma Volatile (C); pragma Volatile (D); pragma Volatile (Done); end record; package P is new POSIX_Generic_Shared_Memory (Window); Object_Name : POSIX_String := TP.Valid_Shared_Memory_Object_Name (1); Access_Failed : exception; task type Shared_Mem_Task (number : Integer) is entry StartRunning; end Shared_Mem_Task; Side_A : Shared_Mem_Task (number => 1); Side_B : Shared_Mem_Task (number => 2); Side_C : Shared_Mem_Task (number => 3); Side_D : Shared_Mem_Task (number => 4); task body Shared_Mem_Task is Shmd : File_Descriptor; Shared_Var : Window; Test_Perm : Permission_Set := Owner_Permission_Set; Obj : P.Shared_Access; Count : Integer := 0; begin Comment ("Waiting to start (" & Integer'Image (number) & ")"); accept StartRunning; Comment ("Opening or creating object (" & Integer'Image (number) & ")"); begin -- Try to create a new shared memory object. Shmd := P.Open_Or_Create_And_Map_Shared_Memory (Object_Name, Allow_Write, Test_Perm, Exclusive); exception when E1 : POSIX_Error => -- If it already exists, just open the existing object. if POSIX.Get_Error_Code = File_Exists then Shmd := P.Open_And_Map_Shared_Memory (Object_Name, Allow_Write); else Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A001"); end if; when E2 : others => Unexpected_Exception (E2, "A002"); end; Comment ("Accessing object (" & Integer'Image (number) & ")"); Obj := P.Access_Shared_Memory (Shmd); Obj.Done := 0; Comment ("Entering loop (" & Integer'Image (number) & ")"); if number = 1 then for I in 0 .. 10 loop Obj.A := I; Count := 0; while ((Obj.B < I) or (Obj.C < I) or (Obj.D < I)) loop delay 0.1; Count := Count + 1; if Count >= 520 then Obj.A := 100; raise Access_Failed; end if; end loop; end loop; elsif number = 2 then for I in 0 .. 10 loop Obj.B := I; Count := 0; while ((Obj.A < I) or (Obj.C < I) or (Obj.D < I)) loop delay 0.1; Count := Count + 1; if Count >= 520 then Obj.B := 100; raise Access_Failed; end if; end loop; end loop; elsif number = 3 then for I in 0 .. 10 loop Obj.C := I; Count := 0; while ((Obj.A < I) or (Obj.B < I) or (Obj.D < I)) loop delay 0.1; Count := Count + 1; if Count >= 520 then Obj.C := 100; raise Access_Failed; end if; end loop; end loop; elsif number = 4 then for I in 0 .. 10 loop Obj.D := I; Count := 0; while ((Obj.A < I) or (Obj.B < I) or (Obj.C < I))loop delay 0.1; Count := Count + 1; if Count >= 520 then Obj.D := 100; raise Access_Failed; end if; end loop; end loop; end if; Comment ("Done loop (" & Integer'Image (number) & ")"); if Obj.Done = 0 then Obj.Done := 1; -- The four counters should stop at the same value. Assert (Obj.A = Obj.B, "A003: values do not match"); end if; begin P.Unmap_And_Close_Shared_Memory (Shmd); Unlink_Shared_Memory (Object_Name); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A004"); end; Comment ("Exiting task (" & Integer'Image (number) & ")"); exception when Access_Failed => -- A task may not be responding, or shared memory may -- not be working correctly. Assert (False, "A005: other counter is not changing"); when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A006"); when E2 : others => Unexpected_Exception (E2, "A007"); end Shared_Mem_Task; begin Header ("p120501.adb", True); -- Clean up old memory objects, in case another test -- shut down improperly, leaving object behind. begin Unlink_Shared_Memory (Object_Name); exception when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, No_Such_File_Or_Directory, E1, "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; -- Give up if shared memory objects really are not -- supported, so as not to allow this test to hang. -- This test comes after at least one attempt to us a shared memory -- operation, to make sure that the proper error code is returned -- when those operations are called. Optional (Shared_Memory_Objects_Option, "A010"); Side_A.StartRunning; Side_B.StartRunning; Side_C.StartRunning; Side_D.StartRunning; while not (Side_A'Terminated) loop delay 0.5; end loop; Comment ("Side_A Terminated"); while not (Side_B'Terminated) loop delay 0.5; end loop; Comment ("Side_B Terminated"); while not (Side_C'Terminated) loop delay 0.5; end loop; Comment ("Side_C Terminated"); while not (Side_D'Terminated) loop delay 0.5; end loop; Comment ("Side_D Terminated"); Done; exception when E : others => Fatal_Exception (E, "A011"); end p120501; libflorist-2025.1.0/tests/p120501.ads000066400000000000000000000061761473553204100166730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120501; libflorist-2025.1.0/tests/p120502.adb000066400000000000000000000121031473553204100166360ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 2 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test for POSIX_Generic_Shared_Memory_Test package -- Two processes communicate through a shared memory object -- containing two counters. Each process increments its own -- counter, and then waits until the other process's counter -- has caught up. They quit after a fixed number of -- iterations. -- Setup: The executable file for program p120502a -- must be accessible via the path ``./p120502a''. with POSIX, POSIX_Files, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report; procedure p120502 is use POSIX, POSIX_Files, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report; Child_1 : Process_ID; Child_2 : Process_ID; Status : Termination_Status; Template : Process_Template; Args : POSIX_String_List; Child_Pathname : constant POSIX_String := "p120502a"; Child_Exists : Boolean := False; begin Header ("p120501.adb", True); declare begin Child_Exists := Is_Accessible (Child_Pathname, (Read_Ok | Execute_Ok => True, others => False)); exception when others => null; end; Assert (Child_Exists, "A001 : executable file for child not found"); Comment ("Creating two child processes"); Open_Template (Template); Make_Empty (Args); POSIX.Append (Args, Child_Pathname); Pass_Through_Verbosity (Args); POSIX.Append (Args, "-child 1"); Start_Process (Child_1, Child_Pathname, Template, Args); Make_Empty (Args); POSIX.Append (Args, Child_Pathname); Pass_Through_Verbosity (Args); POSIX.Append (Args, "-child 2"); Start_Process (Child_2, Child_Pathname, Template, Args); Comment ("Waiting for children to terminate"); Wait_For_Child_Process (Status, Child_1); Check_Child_Status (Status, Child_1, 0, "A002"); Wait_For_Child_Process (Status, Child_2); Check_Child_Status (Status, Child_2, 0, "A003"); Done; exception when E : others => Fatal_Exception (E, "A004"); end p120502; libflorist-2025.1.0/tests/p120502.ads000066400000000000000000000061751473553204100166730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 2 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120502; libflorist-2025.1.0/tests/p120502a.adb000066400000000000000000000150341473553204100170050ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 2 a -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Child process for test p120502. -- Two processes communicate through a shared memory object -- containing two counters. Each process increments its own -- counter, and then waits until the other process's counter -- has caught up. They quit after a fixed number of -- iterations. with POSIX, POSIX_IO, POSIX_Generic_Shared_Memory, POSIX_Memory_Mapping, POSIX_Permissions, POSIX_Report, POSIX_Shared_Memory_Objects, Test_Parameters; procedure p120502a is use POSIX, POSIX_IO, POSIX_Memory_Mapping, POSIX_Permissions, POSIX_Report, POSIX_Shared_Memory_Objects; package TP renames Test_Parameters; type Window is record A : Integer; B : Integer; Done : Integer; pragma Volatile (A); pragma Volatile (B); pragma Volatile (Done); end record; package P is new POSIX_Generic_Shared_Memory (Window); Object_Name : POSIX_String := TP.Valid_Shared_Memory_Object_Name (1); Access_Failed : exception; Shmd : File_Descriptor; Test_Perm : Permission_Set := Owner_Permission_Set; Obj : P.Shared_Access; Count : Integer := 0; begin Comment ("child: 120502a"); Assert (Child = 1 or Child = 2, "A001: Child =" & Integer'Image (Child)); begin Comment ("child: try to create a new shared memory object"); Shmd := P.Open_Or_Create_And_Map_Shared_Memory (Object_Name, Allow_Write, Test_Perm, Exclusive); exception when E1 : POSIX_Error => if POSIX.Get_Error_Code = File_Exists then Comment ("child: object already exists; try to open it"); Shmd := P.Open_And_Map_Shared_Memory (Object_Name, Allow_Write); else Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A002: child"); end if; when E2 : others => Fatal_Exception (E2, "A003: child"); end; Optional (Shared_Memory_Objects_Option, "A004: child"); Obj := P.Access_Shared_Memory (Shmd); Obj.Done := 0; if Child = 1 then for I in 0 .. 10 loop Obj.A := I; Count := 0; while Obj.B < I loop delay 0.2; Count := Count + 1; if Count >= 520 then raise Access_Failed; end if; end loop; end loop; else for I in 0 .. 10 loop Obj.B := I; Count := 0; while Obj.A < I loop delay 0.2; Count := Count + 1; if Count >= 520 then raise Access_Failed; end if; end loop; end loop; end if; if Obj.Done = 0 then Obj.Done := 1; -- The two counters should stop at the same value. Assert (Obj.A = Obj.B, "A005: child, values do not match"); end if; begin P.Unmap_And_Close_Shared_Memory (Shmd); Unlink_Shared_Memory (Object_Name); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A006: child"); end; Done; exception when Access_Failed => -- The other process may not be executing, -- or shared memory may not be working correctly. Assert (False, "A007: child, other counter is not changing"); Done; when E1 : POSIX_Error => Optional (Shared_Memory_Objects_Option, Operation_Not_Implemented, E1, "A008: child"); Done; when E2 : others => Unexpected_Exception (E2, "A009: child"); Done; end p120502a; libflorist-2025.1.0/tests/p120502a.ads000066400000000000000000000061761473553204100170350ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 2 0 5 0 2 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p120502a; libflorist-2025.1.0/tests/p140100.adb000066400000000000000000000732131473553204100166430ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 4 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Basic test for package POSIX_Timers, -- in IEEE Std 1003.5b Section 14.1. -- This test covers only features that depend only on -- the package itself and features from other packages -- that are required to be supported. -- More detailed tests are required for specific properties -- of timers, defined in [14.1.7]. -- See other tests for uses of this package in combination -- with optional features, signals, and tasking. -- ....This does not cover periodic timers. with Calendar, POSIX, POSIX_Limits, POSIX_Report, POSIX_Signals, POSIX_Timers, Test_Parameters; procedure p140100 is use POSIX, POSIX_Report, POSIX_Signals, POSIX_Timers, Test_Parameters; Clock_Realtime_Supported : Boolean := False; Clock_Realtime_Moves : Boolean := False; Interval_Roundup : Boolean := False; Timer : Timer_ID; Zero_Timespec : constant Timespec := To_Timespec (0, 0); type Timer_Mode is (Absolute, Relative); procedure Test_Timer (Mode : Timer_Mode); procedure Test_Timer (Mode : Timer_Mode) is Time : Timespec; Event : Signal_Event; State : Timer_State; begin Test ("Timer in mode " & Timer_Mode'Image (Mode)); Set_Signal (Event, SIGUSR1); Set_Notification (Event, No_Notification); Timer := Create_Timer (Clock_Realtime, Event); ---------------------------------------------------------- -- The timer returned by create_Timer should be in the -- disarmed state State := Get_Timer_State (Timer); Assert (Get_Initial (State) = Zero_Timespec, "A001"); Assert (Get_Interval (State) = Zero_Timespec, "A002"); --------------------------------------------------------- -- It is possible to arm a timer -- and then disarm it before it expires. -- There should be time left on the timer -- and it should be less than or equal to the time requested. Time := Get_Time (Clock_Realtime); Set_Initial (State, Time + To_Timespec (1, 0)); Set_Interval (State, Zero_Timespec); Arm_Timer (Timer, Absolute_Timer, State); Disarm_Timer (Timer); State := Get_Timer_State (Timer); Assert (Get_Initial (State) = Zero_Timespec, "A003: Get_Initial after disarm /= 0"); Assert (Get_Interval (State) <= To_Timespec (1, 0), "A004: Get_Interval after disarm > initial value"); -------------------------------------------------------------- -- Arming timer with zero initial value -- should be detected with error code Invalid_Argument. begin Set_Initial (State, Zero_Timespec); Set_Interval (State, Zero_Timespec); Arm_Timer (Timer, Absolute_Timer, State); Assert (False, "A005: zero initial value not detected"); Disarm_Timer (Timer); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A006"); end if; when E2 : others => Unexpected_Exception (E2, "A007"); end; if Mode = Relative then ----------------------------------------------------------- -- Arming timer with negative initial value -- should be detected with error code Invalid_Argument. begin Set_Initial (State, To_Timespec (-1, 0)); Set_Interval (State, Zero_Timespec); Arm_Timer (Timer, Absolute_Timer, State); Assert (False, "A008: negative initial value not detected"); Disarm_Timer (Timer); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A009"); end if; when E2 : others => Unexpected_Exception (E2, "A010"); end; else -- absolute timer -------------------------------------------------------------- -- Arming timer with present or past time -- causes it to go off immediately. begin Time := Get_Time (Clock_Realtime); Set_Initial (State, Time); Set_Interval (State, Zero_Timespec); Arm_Timer (Timer, Absolute_Timer, State); State := Get_Timer_State (Timer); Assert (Get_Initial (State) = Zero_Timespec, "A011: Get_Initial after expiration /= 0"); Assert (Get_Interval (State) = Zero_Timespec, "A012: Get_Interval after expiration /= 0"); Assert (Get_Timer_Overruns (Timer) = 0, "A013: nonzero overruns"); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A014"); when E2 : others => Unexpected_Exception (E2, "A015"); end; end if; ------------------------------------------------------------- -- Arming timer with future time causes -- it to go off after that time has passed. -- Test this by requesting delays of several lengths, -- then delaying for that amount of time and checking -- whether the timer has expired. declare Initial, LastInitial, NowInitial, Start_Time, Stop_Time, Temp : Timespec; PDelta : Timespec := To_Timespec (0, 1); -- Ada times and interval, to be used as backup -- in case Clock_Realtime does not work. NowState : Timer_State; Failed : Boolean; begin while PDelta < To_Timespec (2, 0) loop Failed := False; Start_Time := Get_Time (Clock_Realtime); if Mode = Relative then Initial := PDelta; Set_Initial (State, Initial); Set_Interval (State, Zero_Timespec); Arm_Timer (Timer, Empty_Set, State); else -- absolute Initial := Start_Time + PDelta; Set_Initial (State, Initial); Set_Interval (State, Zero_Timespec); Arm_Timer (Timer, Absolute_Timer, State); end if; NowState := Get_Timer_State (Timer); NowInitial := Get_Initial (NowState); Temp := NowInitial - PDelta; if Temp > Zero_Timespec then Comment ("observed interval roundup", Temp); if Get_Seconds (Temp) > 1 then Assert (Interval_Roundup, "A016: unbelievable interval roundup: " & Image (Temp)); Interval_Roundup := True; Failed := True; end if; end if; while not Failed loop LastInitial := NowInitial; NowState := Get_Timer_State (Timer); NowInitial := Get_Initial (NowState); exit when NowInitial = Zero_Timespec; if NowInitial >= LastInitial then Assert (False, "A017: timer value nondecreasing"); Comment ("request", PDelta); Comment ("current", NowInitial); Failed := True; end if; end loop; if not Failed then Stop_Time := Get_Time (Clock_Realtime); Comment ("request", PDelta); Temp := Stop_Time - Start_Time; if Temp < PDelta then Assert (False, "A018: early timer expiration: " & Image (PDelta - Temp)); Comment ("UNDER ", PDelta - Temp); else Comment ("over ", Temp - PDelta); end if; end if; PDelta := PDelta * 2; end loop; exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A019"); when E2 : others => Unexpected_Exception (E2, "A020"); end; Delete_Timer (Timer); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A021"); when E2 : others => Unexpected_Exception (E2, "A022"); end Test_Timer; begin Header ("p140100"); ----------------------------------------------------------------------- -- We first do a (superficial) test of the arithmetic on -- type Timespec, since the rest of this test depends on that. Test ("Timespec arithmetic accuracy"); declare One_Second : constant Timespec := To_Timespec (1, 0); PDelta : Timespec := To_Timespec (0, 1); N : Nanoseconds_Base := 1; begin Assert (To_Timespec (0, 1) > Zero_Timespec, "A023"); Assert (To_Timespec (-1, 0) < Zero_Timespec, "A024"); Assert (To_Timespec (0, 0) = Zero_Timespec, "A025"); Assert (To_Timespec (0, 1) + To_Timespec (0, 1) = To_Timespec (0, 2), "A026"); Assert (To_Timespec (0, Nanoseconds'Last) + To_Timespec (0, 1) = To_Timespec (1, 0), "A027"); Assert (To_Timespec (0, Nanoseconds'Last) - To_Timespec (0, 1) = To_Timespec (0, Nanoseconds'Last - 1), "A028"); while PDelta < To_Timespec (2, 0) loop if PDelta < One_Second then Assert (PDelta = To_Timespec (0, N), "A029"); Assert (N = Get_Nanoseconds (PDelta), "A030"); end if; Assert (Get_Seconds (PDelta) < 2, "A031"); Assert (PDelta > Zero_Timespec, "A032"); PDelta := PDelta * 2; N := N * 2; end loop; Assert (To_Timespec (987_654_321, 87_654_321) + To_Timespec (100_000_000, 10_000_000) = To_Timespec (1_087_654_321, 97_654_321), "A033"); Assert (To_Timespec (987_654_321, 87_654_321) - To_Timespec (100_000_000, 10_000_000) = To_Timespec (887_654_321, 77_654_321), "A034"); Assert (To_Timespec (0, 955_899) > Zero_Timespec, "A035"); Assert (To_Timespec (0, 955_899) - To_Timespec (0, 955_900) = To_Timespec (-1, 1E9 - 1), "A036"); exception when E : others => Unexpected_Exception (E, "A037"); end; -------------------------------------------------------- -- Testing the validity of variables of type Timer_ID will be -- done with testing of sections [14.1.5] and [14.1.6]. --------------------------------------------------------- -- Testing the resolution of the identifier Clock_Realtime -- will be done with testing of section [14.1.4]. ----------------------------------------------------------------------- Test ("Timer_State type and operations [14.1.3]"); declare Temp1, Temp2 : Timespec; State : Timer_State; begin ------------------------------------------------------------ -- The effects of the Get_/Set_ operations -- on timers are consistent with one another. Set_Seconds (Temp1, 999); Set_Nanoseconds (Temp1, 1111); Set_Initial (State, Temp1); Temp2 := Get_Initial (State); Assert (Temp1 = Temp2, "Get_/Set_Initial"); Set_Interval (State, Temp1); Temp2 := Get_Interval (State); Assert (Temp1 = Temp2, "Get_/Set_Interval"); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A038"); when E2 : others => Unexpected_Exception (E2, "A039"); end; ----------------------------------------------------------------------- Test ("Timer_Options type and operations [14.1.3]"); declare Options : Timer_Options; begin Assert (Options = Empty_Set, "Timer_Options default value"); ----------------------------------------------------------------- -- The effect of the Absolute_Timer option -- is different from specifying no option. Options := Absolute_Timer; Assert (Options /= Empty_Set, "Absolute_Timer value"); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A040"); when E2 : others => Unexpected_Exception (E2, "A041"); end; ----------------------------------------------------------------------- Test ("Resolution (Clock_Realtime) [14.1.4]"); declare Resolution : Timespec := To_Timespec (999, 999); S : Seconds; NS : Nanoseconds; begin Resolution := Get_Resolution (Clock_Realtime); Clock_Realtime_Supported := True; ---------------------------------------------------------------- -- The resolution reported by Get_Resolution is consistent -- with POSIX_Limits.Portable_Clock_Resolution_Minimum. Split (Resolution, S, NS); Assert (S = 0 and NS <= POSIX_Limits.Portable_Clock_Resolution_Minimum, "A042"); Comment ("Clock_Realtime reported resolution", Resolution); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A043"); when E2 : others => Unexpected_Exception (E2, "A044"); end; ----------------------------------------------------------------------- Test ("Get_Time (Clock_Realtime) [14.1.4]"); declare Time : Timespec := To_Timespec (-1, 0); begin Time := Get_Time (Clock_Realtime); Assert (Clock_Realtime_Supported, "inconsistent support"); Clock_Realtime_Supported := True; Assert (Get_Seconds (Time) /= -1, "A045"); Comment ("current time", Time); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A046"); when E2 : others => Unexpected_Exception (E2, "A047"); end; ----------------------------------------------------------------------- Test ("Clock_Realtime behavior [14.1.4]"); declare Resolution : Timespec; S : Seconds; NS : Nanoseconds; PTime, -- start time according to POSIX clock PNow : Timespec; -- current time according to POSIX clock N : constant := 100; Count : Integer; Pmin, -- minimum of N Pdif values Pdif : Timespec; -- apparent POSIX clock resolution ATime, -- start time according to Ada clock ANow : Calendar.Time; -- current time according to Ada clock Amin, -- minimum of N Adif values Adif : Duration; -- apparent Ada clock resolution begin --------------------------------------------------------------------- -- The maximum allowable value returned by Get_Resolution -- for Clock_Realtime is Portable_Clock_Resolution_Minimum. Resolution := Get_Resolution (Clock_Realtime); Split (Resolution, S, NS); Clock_Realtime_Supported := True; --------------------------------------------------------------------- -- The effective clock resolution should be consistent with -- the reported resolution. -- This can be partially checked by repeatedly -- reading the clock until the value changes, -- and then looking at the difference in clock values. -- First check, using Ada's Calendar.Clock, that Clock_Realtime -- is moving, so we won't get stuck in an infinite loop when -- we test the clock later. ATime := Calendar.Clock; PTime := Get_Time (Clock_Realtime); loop Adif := Calendar."-" (ATime, Calendar.Clock); Pdif := PTime - Get_Time (Clock_Realtime); Clock_Realtime_Moves := True; if Adif > 2.0 then Fail ("A048: Clock_Realtime does not move"); Clock_Realtime_Moves := False; exit; end if; exit when Pdif /= Zero_Timespec; end loop; -- Now find an upper bound on the Clock_Realtime resolution. -- See how this compares with the Ada Calendar clock. if Clock_Realtime_Moves then PTime := Get_Time (Clock_Realtime); Pmin := To_Timespec (1000, 0); Count := 0; while Count < N loop PNow := Get_Time (Clock_Realtime); Pdif := PNow - PTime; Split (Pdif, S, NS); if Pdif > Zero_Timespec then if Pdif < Pmin then Pmin := Pdif; end if; PTime := PNow; Count := Count + 1; end if; end loop; Split (Pmin, S, NS); Assert (S = 0 and NS <= POSIX_Limits.Portable_Clock_Resolution_Minimum, "A049"); Comment ("Clock_Realtime apparent resolution + overhead", Pmin); end if; -- For comparison, check the resolution of Calendar.Clock. ATime := Calendar.Clock; Amin := 1000.0; Count := 0; while Count < N loop ANow := Calendar.Clock; Adif := Calendar."-" (ANow, ATime); if Adif > 0.0 then if Adif < Amin then Amin := Adif; end if; ATime := ANow; Count := Count + 1; end if; end loop; Comment ("Calendar.Clock apparent resolution + overhead =" & Integer'Image (Integer (Amin * 1E9))); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A050"); when E2 : others => Unexpected_Exception (E2, "A051"); end; ----------------------------------------------------------------------- -- An uninitialized Clock_ID value should be detected as -- invalid, or else work as a valid argument. Test ("uninitialized Clock_ID value [14.1.4]"); declare Resolution, Time : Timespec; begin begin Resolution := Get_Resolution (Invalid_Clock_ID); Expect_Exception ("A052: Invalid Clock_ID has Resolution"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A053"); end if; when E2 : others => Unexpected_Exception (E2, "A054"); end; begin Time := Get_Time (Invalid_Clock_ID); Expect_Exception ("Invalid Clock_ID has Get_Time"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A055"); end if; when E2 : others => Unexpected_Exception (E2, "A056"); end; end; ----------------------------------------------------------------------- -- POSIX_Error is raised with error code Invalid_Argument if -- Set_Time is called with invalid clock identifier, -- or the Value parameter for Set_Time is outside -- the range allowed for the specified Clock, or the argument of type -- Timespec cannot not be interpreted as a valid time. -- An invalid value of type Timespec may be obtained with high -- probability via an uninitialized variable. -- These requirements are checked in a separate program, along -- with other checks of operations that may require special privilege. ----------------------------------------------------------------------- Test ("Signal_Event variable initialization"); declare Event : Signal_Event; begin Set_Notification (Event, No_Notification); Set_Signal (Event, SIGUSR1); Set_Notification (Event, Signal_Notification); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A057"); when E2 : others => Unexpected_Exception (E2, "A058"); end; ----------------------------------------------------------------------- -- An attempt to create a timer with an invalid clock ID -- results in POSIX_Error with Invalid_Argument, -- if Timers_Option is supported. Test ("Create_Timer [4.1.5], invalid clock ID"); declare Event : Signal_Event; begin Set_Notification (Event, No_Notification); Timer := Create_Timer (Invalid_Clock_ID, Event); Expect_Exception ("A059: Invalid Clock_ID can create timer"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A060"); end if; when E2 : others => Unexpected_Exception (E2, "A061"); end; ----------------------------------------------------------------------- -- An attempt to delete a timer that was not initialized -- should either fail, or fail with Operation_Not_Implemented. Test ("Delete_Timer [4.1.6], invalid timer ID"); declare Timer : Timer_ID; -- uninitialized begin Delete_Timer (Timer); Comment ("Uninitialized Timer_ID can be deleted"); Delete_Timer (Timer); Fail ("A062: deleted Timer_ID can be deleted"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A063"); end if; when E2 : others => Unexpected_Exception (E2, "A064"); end; ----------------------------------------------------------------------- -- An attempt to arm a timer with invalid timer ID should fail Test ("Arm_Timer, Invalid timer ID"); declare State : Timer_State; begin Set_Initial (State, To_Timespec (1, 0)); Set_Interval (State, Zero_Timespec); Arm_Timer (Timer, Empty_Set, State); Disarm_Timer (Timer); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A065"); end if; when E2 : others => Unexpected_Exception (E2, "A066"); end; ----------------------------------------------------------------------- -- An attempt to Get_Timer_State a timer that was not initialized -- should either fail, or fail with Operation_Not_Implemented. Test ("Get_Timer_State, invalid timer ID"); declare Uninitialized_Timer : Timer_ID; pragma Warnings (Off, Uninitialized_Timer); State : Timer_State; begin State := Get_Timer_State (Uninitialized_Timer); Assert (False, "A067: can Get_Timer_State from Uninitialized Timer_ID"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A068"); end if; when E2 : others => Unexpected_Exception (E2, "A069"); end; ----------------------------------------------------------------------- -- An attempt to Get_Timer_Overruns a timer that was not initialized -- should either fail, or fail with Operation_Not_Implemented. Test ("Get_Timer_Overruns, invalid timer ID"); declare Uninitialized_Timer : Timer_ID; pragma Warnings (Off, Uninitialized_Timer); Runs : Integer; begin Runs := Get_Timer_Overruns (Uninitialized_Timer); Assert (False, "A070: can Get_Time_Overruns from uninitialized Timer_ID"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A071"); end if; when E2 : others => Unexpected_Exception (E2, "A072"); end; ----------------------------------------------------------------------- -- It should be possible to create a timer. -- Since the clock ID is valid and we only create one timer at a -- time in this process, it should succeed. -- This should work both with and without signal notification. Test ("Create_Timer [14.1.5], valid clock ID"); declare Event : Signal_Event; begin Comment ("Set_Notification"); Set_Notification (Event, No_Notification); Comment ("Create_Timer"); Timer := Create_Timer (Clock_Realtime, Event); Test ("Delete_Timer [14.1.6], valid timer ID"); Delete_Timer (Timer); Set_Signal (Event, SIGUSR1); Set_Notification (Event, Signal_Notification); Timer := Create_Timer (Clock_Realtime, Event); Delete_Timer (Timer); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A073"); when E2 : others => Unexpected_Exception (E2, "A074"); end; ----------------------------------------------------------------------- -- Time values between two consecutive multiples of the resolution -- of the specified clock shall be rounded up to the next larger -- multiple of the resolution (Arm_Timer). Test ("Arm_Timer [14.1.7] Time rounded up to the higher resolution"); declare Event : Signal_Event; Sample_Timer : Timer_ID; Target_1, Target_2 : Timer_State; Result_1, Result_2 : Timer_State; Diff_1, Diff_2 : Timespec; Resolution : Timespec; begin Set_Signal (Event, SIGUSR1); Set_Notification (Event, No_Notification); Resolution := Get_Resolution (Clock_Realtime); Sample_Timer := Create_Timer (Clock_Realtime, Event); Set_Initial (Target_1, To_Timespec (100.0)); Set_Interval (Target_1, To_Timespec (0.0)); Target_2 := Target_1; Set_Initial (Target_2, To_Timespec (100.0) + Resolution / 2); Arm_Timer (Sample_Timer, Empty_Set, Target_1); Result_1 := Get_Timer_State (Sample_Timer); Arm_Timer (Sample_Timer, Empty_Set, Target_2); Result_2 := Get_Timer_State (Sample_Timer); Diff_1 := Get_Initial (Result_1); Diff_2 := Get_Initial (Result_2); Comment ("Resolution", Resolution); Comment ("Diff_1", Diff_1); Comment ("Diff_2", Diff_2); if Diff_1 > Resolution then Comment ("Timer-setting overhead exceeds resolution"); else Assert (Diff_2 - Diff_1 > (Resolution * 3) / 4, "A075: time apparently not rounded up"); end if; Delete_Timer (Timer); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A076"); when E2 : others => Unexpected_Exception (E2, "A077"); end; ----------------------------------------------------------------------- -- An attempt to delete a timer that was previously deleted -- should either fail, or fail with Operation_Not_Implemented. Test ("Delete_Timer [4.1.6], previously deleted timer ID"); begin Delete_Timer (Timer); Expect_Exception ("A078: deleted Timer_ID can be deleted"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Optional (Timers_Option, Operation_Not_Implemented, E1, "A079"); end if; when E2 : others => Unexpected_Exception (E2, "A080"); end; ----------------------------------------------------------------------- Test ("Operations on one-shot timer [14.1.7]"); Test_Timer (Absolute); ----------------------------------------------------------------------- Test ("Operations on relative one-shot timer [14.1.7]"); Test_Timer (Relative); ----------------------------------------------------------------------- Done; exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A081"); Done; when E2 : others => Fatal_Exception (E2, "A082"); end p140100; libflorist-2025.1.0/tests/p140100.ads000066400000000000000000000061761473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 4 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p140100; libflorist-2025.1.0/tests/p140101.adb000066400000000000000000000300711473553204100166370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 4 0 1 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test for package POSIX_Timers, -- in IEEE Std 1003.5b Section 14.1. -- This test covers features that require special privilege. with POSIX, POSIX_Report, POSIX_Timers, Test_Parameters; procedure p140101 is use POSIX, POSIX_Report, POSIX_Timers, Test_Parameters; Time_Restore : Timespec; -- Used to restore clock value. begin Header ("p140101", Root_OK => True); ----------------------------------------------------------------------- -- Set_Time can be used to set the clock to a valid -- value, unless the calling process lacks sufficient privilege. Test ("Set_Time [14.1.4] all valid data"); begin Time_Restore := Get_Time (Clock_Realtime); Set_Time (Clock_Realtime, Time_Restore); Assert (Time_Restore <= Get_Time (Clock_Realtime), "A001"); Assert (Get_Seconds (Time_Restore) <= Get_Seconds (Get_Time (Clock_Realtime)), "A002"); exception when E1 : POSIX_Error => Privileged (Set_Time_Privilege, Timers_Option, Operation_Not_Implemented, E1, "A003"); when E2 : others => Unexpected_Exception (E2, "A004"); end; ----------------------------------------------------------------------- -- POSIX_Error is raised with error code Invalid_Argument if -- Set_Time is called with invalid clock identifier. -- An invalid value of any type may be obtained with high -- probability via an uninitialized variable. To improve -- the odds, we can try to make sure the memory contains -- an "interesting" value (e.g. not zero) by overlaying -- an uninitialized variable on a memory location that -- previously contained a value of a different type. Test ("Set_Time [14.1.4] Invalid clock ID"); declare T : Timespec; Invalid : Clock_ID := Invalid_Clock_ID; Invalid_ID_Found : Boolean := False; begin -- Check that we actually have an invalid Clock_ID value. begin T := Get_Time (Invalid); Comment ("WARNING: garbage clock ID appears to work!"); exception when E1 : POSIX_Error => if Get_Error_Code = Invalid_Argument then Invalid_ID_Found := True; else Optional (Timers_Option, Operation_Not_Implemented, E1, "A005"); end if; when E2 : others => Unexpected_Exception (E2, "A006"); end; if Invalid_ID_Found then Set_Time (Invalid, To_Timespec (0.1)); Expect_Exception ("A007"); end if; exception when E1 : POSIX_Error => Privileged (Privilege => Set_Time_Privilege, Option => Timers_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; ------------------------------------------------------------ -- Testing to see if the Clock_Realtime can support up to -- at least Seconds'Last. Test ("Clock_Realtime can be set to Seconds'Last [14.1.2]"); Comment ("This test can be performed only by the system adminstrator"); declare Time_After : Timespec; begin Time_Restore := Get_Time (Clock_Realtime); Set_Time (Clock_Realtime, To_Timespec (Seconds'Last, 0)); Time_After := Get_Time (Clock_Realtime); Assert (Get_Seconds (Time_After) = Seconds'Last, "A010: " & Image (Time_After)); Set_Time (Clock_Realtime, Time_Restore); exception when E1 : POSIX_Error => Privileged (Set_Time_Privilege, Timers_Option, Operation_Not_Implemented, E1, "A011"); end; ----------------------------------------------------------------------- -- POSIX_Error is raised with error code Invalid_Argument if -- the Value parameter for Set_Time is outside -- the range allowed for the specified Clock. Test ("Set_Time [14.1.4] negative Timespec"); begin Set_Time (Clock_Realtime, To_Timespec (-5.0)); -- This may or may not raise an exception. Set_Time (Clock_Realtime, Time_Restore); exception when Constraint_Error => -- Value might simply be out of range. null; when E1 : POSIX_Error => Privileged (Privilege => Set_Time_Privilege, Option => Timers_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A012"); when E2 : others => Unexpected_Exception (E2, "A013"); end; Test ("Set_Time [14.1.4] zero Timespec"); begin Set_Time (Clock_Realtime, To_Timespec (0.0)); -- This may or may not raise an exception. Set_Time (Clock_Realtime, Time_Restore); exception when Constraint_Error => -- Value might simply be out of range. null; when E1 : POSIX_Error => Privileged (Privilege => Set_Time_Privilege, Option => Timers_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A014"); when E2 : others => Unexpected_Exception (E2, "A015"); end; Test ("Set_Time [14.1.4] large positive Timespec"); begin Set_Time (Clock_Realtime, To_Timespec (1000_000_000.0)); -- This may or may not raise an exception. Set_Time (Clock_Realtime, Time_Restore); exception when Constraint_Error => -- Value might simply be out of range. null; when E1 : POSIX_Error => Privileged (Privilege => Set_Time_Privilege, Option => Timers_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A016"); when E2 : others => Unexpected_Exception (E2, "A017"); end; ----------------------------------------------------------------------- -- POSIX_Error is raised with error code Invalid_Argument if -- the argument of type Timespec cannot not be interpreted -- as a valid time. Test ("Set_Time [14.1.4] Invalid Timespec"); declare Time : Timespec := Invalid_Timespec; begin Set_Time (Clock_Realtime, Time); Expect_Exception ("A018"); Set_Time (Clock_Realtime, Time_Restore); exception when Constraint_Error => -- Value might simply be out of range. null; when E1 : POSIX_Error => Privileged (Privilege => Set_Time_Privilege, Option => Timers_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A019"); when E2 : others => Unexpected_Exception (E2, "A020"); end; Test ("Set_Time [14.1.4] uninitialized Timespec"); declare Uninitialized_Time : Timespec; begin Set_Time (Clock_Realtime, Uninitialized_Time); -- No exception will be raised if the value happens to -- be in range, by accident. Set_Time (Clock_Realtime, Time_Restore); exception when Constraint_Error => -- Value might simply be out of range. null; when E1 : POSIX_Error => Privileged (Privilege => Set_Time_Privilege, Option => Timers_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A021"); when E2 : others => Unexpected_Exception (E2, "A022"); end; ----------------------------------------------------------------------- -- Time values between two consecutive multiples of the resolution -- of the specified clock shall be truncated down to the smaller -- multiple of the resolution (Set_Time). Test ("Set_Time [14.1.4] Time truncated to the smaller resolution"); declare Clock : constant Clock_ID := Clock_Realtime; Resolution : Timespec; Diff_1, Diff_2 : Timespec; Target_1, Target_2 : Timespec; begin Resolution := Get_Resolution (Clock); Time_Restore := Get_Time (Clock_Realtime); Target_1 := Time_Restore; Target_2 := Time_Restore + Resolution / 2; Set_Time (Clock, Target_1); Diff_1 := Get_Time (Clock) - Target_1; Set_Time (Clock, Target_2); Diff_2 := Get_Time (Clock) - Target_2; Set_Time (Clock, Time_Restore); Comment ("Resolution", Resolution); Comment ("Diff_1", Diff_1); Comment ("Diff_2", Diff_2); Assert (Diff_1 - Diff_2 < Resolution / 4, "A023: time apparently not truncated"); exception when E1 : POSIX_Error => Privileged (Privilege => Set_Time_Privilege, Option => Timers_Option, Expected_If_Not_Supported => Operation_Not_Implemented, Expected_If_Supported => Invalid_Argument, E => E1, Message => "A024"); when E2 : others => Unexpected_Exception (E2, "A025"); end; ----------------------------------------------------------------------- Done; exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1, "A026"); Done; when E2 : others => Fatal_Exception (E2, "A027"); end p140101; libflorist-2025.1.0/tests/p140101.ads000066400000000000000000000062741473553204100166700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 4 0 1 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This test covers features that require special privilege. procedure p140101; libflorist-2025.1.0/tests/p150100.adb000066400000000000000000000627051473553204100166500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5B VALIDATION TEST SUITE -- -- -- -- P 1 5 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test for POSIX_Message_Queues package. -- Setup: When this test is run the executable program p150100b -- must be accessible via the pathname "./bin/p150100b". with Ada_Streams, POSIX, POSIX_Configurable_System_Limits, POSIX_File_Status, POSIX_IO, POSIX_Limits, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals, Test_Parameters; procedure p150100 is use Ada_Streams, POSIX, POSIX_Configurable_System_Limits, POSIX_File_Status, POSIX_IO, POSIX_Message_Queues, POSIX_Permissions, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Report, POSIX_Signals; package TP renames Test_Parameters; Mqd : Message_Queue_Descriptor; Attr : Attributes; Child_Pathname : constant POSIX_String := "./bin/p150100b"; Child_Filename : constant POSIX_String := "p150100b"; begin Header ("p150100", Root_OK => True); Comment ("Parent Process Beginning."); ----------------------------------------------------------------------- -- The Set/Get_Max_Messages operations on the Attributes type -- give consistent results. begin Test ("Set/Get_Max_Messages [15.1.1]"); Set_Max_Messages (Attr, 10); Assert (Get_Max_Messages (Attr) = 10, "A001: get_max_messages"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A002"); when E2 : others => Unexpected_Exception (E2, "A003"); end; ----------------------------------------------------------------------- -- The Set/Get_Message_Length operations on the Attributes type -- give consistent results. begin Test ("Set/Get_Message_Length [15.1.1]"); Set_Message_Length (Attr, 100); Assert (Get_Message_Length (Attr) = 100, "A004: get_message_length"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A005"); when E2 : others => Unexpected_Exception (E2, "A006"); end; ----------------------------------------------------------------------- -- The Set/Get_Options operations on the Attributes type -- give consistent results. begin Test ("Set/Get_Options [15.1.1]"); Set_Options (Attr, POSIX_Message_Queues.Non_Blocking); Assert (Get_Options (Attr) = POSIX_Message_Queues.Non_Blocking, "A007"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; ----------------------------------------------------------------------- -- Test the Get_Message_Count call on the Attributes type to see -- that a positive value is returned. begin Test ("Get_Message_Count [15.1.1]"); Assert (Get_Message_Count (Attr) >= 0, "A010"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A011"); when E2 : others => Unexpected_Exception (E2, "A012"); end; ----------------------------------------------------------------------- -- Calls to Send shall fail if a message queue resource is -- temporarily unavailable (such as if the message queue is full). begin Test ("Temporarily Unavailable Error"); Set_Options (Attr, POSIX_Message_Queues.Non_Blocking); Set_Message_Length (Attr, 100); Set_Max_Messages (Attr, 1); Mqd := Open_Or_Create (TP.Valid_MQ_Name (1), Read_Write, Owner_Permission_Set, POSIX_IO.Open_Option_Set (POSIX_Message_Queues.Get_Options (Attr)), Attr, POSIX.RTS_Signals); Send (Mqd, To_Stream_Element_Array ("Hello....."), 1); Send (Mqd, To_Stream_Element_Array ("Hello....."), 1); Expect_Exception ("A013: POSIX_Error"); Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (1)); exception when E1 : POSIX_Error => if Get_Error_Code /= Resource_Temporarily_Unavailable then Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A014"); else Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (1)); end if; end; ----------------------------------------------------------------------- -- A Message Queue is actually created by the -- Open_Or_Create call, can be closed, and can be reopened in any mode. begin Test ("Open_Or_Create [15.1.2]"); Mqd := Open_Or_Create (TP.Valid_MQ_Name (2), Read_Write, Owner_Permission_Set); begin Assert (Is_Message_Queue (Get_File_Status (TP.Valid_MQ_Name (2))), "A015: file status"); exception when E : POSIX_Error => if Get_Error_Code = No_Such_File_Or_Directory then Comment ("message queue is not in file system"); else Unexpected_Exception (E, "A016: get file status failed"); end if; end; Close (Mqd); Mqd := Open (TP.Valid_MQ_Name (2), Read_Write); Close (Mqd); Mqd := Open (TP.Valid_MQ_Name (2), Write_Only); Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (2)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A017"); when E2 : others => Unexpected_Exception (E2, "A018"); end; ----------------------------------------------------------------------- -- The Unlink_Message_Queue procedure works. begin Test ("Unlink_Message_Queue [15.1.4]"); Mqd := Open_Or_Create (TP.Valid_MQ_Name (3), Read_Write, Owner_Permission_Set, POSIX_IO.Open_Option_Set (POSIX_Message_Queues.Get_Options (Attr)), Attr, POSIX.RTS_Signals); Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (3)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A019"); when E2 : others => Unexpected_Exception (E2, "A020"); end; ----------------------------------------------------------------------- -- Error Code is No_Such_File_Or_Directory when trying to -- open an unlinked message queue. begin Test ("Open unlinked message queue"); Mqd := Open (TP.Valid_MQ_Name (3), Read_Write); Expect_Exception ("A021: POSIX_Error"); Close (Mqd); exception when E1 : POSIX_Error => if Get_Error_Code /= No_Such_File_Or_Directory then Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A022"); end if; when E2 : others => Unexpected_Exception (E2, "A023"); end; ----------------------------------------------------------------------- -- Error Code is No_Such_File_Or_Directory when trying to -- open a message queue which has not been created. begin Test ("Open never-created message queue"); Mqd := Open (TP.Valid_MQ_Name (4), Read_Write); Expect_Exception ("A024: POSIX_Error"); Close (Mqd); exception when E1 : POSIX_Error => if Get_Error_Code /= No_Such_File_Or_Directory then Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A025"); end if; when E2 : others => Unexpected_Exception (E2, "A026"); end; ----------------------------------------------------------------------- -- The Open_Or_Create procedure works when attributes are -- passed as a parameter, and that attributes remain consistent after -- creation of message queue. declare Local_Attr : Attributes; begin Test ("Open_Or_Create w/ Attributes"); Set_Max_Messages (Attr, 10); Set_Message_Length (Attr, 10); Set_Options (Attr, POSIX_Message_Queues.Non_Blocking); Mqd := Open_Or_Create (TP.Valid_MQ_Name (4), Read_Write, Owner_Permission_Set, POSIX_IO.Open_Option_Set (POSIX_Message_Queues.Get_Options (Attr)), Attr, POSIX.RTS_Signals); Local_Attr := POSIX_Message_Queues.Get_Attributes (Mqd); Comment ("Message_Length set to " & Integer'Image (Get_Message_Length (Local_Attr))); Assert (Get_Max_Messages (Local_Attr) = 10, "A027: max messages"); Assert (Get_Message_Length (Local_Attr) = 10, "A028: message length"); Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (4)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A029"); when E2 : others => Unexpected_Exception (E2, "A030"); end; ----------------------------------------------------------------------- -- Message can be sent to a queue and then received from the -- queue. declare Last : Ada_Streams.Stream_Element_Offset; Prio : Message_Priority; Msg : Ada_Streams.Stream_Element_Array (1 .. 10); begin Test ("Send [15.1.5]"); Set_Max_Messages (Attr, 10); Set_Message_Length (Attr, 10); Set_Options (Attr, POSIX_Message_Queues.Non_Blocking); Mqd := Open_Or_Create (TP.Valid_MQ_Name (5), Read_Write, Owner_Permission_Set, Empty_Set, Attr); Send (Mqd, To_Stream_Element_Array ("Hello....."), 1); Receive (Mqd, Msg, Last, Prio); Assert (Prio = 1, "A031: incorrect priority"); Assert (Last = 10 and then Msg = To_Stream_Element_Array ("Hello....."), "A032: wrong message"); Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (5)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A033"); when E2 : others => Unexpected_Exception (E2, "A034"); end; ----------------------------------------------------------------------- -- A message can be received and that the Priority is set -- properly. declare Last : Ada_Streams.Stream_Element_Offset; Prio : Message_Priority; Msg : Ada_Streams.Stream_Element_Array (1 .. 5); begin Test ("Receive [15.1.6]"); Set_Options (Attr, POSIX_Message_Queues.Non_Blocking); Set_Message_Length (Attr, 5); Set_Max_Messages (Attr, 1); Mqd := Open_Or_Create (TP.Valid_MQ_Name (6), Read_Write, Owner_Permission_Set, Empty_Set, Attr); Send (Mqd, To_Stream_Element_Array ("Hello"), 1); Receive (Mqd, Msg, Last, Prio); Assert (Prio = 1, "A035: incorrect priority"); Assert (Last = 5 and then Msg = To_Stream_Element_Array ("Hello"), "A036: message data corrupted"); Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (6)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A037"); when E2 : others => Unexpected_Exception (E2, "A038"); end; ----------------------------------------------------------------------- -- The Request_Notify and Remove_Notify functions can be -- called. declare Event : Signal_Event; begin Test ("Request/Remove_Notify [15.1.8]"); Mqd := Open_Or_Create (TP.Valid_MQ_Name (6), Read_Write, Owner_Permission_Set, Empty_Set, Attr); Set_Notification (Event, No_Notification); Set_Signal (Event, Signal_Kill); Request_Notify (Mqd, Event); -- Not notify the process, -- should return no error messages if implemented Remove_Notify (Mqd); Close (Mqd); Unlink_Message_Queue (TP.Valid_MQ_Name (6)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Realtime_Signals_Option, Operation_Not_Implemented, E1, "A039"); when E2 : others => Unexpected_Exception (E2, "A040"); end; ----------------------------------------------------------------------- -- Communication is possible between two processes -- using Message_queues. declare Child_PID : Process_ID; Child_Status : Termination_Status; Template : Process_Template; Arg_List : POSIX_String_List; begin Test ("Two-process communication"); POSIX.Append (Arg_List, Child_Filename); Open_Template (Template); Start_Process (Child_PID, Child_Pathname, Template, Arg_List); Comment ("Message Receiver process started."); Set_Options (Attr, POSIX_Message_Queues.Non_Blocking); Set_Message_Length (Attr, 10); Set_Max_Messages (Attr, 1); Mqd := Open_Or_Create (TP.Valid_MQ_Name (7), Read_Write, Owner_Permission_Set, Empty_Set, Attr); Send (Mqd, To_Stream_Element_Array ("Hello....."), 1); Wait_For_Child_Process (Child_Status, Child_PID); Check_Child_Status (Child_Status, Child_PID, Normal_Exit, "A041"); Unlink_Message_Queue (TP.Valid_MQ_Name (7)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A042"); when E2 : others => Unexpected_Exception (E2, "A043"); end; ------------------------------------------------------------------------ -- The Bad_File_Descriptor error code is given when -- attempting to access a node with improper permissions. begin Test ("Bad_File_Descriptor Error"); Mqd := Open_Or_Create (TP.Valid_MQ_Name (8), POSIX_IO.Read_Only, Owner_Permission_Set); Send (Mqd, To_Stream_Element_Array ("Hello....."), 1); Unlink_Message_Queue (TP.Valid_MQ_Name (8)); Expect_Exception ("A044: POSIX_Error, Bad_File_Descriptor"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, Bad_File_Descriptor, E1, "A045"); when E2 : others => Unexpected_Exception (E2, "A046"); end; ------------------------------------------------------------------------ -- The File_Exists error code is given when attempting to -- Open_Or_Create a message queue with the Exclusive option, -- if there already exists a message queue with the same name. -- Retest for each of the two overloaded versions. begin Test ("File_Exists Error"); Set_Max_Messages (Attr, 1); Set_Message_Length (Attr, 10); Mqd := Open_Or_Create (TP.Valid_MQ_Name (9), POSIX_IO.Read_Only, Owner_Permission_Set, POSIX_IO.Empty_Set, Attr); Mqd := Open_Or_Create (TP.Valid_MQ_Name (9), POSIX_IO.Read_Only, Owner_Permission_Set, POSIX_IO.Exclusive); Expect_Exception ("A047: POSIX_ERROR, File_Exists"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, File_Exists, E1, "A048"); when E2 : others => Unexpected_Exception (E2, "A049"); end; begin Test ("File_Exists Error, second version"); Mqd := Open_Or_Create (TP.Valid_MQ_Name (9), POSIX_IO.Read_Only, Owner_Permission_Set, POSIX_IO.Exclusive, Attr); Expect_Exception ("A050: POSIX_ERROR, File_Exists"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, File_Exists, E1, "A051"); when E2 : others => Unexpected_Exception (E2, "A052"); end; ------------------------------------------------------------------------ -- The Bad_File_Descriptor error code is given when -- attempting to close an invalid message queue. declare QD : Message_Queue_Descriptor; begin Test ("Bad File Descriptor Error"); QD := POSIX_Message_Queues.Open (TP.Valid_MQ_Name (9), POSIX_IO.Read_Only, Empty_Set); Close (QD); POSIX_Message_Queues.Close (QD); Expect_Exception ("A053: POSIX_ERROR, Bad_File_Descriptor"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, Bad_File_Descriptor, E1, "A054"); when E2 : others => Unexpected_Exception (E2, "A055"); end; ------------------------------------------------------------------------ -- The No_Such_File_Or_Directory error code is given when -- attempting to unlink a nonexistent message queue. begin Test ("No_Such_File_Or_Directory Error"); Unlink_Message_Queue (TP.Valid_MQ_Name (10)); Expect_Exception ("A056: POSIX_Error, No_Such_File_Or_Directory"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, No_Such_File_Or_Directory, E1, "A057"); when E2 : others => Unexpected_Exception (E2, "A058"); end; ------------------------------------------------------------------------ -- The Bad_File_Descriptor error code is given when -- attempting to send to an invalid message queue. declare Uninitialized_QD : Message_Queue_Descriptor; pragma Warnings (Off, Uninitialized_QD); begin Test ("Send to Invalid Message Queue"); Send (Uninitialized_QD, To_Stream_Element_Array ("Hello....."), 0); Expect_Exception ("A059: POSIX_ERROR, Bad_File_Descriptor"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, Bad_File_Descriptor, E1, "A060"); when E2 : others => Unexpected_Exception (E2, "A061"); end; ------------------------------------------------------------------------ -- The Invalid_Argument error code is given when -- attempting to send a message with a priority that is too high. declare Mqd : Message_Queue_Descriptor; begin Test ("Invalid_Argument Error"); Mqd := Open_Or_Create (TP.Valid_MQ_Name (9), Write_Only, Owner_Permission_Set, Empty_Set, Attr); Send (Mqd, To_Stream_Element_Array ("Hello....."), POSIX_Configurable_System_Limits.Message_Priority_Maximum + 1); Expect_Exception ("A062: POSIX_ERROR, Invalid_Argument"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, Invalid_Argument, E1, "A063"); when Constraint_Error => Assert (POSIX_Configurable_System_Limits.Message_Priority_Maximum <= POSIX_Limits.Message_Priority_Maxima'Last, "A064"); when E2 : others => Unexpected_Exception (E2, "A065"); end; ------------------------------------------------------------------------ -- The Message_Too_Long error code is given when attempting -- to send a message that is longer than the maximum length. begin Test ("Message_Too_Long Error"); Set_Options (Attr, POSIX_Message_Queues.Non_Blocking); Set_Max_Messages (Attr, 10); Set_Message_Length (Attr, 1); Mqd := Open_Or_Create (TP.Valid_MQ_Name (10), Write_Only, Owner_Permission_Set, POSIX_IO.Non_Blocking, Attr); Comment ("Sending excessively long message"); Send (Mqd, To_Stream_Element_Array ("Hello....."), 1); Expect_Exception ("A066: POSIX_ERROR, Message_Too_Long"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, Message_Too_Long, E1, "A067"); when E2 : others => Unexpected_Exception (E2, "A068"); end; ------------------------------------------------------------------------ -- The Bad_File_Descriptor error code is given when -- attempting to receive from an invalid message queue. declare QD : Message_Queue_Descriptor; AR : Stream_Element_Array (1 .. 10); Last : Ada_Streams.Stream_Element_Offset; Prio : Integer; begin Test ("Receive Invalid Message Queue"); Mqd := Open (TP.Valid_MQ_Name (10), Write_Only); Close (QD); Receive (QD, AR, Last, Prio); Expect_Exception ("A069: POSIX_ERROR, Bad_File_Descriptor"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, Bad_File_Descriptor, E1, "A070"); when E2 : others => Unexpected_Exception (E2, "A071"); end; ------------------------------------------------------------------------ -- The Message_Too_Long error code is given when attempting -- to receive a message into an array that is shorter than the -- Message Length attribute of the message queue. declare AR : Stream_Element_Array (1 .. 2); Last : Ada_Streams.Stream_Element_Offset; Prio : Integer; begin Test ("Receive to Short Array"); Set_Message_Length (Attr, 10); Mqd := Open_Or_Create (TP.Valid_MQ_Name (11), Read_Write, Owner_Permission_Set, Empty_Set, Attr); Send (Mqd, To_Stream_Element_Array ("Hello....."), 1); Receive (Mqd, AR, Last, Prio); Expect_Exception ("A072: POSIX_Error, Message_Too_Long"); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, Message_Too_Long, E1, "A073"); when E2 : others => Unexpected_Exception (E2, "A074"); end; ------------------------------------------------------------------------ -- The Generic_Message_Passing package can be used. declare package Int_Queues is new Generic_Message_Queues (Integer); GQD : Message_Queue_Descriptor; Local_Attr : Attributes; SI : Integer; RI : Integer; Prio : Integer; begin Test ("Generic Message Queues [15.1.7]"); SI := 2; Prio := 1; Set_Max_Messages (Local_Attr, 10); Set_Message_Length (Local_Attr, 4); GQD := Open_Or_Create (TP.Valid_MQ_Name (12), Read_Write, Owner_Permission_Set, Empty_Set, Local_Attr); Local_Attr := Get_Attributes (GQD); Comment ("Max Messages = " & Integer'Image (Get_Max_Messages (Local_Attr))); Comment ("Message Length = " & Integer'Image (Get_Message_Length (Local_Attr))); Int_Queues.Send (GQD, SI, 1); Comment ("Message sent"); Int_Queues.Receive (GQD, RI, Prio); Comment ("Message received"); Assert (RI = SI, "A075: integer corrupted during transmission"); Unlink_Message_Queue (TP.Valid_MQ_Name (12)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A076"); when E2 : others => Unexpected_Exception (E2, "A077"); end; ------------------------------------------------------------------------ -- Loop over the array of MQ names used, and unlink them all. for I in 1 .. 12 loop begin Unlink_Message_Queue (TP.Valid_MQ_Name (I)); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, No_Such_File_Or_Directory, E1, "A078"); when E2 : others => Unexpected_Exception (E2, "A079"); end; end loop; ------------------------------------------------------------------------ Done; exception when E : others => Fatal_Exception (E, "A080"); end p150100; libflorist-2025.1.0/tests/p150100.ads000066400000000000000000000061761473553204100166710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 5 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p150100; libflorist-2025.1.0/tests/p150100b.adb000066400000000000000000000101431473553204100167770ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 5 0 1 0 0 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test for POSIX_Message_Queues package, supplentary main program -- for child process. with Ada_Streams, POSIX, POSIX_IO, POSIX_Message_Queues, POSIX_Process_Primitives, POSIX_Report, Test_Parameters; procedure p150100b is use Ada_Streams, POSIX, POSIX_IO, POSIX_Message_Queues, POSIX_Process_Primitives, POSIX_Report; package TP renames Test_Parameters; Mqd : Message_Queue_Descriptor; Msg : Stream_Element_Array (1 .. 10); Last : Stream_Element_Offset; Prio : Message_Priority; begin Mqd := Open (TP.Valid_MQ_Name (7), Read_Only); Receive (Mqd, Msg, Last, Prio); Assert (Last = 10, "A001"); Assert (Msg = To_Stream_Element_Array ("Hello....."), "A002: Child"); Close (Mqd); Exit_Process (Normal_Exit); exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A003: Child"); when E2 : others => Unexpected_Exception (E2, "A004: Child"); end p150100b; libflorist-2025.1.0/tests/p150100b.ads000066400000000000000000000061771473553204100170340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 5 0 1 0 0 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p150100b; libflorist-2025.1.0/tests/p150101.adb000066400000000000000000000441461473553204100166500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 5 0 1 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Test package POSIX_Message_Queues -- in IEEE Std 1003.5b Section 15.1. -- This is a test of Message Queues based on a possible -- application usage model. It does not try to exercise the whole -- package. It just checks that Message Queues can be used to -- communicate between tasks. -- The basic concept of the test is to simulate a bank, -- via a set of "customer" tasks (i.e., clients) and a -- smaller set of "teller" tasks (i.e., servers). -- Each customer requires one service. -- (The customers and tellers are collectively termed the "players".) -- Message Queues are used to enforce an orderly service discipline, -- so that each teller serves one customer at a time. with Ada_Streams, POSIX, POSIX_IO, POSIX_Limits, POSIX_Message_Queues, POSIX_Permissions, POSIX_Report, System, Test_Parameters, Unchecked_Conversion; procedure p150101 is use Ada_Streams, POSIX, POSIX_IO, POSIX_Message_Queues, POSIX_Permissions, POSIX_Report; package TP renames Test_Parameters; Attr : Attributes; Prio : Message_Priority; Last : Stream_Element_Offset; Buffer : Stream_Element_Array (1 .. 8); Num_Customers : constant := 100; Num_Tellers : constant := 5; Null_Player : constant := 0; Num_Players : constant := Num_Customers + Num_Tellers + 3; type Player_ID is range Null_Player .. Num_Players; Main_Program : constant Player_ID := 1; subtype Teller_ID is Player_ID range Main_Program + 1 .. Num_Tellers; subtype Customer_ID is Player_ID range Teller_ID'Last + 1 .. Player_ID'Last; task type Customer is entry Start (ID : Customer_ID); end Customer; task type Teller is entry Start (ID : Teller_ID); end Teller; Tellers : array (Teller_ID) of Teller; Customers : array (Customer_ID) of Customer; Customer_Count : Integer := 0; -- In case we can't open enough queues for all the -- players, we scale back to Last_Queue. Last_Queue : Integer := 0; Last_Player : Player_ID := 0; Teller_Queue : Message_Queue_Descriptor; Exit_Queue : Message_Queue_Descriptor; Player_Waits : array (Teller_ID'First .. Customer_ID'Last) of Message_Queue_Descriptor; ----------------------------------- -- Player_ID_Message_Conversions -- ----------------------------------- package Player_ID_MSG_Conversions is Player_ID_Length : constant Stream_Element_Offset; function To_Player_ID (Buffer : in Stream_Element_Array) return Player_ID; function To_Stream_Element_Array (ID : in Player_ID) return Stream_Element_Array; procedure Put_Player_ID (Buffer : out Stream_Element_Array; ID : in Player_ID); private Truncation : constant Boolean := (Player_ID'Size / Stream_Element'Size) * Stream_Element'Size /= Player_ID'Size; Player_ID_Length : constant Stream_Element_Offset := Player_ID'Size / Stream_Element'Size + Boolean'Pos (Truncation); end Player_ID_MSG_Conversions; package body Player_ID_MSG_Conversions is type PID_Ptr is access Player_ID; function To_PID_Ptr is new Unchecked_Conversion (System.Address, PID_Ptr); function To_Player_ID (Buffer : in Stream_Element_Array) return Player_ID is begin Assert (Buffer'Length = Player_ID_Length, "A001: Buffer'Length =" & Stream_Element_Offset'Image (Buffer'Length)); return To_PID_Ptr (Buffer (Buffer'First)'Address).all; end To_Player_ID; procedure Put_Player_ID (Buffer : out Stream_Element_Array; ID : in Player_ID) is begin Assert (Buffer'Length = Player_ID_Length, "A002"); To_PID_Ptr (Buffer (Buffer'First)'Address).all := ID; end Put_Player_ID; function To_Stream_Element_Array (ID : in Player_ID) return Stream_Element_Array is Buffer : Stream_Element_Array (1 .. Player_ID_Length); begin To_PID_Ptr (Buffer (Buffer'First)'Address).all := ID; return Buffer; end To_Stream_Element_Array; end Player_ID_MSG_Conversions; use Player_ID_MSG_Conversions; type Teller_Player_Array is array (Teller_ID) of Player_ID; ------- -- P -- ------- -- Checks for duplicate messages. protected P is procedure Serve (CID : Customer_ID; TID : Teller_ID); procedure End_Serve (CID : Customer_ID; TID : Teller_ID); procedure Claim (CID : Customer_ID; TID : Teller_ID); private Serving : Teller_Player_Array := (others => Null_Player); end P; protected body P is procedure Serve (CID : Customer_ID; TID : Teller_ID) is begin Assert (Serving (TID) = CID, "A003: wrong customer" & Player_ID'Image (CID) & ":" & Player_ID'Image (Serving (TID))); end Serve; procedure End_Serve (CID : Customer_ID; TID : Teller_ID) is begin Assert (Serving (TID) = CID, "A004: wrong customer" & Player_ID'Image (CID) & ":" & Player_ID'Image (Serving (TID))); Serving (TID) := Null_Player; end End_Serve; procedure Claim (CID : Customer_ID; TID : Teller_ID) is begin Assert (Serving (TID) = Null_Player, "A005: double claim"); Serving (TID) := CID; end Claim; end P; ----------- -- Cmmnt -- ----------- procedure Cmmnt (ID : Player_ID; Message : String); procedure Cmmnt (ID : Player_ID; Message : String) is begin if ID in Teller_ID then Comment ("Teller" & Player_ID'Image (ID) & " " & Message); else Comment ("Customer" & Player_ID'Image (ID) & " " & Message); end if; end Cmmnt; -------------- -- Shutdown -- -------------- -- Shut down all the Customer and Teller tasks. procedure Shutdown (Self : Player_ID); procedure Shutdown (Self : Player_ID) is begin for I in Customer_ID loop if Self /= I then abort Customers (I); end if; end loop; for I in Teller_ID loop if Self /= I then abort Tellers (I); end if; end loop; if Self in Teller_ID then abort Tellers (Self); elsif Self in Customer_ID then abort Customers (Self); end if; end Shutdown; ------------ -- Customer -- ------------ task body Customer is Self : Customer_ID; My_Teller : Teller_ID; Prio : Message_Priority; Last : Stream_Element_Offset; Buffer : Stream_Element_Array (1 .. 8); My_Wait_Queue : Message_Queue_Descriptor; begin -- Customer waits to be assigned an ID accept Start (ID : Customer_ID) do Self := ID; end Start; My_Wait_Queue := Player_Waits (Self); Cmmnt (Self, "waits for available teller"); Receive (Teller_Queue, Buffer, Last, Prio); My_Teller := To_Player_ID (Buffer (1 .. Last)); Cmmnt (Self, "wakes up Teller" & Player_ID'Image (My_Teller)); P.Claim (Self, My_Teller); Send (Player_Waits (My_Teller), To_Stream_Element_Array (Self), 1); Cmmnt (Self, "waits for teller to perform service"); Receive (My_Wait_Queue, Buffer, Last, Prio); Cmmnt (Self, "leaves the bank"); Send (Exit_Queue, To_Stream_Element_Array (Self), 1); exception when E : others => Unexpected_Exception (E, "A006: in Customer" & Player_ID'Image (Self)); Shutdown (Self); end Customer; ------------ -- Teller -- ------------ task body Teller is Self : Teller_ID; My_Customer : Player_ID; Prio : Message_Priority; Last : Stream_Element_Offset; Buffer : Stream_Element_Array (1 .. 8); My_Wait_Queue : Message_Queue_Descriptor; begin -- Teller waits to be assigned an ID accept Start (ID : Teller_ID) do Self := ID; end Start; My_Wait_Queue := Player_Waits (Self); loop Cmmnt (Self, "opens for business"); Send (Teller_Queue, To_Stream_Element_Array (Self), 1); Cmmnt (Self, "waits for a customer to show up"); Receive (My_Wait_Queue, Buffer, Last, Prio); My_Customer := To_Player_ID (Buffer (1 .. Last)); Cmmnt (Self, "Last=" & Stream_Element_Offset'Image (Last)); Cmmnt (Self, "My_Customer=" & Player_ID'Image (My_Customer)); exit when My_Customer = Null_Player; P.Serve (My_Customer, Self); Cmmnt (Self, "delays, serving Customer" & Player_ID'Image (My_Customer)); delay Duration (Self) * Duration'(0.001); P.End_Serve (My_Customer, Self); Cmmnt (Self, "wakes up the customer"); Send (Player_Waits (My_Customer), To_Stream_Element_Array ("Go Ahead"), 1); end loop; exception when E : others => Unexpected_Exception (E, "A007: in Teller" & Player_ID'Image (Self)); Shutdown (Self); end Teller; -------------- -- Watchdog -- -------------- task Watchdog; task body Watchdog is begin delay 15.0; Fatal ("A008: watchdog timeout"); end Watchdog; begin Header ("p150101"); ----------------------------------------------------------------------- Test ("Use Message Queues to synchronize Ada tasks."); declare EC : Error_Code; begin Comment ("Initialize message queues"); Set_Message_Length (Attr, 8); Set_Max_Messages (Attr, 200); Comment ("Opening teller queue (1)"); Last_Queue := Last_Queue + 1; Teller_Queue := Open_Or_Create (TP.Valid_MQ_Name (Last_Queue), Read_Write, Owner_Permission_Set, POSIX_IO.Empty_Set, Attr, POSIX.RTS_Signals); Comment ("Opening exit queue (2)"); Last_Queue := Last_Queue + 1; Exit_Queue := Open_Or_Create (TP.Valid_MQ_Name (Last_Queue), Read_Write, Owner_Permission_Set, POSIX_IO.Empty_Set, Attr, POSIX.RTS_Signals); Last_Player := Tellers'First - 1; begin while Last_Player < Customer_ID'Last loop Last_Player := Last_Player + 1; Last_Queue := Last_Queue + 1; Comment ("Opening queue" & Integer'Image (Last_Queue)); Player_Waits (Last_Player) := Open_Or_Create (TP.Valid_MQ_Name (Last_Queue), Read_Write, Owner_Permission_Set, POSIX_IO.Empty_Set, Attr, POSIX.RTS_Signals); end loop; exception when POSIX_Error => EC := Get_Error_Code; if EC = Too_Many_Open_Files_In_System or EC = Too_Many_Open_Files or EC = No_Space_Left_On_Device then Comment ("Failed to create queue"); Assert (Integer (Last_Queue) > POSIX_Limits.Portable_Open_Message_Queues_Maximum, "A009"); else raise; end if; Last_Player := Last_Player - 1; Last_Queue := Last_Queue - 1; end; exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A010"); when E2 : others => Shutdown (Main_Program); Fatal_Exception (E2, "A011: Queue creation"); end; Comment ("Last_Queue = " & Integer'Image (Last_Queue)); ----------------------------------------------------------------------- begin Comment ("Start all players"); for I in Teller_ID'Range loop Tellers (I).Start (I); end loop; for I in Customer_ID'First .. Last_Player loop Customers (I).Start (I); Customer_Count := Customer_Count + 1; Comment ("Customer arrived. Customer count =" & Integer'Image (Customer_Count)); end loop; if Last_Player < Customer_ID'Last then Comment ("Send away" & Player_ID'Image (Customer_ID'Last - Last_Player) & " extra customers"); for I in Last_Player + 1 .. Customer_ID'Last loop Comment ("aborting customer " & Customer_ID'Image (I)); abort Customers (I); Customer_Count := Customer_Count - 1; Comment ("Customer gave up. Customer count =" & Integer'Image (Customer_Count)); end loop; end if; exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A012"); when E2 : others => Shutdown (Main_Program); Fatal_Exception (E2, "A013 : Startup"); end; ----------------------------------------------------------------------- begin Comment ("Wait for all customers to finish"); for I in Customer_ID'First .. Last_Player loop Receive (Exit_Queue, Buffer, Last, Prio); Assert (Last = Player_ID_Length, "A014"); Customer_Count := Customer_Count - 1; Comment ("Customer" & Player_ID'Image (To_Player_ID (Buffer (1 .. Player_ID_Length))) & " left. Customers count =" & Integer'Image (Customer_Count)); end loop; exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A015"); when E2 : others => Shutdown (Main_Program); Fatal_Exception (E2, "A016: Waiting for finish"); end; ----------------------------------------------------------------------- begin Comment ("Wake up tellers to exit"); for I in Tellers'Range loop Send (Player_Waits (I), To_Stream_Element_Array (Null_Player), 1); end loop; exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A017"); when E2 : others => Shutdown (Main_Program); Fatal_Exception (E2, "A018: Waking up tellers to exit"); end; ----------------------------------------------------------------------- begin Comment ("Wait for all players to terminate"); for I in Tellers'Range loop while not Tellers (I)'Terminated loop delay 0.01; end loop; end loop; for I in Customers'Range loop while not Customers (I)'Terminated loop delay 0.01; end loop; end loop; exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A019"); when E2 : others => Shutdown (Main_Program); Fatal_Exception (E2, "A020: Waking up tellers to exit"); end; ----------------------------------------------------------------------- begin Comment ("Unlink message queues"); for I in 1 .. Last_Queue loop Comment ("Unlinking queue" & Integer'Image (I)); Unlink_Message_Queue (TP.Valid_MQ_Name (I)); end loop; exception when E1 : POSIX_Error => Optional (Message_Queues_Option, Operation_Not_Implemented, E1, "A021"); when E2 : others => Shutdown (Main_Program); Fatal_Exception (E2, "A022: Unlinking message queues"); end; ----------------------------------------------------------------------- abort Watchdog; Done; exception when E : others => Shutdown (Main_Program); Fatal_Exception (E, "A023"); end p150101; libflorist-2025.1.0/tests/p150101.ads000066400000000000000000000061751473553204100166710ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 5 0 1 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p150101; libflorist-2025.1.0/tests/p990000.adb000066400000000000000000000111141473553204100166470ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with P9900doc, POSIX_Report; package body P990000 is use POSIX_Report; function Period (Job : Jobs) return Duration is begin return Duration (1.0 / Float (Rate (Job))); end Period; -- The following array is used to "confuse" the compiler, so that -- is unlikely to optimize away calls to Do_Unit_Work. A : array (0 .. 1) of aliased Integer := (0, 1); procedure Do_Unit_Work (Dummy : Integer) is -- some code that cannot safely be "optimized" away, -- whose Computation time is to be used as a measurement of time I : Integer := Integer (Dummy mod 2); T : Integer := A (I); J : Integer := (I + 1) mod 2; begin A (I) := A (J); A (J) := T; if A (1) > 1 then Fatal ("should never happen"); -- A's values are always either 0 or 1; they are just shuffled -- to confuse potentially trivializing optimizations of -- time-delay loops. end if; exception when E : others => Fatal_Exception (E, "A001: P990000a"); end Do_Unit_Work; procedure Do_Input (Load : Natural) is begin for L in 1 .. Load loop Do_Unit_Work (L); end loop; end Do_Input; procedure Do_Computation (Load : Natural) is begin for L in 1 .. Load loop Do_Unit_Work (L); end loop; end Do_Computation; procedure Do_Output (Load : Natural) is begin for L in 1 .. Load loop Do_Unit_Work (L); end loop; end Do_Output; end P990000; libflorist-2025.1.0/tests/p990000.ads000066400000000000000000000135341473553204100167000ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package contains declarations of types, constants, -- and subprograms that are common to the P9900** series of -- tests. -- See file P9900doc.ads for more detailed explanation. with Calendar, Ada.Real_Time, POSIX, POSIX_Calendar, P9900doc, System; package P990000 is subtype Jobs is Integer range 0 .. 5; type Job_Duration_Array is array (Jobs) of Duration; type Job_Integer_Array is array (Jobs) of Integer; type Shared_Data_Area is record Missed_Deadlines : aliased Boolean; Input_Load, Computation_Load, Output_Load : aliased Job_Integer_Array; Start_Calendar_Time : aliased Calendar.Time; Start_POSIX_Time : aliased POSIX_Calendar.POSIX_Time; Start_Timespec : aliased POSIX.Timespec; Start_Real_Time : aliased Ada.Real_Time.Time; Check : aliased Integer; end record; pragma Volatile (Shared_Data_Area); type Shared_Data_Ptr is access all Shared_Data_Area; type Job_Procedure_Ptr is access procedure (Job : Jobs); Main_Priority : constant System.Priority := System.Priority'Last; Priority : constant array (Jobs) of System.Priority := (System.Priority'Last - 1, System.Priority'Last - 2, System.Priority'Last - 3, System.Priority'Last - 4, System.Priority'Last - 5, System.Priority'Last - 6); Rate : constant array (Jobs) of Natural := (32, 16, 8, 4, 2, 1); function Period (Job : Jobs) return Duration; -- returns 1.0 / Rate (Job) Computation_Time : constant array (Jobs) of Float := (0.004, 0.005, 0.002, 0.005, 0.001, 0.006); Input_Time : constant array (Jobs) of Float := (others => 0.00000016); Output_Time : constant array (Jobs) of Float := (others => 0.00000016); -- The following constants determine how long we run some of -- the iterative approximations. Seconds_To_Run : constant Integer := 10; -- number of seconds to run each simulation -- during bisection Real_Accuracy : constant := 100.0; -- Real_Accuracy specifies the number of decimal digits to -- which we measure the execution time of procedure that does one unit -- of simulated work. Accuracy : constant := 100; -- Accuracy specifies the relative accuracy to which we determine the -- breakdown utilization, i.e., we quit when -- Hi - Lo <= (Load_Factor + Accuracy) / Accuracy procedure Do_Unit_Work (Dummy : Integer); -- One execution of Do_Unit_Work is the unit of simulated work load, -- corresponding to one use of the parameter Load -- in the procedures below. procedure Do_Input (Load : Natural); procedure Do_Computation (Load : Natural); procedure Do_Output (Load : Natural); end P990000; libflorist-2025.1.0/tests/p990000b.adb000066400000000000000000000414151473553204100170200ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 0 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with p990000b, POSIX, POSIX_IO, POSIX_Configurable_System_Limits, POSIX_Report, POSIX_Permissions, POSIX_Process_Environment, POSIX_Semaphores, Test_Parameters; ............ with POSIX_IO, POSIX_Files, POSIX_Memory_Mapping, POSIX_Page_Alignment, POSIX_Permissions, System, Unchecked_Conversion, POSIX_Report; package body p990000b is use p990000b, POSIX, POSIX_IO, POSIX_Configurable_System_Limits, POSIX_Report, POSIX_Permissions, POSIX_Process_Environment, POSIX_Semaphores, Test_Parameters; ............ use POSIX_IO, POSIX_Files, POSIX_Memory_Mapping, POSIX_Page_Alignment, POSIX_Permissions, System, POSIX_Report; procedure Do_Unit_Work (Dummy : Integer); procedure Compute_Loads (Load_Factor : Positive); function Address_For_Data_Area return System.Address; type Shared_Data_Area is record Period : aliased Job_Duration_Array; Missed_Deadlines : aliased Boolean; Computation_Load, Input_Load, Output_Load : aliased Job_Integer_Array; Start_Time, Stop_Time : aliased Time; Next_Request_Time : aliased Job_Time_Array; end record; FD : File_Descriptor; function Address_For_Data_Area return System.Address is begin -- Open or create file to hold shared data. begin FD := Open_Or_Create (Name => Shared_Data_Filename, Mode => Read_Write, Permissions => Owner_Permission_Set, Options => Exclusive); -- We are the first to create the file. exception when POSIX_Error => if Get_Error_Code = File_Exists then -- The file already exists. FD := Open (Name => Shared_Data_Filename, Mode => Read_Write); end if; end; -- Map the file into shared memory. return Map_Memory (Length => Length (Shared_Data_Area'Size), Protection => Allow_Read + Allow_Write, Mapping => Map_Shared, File => FD, Offset => 0); end Address_For_Data_Area; Data_Address : constant System.Address := Address_For_Data_Area; Data : Shared_Data_Area; for Data'Address use Data_Address; Rate : constant array (Jobs) of Integer := (16, 8, 6, 4, 2, 1); Computation_Time : constant array (Jobs) of Float := (0.004, 0.005, 0.000025, 0.0278, 0.000025, 0.018); Input_Time : constant array (Jobs) of Float := (others => 0.00000016); Output_Time : constant array (Jobs) of Float := (others => 0.00000016); -- The following constants determine how long we run some of -- the iterative approximations. Real_Accuracy : constant := 100.0; Accuracy : constant := 100; procedure Compute_Loads (Load_Factor : Positive) is begin for J in Jobs loop Input_Load (J) := Integer (Float (Load_Factor) * Input_Time (J)); Output_Load (J) := Integer (Float (Load_Factor) * Output_Time (J)); Computation_Load (J) := Integer (Float (Load_Factor) * Computation_Time (J)); end loop; exception when E : others => Fatal_Exception (E, "A001: p990000a"); end Compute_Loads; -- The following array is used to "confuse" the compiler, so that -- is unlikely to optimize away calls to Do_Unit_Work. A : array (0 .. 1) of aliased Integer := (0, 1); procedure Do_Unit_Work (Dummy : Integer) is -- some code that cannot safely be "optimized" away, -- whose Computation time is to be used as a measurement of time I : Integer := Integer (Dummy mod 2); T : Integer := A (I); J : Integer := (I + 1) mod 2; begin A (I) := A (J); A (J) := T; exception when E : others => Fatal_Exception (E, "A002: p990000a"); end Do_Unit_Work; -- generic -- with procedure Run_Jobs; procedure Find_Utilization_Limit is T1, T2 : Time; Clock_Resolution_Bound, D, Base : Duration; K, Hi, Lo, Load_Factor : Integer; Total_Utilization, Unit_Work_Execution_Time : Float; begin -- Compute job periods and estimate total utilization. Total_Utilization := 0.0; for J in Jobs loop Period (J) := Duration (1.0 / Float (Rate (J))); Total_Utilization := Total_Utilization + (Input_Time (J) + Computation_Time (J) + Output_Time (J)) * Float (Rate (J)); end loop; -- Estimate resolution of Calendar.Clock. Clock_Resolution_Bound := 100.0; for I in 1 .. 1000 loop T1 := Clock; loop T2 := Clock; D := T2 - T1; exit when D > 0.0; T1 := T2; end loop; if D < Clock_Resolution_Bound then Clock_Resolution_Bound := D; end if; end loop; Comment ("using clock resolution bound of" & Integer'Image (Integer (D * 1_000_000)) & "us"); -- Use Calendar.Clock to measure execution time of -- procedure Do_Unit_Work, to a number of decimal -- digits specified by the constant Real_Accuracy. -- Use dual-loop benchmark method. K := 10000; loop T1 := Clock; for J in 1 .. K loop Do_Unit_Work (J); end loop; T2 := Clock; Base := T2 - T1; exit when Base > Real_Accuracy * Clock_Resolution_Bound; K := K * 10; end loop; T1 := Clock; for J in 1 .. K loop Do_Unit_Work (J); Do_Unit_Work (J); end loop; T2 := Clock; D := (T2 - T1) - Base; Unit_Work_Execution_Time := Float (D) / Float (K); Comment ("unit_work computation time", To_Timespec (Duration (Unit_Work_Execution_Time))); -- Initialize lower and upper bounds on achievable -- load factor, before bisection. -- Upper bound (Hi) must be high enough to cause failure. Lo := 1; Comment ("finding a breakdown load factor"); Hi := 1; loop Compute_Loads (Hi); Missed_Deadlines.all := False; Run_Jobs; if Missed_Deadlines.all then Comment ("overloaded at " & Integer'Image (Hi)); exit; else Lo := Hi; Comment ("underloaded at " & Integer'Image (Hi)); Hi := Hi * 16; end if; end loop; -- Zero in on maximum workable load factor, by bisection. Comment ("using bisection to find limiting load factor"); loop Load_Factor := (Lo + Hi) / 2; -- Lo <= Load_Factor < Hi Compute_Loads (Load_Factor); Missed_Deadlines.all := False; Run_Jobs; if Missed_Deadlines.all then Hi := Load_Factor; Comment ("overloaded at " & Integer'Image (Load_Factor)); else Lo := Load_Factor; Comment ("underloaded at " & Integer'Image (Load_Factor)); end if; exit when Hi - Lo <= (Load_Factor + Accuracy) / Accuracy; end loop; Comment ("limiting load factor =" & Integer'Image (Load_Factor)); -- Compute actual effective utilization. Total_Utilization := 0.0; for J in Jobs loop Total_Utilization := Total_Utilization + Float ((Input_Load (J) + Output_Load (J) + Computation_Load (J)) * Rate (J)) * Unit_Work_Execution_Time; end loop; Comment ("apparent limit utilization =" & Integer'Image (Integer (Total_Utilization * 100.0)) & "%"); if A (1) > 1 then Fatal ("should never happen"); -- A's values are always either 0 or 1; they are just shuffled -- to confuse potentially trivializing optimizations of -- time-delay loops. end if; exception when E : others => Fatal_Exception (E, "A003: p990000a"); end Find_Utilization_Limit; procedure Do_Input (Job : Jobs) is begin for L in 1 .. Input_Load (Job) loop Do_Unit_Work (L); end loop; exception when E : others => Fatal_Exception (E, "A004: p990000a"); end Do_Input; procedure Do_Output (Job : Jobs) is begin for L in 1 .. Output_Load (Job) loop Do_Unit_Work (L); end loop; exception when E : others => Fatal_Exception (E, "A005: p990000a"); end Do_Output; procedure Do_Computation (Job : Jobs) is begin for L in 1 .. Computation_Load (Job) loop Do_Unit_Work (L); end loop; exception when E : others => Fatal_Exception (E, "A006: p990000a"); end Do_Computation; package body IO is Mutex : Semaphore_Descriptor; procedure Initialize is begin Optional (Semaphores_Option, "A001: p99001c"); begin Comment ("IO.Initialize: Creating semaphore (1) " & To_String (Valid_Semaphore_Name (1))); Mutex := Open_Or_Create (Name => Valid_Semaphore_Name (1), Permissions => Owner_Permission_Set, Value => 1, -- open Options => POSIX_IO.Empty_Set); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A002: p99001c"); when E2 : others => Unexpected_Exception (E2, "A003: p99001c"); end; exception when E : others => Fatal_Exception (E, "A004: p9900001c"); end Initialize; procedure Input (Self : Jobs) is begin Comment ("IO.Input"); Wait (Sem => Mutex, Masked_Signals => RTS_Signals); Do_Input (Self); Post (Sem => Mutex); exception when E : others => Fatal_Exception (E, "A005: p9900001c"); end Input; procedure Output (Self : Jobs) is begin Comment ("IO.Output"); Wait (Sem => Mutex, Masked_Signals => RTS_Signals); Do_Output (Self); Post (Sem => Mutex); exception when E : others => Fatal_Exception (E, "A006: p9900001c"); end Output; end IO; package body Sync is Waiting_To_Start : Semaphore_Descriptor; Waiting_For_Completion : Semaphore_Descriptor; Mutex : Semaphore_Descriptor; Done_Count : Integer := 0; procedure Initialize is begin Optional (Semaphores_Option, "A007: p99001c"); begin Comment ("Sync.Initialize: Creating semaphore (2) " & To_String (Valid_Semaphore_Name (2))); Waiting_To_Start := Open_Or_Create (Name => Valid_Semaphore_Name (2), Permissions => Owner_Permission_Set, Value => 0, -- closed Options => POSIX_IO.Empty_Set); Comment ("Sync.Initialize: Creating semaphore (3) " & To_String (Valid_Semaphore_Name (3))); Mutex := Open_Or_Create (Name => Valid_Semaphore_Name (3), Permissions => Owner_Permission_Set, Value => 0, Options => POSIX_IO.Empty_Set); Comment ("Sync.Initialize: Creating semaphore (4) " & To_String (Valid_Semaphore_Name (4))); Waiting_For_Completion := Open_Or_Create (Name => Valid_Semaphore_Name (4), Permissions => Owner_Permission_Set, Value => 0, Options => POSIX_IO.Empty_Set); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A008: p99001c"); when E2 : others => Unexpected_Exception (E2, "A009: p99001c"); end; exception when E : others => Fatal_Exception (E, "A010: p9900001c"); end Initialize; procedure Start_All_Jobs is -- called by the main program to start all jobs begin Comment ("Starting jobs"); for J in Jobs loop Post (Waiting_To_Start); end loop; exception when E : others => Fatal_Exception (E, "A011: p9900001c"); end Start_All_Jobs; procedure Await_Start is -- called once by each process to wait to start begin Comment ("Awaiting start"); Wait (Sem => Waiting_To_Start, Masked_Signals => RTS_Signals); exception when E : others => Fatal_Exception (E, "A012: p99001c"); end Await_Start; procedure Done is -- called once by each process to complete begin Comment ("Done one job"); Wait (Sem => Mutex, Masked_Signals => RTS_Signals); Done_Count := Done_Count + 1; if Done_Count = Jobs'Last - Jobs'First + 1 then -- wake up the main program Post (Waiting_For_Completion); end if; Post (Sem => Mutex); exception when E : others => Fatal_Exception (E, "A013: p99001c"); end Done; procedure Await_All_Jobs_Done is -- called by the main program to wait for all jobs to finish begin Comment ("Awaiting completion of all jobs"); Wait (Sem => Waiting_For_Completion, Masked_Signals => RTS_Signals); exception when E : others => Fatal_Exception (E, "A014: p9900001c"); end Await_All_Jobs_Done; end Sync; begin ......... IO.Initialize; Sync.Initialize; ......... -- Initialize individual exported pointers to point to components -- of the shared data area. Period := Data.Period'Access; Missed_Deadlines := Data.Missed_Deadlines'Access; Computation_Load := Data.Computation_Load'Access; Input_Load := Data.Input_Load'Access; Output_Load := Data.Output_Load'Access; Start_Time := Data.Start_Time'Access; Stop_Time := Data.Stop_Time'Access; Next_Request_Time := Data.Next_Request_Time'Access; end p990000b; libflorist-2025.1.0/tests/p990000b.ads000066400000000000000000000124621473553204100170410ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 0 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the versions p9900** set of tests that -- use multiple processes and shared memory. -- This package contains code that is common to all these tests. -- Each of these tests runs a set of periodic tasks/processes -- that serially share access to an "I/O" object. -- The tests differ by the mechanisms that they use for: -- concurrency & scheduling -- Ada tasks, task priority -- POSIX processes, process priority -- timing control -- Ada clock and delay -- POSIX clock and timers -- POSIx clock and pthread_cond_timedwait -- mutual exclusion and synchronization -- Ada protected objects -- POSIX mutexes and CV's (process-shared or otherwise) -- POSIX semaphores with Calendar, POSIX, System; package p990000b is use Calendar, POSIX; subtype Jobs is Integer range 0 .. 5; type Job_Duration_Array is array (Jobs) of Duration; type JDA_Ptr is access all Job_Duration_Array; type Job_Integer_Array is array (Jobs) of Integer; type JIA_Ptr is access all Job_Integer_Array; type Job_Time_Array is array (Jobs) of Time; type JTA_Ptr is access all Job_Time_Array; type Time_Ptr is access all Time; type Boolean_Ptr is access all Boolean; Priority : constant array (Jobs) of System.Priority := (System.Priority'Last - 1, System.Priority'Last - 2, System.Priority'Last - 3, System.Priority'Last - 4, System.Priority'Last - 5, System.Priority'Last - 6); Shared_Data_Filename : constant POSIX_String := "p990040_data"; Period : JDA_Ptr; -- periods of jobs are set in the body of this package Missed_Deadlines : Boolean_Ptr; -- ???? -- Need to do something to insure atomic access to object. Computation_Load, Input_Load, Output_Load : JIA_Ptr; Start_Time, Stop_Time : Time_Ptr; Next_Request_Time : JTA_Ptr; Seconds_To_Run : constant Integer := 10; -- number of seconds to run each simulation -- during bisection procedure Do_Input (Job : Jobs); procedure Do_Computation (Job : Jobs); procedure Do_Output (Job : Jobs); generic with procedure Run_Jobs; procedure Find_Utilization_Limit; end p990000b; libflorist-2025.1.0/tests/p990001a.adb000066400000000000000000000122701473553204100170150ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 a -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with POSIX_Report, P9900doc, P990000, System; package body P990001a is use POSIX_Report, P9900doc, P990000; protected IO is procedure Do_Input (Load : Natural); procedure Do_Output (Load : Natural); end IO; protected Sync is procedure Start_All_Jobs; entry Await_Start; procedure Done_Job; entry Await_All_Jobs_Done; pragma Priority (System.Priority'Last); private All_Go : Boolean := False; Done_Count : Integer := 0; end Sync; protected body IO is procedure Do_Input (Load : Natural) is begin P990000.Do_Input (Load); exception when E : others => Fatal_Exception (E, "A001: P990001a"); end Do_Input; procedure Do_Output (Load : Natural) is begin P990000.Do_Output (Load); exception when E : others => Fatal_Exception (E, "A002: P990001a"); end Do_Output; end IO; protected body Sync is procedure Start_All_Jobs is begin All_Go := True; end Start_All_Jobs; entry Await_Start when All_Go is begin null; end Await_Start; procedure Done_Job is begin Done_Count := Done_Count + 1; end Done_Job; entry Await_All_Jobs_Done when Done_Count >= Jobs'Last is begin All_Go := False; Done_Count := 0; end Await_All_Jobs_Done; end Sync; procedure Do_Input (Load : Natural) is begin IO.Do_Input (Load); end Do_Input; procedure Do_Output (Load : Natural) is begin IO.Do_Output (Load); end Do_Output; procedure Start_All_Jobs is begin Sync.Start_All_Jobs; end Start_All_Jobs; procedure Await_All_Jobs_Done is begin Sync.Await_All_Jobs_Done; end Await_All_Jobs_Done; procedure Await_Start is begin Sync.Await_Start; end Await_Start; procedure Done_Job is begin Sync.Done_Job; end Done_Job; procedure Initialize is begin null; end Initialize; procedure Finalize is begin null; end Finalize; end P990001a; libflorist-2025.1.0/tests/p990001a.ads000066400000000000000000000074531473553204100170450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- It provides operations related to mutual exclusion -- and synchronization. -- This version uses Ada protected objects. with P990000; package P990001a is use P990000; procedure Do_Input (Load : Natural); procedure Do_Output (Load : Natural); procedure Start_All_Jobs; -- called by the main program to start all jobs procedure Await_All_Jobs_Done; -- called by the main program to wait for all jobs to finish procedure Await_Start; -- called once by each process to wait to start procedure Done_Job; -- called once by each process to complete procedure Initialize; procedure Finalize; end P990001a; libflorist-2025.1.0/tests/p990001b.adb000066400000000000000000000152661473553204100170260ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with P990000, POSIX, POSIX_Condition_Variables, POSIX_Configurable_System_Limits, POSIX_Mutexes, POSIX_Report; package body P990001b is use P990000, POSIX, POSIX_Condition_Variables, POSIX_Configurable_System_Limits, POSIX_Mutexes, POSIX_Report; MA : POSIX_Mutexes.Attributes; IO_Mutex : Mutex; -- protects IO IO_MutexD : Mutex_Descriptor; Sync_Mutex : Mutex; -- protects startup and termination Sync_MutexD : Mutex_Descriptor; All_Go : Boolean := False; Done_Count : Integer := 0; C : Condition; CA : POSIX_Condition_Variables.Attributes; CD : Condition_Descriptor; procedure Do_Input (Load : Natural) is begin Lock (IO_MutexD); P990000.Do_Input (Load); Unlock (IO_MutexD); exception when E : others => Fatal_Exception (E, "A001: P990001b"); end Do_Input; procedure Do_Output (Load : Natural) is begin Lock (IO_MutexD); P990000.Do_Output (Load); Unlock (IO_MutexD); exception when E : others => Fatal_Exception (E, "A002: P990001b"); end Do_Output; procedure Start_All_Jobs is begin Lock (Sync_MutexD); All_Go := True; POSIX_Condition_Variables.Signal (CD); Unlock (Sync_MutexD); exception when E : others => Fatal_Exception (E, "A003: P990001b"); end Start_All_Jobs; procedure Await_Start is begin Lock (Sync_MutexD); while not All_Go loop Wait (CD, Sync_MutexD); end loop; Unlock (Sync_MutexD); exception when E : others => Fatal_Exception (E, "A004: P990001b"); end Await_Start; procedure Done_Job is begin Lock (Sync_MutexD); Done_Count := Done_Count + 1; POSIX_Condition_Variables.Signal (CD); Unlock (Sync_MutexD); exception when E : others => Fatal_Exception (E, "A005: P990001b"); end Done_Job; procedure Await_All_Jobs_Done is begin Lock (Sync_MutexD); while Done_Count < Jobs'Last loop Wait (CD, Sync_MutexD); end loop; Done_Count := 0; All_Go := False; Unlock (Sync_MutexD); exception when E : others => Fatal_Exception (E, "A006: P990001b"); end Await_All_Jobs_Done; procedure Initialize is begin null; end Initialize; procedure Finalize is begin null; end Finalize; begin Optional (Mutex_Option, "A007: P990001b"); begin Initialize (MA); Set_Locking_Policy (MA, Highest_Ceiling_Priority); Initialize (IO_Mutex, MA); exception when E1 : POSIX_Error => if Get_Error_Code /= Operation_Not_Supported then Optional (Mutex_Option, Mutex_Priority_Ceiling_Option, Operation_Not_Implemented, E1, "A008: P990001b"); end if; Initialize (MA); Initialize (IO_Mutex, MA); end; IO_MutexD := Descriptor_Of (IO_Mutex); begin Initialize (MA); Set_Locking_Policy (MA, Highest_Ceiling_Priority); Initialize (Sync_Mutex, MA); Comment ("initialized Sync_Mutex w/priority ceiling"); exception when E1 : POSIX_Error => if Get_Error_Code /= Operation_Not_Supported then Optional (Mutex_Option, Mutex_Priority_Ceiling_Option, Operation_Not_Implemented, E1, "A009: P990001b "); end if; Initialize (MA); Initialize (Sync_Mutex, MA); Comment ("initialized Sync_Mutex w/o priority ceiling"); end; Sync_MutexD := Descriptor_Of (Sync_Mutex); Comment ("initialized Sync_MutexD"); Initialize (CA); Initialize (C, CA); CD := Descriptor_Of (C); exception when E : others => Fatal_Exception (E, "A010: P990001b"); end P990001b; libflorist-2025.1.0/tests/p990001b.ads000066400000000000000000000074731473553204100170500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- It provides operations related to mutual exclusion -- and synchronization. -- This version uses POSIX mutexes and condition variables. with P990000; package P990001b is use P990000; procedure Do_Input (Load : Natural); procedure Do_Output (Load : Natural); procedure Start_All_Jobs; -- called by the main program to start all jobs procedure Await_All_Jobs_Done; -- called by the main program to wait for all jobs to finish procedure Await_Start; -- called once by each process to wait to start procedure Done_Job; -- called once by each process to complete procedure Initialize; procedure Finalize; end P990001b; libflorist-2025.1.0/tests/p990001c.adb000066400000000000000000000162601473553204100170220ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 c -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with P990000, POSIX, POSIX_IO, POSIX_Configurable_System_Limits, POSIX_Report, POSIX_Permissions, POSIX_Process_Environment, POSIX_Semaphores, Test_Parameters; package body P990001c is use P990000, POSIX, POSIX_IO, POSIX_Configurable_System_Limits, POSIX_Report, POSIX_Permissions, POSIX_Process_Environment, POSIX_Semaphores, Test_Parameters; IO_Lock, Sync_Lock, Waiting_To_Start, Waiting_For_Completion : Semaphore_Descriptor; procedure Do_Input (Load : Natural) is begin Wait (Sem => IO_Lock, Masked_Signals => RTS_Signals); P990000.Do_Input (Load); Post (Sem => IO_Lock); exception when E : others => Fatal_Exception (E, "A001: P990001c"); end Do_Input; procedure Do_Output (Load : Natural) is begin Wait (Sem => IO_Lock, Masked_Signals => RTS_Signals); P990000.Do_Output (Load); Post (Sem => IO_Lock); exception when E : others => Fatal_Exception (E, "A002: P990001c"); end Do_Output; procedure Start_All_Jobs is begin for J in Jobs loop Post (Waiting_To_Start); end loop; exception when E : others => Fatal_Exception (E, "A003: P990001c"); end Start_All_Jobs; procedure Await_Start is begin Wait (Sem => Waiting_To_Start, Masked_Signals => RTS_Signals); exception when E : others => Fatal_Exception (E, "A004: P990001c"); end Await_Start; procedure Done_Job is begin Wait (Sem => Sync_Lock, Masked_Signals => RTS_Signals); Post (Sem => Waiting_For_Completion); Post (Sem => Sync_Lock); exception when E : others => Fatal_Exception (E, "A005: P990001c"); end Done_Job; procedure Await_All_Jobs_Done is begin for I in Jobs'Range loop Wait (Sem => Waiting_For_Completion, Masked_Signals => RTS_Signals); end loop; exception when E : others => Fatal_Exception (E, "A006: P990001c"); end Await_All_Jobs_Done; procedure Finalize is begin -- clear out leftover semaphores for I in 1 .. 4 loop begin Unlink_Semaphore (Valid_Semaphore_Name (I)); exception when POSIX_Error => Check_Error_Code (No_Such_File_Or_Directory, "A007"); when E : others => Unexpected_Exception (E, "A008"); end; end loop; exception when E : others => Fatal_Exception (E, "A009: P990001c"); end Finalize; procedure Initialize is procedure Set (Semd : Semaphore_Descriptor; Val : Natural); procedure Set (Semd : Semaphore_Descriptor; Val : Natural) is begin if Get_Value (Semd) = Val then return; end if; while Get_Value (Semd) > 0 loop Wait (Semd); end loop; while Get_Value (Semd) < Val loop Post (Semd); end loop; Comment ("forced value of leftover semaphore to " & Integer'Image (Get_Value (Semd))); exception when E : others => Fatal_Exception (E, "A010: P990001c"); end Set; begin Set (IO_Lock, 1); Set (Waiting_To_Start, 0); Set (Sync_Lock, 1); Set (Waiting_For_Completion, 0); exception when E : others => Fatal_Exception (E, "A011: P990001c"); end Initialize; begin Optional (Semaphores_Option, "A012: P990001c"); IO_Lock := Open_Or_Create (Name => Valid_Semaphore_Name (1), Permissions => Owner_Permission_Set, Value => 1, -- open Options => POSIX_IO.Empty_Set); Waiting_To_Start := Open_Or_Create (Name => Valid_Semaphore_Name (2), Permissions => Owner_Permission_Set, Value => 0, -- closed Options => POSIX_IO.Empty_Set); Sync_Lock := Open_Or_Create (Name => Valid_Semaphore_Name (3), Permissions => Owner_Permission_Set, Value => 1, -- open Options => POSIX_IO.Empty_Set); Waiting_For_Completion := Open_Or_Create (Name => Valid_Semaphore_Name (4), Permissions => Owner_Permission_Set, Value => 0, -- closed Options => POSIX_IO.Empty_Set); exception when E : others => Fatal_Exception (E, "A013: P990001c"); end P990001c; libflorist-2025.1.0/tests/p990001c.ads000066400000000000000000000074461473553204100170510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 c -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- It provides operations related to mutual exclusion -- and synchronization. -- This version uses POSIX semaphores. with P990000; package P990001c is use P990000; procedure Do_Input (Load : Natural); procedure Do_Output (Load : Natural); procedure Start_All_Jobs; -- called by the main program to start all jobs procedure Await_All_Jobs_Done; -- called by the main program to wait for all jobs to finish procedure Await_Start; -- called once by each process to wait to start procedure Done_Job; -- called once by each process to complete procedure Initialize; procedure Finalize; end P990001c; libflorist-2025.1.0/tests/p990001d.adb000066400000000000000000000203261473553204100170210ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 d -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with p990000b, POSIX, POSIX_IO, POSIX_Configurable_System_Limits, POSIX_Report, POSIX_Permissions, POSIX_Process_Environment, POSIX_Semaphores, Test_Parameters; package body p990001d is use p990000b, POSIX, POSIX_IO, POSIX_Configurable_System_Limits, POSIX_Report, POSIX_Permissions, POSIX_Process_Environment, POSIX_Semaphores, Test_Parameters; package body IO is Mutex : Semaphore_Descriptor; procedure Initialize is begin Optional (Semaphores_Option, "A001: p99001c"); begin Comment ("IO.Initialize: Creating semaphore (1) " & To_String (Valid_Semaphore_Name (1))); Mutex := Open_Or_Create (Name => Valid_Semaphore_Name (1), Permissions => Owner_Permission_Set, Value => 1, -- open Options => POSIX_IO.Empty_Set); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A002: p99001c"); when E2 : others => Unexpected_Exception (E2, "A003: p99001c"); end; exception when E : others => Fatal_Exception (E, "A004: p9900001c"); end Initialize; procedure Input (Self : Jobs) is begin Comment ("IO.Input"); Wait (Sem => Mutex, Masked_Signals => RTS_Signals); Do_Input (Self); Post (Sem => Mutex); exception when E : others => Fatal_Exception (E, "A005: p9900001c"); end Input; procedure Output (Self : Jobs) is begin Comment ("IO.Output"); Wait (Sem => Mutex, Masked_Signals => RTS_Signals); Do_Output (Self); Post (Sem => Mutex); exception when E : others => Fatal_Exception (E, "A006: p9900001c"); end Output; end IO; package body Sync is Waiting_To_Start : Semaphore_Descriptor; Waiting_For_Completion : Semaphore_Descriptor; Mutex : Semaphore_Descriptor; Done_Count : Integer := 0; procedure Initialize is begin Optional (Semaphores_Option, "A007: p99001c"); begin Comment ("Sync.Initialize: Creating semaphore (2) " & To_String (Valid_Semaphore_Name (2))); Waiting_To_Start := Open_Or_Create (Name => Valid_Semaphore_Name (2), Permissions => Owner_Permission_Set, Value => 0, -- closed Options => POSIX_IO.Empty_Set); Comment ("Sync.Initialize: Creating semaphore (3) " & To_String (Valid_Semaphore_Name (3))); Mutex := Open_Or_Create (Name => Valid_Semaphore_Name (3), Permissions => Owner_Permission_Set, Value => 0, Options => POSIX_IO.Empty_Set); Comment ("Sync.Initialize: Creating semaphore (4) " & To_String (Valid_Semaphore_Name (4))); Waiting_For_Completion := Open_Or_Create (Name => Valid_Semaphore_Name (4), Permissions => Owner_Permission_Set, Value => 0, Options => POSIX_IO.Empty_Set); exception when E1 : POSIX_Error => Optional (Semaphores_Option, Operation_Not_Implemented, E1, "A008: p99001c"); when E2 : others => Unexpected_Exception (E2, "A009: p99001c"); end; exception when E : others => Fatal_Exception (E, "A010: p9900001c"); end Initialize; procedure Start_All_Jobs is -- called by the main program to start all jobs begin Comment ("Starting jobs"); for J in Jobs loop Post (Waiting_To_Start); end loop; exception when E : others => Fatal_Exception (E, "A011: p9900001c"); end Start_All_Jobs; procedure Await_Start is -- called once by each process to wait to start begin Comment ("Awaiting start"); Wait (Sem => Waiting_To_Start, Masked_Signals => RTS_Signals); exception when E : others => Fatal_Exception (E, "A012: p99001c"); end Await_Start; procedure Done is -- called once by each process to complete begin Comment ("Done one job"); Wait (Sem => Mutex, Masked_Signals => RTS_Signals); Done_Count := Done_Count + 1; if Done_Count = Jobs'Last - Jobs'First + 1 then -- wake up the main program Post (Waiting_For_Completion); end if; Post (Sem => Mutex); exception when E : others => Fatal_Exception (E, "A013: p99001c"); end Done; procedure Await_All_Jobs_Done is -- called by the main program to wait for all jobs to finish begin Comment ("Awaiting completion of all jobs"); Wait (Sem => Waiting_For_Completion, Masked_Signals => RTS_Signals); exception when E : others => Fatal_Exception (E, "A014: p9900001c"); end Await_All_Jobs_Done; end Sync; begin IO.Initialize; Sync.Initialize; end p990001d; libflorist-2025.1.0/tests/p990001d.ads000066400000000000000000000072251473553204100170450ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 1 d -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the p9900** set of tests. -- It provides operations related to mutual exclusion -- and synchronization. -- This version uses POSIX semaphores. with p990000b; package p990001d is use p990000b; package IO is procedure Initialize; procedure Input (Self : Jobs); procedure Output (Self : Jobs); end IO; package Sync is procedure Initialize; procedure Start_All_Jobs; procedure Await_Start; procedure Done; procedure Await_All_Jobs_Done; end Sync; end p990001d; libflorist-2025.1.0/tests/p990002a.adb000066400000000000000000000117631473553204100170240ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 a -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Calendar, P990000, POSIX, POSIX_Report; package body P990002a is use Calendar, P990000, POSIX_Report; Data : Shared_Data_Ptr; Start_Time, Stop_Time : Calendar.Time; Next_Request_Time : array (Jobs) of Calendar.Time; procedure Initialize_Scheduling (Shared_Data : Shared_Data_Ptr) is begin Data := Shared_Data; Assert (Data.Check = 9999, "A001: P99002a"); Start_Time := Data.Start_Calendar_Time; Comment ("Clock - Start_Time", POSIX.To_Timespec (Clock - Start_Time)); Stop_Time := Start_Time + Duration (Seconds_To_Run); Next_Request_Time := (others => Start_Time); exception when E : others => Fatal_Exception (E, "A002: P990002a"); end Initialize_Scheduling; function Reschedule (Job : Jobs) return Boolean is Last_Completion_Time : Time; begin if Data.Missed_Deadlines then -- there is at least one task that has already missed its -- deadline, so no need to continue anymore return False; end if; Next_Request_Time (Job) := Next_Request_Time (Job) + Period (Job); Last_Completion_Time := Clock; if Next_Request_Time (Job) <= Last_Completion_Time then Data.Missed_Deadlines := True; Comment ("lateness", POSIX.To_Timespec (Last_Completion_Time - Next_Request_Time (Job))); return False; end if; if Next_Request_Time (Job) >= Stop_Time then -- if the test has been running for enough time return False; end if; delay until Next_Request_Time (Job); -- We should not wake up early. Assert (Clock >= Next_Request_Time (Job), "A003: P990002a "); return True; exception when E : others => Fatal_Exception (E, "A004: P990002a"); return False; end Reschedule; procedure Finalize is begin null; end Finalize; end P990002a; libflorist-2025.1.0/tests/p990002a.ads000066400000000000000000000067371473553204100170520ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- It provides operations related to timing control. -- This version uses the Ada clock and delay statements. with P990000; package P990002a is procedure Initialize_Scheduling (Shared_Data : P990000.Shared_Data_Ptr); function Reschedule (Job : P990000.Jobs) return Boolean; procedure Finalize; end P990002a; libflorist-2025.1.0/tests/p990002b.adb000066400000000000000000000147371473553204100170310ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with P990000, POSIX, POSIX_Mutexes, POSIX_Condition_Variables, POSIX_Configurable_System_Limits, POSIX_Timers, POSIX_Report; package body P990002b is use P990000, POSIX, POSIX_Mutexes, POSIX_Condition_Variables, POSIX_Configurable_System_Limits, POSIX_Timers, POSIX_Report; function Clock return Timespec; function Clock return Timespec is begin return Get_Time (Clock_Realtime); end Clock; Zero : constant Timespec := To_Timespec (0, 0); Start_Time, Stop_Time : Timespec; Next_Request_Time : array (Jobs) of Timespec; M : Mutex; C : Condition; MA : POSIX_Mutexes.Attributes; CA : POSIX_Condition_Variables.Attributes; MD : Mutex_Descriptor; CD : Condition_Descriptor; Data : Shared_Data_Ptr; procedure Initialize_Scheduling (Shared_Data : Shared_Data_Ptr) is begin Data := Shared_Data; Assert (Data.Check = 9999, "A001: P99002b"); Start_Time := Data.Start_Timespec; Comment ("Clock - Start_Time", Clock - Start_Time); Stop_Time := Start_Time + POSIX.To_Timespec (Seconds (Seconds_To_Run), 0); Comment ("Stop_Time - Clock", Stop_Time - Clock); Next_Request_Time := (others => Start_Time); exception when E : others => Fatal_Exception (E, "A002: P990002b"); end Initialize_Scheduling; function Reschedule (Job : Jobs) return Boolean is Last_Completion_Time : Timespec; begin if Data.Missed_Deadlines then -- there is at least one task that has already missed its -- deadline, so no need to continue anymore return False; end if; Next_Request_Time (Job) := Next_Request_Time (Job) + To_Timespec (Period (Job)); Last_Completion_Time := Clock; if Next_Request_Time (Job) <= Last_Completion_Time then Data.Missed_Deadlines := True; Comment ("lateness", Last_Completion_Time - Next_Request_Time (Job)); return False; end if; if Next_Request_Time (Job) >= Stop_Time then -- if the test has been running for enough time return False; end if; Lock (MD); loop begin Timed_Wait (CD, MD, Next_Request_Time (Job)); exception when POSIX_Error => -- The only error return here shoud be if we timed out. Assert (Get_Error_Code = Timed_Out, "A003: P990002b"); when E : others => Unexpected_Exception (E, "A004: P990002b"); end; exit when Clock >= Next_Request_Time (Job); end loop; Unlock (MD); return True; exception when E : others => Fatal_Exception (E, "A005: P990002b"); return False; end Reschedule; procedure Finalize is begin null; end Finalize; begin Optional (Mutex_Option, "A006: P990002b"); Optional (Timers_Option, "A007: P990002b"); Initialize (MA); begin Set_Locking_Policy (MA, Highest_Ceiling_Priority); Initialize (M, MA); exception when E1 : POSIX_Error => Optional (Mutex_Option, Mutex_Priority_Ceiling_Option, Operation_Not_Implemented, E1, "A008: P990002b"); Initialize (MA); Initialize (M, MA); end; MD := Descriptor_Of (M); Initialize (CA); Initialize (C, CA); CD := Descriptor_Of (C); exception when E : others => Fatal_Exception (E, "A009: P99002b"); end P990002b; libflorist-2025.1.0/tests/p990002b.ads000066400000000000000000000067501473553204100170460ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- It provides operations related to timing control. -- This version uses POSIX Clock_Realtime and Timed_Wait on a CV. with P990000; package P990002b is procedure Initialize_Scheduling (Shared_Data : P990000.Shared_Data_Ptr); function Reschedule (Job : P990000.Jobs) return Boolean; procedure Finalize; end P990002b; libflorist-2025.1.0/tests/p990002c.adb000066400000000000000000000151621473553204100170230ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 c -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with P990000, POSIX, POSIX_Calendar, POSIX_Mutexes, POSIX_Condition_Variables, POSIX_Configurable_System_Limits, POSIX_Report; package body P990002c is use P990000, POSIX, POSIX_Calendar, POSIX_Mutexes, POSIX_Condition_Variables, POSIX_Configurable_System_Limits, POSIX_Report; Data : Shared_Data_Ptr; function Clock return Timespec; function Clock return Timespec is begin return To_Timespec (Clock); end Clock; Zero : constant Timespec := To_Timespec (0, 0); Start_Time, Stop_Time : Timespec; Next_Request_Time : array (Jobs) of Timespec; M : Mutex; C : Condition; MA : POSIX_Mutexes.Attributes; CA : POSIX_Condition_Variables.Attributes; MD : Mutex_Descriptor; CD : Condition_Descriptor; procedure Initialize_Scheduling (Shared_Data : Shared_Data_Ptr) is begin Data := Shared_Data; Assert (Data.Check = 9999, "A001: p99002c"); Start_Time := To_Timespec (Data.Start_POSIX_Time); Comment ("Clock - Start_Time", Clock - Start_Time); Stop_Time := Start_Time + POSIX.To_Timespec (POSIX.Seconds (Seconds_To_Run), 0); Comment ("Stop_Time - Clock", Stop_Time - Clock); Next_Request_Time := (others => Start_Time); exception when E : others => Fatal_Exception (E, "A002: p990002c"); end Initialize_Scheduling; function Reschedule (Job : Jobs) return Boolean is Last_Completion_Time : Timespec; begin if Data.Missed_Deadlines then -- there is at least one task that has already missed its -- deadline, so no need to continue anymore return False; end if; Next_Request_Time (Job) := Next_Request_Time (Job) + To_Timespec (Period (Job)); Last_Completion_Time := Clock; if Next_Request_Time (Job) <= Last_Completion_Time then Data.Missed_Deadlines := True; Comment ("lateness", Last_Completion_Time - Next_Request_Time (Job)); return False; end if; if Next_Request_Time (Job) >= Stop_Time then -- if the test has been running for enough time return False; end if; Lock (MD); loop begin Timed_Wait (CD, MD, Next_Request_Time (Job)); exception when POSIX_Error => -- The only error return here shoud be if we timed out. Assert (Get_Error_Code = Timed_Out, "A003: p990002c"); Assert (Clock >= Next_Request_Time (Job), "A004: p99002c"); when E : others => Unexpected_Exception (E, "A005: p990002c"); Unlock (MD); end; exit when Clock >= Next_Request_Time (Job); end loop; Unlock (MD); return True; exception when E : others => Fatal_Exception (E, "A006: p990002c"); return False; end Reschedule; procedure Finalize is begin null; end Finalize; begin Optional (Mutex_Option, "A007: p990002c"); Initialize (MA); begin Set_Locking_Policy (MA, Highest_Ceiling_Priority); Initialize (M, MA); exception when E1 : POSIX_Error => if Get_Error_Code /= Operation_Not_Supported then Optional (Mutex_Option, Mutex_Priority_Ceiling_Option, Operation_Not_Implemented, E1, "A008: p990002c"); end if; Initialize (MA); Initialize (M, MA); end; MD := Descriptor_Of (M); Initialize (CA); Initialize (C, CA); CD := Descriptor_Of (C); exception when E : others => Fatal_Exception (E, "A009: p990002c"); end P990002c; libflorist-2025.1.0/tests/p990002c.ads000066400000000000000000000067471473553204100170550ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 c -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- It provides operations related to timing control. -- This version uses POSIX_Calendar.Clock and Timed_Wait on a CV. with P990000; package P990002c is procedure Initialize_Scheduling (Shared_Data : P990000.Shared_Data_Ptr); function Reschedule (Job : P990000.Jobs) return Boolean; procedure Finalize; end P990002c; libflorist-2025.1.0/tests/p990002d.adb000066400000000000000000000123131473553204100170170ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 d -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Real_Time, P990000, POSIX, POSIX_Report; package body P990002d is use Ada.Real_Time, P990000, POSIX_Report; Data : Shared_Data_Ptr; Start_Time, Stop_Time : Ada.Real_Time.Time; Next_Request_Time : array (Jobs) of Ada.Real_Time.Time; procedure Initialize_Scheduling (Shared_Data : Shared_Data_Ptr) is begin Data := Shared_Data; Start_Time := Data.Start_Real_Time; Stop_Time := Start_Time + Ada.Real_Time.To_Time_Span (Duration (Seconds_To_Run)); Next_Request_Time := (others => Start_Time); exception when E : others => Fatal_Exception (E, "A001: P990002d"); end Initialize_Scheduling; function Reschedule (Job : Jobs) return Boolean is Last_Completion_Time : Time; Time_To_Next_Request : Ada.Real_Time.Time_Span; begin if Data.Missed_Deadlines then -- there is at least one task that has already missed its -- deadline, so no need to continue anymore return False; end if; Next_Request_Time (Job) := Next_Request_Time (Job) + Ada.Real_Time.To_Time_Span (Period (Job)); Last_Completion_Time := Clock; Time_To_Next_Request := Next_Request_Time (Job) - Last_Completion_Time; if Time_To_Next_Request < Ada.Real_Time.Time_Span_Zero then Data.Missed_Deadlines := True; Comment ("lateness", POSIX.To_Timespec (Ada.Real_Time.To_Duration (-Time_To_Next_Request))); return False; end if; if Next_Request_Time (Job) >= Stop_Time then -- if the test has been running for enough time return False; end if; delay until Next_Request_Time (Job); -- We should not wake up early. Assert (Clock >= Next_Request_Time (Job), "A002: P990002d"); return True; exception when E : others => Fatal_Exception (E, "A003: P990002d"); return False; end Reschedule; procedure Finalize is begin null; end Finalize; begin Optional (Semaphores_Option, "A004: P990002d"); exception when E : others => Fatal_Exception (E, "A005: P990002d"); end P990002d; libflorist-2025.1.0/tests/p990002d.ads000066400000000000000000000067571473553204100170570ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 2 d -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- It provides operations related to timing control. -- This version uses the Ada.Real_Time clock and delay until statements. with P990000; package P990002d is procedure Initialize_Scheduling (Shared_Data : P990000.Shared_Data_Ptr); function Reschedule (Job : P990000.Jobs) return Boolean; procedure Finalize; end P990002d; libflorist-2025.1.0/tests/p990003a.adb000066400000000000000000000067351473553204100170300ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 0 a -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- See P9900doc.ads for more detailed explanation. with P990000, P9900doc; package body P990003a is Data : aliased P990000.Shared_Data_Area; function Shared_Data return P990000.Shared_Data_Ptr is begin Data.Check := 9999; return Data'Access; end Shared_Data; procedure Finalize is begin null; end Finalize; end P990003a; libflorist-2025.1.0/tests/p990003a.ads000066400000000000000000000101451473553204100170370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 3 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- Each of these tests runs a set of periodic tasks/processes -- that serially share access to an "I/O" object. -- The tests differ by the mechanisms that they use for: -- concurrency & scheduling -- Ada tasks, task priority -- POSIX processes, process priority -- timing control -- Ada clock and delay -- POSIX clock and timers -- POSIx clock and pthread_cond_timedwait -- mutual exclusion and synchronization -- Ada protected objects -- POSIX mutexes and CV's (process-shared or otherwise) -- POSIX semaphores -- This package contains shared variable data structures that are -- common to all these tests. -- This version makes use of local memory to allow access to global data -- by several tasks within a single process. -- See P9900doc.ads for more detailed explanation. with P990000; package P990003a is function Shared_Data return P990000.Shared_Data_Ptr; procedure Finalize; end P990003a; libflorist-2025.1.0/tests/p990003b.adb000066400000000000000000000160141473553204100170200ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 0 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- See P9900doc.ads for more detailed explanation. with POSIX, POSIX_Configurable_System_Limits, POSIX_Files, POSIX_IO, POSIX_Memory_Mapping, POSIX_Page_Alignment, POSIX_Permissions, POSIX_Report, P9900doc, P990000, System, System_Storage_Elements, Unchecked_Conversion; package body P990003b is use POSIX, POSIX_IO, POSIX_Memory_Mapping, POSIX_Permissions, POSIX_Report, P990000, System_Storage_Elements; function Address_For_Data_Area return System.Address; Page_Size : constant Storage_Offset := Storage_Offset (POSIX_Configurable_System_Limits.Page_Size); Shared_Data_Filename : constant POSIX_String := "P990003b_data"; FD : File_Descriptor; Length : constant Integer := Shared_Data_Area'Size / POSIX_Character'Size; function Address_For_Data_Area return System.Address is Result : System.Address; Dummy_Data : Shared_Data_Area; subtype Buf is IO_Buffer (1 .. Length); type Buf_Ptr is access Buf; function To_Buf_Ptr is new Unchecked_Conversion (System.Address, Buf_Ptr); Last : IO_Count := 0; begin -- Open or create file to hold shared data. begin FD := Open_Or_Create (Name => Shared_Data_Filename, Mode => Write_Only, Permissions => (Owner_Write => True, Others => False), Options => Exclusive); -- We are the first to create the file, so we can safely -- initialize it while others do not have read permission. Dummy_Data.Check := 9999; Write (FD, To_Buf_Ptr (Dummy_Data'Address).all, Last); -- The above will set the size, and initialize the file. Assert (Last = IO_Count (Length), "A001: P99003b"); Change_Permissions (FD, Owner_Permission_Set); Close (FD); exception when E : POSIX_Error => if Get_Error_Code = File_Exists then null; -- We will just open the file, below. else Fatal_Exception (E, "A002: P990003b"); end if; end; -- The file already exists. loop begin FD := Open (Name => Shared_Data_Filename, Mode => Read_Write); exit; exception when POSIX_Error => Check_Error_Code (Permission_Denied, "A003: P99003b"); delay 1.0; Comment ("retrying open"); end; end loop; -- Map the file into shared memory. Result := Map_Memory (Length => Storage_Offset (Length), Protection => Allow_Read + Allow_Write, Mapping => Map_Shared, File => FD, Offset => 0); return Result; exception when E : others => Unexpected_Exception (E, "A004: P990003b"); return System.Null_Address; end Address_For_Data_Area; Data_Address : constant System.Address := Address_For_Data_Area; Data : aliased P990000.Shared_Data_Area; for Data'Address use Data_Address; pragma Import (Ada, Data); -- The reason we have the Import pragma here is that -- we don't want the compiler to try to initialize the shared -- object Data, since it may already contain data values written -- there by another process. function Shared_Data return P990000.Shared_Data_Ptr is begin return Data'Access; end Shared_Data; function To_Ptr is new Unchecked_Conversion (System.Address, P990000.Shared_Data_Ptr); Data_Ptr : P990000.Shared_Data_Ptr := To_Ptr (Data_Address); procedure Finalize is begin Unmap_Memory (Data_Address, Storage_Offset (Length)); Close (FD); POSIX_Files.Unlink (Shared_Data_Filename); end Finalize; begin Optional (Memory_Mapped_Files_Option, "A005: P990003b"); Assert (Data.Check = 9999, "A006: P99003b"); exception when E : others => Fatal_Exception (E, "A007: P990003b"); end P990003b; libflorist-2025.1.0/tests/p990003b.ads000066400000000000000000000103551473553204100170430ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 0 3 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package supports the P9900** set of tests. -- Each of these tests runs a set of periodic tasks/processes -- that serially share access to an "I/O" object. -- The tests differ by the mechanisms that they use for: -- concurrency & scheduling -- Ada tasks, task priority -- POSIX processes, process priority -- timing control -- Ada clock and delay -- POSIX clock and timers -- POSIx clock and pthread_cond_timedwait -- mutual exclusion and synchronization -- Ada protected objects -- POSIX mutexes and CV's (process-shared or otherwise) -- POSIX semaphores -- This package contains shared variable data structures that are -- common to all these tests. -- This version makes use of shared memory to allow access to global data -- by several processes. The original version of this package (P990003a) -- cannot be used by multiple processes, since the data is local to a -- single process. -- See P9900doc.ads for more detailed explanation. with P990000, P9900doc; package P990003b is function Shared_Data return P990000.Shared_Data_Ptr; procedure Finalize; end P990003b; libflorist-2025.1.0/tests/p990010.adb000066400000000000000000000064601473553204100166600ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 1 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P990010a; procedure P990010 is begin P990010a.Parent_Main; end P990010; libflorist-2025.1.0/tests/p990010.ads000066400000000000000000000063631473553204100167030ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 1 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. procedure P990010; libflorist-2025.1.0/tests/p990010a.ads000066400000000000000000000100271473553204100170340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 1 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001a, -- protected objects P990002a, -- clock and delay P990003a; -- locally shared data package P990010a is new P9900x0 (Version => "10", Needs_Clock_Realtime => False, Jobs_Are_Processes => False, Initialize_Sync => P990001a.Initialize, Do_Input => P990001a.Do_Input, Do_Output => P990001a.Do_Output, Start_All_Jobs => P990001a.Start_All_Jobs, Await_All_Jobs_Done => P990001a.Await_All_Jobs_Done, Await_Start => P990001a.Await_Start, Done_Job => P990001a.Done_Job, Finalize_Sync => P990001a.Finalize, Initialize_Scheduling => P990002a.Initialize_Scheduling, Reschedule => P990002a.Reschedule, Finalize_Scheduling => P990002a.Finalize, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); libflorist-2025.1.0/tests/p990011.adb000066400000000000000000000073171473553204100166630ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 1 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P990011a; procedure P990011 is begin P990011a.Parent_Main; end P990011; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 locked by: baker; -- date: 1998/06/28 21:26:43; author: baker; state: Exp; -- Initial revision -- ============================================================================= -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990011.ads000066400000000000000000000076651473553204100167120ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 1 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc; procedure P990011; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.2 -- date: 1998/03/29 21:57:30; author: baker; state: Exp; lines: +42 -0 -- Added standard header. -- ---------------------------- -- revision 1.3 -- date: 1998/03/30 01:00:12; author: bakers; state: Exp; lines: +2 -2 -- Corrected typos. -- ---------------------------- -- revision 1.4 locked by: baker; -- date: 1998/06/28 21:36:50; author: baker; state: Exp; lines: +7 -3 -- Restructured p9900** series of tests completely, to use -- generic package. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990011a.ads000066400000000000000000000110311473553204100170310ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 1 1 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001a, -- protected objects P990002c, -- POSIX_Calendar.Clock and Timed_Wait P990003a; -- locally shared data package P990011a is new P9900x0 (Version => "11", Needs_Clock_Realtime => False, Jobs_Are_Processes => False, Initialize_Sync => P990001a.Initialize, Do_Input => P990001a.Do_Input, Do_Output => P990001a.Do_Output, Start_All_Jobs => P990001a.Start_All_Jobs, Await_All_Jobs_Done => P990001a.Await_All_Jobs_Done, Await_Start => P990001a.Await_Start, Done_Job => P990001a.Done_Job, Finalize_Sync => P990001a.Finalize, Initialize_Scheduling => P990002c.Initialize_Scheduling, Reschedule => P990002c.Reschedule, Finalize_Scheduling => P990002c.Finalize, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1998/06/28 21:20:40; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- revision 1.2 locked by: baker; -- date: 1998/06/30 13:30:45; author: baker; state: Exp; lines: +4 -3 -- Added finalization. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " -- Added Initialize_Sync. libflorist-2025.1.0/tests/p990020.adb000066400000000000000000000064601473553204100166610ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 2 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P990020a; procedure P990020 is begin P990020a.Parent_Main; end P990020; libflorist-2025.1.0/tests/p990020.ads000066400000000000000000000063631473553204100167040ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 2 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. procedure P990020; libflorist-2025.1.0/tests/p990020a.ads000066400000000000000000000100521473553204100170330ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 2 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001b, -- POSIX mutexes and CVs P990002b, -- POSIX_Timers and Clock_Realtime P990003a; -- locally shared data package P990020a is new P9900x0 (Version => "20", Needs_Clock_Realtime => True, Jobs_Are_Processes => False, Initialize_Sync => P990001b.Initialize, Do_Input => P990001b.Do_Input, Do_Output => P990001b.Do_Output, Start_All_Jobs => P990001b.Start_All_Jobs, Await_All_Jobs_Done => P990001b.Await_All_Jobs_Done, Await_Start => P990001b.Await_Start, Done_Job => P990001b.Done_Job, Finalize_Sync => P990001b.Finalize, Initialize_Scheduling => P990002b.Initialize_Scheduling, Reschedule => P990002b.Reschedule, Finalize_Scheduling => P990002b.Finalize, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); libflorist-2025.1.0/tests/p990021.ads000066400000000000000000000074141473553204100167030ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 2 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with P9900doc; procedure p990021; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1998/06/17 19:02:08; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- revision 1.2 -- date: 1998/06/30 14:28:51; author: baker; state: Exp; lines: +42 -0 -- Added standard header. -- ---------------------------- -- revision 1.3 locked by: baker; -- date: 1998/09/08 22:20:37; author: baker; state: Exp; lines: +2 -1 -- Added with clause for documentation spec. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990021a.ads000066400000000000000000000113511473553204100170370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 2 1 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- This version uses: -- POSIX processes and process priorities for concurrency and scheduling -- Ada delay statements and Ada.Calendar.Clock for timing control -- POSIX semaphores for mutual exclusion -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001c, -- POSIX named semaphores P990002a, -- Calendar and delay P990003b; -- interprocess shared data package P990021a is new P9900x0 (Version => "40", Needs_Clock_Realtime => False, Jobs_Are_Processes => True, Initialize_Sync => P990001c.Initialize, Do_Input => P990001c.Do_Input, Do_Output => P990001c.Do_Output, Start_All_Jobs => P990001c.Start_All_Jobs, Await_All_Jobs_Done => P990001c.Await_All_Jobs_Done, Await_Start => P990001c.Await_Start, Done_Job => P990001c.Done_Job, Finalize_Sync => P990001c.Finalize, Initialize_Scheduling => P990002a.Initialize_Scheduling, Reschedule => P990002a.Reschedule, Finalize_Scheduling => P990002a.Finalize, Shared_Data => P990003b.Shared_Data, Finalize_Shared_Data => P990003b.Finalize ); ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1998/06/28 21:20:43; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- revision 1.2 locked by: baker; -- date: 1998/06/30 13:30:54; author: baker; state: Exp; lines: +5 -2 -- Added finalization. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " -- Added Initialize_Sync. libflorist-2025.1.0/tests/p990030.adb000066400000000000000000000064601473553204100166620ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 3 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P990030a; procedure P990030 is begin P990030a.Parent_Main; end P990030; libflorist-2025.1.0/tests/p990030.ads000066400000000000000000000063631473553204100167050ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 3 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. procedure P990030; libflorist-2025.1.0/tests/p990030a.ads000066400000000000000000000100521473553204100170340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 3 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001b, -- POSIX mutexes and CVs P990002c, -- POSIX_Calendar and CV time wait P990003a; -- locally shared data package P990030a is new P9900x0 (Version => "30", Needs_Clock_Realtime => True, Jobs_Are_Processes => False, Initialize_Sync => P990001b.Initialize, Do_Input => P990001b.Do_Input, Do_Output => P990001b.Do_Output, Start_All_Jobs => P990001b.Start_All_Jobs, Await_All_Jobs_Done => P990001b.Await_All_Jobs_Done, Await_Start => P990001b.Await_Start, Done_Job => P990001b.Done_Job, Finalize_Sync => P990001b.Finalize, Initialize_Scheduling => P990002c.Initialize_Scheduling, Finalize_Scheduling => P990002c.Finalize, Reschedule => P990002c.Reschedule, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); libflorist-2025.1.0/tests/p990040.adb000066400000000000000000000066501473553204100166640ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 4 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. -- Setup: The executable file for program p990050a should -- be accessible via pathname "./p990050a". with P9900doc, P990040a; procedure P990040 is begin P990040a.Parent_Main; end P990040; libflorist-2025.1.0/tests/p990040.ads000066400000000000000000000061751473553204100167070ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 4 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p990040; libflorist-2025.1.0/tests/p990040a.ads000066400000000000000000000103731473553204100170430ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 4 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- This version uses: -- POSIX processes and process priorities for concurrency and scheduling -- Ada delay statements and Ada.Calendar.Clock for timing control -- POSIX semaphores for mutual exclusion -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001c, -- POSIX named semaphores P990002a, -- Calendar and delay P990003b; -- interprocess shared data package P990040a is new P9900x0 (Version => "40", Needs_Clock_Realtime => False, Jobs_Are_Processes => True, Initialize_Sync => P990001c.Initialize, Do_Input => P990001c.Do_Input, Do_Output => P990001c.Do_Output, Start_All_Jobs => P990001c.Start_All_Jobs, Await_All_Jobs_Done => P990001c.Await_All_Jobs_Done, Await_Start => P990001c.Await_Start, Done_Job => P990001c.Done_Job, Finalize_Sync => P990001c.Finalize, Initialize_Scheduling => P990002a.Initialize_Scheduling, Reschedule => P990002a.Reschedule, Finalize_Scheduling => P990002a.Finalize, Shared_Data => P990003b.Shared_Data, Finalize_Shared_Data => P990003b.Finalize ); libflorist-2025.1.0/tests/p990040b.adb000066400000000000000000000065001473553204100170200ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 4 0 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P990040a; procedure P990040b is begin P990040a.Child_Main; end P990040b; libflorist-2025.1.0/tests/p990040b.ads000066400000000000000000000064031473553204100170430ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 4 0 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc; procedure P990040b; libflorist-2025.1.0/tests/p990050.adb000066400000000000000000000067401473553204100166650ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 5 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. -- Setup: The executable file for program p990050a should -- be accessible via pathname "./p990050a". with P9900doc, P990050a, POSIX_Report; procedure P990050 is begin POSIX_Report.Comment ("P990050"); P990050a.Parent_Main; end P990050; libflorist-2025.1.0/tests/p990050.ads000066400000000000000000000061751473553204100167100ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 5 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p990050; libflorist-2025.1.0/tests/p990050a.ads000066400000000000000000000104071473553204100170420ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 5 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- This version uses: -- POSIX processes and process priorities for concurrency and scheduling -- Ada delay statements and Ada.Real_Time.Clock for timing control -- POSIX semaphores for mutual exclusion -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001c, -- POSIX named semaphores P990002d, -- Ada.Real_Time and delay until P990003b; -- interprocess shared data package P990050a is new P9900x0 (Version => "50", Needs_Clock_Realtime => False, Jobs_Are_Processes => True, Initialize_Sync => P990001c.Initialize, Do_Input => P990001c.Do_Input, Do_Output => P990001c.Do_Output, Start_All_Jobs => P990001c.Start_All_Jobs, Await_All_Jobs_Done => P990001c.Await_All_Jobs_Done, Await_Start => P990001c.Await_Start, Done_Job => P990001c.Done_Job, Finalize_Sync => P990001c.Finalize, Initialize_Scheduling => P990002d.Initialize_Scheduling, Reschedule => P990002d.Reschedule, Finalize_Scheduling => P990002d.Finalize, Shared_Data => P990003b.Shared_Data, Finalize_Shared_Data => P990003b.Finalize ); libflorist-2025.1.0/tests/p990050b.adb000066400000000000000000000065001473553204100170210ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 5 0 b -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P990050a; procedure P990050b is begin P990050a.Child_Main; end P990050b; libflorist-2025.1.0/tests/p990050b.ads000066400000000000000000000064031473553204100170440ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 5 0 b -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc; procedure P990050b; libflorist-2025.1.0/tests/p990060.adb000066400000000000000000000071761473553204100166720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 6 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P990060a; procedure P990060 is begin P990060a.Parent_Main; end P990060; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 locked by: baker; -- date: 1998/06/28 21:26:46; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990060.ads000066400000000000000000000076641473553204100167150ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 6 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc; procedure P990060; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.2 -- date: 1998/03/29 21:57:38; author: baker; state: Exp; lines: +42 -0 -- Added standard header. -- ---------------------------- -- revision 1.3 -- date: 1998/03/30 01:01:00; author: bakers; state: Exp; lines: +2 -2 -- Corrected typos. -- ---------------------------- -- revision 1.4 locked by: baker; -- date: 1998/06/28 21:36:55; author: baker; state: Exp; lines: +8 -4 -- Restructured p9900** series of tests completely, to use -- generic package. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990060a.ads000066400000000000000000000110131473553204100170350ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 6 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001b, -- POSIX mutexes and CVs P990002a, -- Calendar and delay P990003a; -- locally shared data package P990060a is new P9900x0 (Version => "60", Needs_Clock_Realtime => True, Jobs_Are_Processes => False, Initialize_Sync => P990001b.Initialize, Do_Input => P990001b.Do_Input, Do_Output => P990001b.Do_Output, Start_All_Jobs => P990001b.Start_All_Jobs, Await_All_Jobs_Done => P990001b.Await_All_Jobs_Done, Await_Start => P990001b.Await_Start, Done_Job => P990001b.Done_Job, Finalize_Sync => P990001b.Finalize, Initialize_Scheduling => P990002a.Initialize_Scheduling, Reschedule => P990002a.Reschedule, Finalize_Scheduling => P990002a.Finalize, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1998/06/28 21:20:41; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- revision 1.2 locked by: baker; -- date: 1998/06/30 13:30:48; author: baker; state: Exp; lines: +4 -1 -- Added finalization. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " -- Added Initialize_Sync. libflorist-2025.1.0/tests/p990070.adb000066400000000000000000000073201473553204100166620ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 7 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P990070a; procedure P990070 is begin P990070a.Parent_Main; end P990070; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 locked by: baker; -- date: 1998/06/28 21:26:46; author: baker; state: Exp; -- Initial revision -- ============================================================================= -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990070.ads000066400000000000000000000076641473553204100167160ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 7 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc; procedure P990070; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.2 -- date: 1998/03/29 21:57:38; author: baker; state: Exp; lines: +42 -0 -- Added standard header. -- ---------------------------- -- revision 1.3 -- date: 1998/03/30 01:01:00; author: bakers; state: Exp; lines: +2 -2 -- Corrected typos. -- ---------------------------- -- revision 1.4 locked by: baker; -- date: 1998/06/28 21:36:55; author: baker; state: Exp; lines: +8 -4 -- Restructured p9900** series of tests completely, to use -- generic package. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990070a.ads000066400000000000000000000110141473553204100170370ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 7 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001c, -- POSIX named semaphores P990002a, -- Calendar and delay P990003a; -- locally shared data package P990070a is new P9900x0 (Version => "70", Needs_Clock_Realtime => True, Jobs_Are_Processes => False, Initialize_Sync => P990001c.Initialize, Do_Input => P990001c.Do_Input, Do_Output => P990001c.Do_Output, Start_All_Jobs => P990001c.Start_All_Jobs, Await_All_Jobs_Done => P990001c.Await_All_Jobs_Done, Await_Start => P990001c.Await_Start, Done_Job => P990001c.Done_Job, Finalize_Sync => P990001c.Finalize, Initialize_Scheduling => P990002a.Initialize_Scheduling, Reschedule => P990002a.Reschedule, Finalize_Scheduling => P990002a.Finalize, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1998/06/28 21:20:41; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- revision 1.2 locked by: baker; -- date: 1998/06/30 13:30:48; author: baker; state: Exp; lines: +4 -1 -- Added finalization. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " -- Added Initialize_Sync. libflorist-2025.1.0/tests/p990080.adb000066400000000000000000000073201473553204100166630ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 8 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P990080a; procedure P990080 is begin P990080a.Parent_Main; end P990080; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 locked by: baker; -- date: 1998/06/28 21:26:43; author: baker; state: Exp; -- Initial revision -- ============================================================================= -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990080.ads000066400000000000000000000076651473553204100167200ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 8 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc; procedure P990080; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.2 -- date: 1998/03/29 21:57:30; author: baker; state: Exp; lines: +42 -0 -- Added standard header. -- ---------------------------- -- revision 1.3 -- date: 1998/03/30 01:00:12; author: bakers; state: Exp; lines: +2 -2 -- Corrected typos. -- ---------------------------- -- revision 1.4 locked by: baker; -- date: 1998/06/28 21:36:50; author: baker; state: Exp; lines: +7 -3 -- Restructured p9900** series of tests completely, to use -- generic package. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990080a.ads000066400000000000000000000110231473553204100170400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 8 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001a, -- protected objects P990002d, -- Ada.Real_Time and delay until P990003a; -- locally shared data package P990080a is new P9900x0 (Version => "80", Needs_Clock_Realtime => False, Jobs_Are_Processes => False, Initialize_Sync => P990001a.Initialize, Do_Input => P990001a.Do_Input, Do_Output => P990001a.Do_Output, Start_All_Jobs => P990001a.Start_All_Jobs, Await_All_Jobs_Done => P990001a.Await_All_Jobs_Done, Await_Start => P990001a.Await_Start, Done_Job => P990001a.Done_Job, Finalize_Sync => P990001a.Finalize, Initialize_Scheduling => P990002d.Initialize_Scheduling, Reschedule => P990002d.Reschedule, Finalize_Scheduling => P990002d.Finalize, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1998/06/28 21:20:40; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- revision 1.2 locked by: baker; -- date: 1998/06/30 13:30:45; author: baker; state: Exp; lines: +4 -3 -- Added finalization. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " -- Added Initialize_Sync. libflorist-2025.1.0/tests/p990090.adb000066400000000000000000000073201473553204100166640ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 9 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P990090a; procedure P990090 is begin P990090a.Parent_Main; end P990090; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 locked by: baker; -- date: 1998/06/28 21:26:43; author: baker; state: Exp; -- Initial revision -- ============================================================================= -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990090.ads000066400000000000000000000076641473553204100167200ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 9 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc; procedure P990090; ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.2 -- date: 1998/03/29 21:57:30; author: baker; state: Exp; lines: +42 -0 -- Added standard header. -- ---------------------------- -- revision 1.3 -- date: 1998/03/30 01:00:12; author: bakers; state: Exp; lines: +2 -2 -- Corrected typos. -- ---------------------------- -- revision 1.4 locked by: baker; -- date: 1998/06/28 21:36:50; author: baker; state: Exp; lines: +7 -3 -- Restructured p9900** series of tests completely, to use -- generic package. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " libflorist-2025.1.0/tests/p990090a.ads000066400000000000000000000110221473553204100170400ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 9 0 a -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc.ads for more detailed explanation. with P9900doc, P9900x0, P990001a, -- protected objects P990002b, -- Clock_Realtime and Timed_Wait P990003a; -- locally shared data package P990090a is new P9900x0 (Version => "90", Needs_Clock_Realtime => True, Jobs_Are_Processes => False, Initialize_Sync => P990001a.Initialize, Do_Input => P990001a.Do_Input, Do_Output => P990001a.Do_Output, Start_All_Jobs => P990001a.Start_All_Jobs, Await_All_Jobs_Done => P990001a.Await_All_Jobs_Done, Await_Start => P990001a.Await_Start, Done_Job => P990001a.Done_Job, Finalize_Sync => P990001a.Finalize, Initialize_Scheduling => P990002b.Initialize_Scheduling, Reschedule => P990002b.Reschedule, Finalize_Scheduling => P990002b.Finalize, Shared_Data => P990003a.Shared_Data, Finalize_Shared_Data => P990003a.Finalize ); ---------------------- -- REVISION HISTORY -- ---------------------- -- ---------------------------- -- revision 1.1 -- date: 1998/06/28 21:20:40; author: baker; state: Exp; -- Initial revision -- ---------------------------- -- revision 1.2 locked by: baker; -- date: 1998/06/30 13:30:45; author: baker; state: Exp; lines: +4 -3 -- Added finalization. -- ---------------------------- -- New changes after this line. Each line starts with: "-- " -- Added Initialize_Sync. libflorist-2025.1.0/tests/p9900doc.ads000066400000000000000000000206711473553204100172260ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 d o c -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MECHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package is a dummy, just to hold comments that apply to all -- of the P9900** series of tests. -- Each of these tests runs a set of periodic tasks or processes -- that serially share access to an "I/O" object. -- The tests differ by the mechanisms that they use for: -- concurrency & priority scheduling -- timing control -- mutual exclusion and synchronization -- access to shared data -- This set of tests comprises the following files: -- Common components, used by all P9900** tests -- ----------------- -- P990000.ads common declarations -- P990000.adb -- P9900x0.ads generic main program -- P9900x0.adb -- Mutual exclusion -- ---------------- -- P990001a.ads mutual exclusion, using Ada protected objects -- P990001a.adb -- P990001b.ads mutual exclusion, using POSIX mutexes and condition variables -- P990001b.adb -- P990001c.ads mutual exclusion, using POSIX named semaphores -- P990001c.adb -- Timing Control -- -------------- -- P990002a.ads scheduling, using Ada clock and delay until statement -- P990002a.adb -- P990002b.ads scheduling, using POSIX Clock_Realtime and Timed_Wait on a CV -- P990002b.adb -- P990002c.ads scheduling, using POSIX_Calendar.Clock and Timed_Wait on a CV -- P990002c.adb -- Access to Shared Data -- --------------------- -- P990003a.ads shared variable stuff, single process w/local memory -- P990003a.adb -- P990003b.ads shared variable stuff, multiple processes w/memory mapping -- P990003b.adb -- Tests (N = 1 .. 4) -- ----- -- P9900N0a.ads components of test P990010 -- P9900N0.ads main program of test -- P9900N0.adb -- P9900N0b.ads main program of child process, if applicable -- The tests that use processes (instead of tasks) -- for concurrency need to have the executable file for the -- child process available in the process working directory -- when the test program is run. The name of the child -- process executable file is the name of the parent with -- the letter "b" appended to the name. For example, for -- test p990040 you need program p990040b for the child. -- Conflict Matrix --------------------------------------------------------------------------- -- p p p p p p p p p p p p -- 9 9 9 9 9 9 9 9 9 9 9 9 -- 9 9 9 9 9 9 9 9 9 9 9 9 -- 0 0 0 0 0 0 0 0 0 0 0 0 -- 0 x x 0 0 0 0 0 0 0 0 0 -- 0 0 0 1 1 1 2 2 2 2 3 3 -- * a b c a b c d a b ----------------------------------------------------------------------------- -- P990000 common declarations -- P9900x0 generic mains -- P9900x0* X *child_main ----------------------------------------------------------------------------- -- P990001a X X X protected objects -- P990001b X X X basic mutexes and CVs -- P990001c X X named semaphores ----------------------------------------------------------------------------- -- P990002a X X X clock and delay -- P990002b X X X Clock_Realtime and Timed_Wait -- P990002c X X X POSIX_Calendar.Clock and delay -- P990002d X X X Ada.Real_Time.Clock and Timed_Wait ----------------------------------------------------------------------------- -- P990003a X X local memory -- P990003b X X X shared memory ----------------------------------------------------------------------------- -- Use Matrix --------------------------------------------------------------------------- -- p p p p p p p p p p -- 9 9 9 9 9 9 9 9 9 9 -- 9 9 9 9 9 9 9 9 9 9 -- 0 0 0 0 0 0 0 0 0 0 -- 0 0 0 0 0 0 0 0 0 0 -- 1 2 3 4 5 6 7 8 9 1 -- 0 0 0 0 0 0 0 0 0 1 --------------------------------------------------------------------------- -- P990000 X X X X X X X X X X common declarations -- P9900x0 X X X X X X X X X X generic mains -- P9900x0* X X *child_main --------------------------------------------------------------------------- -- P990001a X X X X protected objects -- P990001b X X X basic mutexes and CVs -- P990001c X X X named semaphores --------------------------------------------------------------------------- -- P990002a X X X X clock and delay -- P990002b X X Clock_Realtime and Timed_Wait -- P990002c X X POSIX_Calendar.Clock and Timed_Wait -- P990002d X X Ada.Real_Time.Clock and delay --------------------------------------------------------------------------- -- P990003a X X X X X X X X local memory -- P990003b X X shared memory --------------------------------------------------------------------------- package P9900doc is end P9900doc; libflorist-2025.1.0/tests/p9900x0.adb000066400000000000000000000370701473553204100167700ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 x 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. with Calendar, Ada.Real_Time, POSIX, POSIX_Calendar, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Process_Scheduling, POSIX_Report, POSIX_Timers, System, P9900doc, P990000; package body P9900x0 is use P990000, POSIX, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Process_Scheduling, POSIX_Report; Data : Shared_Data_Ptr; -- Initialized in each main procedure. -- For versions that use multiple processes, we also need to -- set the process priority, elsewhere. procedure Compute_Loads (Load_Factor : Positive); procedure Find_Utilization_Limit; procedure Start_Tasks; procedure Stop_Tasks; procedure Start_Processes; procedure Stop_Processes; procedure Work (Job : Jobs); -- Implements the body of periodic task. function Run_Jobs return Boolean; procedure Compute_Loads (Load_Factor : Positive) is begin Data.Input_Load (1) := 1; for J in Jobs loop Data.Input_Load (J) := Integer (Float (Load_Factor) * Input_Time (J)); Data.Output_Load (J) := Integer (Float (Load_Factor) * Output_Time (J)); Data.Computation_Load (J) := Integer (Float (Load_Factor) * Computation_Time (J)); end loop; exception when E : others => Fatal_Exception (E, "A001: P9900x0"); end Compute_Loads; procedure Work (Job : Jobs) is begin Await_Start; loop Do_Input (Data.Input_Load (Job)); Do_Computation (Data.Computation_Load (Job)); Do_Output (Data.Output_Load (Job)); exit when not Reschedule (Job); end loop; Done_Job; exception when E : others => Done_Job; Fatal_Exception (E, "A002: P9900x0"); end Work; function Run_Jobs return Boolean is begin Data.Missed_Deadlines := False; Initialize_Sync; if Jobs_Are_Processes then Start_Processes; Data.Start_POSIX_Time := POSIX_Calendar.Clock; Data.Start_Calendar_Time := Calendar.Clock; Data.Start_Real_Time := Ada.Real_Time.Clock; if Needs_Clock_Realtime then Data.Start_Timespec := POSIX_Timers.Get_Time (POSIX_Timers.Clock_Realtime); end if; Initialize_Scheduling (Data); Start_All_Jobs; Await_All_Jobs_Done; Stop_Processes; else Start_Tasks; Data.Start_POSIX_Time := POSIX_Calendar.Clock; Data.Start_Calendar_Time := Calendar.Clock; Data.Start_Real_Time := Ada.Real_Time.Clock; if Needs_Clock_Realtime then Data.Start_Timespec := POSIX_Timers.Get_Time (POSIX_Timers.Clock_Realtime); end if; Initialize_Scheduling (Data); Start_All_Jobs; Await_All_Jobs_Done; Stop_Tasks; end if; Finalize_Scheduling; return not Data.Missed_Deadlines; exception when E : others => Finalize_Scheduling; Fatal_Exception (E, "A003: P9900x0"); return not Data.Missed_Deadlines; end Run_Jobs; procedure Find_Utilization_Limit is use Calendar; T1, T2 : Time; Clock_Resolution_Bound, D, Base : Duration; K, Hi, Lo, Load_Factor : Integer; Total_Utilization, Unit_Work_Execution_Time : Float; begin -- Compute job periods and estimate total utilization. Total_Utilization := 0.0; for J in Jobs loop Total_Utilization := Total_Utilization + (Input_Time (J) + Computation_Time (J) + Output_Time (J)) * float (Rate (J)); end loop; -- Estimate resolution of Calendar.Clock. Clock_Resolution_Bound := 100.0; for I in 1 .. 1000 loop T1 := Clock; loop T2 := Clock; D := T2 - T1; exit when D > 0.0; T1 := T2; end loop; if D < Clock_Resolution_Bound then Clock_Resolution_Bound := D; end if; end loop; Comment ("using clock resolution bound of" & Integer'Image (Integer (D * 1_000_000)) & "us"); -- Use Calendar.Clock to measure execution time of -- procedure P990000.Do_Unit_Work, to a number of decimal -- digits specified by the constant Real_Accuracy. -- Use dual-loop benchmark method. K := 10000; loop T1 := Clock; for J in 1 .. K loop P990000.Do_Unit_Work (J); end loop; T2 := Clock; Base := T2 - T1; exit when Base > Real_Accuracy * Clock_Resolution_Bound; K := K * 10; end loop; T1 := Clock; for J in 1 .. K loop P990000.Do_Unit_Work (J); P990000.Do_Unit_Work (J); end loop; T2 := Clock; D := (T2 - T1) - Base; Unit_Work_Execution_Time := Float (D) / Float (K); Comment ("unit_work computation time", To_Timespec (Duration (Unit_Work_Execution_Time))); -- Initialize lower and upper bounds on achievable -- load factor, before bisection. -- Upper bound (Hi) must be high enough to cause failure. Lo := 1; Comment ("finding a breakdown load factor"); Hi := 1; loop Compute_Loads (Hi); if Run_Jobs then Lo := Hi; Comment ("underloaded at " & Integer'Image (Hi)); Hi := Hi * 16; else Comment ("overloaded at " & Integer'Image (Hi)); exit; end if; end loop; -- Zero in on maximum workable load factor, by bisection. Comment ("using bisection to find limiting load factor"); loop Load_Factor := (Lo + Hi) / 2; -- Lo <= Load_Factor < Hi Compute_Loads (Load_Factor); if Run_Jobs then Lo := Load_Factor; Comment ("underloaded at " & Integer'Image (Load_Factor)); else Hi := Load_Factor; Comment ("overloaded at " & Integer'Image (Load_Factor)); end if; exit when Hi - Lo <= (Load_Factor + Accuracy) / Accuracy; end loop; Comment ("limiting load factor =" & Integer'Image (Load_Factor)); -- Compute actual effective utilization. Total_Utilization := 0.0; for J in Jobs loop Total_Utilization := Total_Utilization + Float ((Data.Input_Load (J) + Data.Output_Load (J) + Data.Computation_Load (J)) * Rate (J)) * Unit_Work_Execution_Time; end loop; Comment ("apparent limit utilization =" & Integer'Image (Integer (Total_Utilization * 100.0)) & "%"); exception when E : others => Fatal_Exception (E, "A004: P9900x0"); end Find_Utilization_Limit; task type Periodic_Task (Job : Jobs) is pragma Priority (Priority (Job)); end Periodic_Task; type Periodic_Task_Ptr is access all Periodic_Task; task body Periodic_Task is begin Work (Job); end Periodic_Task; Periodic_Tasks : array (Jobs) of Periodic_Task_Ptr; procedure Start_Tasks is begin for J in Jobs loop Periodic_Tasks (J) := new Periodic_Task (J); end loop; exception when E : others => Fatal_Exception (E, "A005: P9900x0: in Start_Jobs"); end Start_Tasks; procedure Stop_Tasks is begin for J in Jobs loop if not Periodic_Tasks (J).all'Terminated then abort Periodic_Tasks (J).all; end if; end loop; exception when E : others => Fatal_Exception (E, "A006: P9900x0: in Stop_Jobs"); end Stop_Tasks; Status : Termination_Status; Periodic_Processes : array (Jobs) of Process_ID; procedure Start_Processes is Child_Pathname : constant POSIX.Pathname := "p9900" & To_POSIX_String (Version) & "b"; Template : Process_Template; Args : POSIX_String_List; Parms : Scheduling_Parameters; Max_Prio : constant Scheduling_Priority := Get_Maximum_Priority (Sched_FIFO); Min_Prio : constant Scheduling_Priority := Get_Minimum_Priority (Sched_FIFO); Num_Jobs : constant Integer := Jobs'Last - Jobs'First + 1; function Process_Prio (Prio : System.Priority) return Scheduling_Priority; function Process_Prio (Prio : System.Priority) return Scheduling_Priority is -- In System.Priority, higher numbers are higher priorities; -- so also for Scheduling_Priority values. begin return Scheduling_Priority (Max_Prio - (System.Priority'Last - Prio)); end Process_Prio; begin -- set main process's priority to the maximum Assert (Integer (Max_Prio - Min_Prio + 1) >= Num_Jobs + 1, "A007: P9900x0"); Comment ("min_prio = " & Scheduling_Priority'Image (Min_Prio)); Comment ("max_prio = " & Scheduling_Priority'Image (Max_Prio)); Comment ("num_jobs = " & Jobs'Image (Num_Jobs)); begin Comment ("priority = " & Scheduling_Priority'Image (Process_Prio (System.Priority'Last))); exception when E : others => Unexpected_Exception (E, "A008: P9900x0: in Run_Jobs/Set_Priority"); raise POSIX_Error; end; begin Comment ("Set_Priority to system.Priority'last"); Set_Priority (Parms, Process_Prio (System.Priority'Last)); exception when E: others => Unexpected_Exception (E, "A009: P9900x0: in Run_Jobs/Set_Priority"); raise POSIX_Error; end; Comment ("setting scheduling policy"); begin null; Set_Scheduling_Policy (Process => Get_Process_ID, New_Policy => Sched_FIFO, Parameters => Parms); exception when E1 : POSIX_Error => Privileged (Realtime_Process_Priority_Privilege, Priority_Process_Scheduling_Option, Operation_Not_Permitted, E1, "A010: P9900x0"); when E2 : others => Unexpected_Exception (E2, "A011: P9900x0: in Run_Jobs/Set_Sched_Policy"); raise POSIX_Error; end; Open_Template (Template); -- create the periodic processes for J in Jobs loop Make_Empty (Args); POSIX.Append (Args, Child_Pathname); Pass_Through_Verbosity (Args); POSIX.Append (Args, "-child" & To_POSIX_String (Jobs'Image (J))); Start_Process (Child => Periodic_Processes (J), Pathname => Child_Pathname, Template => Template, Arg_List => Args); Set_Priority (Parms, Process_Prio (Priority (J))); Set_Scheduling_Policy (Process => Periodic_Processes (J), New_Policy => Sched_FIFO, Parameters => Parms); Wait_For_Child_Process (Status => Status, Child => Periodic_Processes (J), Block => False); Assert (not Status_Available (Status), "A012: P9900x0"); end loop; exception when E : others => Fatal_Exception (E, "A013: P9900x0: Start_Jobs"); end Start_Processes; procedure Stop_Processes is begin for J in Jobs loop Wait_For_Child_Process (Status => Status, Child => Periodic_Processes (J)); Check_Child_Status (Status => Status, Child_ID => Periodic_Processes (J), Expected => 0, Message => "A014: P9900x0"); end loop; exception when E : others => Fatal_Exception (E, "A015: P9900x0: Stop_Jobs"); end Stop_Processes; procedure Parent_Main is task Main is pragma Priority (Main_Priority); end Main; task body Main is begin Header ("P9900" & Version, Root_OK => True); Optional (Priority_Process_Scheduling_Option, "A016: P9900x0"); if Needs_Clock_Realtime then Optional (Timers_Option, "P9900x0"); end if; Data := Shared_Data; Find_Utilization_Limit; Done; exception when E : others => Fatal_Exception (E, "A017: P9900x0"); end Main; begin while not Main'Terminated loop delay 1.0; end loop; Finalize_Sync; Finalize_Shared_Data; exception when E : others => Finalize_Sync; Finalize_Shared_Data; Fatal_Exception (E, "A018: P9900x0"); end Parent_Main; procedure Child_Main is begin Data := Shared_Data; Initialize_Scheduling (Data); Work (Jobs (Child)); exception when E : others => Fatal_Exception (E, "A019: P9900x0"); end Child_Main; end P9900x0; libflorist-2025.1.0/tests/p9900x0.ads000066400000000000000000000101311473553204100167760ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 9 9 0 0 x 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Simulate mix of periodic jobs with rate monotone priorities. -- See P9900doc for more detailed explanation. with P9900doc, POSIX, P990000; use P990000; generic Version : String; Needs_Clock_Realtime : Boolean; Jobs_Are_Processes : Boolean; with procedure Initialize_Sync; with procedure Do_Input (Load : Natural); with procedure Do_Output (Load : Natural); with procedure Start_All_Jobs; with procedure Await_All_Jobs_Done; with procedure Await_Start; with procedure Done_Job; with procedure Finalize_Sync; with procedure Initialize_Scheduling (Shared_Data : Shared_Data_Ptr); with function Reschedule (Job : Jobs) return Boolean; with procedure Finalize_Scheduling; with function Shared_Data return Shared_Data_Ptr; with procedure Finalize_Shared_Data; package P9900x0 is procedure Parent_Main; procedure Child_Main; -- Child_Main is only used for tests that involve creation of -- more than one POSIX process. end P9900x0; libflorist-2025.1.0/tests/posix_report.adb000066400000000000000000000750701473553204100204760ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P O S I X _ R E P O R T -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 2000-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Command_Line, Ada.Text_IO, POSIX_Configurable_System_Limits, POSIX_Options, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Signals; pragma Elaborate_All (POSIX_Process_Identification); package body POSIX_Report is use Ada.Command_Line, Ada.Exceptions, Ada.Text_IO, POSIX, POSIX_Configurable_System_Limits, POSIX_Process_Identification, POSIX_Process_Primitives, POSIX_Options, POSIX_Signals; subtype Exit_Status is POSIX_Process_Primitives.Exit_Status; ------------------------- -- Local Subprograms -- ------------------------- function int_to_uid (Id : Integer) return POSIX_Process_Identification.User_ID; procedure Fail (E : Ada.Exceptions.Exception_Occurrence; Message : String); function Option_Name (Option : POSIX_Option) return String; pragma Warnings (Off, Option_Name); procedure Nonsupport_Message (Option : POSIX_Option; Message : String); procedure Fail (E : Exception_Occurrence; Message : String) is begin Put (" !!TEST FAILED: " & Exception_Name (E)); if Message = "" then if Exception_Message (E) = "" then New_Line; else Put_Line (": " & Exception_Message (E)); end if; elsif Exception_Message (E) = "" then Put_Line (": " & Message); else Put_Line (": " & Exception_Message (E) & ": " & Message); end if; Error_Count := Error_Count + 1; end Fail; function Option_Name (Option : POSIX_Option) return String is begin case Option is when Asynchronous_IO_Option => return "Asynchronous IO"; when Change_Owner_Restriction_Option => return "Change Owner Restriction"; when Filename_Truncation_Option => return "Filename Truncation"; when File_Synchronization_Option => return "File Synchronization"; when Memory_Mapped_Files_Option => return "Memory Mapped Files"; when Memory_Locking_Option => return "Memory Locking"; when Memory_Range_Locking_Option => return "Memory Range Locking"; when Memory_Protection_Option => return "Memory Protection"; when Message_Queues_Option => return "Message Queues"; when Mutex_Priority_Ceiling_Option => return "Mutex Priority Ceiling"; when Mutex_Priority_Inheritance_Option => return "Mutex Priority Inheritance"; when Mutex_Option => return "Mutexes"; when Prioritized_IO_Option => return "Prioritized IO"; when Priority_Process_Scheduling_Option => return "Priority Process Scheduling"; when Priority_Task_Scheduling_Option => return "Priority Task Scheduling"; when Process_Shared_Option => return "Process Shared"; when Realtime_Signals_Option => return "Realtime Signals"; when Saved_IDs_Option => return "Saved IDs"; when Job_Control_Option => return "Job Control"; when Semaphores_Option => return "Semaphores"; when Shared_Memory_Objects_Option => return "Shared Memory"; when Signal_Entries_Option => return "Signal Entries"; when Synchronized_IO_Option => return "Synchronized IO"; when Timers_Option => return "Timers"; end case; end Option_Name; function int_to_uid (Id : Integer) return POSIX_Process_Identification.User_ID is begin return Value (Integer'Image (Id)); end int_to_uid; procedure Nonsupport_Message (Option : POSIX_Option; Message : String) is begin if not Nonsupport (Option) then if Message = "" then Comment (POSIX_Option'Image (Option) & " not supported"); else Comment (POSIX_Option'Image (Option) & " not supported [" & Message & "]"); end if; Nonsupport (Option) := True; end if; end Nonsupport_Message; ----------------------- -- Local Variables -- ----------------------- Super_User_ID : User_ID := int_to_uid (0); procedure Header (Label : String; Root_OK : Boolean := False) is begin Put_Line (",.,. " & Label & " " & Test_Identifier); if Get_Real_User_ID = Super_User_ID and then not Root_OK then Fail ("For safety reasons, the test program should not be " & "run as root"); Done; Exit_Process (Exit_Status'Last); end if; Program_Name_Length := Label'Length; if Program_Name_Length > Program_Name'Length then Program_Name_Length := Program_Name'Length; end if; Program_Name (1 .. Program_Name_Length) := Label (Label'First .. Label'First + Program_Name_Length - 1); exception when E : others => Fatal_Exception (E, "in Header"); end Header; procedure Test (Label : String) is begin if not Terse then Put_Line ("---- *-Subtest: " & Label); Flush; end if; Test_Label_Length := Label'Length; if Test_Label_Length > Test_Label'Length then Test_Label_Length := Test_Label'Length; end if; Test_Label (1 .. Test_Label_Length) := Label (Label'First .. Label'First + Test_Label_Length - 1); end Test; procedure Fail (Message : String) is begin Put_Line (" !!TEST FAILED: " & Message); Flush; Error_Count := Error_Count + 1; end Fail; procedure Assert (Condition : Boolean; Message : String) is begin if not Condition then if Message = "" then Fail ("assert"); else Fail ("assert [" & Message & "]"); end if; end if; end Assert; procedure Expect_Exception (Message : String) is begin Fail ("exception not raised [" & Message & "]"); end Expect_Exception; procedure Unexpected_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin Fail ("exception " & Exception_Name (E) & " [" & Message & "]"); if Exception_Message (E) /= "" and then Verbose then Put_Line (" -- Exception message = " & Exception_Message (E)); Flush; end if; end Unexpected_Exception; procedure Check_Error_Code (EC : POSIX.Error_Code; Message : String) is EEC : POSIX.Error_Code := POSIX.Get_Error_Code; begin if EEC /= EC then if Message = "" then Fail ("incorrect error code " & POSIX.Image (EEC) & " [expected " & POSIX.Image (EC) & "]"); else Fail ("incorrect error code " & POSIX.Image (EEC) & " [expected " & POSIX.Image (EC) & "]" & ": " & Message); end if; end if; end Check_Error_Code; procedure Check_Error_Code (EC : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is EEC : POSIX.Error_Code := POSIX.Get_Error_Code; begin if Exception_Identity (E) /= POSIX_Error'Identity then Fail (E, Message); elsif EEC /= EC then if Message = "" then Fail ("incorrect error code " & POSIX.Image (EEC) & " [expected " & POSIX.Image (EC) & "]"); else Fail ("incorrect error code " & POSIX.Image (EEC) & " [expected " & POSIX.Image (EC) & "]" & ": " & Message); end if; elsif Exception_Message (E) /= "" and then Exception_Message (E) /= POSIX.Image (EC) then if Message = "" then Fail ("incorrect Exception_Message: " & Exception_Message (E)); else Fail ("incorrect Exception_Message: " & Exception_Message (E) & ": " & Message); end if; end if; end Check_Error_Code; procedure Check_Message (E : Ada.Exceptions.Exception_Occurrence; Expected_Message : String; Message : String) is begin if Exception_Message (E) /= Expected_Message then Fail (Message & ": message is not " & Expected_Message); end if; end Check_Message; procedure Comment (Msg : String) is begin if Verbose then Put_Line (" -- " & Msg); Flush; end if; end Comment; function Image (T : POSIX.Timespec) return String is S : Seconds; NS : Nanoseconds; Z : constant Integer := Character'Pos ('0'); begin Split (T, S, NS); declare SBuff : String (1 .. 9) := "000000000"; I : Integer := SBuff'Last; begin while NS > 0 loop SBuff (I) := Character'Val (Z + Integer (NS rem 10)); NS := NS / 10; I := I - 1; end loop; return Seconds'Image (S) & "." & SBuff & "s"; end; end Image; procedure Comment (Msg : String; T : POSIX.Timespec) is begin Comment (Msg & " = " & Image (T)); end Comment; function Is_Supported (Option : POSIX_Option) return Boolean is use POSIX_Configurable_System_Limits; begin case Option is when Asynchronous_IO_Option => if True in Asynchronous_IO_Support then if False in Asynchronous_IO_Support then return Asynchronous_IO_Is_Supported; end if; else return False; end if; when Change_Owner_Restriction_Option => raise Constraint_Error; when Filename_Truncation_Option => raise Constraint_Error; when File_Synchronization_Option => if True in File_Synchronization_Support then if False in File_Synchronization_Support then return File_Synchronization_Is_Supported; end if; else return False; end if; when Memory_Mapped_Files_Option => if True in Memory_Mapped_Files_Support then if False in Memory_Mapped_Files_Support then return Memory_Mapped_Files_Are_Supported; end if; else return False; end if; when Memory_Locking_Option => if True in Memory_Locking_Support then if False in Memory_Locking_Support then return Memory_Locking_Is_Supported; end if; else return False; end if; when Memory_Range_Locking_Option => if True in Memory_Range_Locking_Support then if False in Memory_Range_Locking_Support then return Memory_Range_Locking_Is_Supported; end if; else return False; end if; when Memory_Protection_Option => if True in Memory_Protection_Support then if False in Memory_Protection_Support then return Memory_Protection_Is_Supported; end if; else return False; end if; when Message_Queues_Option => if True in Message_Queues_Support then if False in Message_Queues_Support then return Message_Queues_Are_Supported; end if; else return False; end if; when Mutex_Priority_Ceiling_Option => if True in Mutex_Priority_Ceiling_Support then if False in Mutex_Priority_Ceiling_Support then return Mutex_Priority_Ceiling_Is_Supported; end if; else return False; end if; when Mutex_Priority_Inheritance_Option => if True in Mutex_Priority_Inheritance_Support then if False in Mutex_Priority_Inheritance_Support then return Mutex_Priority_Inheritance_Is_Supported; end if; else return False; end if; when Mutex_Option => if True in Mutexes_Support then if False in Mutexes_Support then return Mutexes_Are_Supported; end if; else return False; end if; when Prioritized_IO_Option => if True in Prioritized_IO_Support then if False in Prioritized_IO_Support then return Prioritized_IO_Is_Supported; end if; else return False; end if; when Priority_Process_Scheduling_Option => if True in Priority_Process_Scheduling_Support then if False in Priority_Process_Scheduling_Support then return Priority_Process_Scheduling_Is_Supported; end if; else return False; end if; when Priority_Task_Scheduling_Option => if True in Priority_Task_Scheduling_Support then if False in Priority_Task_Scheduling_Support then return Priority_Task_Scheduling_Is_Supported; end if; else return False; end if; when Process_Shared_Option => if True in Process_Shared_Support then if False in Process_Shared_Support then return Process_Shared_Is_Supported; end if; else return False; end if; when Realtime_Signals_Option => if True in Realtime_Signals_Support then if False in Realtime_Signals_Support then return Realtime_Signals_Are_Supported; end if; else return False; end if; when Job_Control_Option => if True in POSIX.Job_Control_Support then if False in POSIX.Job_Control_Support then return Job_Control_Is_Supported; end if; else return False; end if; when Saved_IDs_Option => if True in POSIX.Saved_IDs_Support then if False in POSIX.Saved_IDs_Support then return Saved_IDs_Are_Supported; end if; else return False; end if; when Semaphores_Option => if True in Semaphores_Support then if False in Semaphores_Support then return Semaphores_Are_Supported; end if; else return False; end if; when Shared_Memory_Objects_Option => if True in Shared_Memory_Objects_Support then if False in Shared_Memory_Objects_Support then return Shared_Memory_Objects_Are_Supported; end if; else return False; end if; when Signal_Entries_Option => if True in Signal_Entries_Support then if False in Signal_Entries_Support then return True; end if; else return False; end if; when Synchronized_IO_Option => if True in Synchronized_IO_Support then if False in Synchronized_IO_Support then return Synchronized_IO_Is_Supported; end if; else return False; end if; when Timers_Option => if True in Timers_Support then if False in Timers_Support then return Timers_Are_Supported; end if; else return False; end if; end case; return True; end Is_Supported; procedure Optional (Option : POSIX_Option; Message : String) is begin if not Is_Supported (Option) then if Message /= "" then Comment (POSIX_Option'Image (Option) & " required: " & Message); else Comment (POSIX_Option'Image (Option) & " required"); end if; Nonsupport (Option) := True; for I in Nonsupport'Range loop if Nonsupport (I) then Put ("**** Nonsupport of " & POSIX_Option'Image (I) & " detected."); New_Line; end if; end loop; Put_Line ("==== Test Not Applicable."); Exit_Process (Normal_Exit); end if; end Optional; procedure Optional (Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if Is_Supported (Option) or else POSIX.Get_Error_Code /= Expected then Fail (E, Message); else Nonsupport_Message (Option, Message); end if; exception when E1 : others => Fail (E1, "checking for support of " & POSIX_Option'Image (Option)); end Optional; procedure Optional (Option_1 : POSIX_Option; Option_2 : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if (Is_Supported (Option_1) and then Is_Supported (Option_2)) or else POSIX.Get_Error_Code /= Expected then Fail (E, Message); else if not Is_Supported (Option_1) then Nonsupport_Message (Option_1, Message); end if; if not Is_Supported (Option_2) then Nonsupport_Message (Option_2, Message); end if; end if; exception when E1 : others => Fail (E1, "checking for support of options"); end Optional; procedure Optional (Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if Is_Supported (Option) then if POSIX.Get_Error_Code /= Expected_If_Supported then Fail (E, Message); end if; elsif POSIX.Get_Error_Code /= Expected_If_Not_Supported then Fail (E, Message); else Nonsupport_Message (Option, Message); end if; exception when E1 : others => Fail (E1, "checking for support of options"); end Optional; function Uid_To_Integer (Uid : POSIX_Process_Identification.User_ID) return Integer; -- .... not portable; needs configurable mechanism function Uid_To_Integer (Uid : POSIX_Process_Identification.User_ID) return Integer is begin return Integer'Value (POSIX_Process_Identification.Image (Uid)); end Uid_To_Integer; procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is pragma Unreferenced (Privilege); Error : constant POSIX.Error_Code := POSIX.Get_Error_Code; begin if Error = Operation_Not_Permitted then Fail (E, Message & " - insufficient privilege"); Privilege_Failure := True; return; end if; if Is_Supported (Option) or else Error /= Expected then Fail (E, Message); else Nonsupport_Message (Option, Message); end if; exception when E1 : others => Fail (E1, "checking for support of " & POSIX_Option'Image (Option)); end Privileged; procedure Privileged (Privilege : POSIX_Privilege; E : Ada.Exceptions.Exception_Occurrence; Message : String) is pragma Unreferenced (Privilege); Error : constant POSIX.Error_Code := POSIX.Get_Error_Code; begin if Error = Operation_Not_Permitted then -- .... This is temporary. -- For the longer term, there should be a locally configurable -- mechanism for determining whether we have appropriate -- privilege for various operations. For now, we assume that -- appropriate privilege is equivalent to having root user-id. if Uid_To_Integer (POSIX_Process_Identification.Get_Effective_User_ID) = 0 then Fail (E, Message & " - user ID zero has insufficient privilege!"); else Fail (E, Message & " - insufficient privilege"); end if; Privilege_Failure := True; return; end if; Unexpected_Exception (E, Message); end Privileged; procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String) is pragma Unreferenced (Privilege); Error : constant POSIX.Error_Code := POSIX.Get_Error_Code; begin if Error = Operation_Not_Permitted then -- .... This is temporary. -- For the longer term, there should be a locally configurable -- mechanism for determining whether we have appropriate -- privilege for various operations. For now, we assume that -- appropriate privilege is equivalent to having root user-id. if Uid_To_Integer (POSIX_Process_Identification.Get_Effective_User_ID) = 0 then Fail (E, Message & " - user ID zero has insufficient privilege!"); else Fail (E, Message & " - insufficient privilege"); end if; Privilege_Failure := True; return; end if; Optional (Option, Expected_If_Not_Supported, Expected_If_Supported, E, Message); end Privileged; procedure Increment_Error_Count (Number : Integer) is pragma Unreferenced (Number); begin Error_Count := Error_Count + 1; end Increment_Error_Count; function Get_Error_Count return Integer is begin return Error_Count; end Get_Error_Count; procedure Done is begin if Error_Count = 0 and not Privilege_Failure then if Child /= 0 then Comment ("child process completed successfully"); else Put_Line ("==== Test Completed Successfully."); end if; else if Privilege_Failure then if Child /= 0 then Put_Line ("**** Child failed due to insufficient privilege"); else Put_Line ("**** Failed some parts due to insufficient privilege"); end if; end if; if Error_Count > 0 and Child = 0 then Put ("==== Failed"); Put (Natural'Image (Error_Count)); Put (" test"); if Error_Count /= 1 then Put ("s."); end if; New_Line; end if; end if; for I in Nonsupport'Range loop if Nonsupport (I) then Put ("**** Nonsupport of " & POSIX_Option'Image (I) & " detected."); New_Line; end if; end loop; Flush; if Child /= 0 then -- Report number of errors back to parent process. if Error_Count >= Natural (Failed_Creation_Exit) then Put ("==== Child error count overflowed"); Error_Count := Natural (Failed_Creation_Exit) - 1; end if; Exit_Process (Exit_Status (Error_Count)); end if; end Done; procedure Fatal (Msg : String) is begin Fail ("fatal error: [" & Msg & "]"); Done; Exit_Process (Normal_Exit); end Fatal; procedure Fatal_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String) is begin if Message /= "" then Fail ("[" & Message & "] fatal exception " & Exception_Name (E)); else Fail ("fatal exception " & Exception_Name (E)); end if; if Exception_Message (E) /= "" and then Verbose then Put_Line (" -- Exception message = " & Exception_Message (E)); Flush; end if; Done; Exit_Process (Normal_Exit); end Fatal_Exception; procedure Pass_Through_Verbosity (Args : in out POSIX.POSIX_String_List) is begin if Verbose then Append (Args, "-v"); elsif Terse then Append (Args, "-t"); end if; end Pass_Through_Verbosity; procedure Check_Child_Status (Status : Termination_Status; Child_ID : Process_ID; Expected : Exit_Status; Message : String) is E : Exit_Status; begin Assert (Child_ID /= Null_Process_ID, Message & ": null child id"); if not Status_Available (Status) then -- Fail when status not available Fail (Message & ": no status available"); return; end if; Assert (Process_ID_Of (Status) = Child_ID, Message & ": wrong child"); if Termination_Cause_Of (Status) /= Exited then -- Fail when did not exit if Termination_Cause_Of (Status) = Terminated_By_Signal then Assert (False, Message & ": terminated by signal" & POSIX_Signals.Signal'Image (Termination_Signal_Of (Status))); elsif Termination_Cause_Of (Status) = Stopped_By_Signal then Assert (False, Message & ": stopped by signal " & POSIX_Signals.Signal'Image (Stopping_Signal_Of (Status))); else Assert (False, Message & ": unknown exit status"); end if; return; end if; E := Exit_Status_Of (Status); if E > 0 and E < Failed_Creation_Exit then -- child process reports errors via exit status Increment_Error_Count (Integer (E)); elsif E /= Expected then if E = Failed_Creation_Exit then Assert (False, Message & ": failed process creation (41)"); elsif E = Unhandled_Exception_Exit then Assert (False, Message & ": unhandled exception (42)"); elsif E = Normal_Exit then Assert (False, Message & ": normal exit (0)"); else Assert (False, Message & ": exit status =" & Exit_Status'Image (E)); end if; end if; declare Sig : Signal; begin Sig := Stopping_Signal_Of (Status); -- Stopping_Signal_Of invalid status Expect_Exception (Message); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, Message); when E : others => Fail (E, Message); end; declare Sig : Signal; begin Sig := Termination_Signal_Of (Status); -- Termination_Signal_Of invalid status Expect_Exception (Message); exception when POSIX_Error => Check_Error_Code (Invalid_Argument, Message); when E : others => Fail (E, Message); end; exception when E : others => Unexpected_Exception (E, Message); end Check_Child_Status; begin for I in 1 .. Argument_Count loop if Argument (I) = "-v" then Verbose := True; elsif Argument (I) = "-t" then Terse := True; elsif Argument (I)'Length >= 6 and then Argument (I)(Argument (I)'First .. Argument (I)'First + 5) = "-child" then -- Treat this argument as value of Child. -- Default value is 1. declare Arg : constant String := Argument (I); J : Integer := Arg'First + 6; Tmp : Integer := 0; begin while J <= Arg'Last and then Arg (J) = ' ' loop J := J + 1; end loop; while J <= Arg'Last and then Arg (J) in '0' .. '9' loop Tmp := Tmp * 10 + Character'Pos (Arg (J)) - Character'Pos ('0'); J := J + 1; end loop; while J <= Arg'Last and then Arg (J) = ' ' loop J := J + 1; end loop; if J /= Arg'Last + 1 or Tmp = 0 then Child := 1; else Child := Tmp; end if; exception when others => Fail ("bad command-line argument"); end; end if; end loop; end POSIX_Report; libflorist-2025.1.0/tests/posix_report.ads000066400000000000000000000272321473553204100205140ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P O S I X _ R E P O R T -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] with Ada.Exceptions, POSIX, POSIX_Process_Identification, POSIX_Process_Primitives; package POSIX_Report is -- This package contains utility routines which are useful for -- running tests. Verbose : Boolean := False; -- set to True if "-v" is on command line. Terse : Boolean := False; -- set to True if "-t" is on command line. Child : Natural := 0; -- set to 1 if "-child" is on command line -- set to NNN if "-child NNN" is on command line, where NNN is a number Test_Identifier : String := "POSIX Ada Validation Tests, Version 1.3a"; -- Call this once for each test program, at the beginning. -- It prints a message indicating that a test is about to be -- performed, regardless of whether verbose is turned on. -- User Root_OK = True if the test is one that makes sense to -- run as root. procedure Header (Label : String; Root_OK : Boolean := False); -- Call this once for each section of the test program. -- It prints a message indicating that a test is about to be -- performed, if verbose is turned on. -- The label should be unique so that if the test fails it is -- possible to find the code for the test by grepping through -- the source. procedure Test (Label : String); -- Call this to record the fact that a test failed. procedure Fail (Message : String); -- Call this to check a condition that should be true. -- The test fails if the argument is false. procedure Assert (Condition : Boolean; Message : String); type POSIX_Option is (Asynchronous_IO_Option, Change_Owner_Restriction_Option, Filename_Truncation_Option, File_Synchronization_Option, Memory_Mapped_Files_Option, Memory_Locking_Option, Memory_Range_Locking_Option, Memory_Protection_Option, Message_Queues_Option, Mutex_Priority_Ceiling_Option, Mutex_Priority_Inheritance_Option, Mutex_Option, Prioritized_IO_Option, Priority_Process_Scheduling_Option, Priority_Task_Scheduling_Option, Process_Shared_Option, Realtime_Signals_Option, Job_Control_Option, Saved_IDs_Option, Semaphores_Option, Shared_Memory_Objects_Option, Signal_Entries_Option, Synchronized_IO_Option, Timers_Option); function Is_Supported (Option : POSIX_Option) return Boolean; -- Call this near the beginning of a test program -- that entirely depends on an option. It will end the test -- if the required option is not supported. procedure Optional (Option : POSIX_Option; Message : String); -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where the feature depends on one option. procedure Optional (Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where the feature depends on two options. procedure Optional (Option_1 : POSIX_Option; Option_2 : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where POSIX_Error should be raised -- with a different error code if the option is supported. procedure Optional (Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); type POSIX_Privilege is (Memory_Locking_Privilege, Realtime_Process_Priority_Privilege, Semaphore_Initialization_Privilege, Set_Time_Privilege); -- add more of these values as we discover more privileges -- Call this inside an exception handler for an -- exception that may be raised in response to an -- attempt to use an optional feature that is not -- supported, where the feature depends on one option -- and also depends on having appropriate privilege. procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); procedure Privileged (Privilege : POSIX_Privilege; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this if the test is supposed to raise an exception, -- other than for nonsupport or lack of privilege. procedure Privileged (Privilege : POSIX_Privilege; Option : POSIX_Option; Expected_If_Not_Supported : POSIX.Error_Code; Expected_If_Supported : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this at a point where control should not reach -- because an exception should have been raised. procedure Expect_Exception (Message : String); -- Call this inside an exception handler for an unexpected -- exception. procedure Unexpected_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for POSIX_Error, -- to validate that the expected error code is set. procedure Check_Error_Code (EC : POSIX.Error_Code; Message : String); -- Call this inside an exception handler for POSIX_Error, -- to validate that the expected error code is set. procedure Check_Error_Code (EC : POSIX.Error_Code; E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this inside an exception handler for any exception -- to check that the exception message is correct. procedure Check_Message (E : Ada.Exceptions.Exception_Occurrence; Expected_Message : String; Message : String); -- Call this from an exception handler for "others", to catch -- completion of test program by an unhandled exception. procedure Fatal_Exception (E : Ada.Exceptions.Exception_Occurrence; Message : String); -- Call this to print out a an informational message, -- iff Verbose = True. -- It does not imply that anything went wrong. procedure Comment (Msg : String); -- Call this to get a printable string for a Timepsec value. function Image (T : POSIX.Timespec) return String; -- This is equivalent to Comment (Msg & " = " & Image (T)); procedure Comment (Msg : String; T : POSIX.Timespec); -- Call this to add to this package's internal error count. procedure Increment_Error_Count (Number : Integer); -- Call this to get this package's internal error count. function Get_Error_Count return Integer; -- Call this once, before exiting, when the testing is complete, -- for normal completion of a main program. procedure Done; -- Call this to terminate a test immediately. procedure Fatal (Msg : String); -- Add to the given argument list the necessary values to pass -- through the verbose/normal/terse state of the parent process. procedure Pass_Through_Verbosity (Args : in out POSIX.POSIX_String_List); -- Check Termination_Status value of child process, to verify -- that the child exited and exited with the anticipated status. -- Add the error count of the child process to that of the parent. procedure Check_Child_Status (Status : POSIX_Process_Primitives.Termination_Status; Child_ID : POSIX_Process_Identification.Process_ID; Expected : POSIX_Process_Primitives.Exit_Status; Message : String); private -- name of the executable file for this program Program_Name : String (1 .. 128) := (others => ' '); Program_Name_Length : Integer := 0; -- label from the last Test subprogram call Test_Label : String (1 .. 128) := (others => ' '); Test_Label_Length : Integer := 0; -- an option has been found to be unsupported Nonsupport : array (POSIX_Option) of Boolean := (others => False); pragma Atomic_Components (Nonsupport); -- an operation has failed due to insufficient privilege Privilege_Failure : Boolean := False; pragma Atomic (Privilege_Failure); -- number of errors so far Error_Count : Natural := 0; pragma Atomic (Error_Count); end POSIX_Report; libflorist-2025.1.0/tests/renumber.adb000066400000000000000000000144541473553204100175570ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- R E N U M B E R -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- Renumbers failure message identifiers in a POSIX.5b test. (a tool) with Ada.Command_Line, Ada.Exceptions, Ada.Strings, Ada.Strings.Fixed, Ada.Text_IO; procedure Renumber is use Ada.Command_Line, Ada.Exceptions, Ada.Strings, Ada.Strings.Fixed, Ada.Text_IO; Infile, Outfile : File_Type; Buf : String (1 .. 128); Last, I, J, K, L : Integer; Count : Integer := 0; Z : constant Integer := Character'Pos ('0'); begin if Argument_Count /= 1 then Put_Line (Standard_Error, "usage: numbering "); return; end if; begin Open (Infile, In_File, Argument (1)); exception when others => Put_Line (Standard_Error, "cannot open input file " & Argument (1)); return; end; begin Open (Outfile, Out_File, Argument (1) & ".scr"); exception when others => begin Create (Outfile, Out_File, Argument (1) & ".scr"); exception when others => Put_Line (Standard_Error, "cannot open or create output file " & Argument (1) & ".scr"); return; end; end; begin loop Get_Line (Infile, Buf, Last); I := 1; J := I + 4; while J <= Last loop if Buf (I) = '"' and then Buf (I + 1) = 'A' and then Buf (I + 2) in '0' .. '9' and then Buf (I + 3) in '0' .. '9' and then Buf (I + 4) in '0' .. '9' then Count := Count + 1; Put (Outfile, """A"); K := Count; L := K / 100; if L /= 0 then Put (Outfile, Character'Val (Z + L)); K:= K - L * 100; else Put (Outfile, '0'); end if; L := K / 10; if L /= 0 then Put (Outfile, Character'Val (Z + L)); K:= K - L * 10; else Put (Outfile, '0'); end if; if K /= 0 then Put (Outfile, Character'Val (Z + K)); else Put (Outfile, '0'); end if; if Buf (I + 5) in 'a' .. 'z' then I := I + 6; J := J + 6; else I := I + 5; J := J + 5; end if; else Put (Outfile, Buf (I)); I:= I + 1; J := J + 1; end if; end loop; for M in I .. Last loop Put (Outfile, Buf (M)); end loop; New_Line (Outfile); end loop; exception when others => null; end; Close (Infile); Close (Outfile); begin Open (Infile, In_File, Argument (1) & ".scr"); exception when others => Put_Line (Standard_Error, "cannot open input file " & Argument (1) & ".scr"); return; end; begin Open (Outfile, Out_File, Argument (1)); exception when others => Put_Line (Standard_Error, "cannot open output file " & Argument (1)); return; end; begin loop Get_Line (Infile, Buf, Last); Put_Line (Outfile, Buf (1 .. Last)); end loop; exception when End_Error => null; end; Close (Infile); Close (Outfile); exception when others => Close (Infile); end Renumber; libflorist-2025.1.0/tests/run_tests_1000077500000000000000000000074341473553204100174640ustar00rootroot00000000000000#!/bin/sh # run all the tests that can reasonably run in a batch # # FLAGS determines the degree of verbosity of the output. # Setting it to "-t" give the tersest form of output. FLAGS="-t" RUN= # remove the old log file # rm -f run_tests_1.log # # run the tests # $RUN ../p020400 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p021000 ${FLAGS} >> run_tests_1.log 2>&1 if [ ! -h bin ] then rm -f ./bin; ln -fs .. ./bin; fi ln -fs ../p030100b $RUN ../p030100 ${FLAGS} >> run_tests_1.log 2>&1 ln -fs ../p030101b $RUN ../p030101 ${FLAGS} >> run_tests_1.log 2>&1 ln -fs ../p030102 $RUN ../p030102 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p030200 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p030300 ${FLAGS} >> run_tests_1.log 2>&1 ln -fs ../p030301b $RUN ../p030301 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p030303 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p030304 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p030305 ${FLAGS} >> run_tests_1.log 2>&1 ln -fs ../p030306a $RUN ../p030306 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p040100 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p040101 ${FLAGS} >> run_tests_1.log 2>&1 #p040300 requires PWD to be set to the current working directory PWD=`pwd` export PWD $RUN ../p040300 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p040301 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p050100 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p050200 ${FLAGS} >> run_tests_1.log 2>&1 umask 033 $RUN ../p050300 ${FLAGS} >> run_tests_1.log 2>&1 # p060100 requires Standard_Error to be a terminal device $RUN ../p060100 ${FLAGS} >> run_tests_1.log $RUN ../p060200 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p060300 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p090100 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p090200 ${FLAGS} >> run_tests_1.log 2>&1 # ../p060100 ${FLAGS} >> run_tests_1.log 2>&1 # ../p060200 ${FLAGS} >> run_tests_1.log 2>&1 # ../p060300 ${FLAGS} >> run_tests_1.log 2>&1 # p070200 requires Standard_Error to be a terminal device # and (apparently) cannot be run in background without hanging # on attempt to set terminal characteristics "after output" # or "after input and output". $RUN ../p070200 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p090100 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p090200 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p110100 ${FLAGS} >> run_tests_1.log 2>&1 # p110101 required raising ulimit -v to 20000 $RUN ../p110101 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p110200 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p110201 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p110300 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p120100 ${FLAGS} >> run_tests_1.log 2>&1 # p120101 should really be run without resource limits ln -fs ../p120101 $RUN ../p120101 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p120200 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p120300 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p120400 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p120500 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p120501 ${FLAGS} >> run_tests_1.log 2>&1 ln -fs ../p120502a $RUN ../p120502 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p140100 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p140101 ${FLAGS} >> run_tests_1.log 2>&1 ln -fs ../p150100b $RUN ../p150100 ${FLAGS} >> run_tests_1.log 2>&1 $RUN ../p150101 ${FLAGS} >> run_tests_1.log 2>&1 # Run the following tests by hand, since they take a very long # time to run and generally exceed the resource and time limits set # in this script to catch infinite loops. # ../p990010 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990011 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990020 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990030 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990040 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990050 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990060 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990070 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990080 ${FLAGS} >> run_tests_1.log 2>&1 # ../p990090 ${FLAGS} >> run_tests_1.log 2>&1 libflorist-2025.1.0/tests/run_tests_2000066400000000000000000000011741473553204100174550ustar00rootroot00000000000000#!/bin/sh # run all the tests that can reasonably run in a batch # that need special privileges on Solaris 2.7. # # FLAGS determines the degree of verbosity of the output. # Setting it to "-t" give the tersest form of output. FLAGS="-t" RUN= # # remove the old log file # rm -f run_tests_2.log # # run the tests # if [ ! -h bin ] then rm -f ./bin; ln -fs .. ./bin; fi $RUN ../p120100 ${FLAGS} >> run_tests_2.log 2>&1 ln -fs ../p120101 $RUN ../p120101 ${FLAGS} >> run_tests_2.log 2>&1 $RUN ../p120200 ${FLAGS} >> run_tests_2.log 2>&1 $RUN ../p120500 ${FLAGS} >> run_tests_2.log 2>&1 $RUN ../p140101 ${FLAGS} >> run_tests_2.log 2>&1 libflorist-2025.1.0/tests/sockets/000077500000000000000000000000001473553204100167335ustar00rootroot00000000000000libflorist-2025.1.0/tests/sockets/Makefile000066400000000000000000000042761473553204100204040ustar00rootroot00000000000000include ../../Config GNATMAKEFLAGS1 = -g -I../../floristlib -L../../floristlib GNATMAKEFLAGS2= -cargs -gnatay -gnatwue -largs -lresolv -lflorist TEST_FILES=\ p180400.adb\ p180401.adb\ p180402.adb\ p180402a.adb\ p180402b.adb\ p180402c.adb\ p180402d.adb\ pdd0100.adb\ test_tcp_listen.adb\ test_tcp_talk.adb\ test_addrinfo.adb\ test_database.adb\ test_local_listen.adb\ test_local_ltime.adb\ test_local_talk.adb\ test_local_ttime.adb\ test_poll_listen.adb\ test_select_listen.adb\ test_tcp_ltime.adb\ test_tcp_options.adb\ test_tcp_ttime.adb\ test_udp_listen.adb\ test_udp_options.adb\ test_udp_talk.adb TESTS=\ p180400\ p180401\ p180402\ p180402a\ p180402b\ p180402c\ p180402d\ pdd0100\ test_tcp_listen\ test_tcp_talk\ test_addrinfo\ test_database\ test_local_listen\ test_local_ltime\ test_local_talk\ test_local_ttime\ test_poll_listen\ test_select_listen\ test_tcp_ltime\ test_tcp_options\ test_tcp_ttime\ test_udp_listen\ test_udp_options\ test_udp_talk all: $(TESTS) posix_report.ads: ln -s ../posix_report.ads posix_report.adb: ln -s ../posix_report.adb test_parameters.ads: # ln -s ../test_parameters.ads test_parameters.adb: # ln -s ../test_parameters.adb p180400: p180400.adb p180401: p180401.adb p180402: p180402.adb p180402a: p180402a.adb p180402b: p180402b.adb p180402c: p180402c.adb p180402d: p180402d.adb pdd0100: pdd0100.adb test_parameters.adb test_tcp_listen: test_tcp_listen.adb test_tcp_talk: test_tcp_talk.adb test_addrinfo: test_addrinfo.adb test_database: test_database.adb test_local_listen: test_local_listen.adb test_local_ltime: test_local_ltime.adb test_local_talk: test_local_talk.adb test_local_ttime: test_local_ttime.adb test_poll_listen: test_poll_listen.adb test_select_listen: test_select_listen.adb test_tcp_ltime: test_tcp_ltime.adb test_tcp_options: test_tcp_options.adb test_tcp_ttime: test_tcp_ttime.adb test_udp_listen: test_udp_listen.adb test_udp_options: test_udp_options.adb test_udp_tal: test_udp_tal.adb tcp: test_tcp_listen test_tcp_talk $(TESTS): posix_report.ads posix_report.adb\ ../../floristlib/libflorist.a test_parameters.ads test_parameters.adb gnatmake $(GNATMAKEFLAGS1) $@ $(GNATMAKEFLAGS2) clean: rm -f *.o *.ali $(TESTS) libflorist-2025.1.0/tests/sockets/p180400.adb000066400000000000000000002124431473553204100203250ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Basic test for package POSIX_Sockets, -- in IEEE Std 1003.5c Section 18.4. -- This test covers only features that depend only on -- the package itself and features from other packages -- that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Report, POSIX_IO, Test_Parameters; -- with Ada.Integer_Text_IO; -- with Ada.Text_IO; procedure p180400 is use POSIX, POSIX_Sockets, POSIX_IO, POSIX_Report, Test_Parameters; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Test_Get_Socket_Address_Info_4Param (Name : in POSIX_String := Valid_Internet_Name; Service : in POSIX_String := "telnet"; Flags : in Address_Flags := Use_For_Binding; Family : in Protocol_Family := PF_INET; To : in Socket_Type := Stream_Socket; Protocol : in Protocol_Number := IPPROTO_TCP; Expected : in Error_Code := Operation_Not_Implemented; Error1 : in String; Error2 : in String; Error3 : in String := "A000"); procedure Test_Create (Family : in Protocol_Family := PF_INET; Soc_Type : in Socket_Type := Stream_Socket; Protocol : in Protocol_Number := IPPROTO_TCP; Expected : in Error_Code := No_Error; Error1 : in String; Error2 : in String := "A000"; Error3 : in String; Error4 : in String); procedure Test_Create_Pair (Family : in Protocol_Family := PF_UNIX; Soc_Type : in Socket_Type := Stream_Socket; Protocol : in Protocol_Number := IPPROTO_IP; Expected : in Error_Code := No_Error; Error1 : in String; Error2 : in String := "A000"; Error3 : in String; Error4 : in String); procedure Test_Get_Socket_Address_Info_3Param (Name : in POSIX_String := Valid_Internet_Name; Service : in POSIX_String := "telnet"; Expected : in Error_Code := No_Error; Error1 : in String := "A000"; Error2 : in String; Error3 : in String); generic type T is (<>); with function Get (Socket : in POSIX_IO.File_Descriptor) return T; with procedure Set (Socket : in POSIX_IO.File_Descriptor; To : in T); procedure Testit (Name : in String; Init : in T; Value : in T; Er1, Er2, Er3, Er4, Er5, Er6, Er7, Er8, Er9, Er10, Er11, Er12 : in String); ----------------------------------------------------------------------- -- Procedure used to test Get_Socket_Address_Info 4-parameter version procedure Test_Get_Socket_Address_Info_4Param (Name : in POSIX_String := Valid_Internet_Name; Service : in POSIX_String := "telnet"; Flags : in Address_Flags := Use_For_Binding; Family : in Protocol_Family := PF_INET; To : in Socket_Type := Stream_Socket; Protocol : in Protocol_Number := IPPROTO_TCP; Expected : in Error_Code := Operation_Not_Implemented; Error1 : in String; Error2 : in String; Error3 : in String := "A000") is Info : Socket_Address_Info_List; Request : Socket_Address_Info; begin Set_Flags (Request, Flags); Set_Family (Request, Family); Set_Socket_Type (Request, To); Set_Protocol_Number (Request, Protocol); Get_Socket_Address_Info (Name, Service, Request, Info); if Error3 /= "A000" then Expect_Exception (Error3); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Optional (Network_Management_Option, Unknown_Protocol_Option, E1, Error1); end if; when E2 : others => Unexpected_Exception (E2, Error2); end Test_Get_Socket_Address_Info_4Param; ----------------------------------------------------------------------- -- Procedure used to test Create method procedure Test_Create (Family : in Protocol_Family := PF_INET; Soc_Type : in Socket_Type := Stream_Socket; Protocol : in Protocol_Number := IPPROTO_TCP; Expected : in Error_Code := No_Error; Error1 : in String; Error2 : in String := "A000"; Error3 : in String; Error4 : in String) is Sock : POSIX_IO.File_Descriptor := 0; begin Sock := Create (Family, Soc_Type, Protocol); Assert (Sock /= 0, Error1); if Error2 /= "A000" then Expect_Exception (Error2); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error3); end if; when E2 : others => Unexpected_Exception (E2, Error4); end Test_Create; ----------------------------------------------------------------------- -- Procedure used to test Create_Pair method procedure Test_Create_Pair (Family : in Protocol_Family := PF_UNIX; Soc_Type : in Socket_Type := Stream_Socket; Protocol : in Protocol_Number := IPPROTO_IP; Expected : in Error_Code := No_Error; Error1 : in String; Error2 : in String := "A000"; Error3 : in String; Error4 : in String) is Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; begin Create_Pair (Peer1, Peer2, Family, Soc_Type, Protocol); Assert (Peer1 /= 0 and Peer2 /= 0, Error1 & ": Socket Pair not Created"); if Error2 /= "A000" then Expect_Exception (Error2); end if; POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error3); end if; when E2 : others => Unexpected_Exception (E2, Error4); end Test_Create_Pair; ----------------------------------------------------------------------- -- Procedure used to test Get_Socket_Address_Info 3-parameter version procedure Test_Get_Socket_Address_Info_3Param (Name : in POSIX_String := Valid_Internet_Name; Service : in POSIX_String := "telnet"; Expected : in Error_Code := No_Error; Error1 : in String := "A000"; Error2 : in String; Error3 : in String) is Info : Socket_Address_Info_List; begin Get_Socket_Address_Info (Name, Service, Info); if Error1 /= "A000" then Expect_Exception (Error1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Optional (Network_Management_Option, Unknown_Protocol_Option, E1, Error2); end if; when E2 : others => Unexpected_Exception (E2, Error3); end Test_Get_Socket_Address_Info_3Param; ----------------------------------------------------------------------- -- Procedure used to test Get and Set methods used with protocol -- independent Socket information procedure Testit (Name : in String; Init : in T; Value : in T; Er1, Er2, Er3, Er4, Er5, Er6, Er7, Er8, Er9, Er10, Er11, Er12 : in String) is begin -------------------------------------------------------------------- -- The Set and Get methods are consistent Test ("Set/Get_" & Name & " [18.4.9]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : T := Value; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set (Socket, Init); Comment ("Socket Set_" & Name); To := Get (Socket); Assert (To = Init, Er1); exception when E : others => Unexpected_Exception (E, Er2); end; -------------------------------------------------------------------- -- The Get method returns a default value Test ("Get_" & Name & " (Default) [18.4.9.2]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : T := Init; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); To := Get (Socket); Assert (To = Value, Er3); exception when E : others => Unexpected_Exception (E, Er4); end; -------------------------------------------------------------------- -- The Set causes the Not_A_Socket POSIX error to -- be raised when the socket has not been created Test ("Not_A_Socket (" & Name & ") [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : T := Init; begin Set (Socket, To); Expect_Exception (Er5); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, Er6); end if; when E2 : others => Unexpected_Exception (E2, Er7); end; -------------------------------------------------------------------- -- The Get causes the Not_A_Socket POSIX error to -- be raised when the socket has not been created Test ("Not_A_Socket (" & Name & ") [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : T := Init; begin To := Get (Socket); Expect_Exception (Er8); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, Er9); end if; when E2 : others => Unexpected_Exception (E2, Er10); end; -------------------------------------------------------------------- -- The Set may cause the Is_Already_Connected -- POSIX error to be raised when the socket is already connected Test ("Is_Already_Connected (" & Name & ") [18.4.9.3]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; To : T := Init; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket, IPPROTO_IP); Set (Peer1, To); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code /= Is_Already_Connected then Comment ("Connected Socket caused an error"); Unexpected_Exception (E1, Er11); end if; when E2 : others => Unexpected_Exception (E2, Er12); end; end Testit; -------------------------------------------------------------------------- -- Begin Tests begin Header ("p180400"); Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Socket Types are in the proper positions Test ("Socket Types Position [18.4.1.1]"); declare Type_of_Socket : Socket_Type; begin Type_of_Socket := 0; Assert (Socket_Type'First = 0 and Socket_Type'Pos (Datagram_Socket) = 1 and Socket_Type'Pos (Stream_Socket) = 2 and Socket_Type'Pos (Raw_Socket) = 4 and Socket_Type'Last = 6, "A001"); exception when E : others => Unexpected_Exception (E, "A002"); end; ----------------------------------------------------------------------- -- Socket Types are unique Test ("Socket Types Uniqueness [18.4.1.1]"); declare A : constant array (1 .. 5) of Socket_Type := (Stream_Socket, Datagram_Socket, Raw_Socket, Sequenced_Packet_Socket, Unspecified_Socket_Type); begin for I in A'Range loop for J in A'Range loop Assert (A (I) /= A (J) or I = J, "A003"); end loop; end loop; exception when E : others => Unexpected_Exception (E, "A004"); end; ----------------------------------------------------------------------- -- Protocol Family has the appropriate range Test ("Protocol Family [18.4.1.1]"); declare Proto_Family : Protocol_Family; begin Proto_Family := 0; Assert (Protocol_Family'First = 0 and Protocol_Family'Last = 25, "A005"); exception when E : others => Unexpected_Exception (E, "A006"); end; ----------------------------------------------------------------------- -- Unspecified Protocol has been declared with the proper value Test ("Unspecified Protocol [18.4.1.1]"); begin Assert (Unspecified_Protocol = 0, "A007"); exception when E : others => Unexpected_Exception (E, "A008"); end; ----------------------------------------------------------------------- -- Protocol_Number has the appropriate range Test ("Protocol Number [18.4.1.1]"); declare Proto_Number : Protocol_Number; begin Proto_Number := 0; Assert (Protocol_Number'First = 0 and Protocol_Number'Last = 65535, "A009"); exception when E : others => Unexpected_Exception (E, "A010"); end; ----------------------------------------------------------------------- -- Default_Protocol has been declared with the proper value Test ("Default Protocol [18.4.1.1]"); begin Assert (Default_Protocol = 0, "A011"); exception when E : others => Unexpected_Exception (E, "A012"); end; ----------------------------------------------------------------------- -- Socket_Address_Pointer type has been propely declared Test ("Socket Addresses [18.4.1.2]"); declare SocAddrPtr : Socket_Address_Pointer; begin SocAddrPtr := Null_Socket_Address; exception when E : others => Unexpected_Exception (E, "A013"); end; ----------------------------------------------------------------------- -- IO_Vector_Range has the proper range Test ("Socket Messages : IO_Vector_Range [18.4.1.3]"); declare IOVRange : IO_Vector_Range; begin IOVRange := 12; Assert (IO_Vector_Range'First = 1, "A014"); Assert (IO_Vector_Range'Last = Natural'Last, "A015"); exception when E : others => Unexpected_Exception (E, "A016"); end; ----------------------------------------------------------------------- -- All options in Message_Option_Set are unique Test ("Message_Option_Set [18.4.1.3]"); declare A : constant array (1 .. 4) of Message_Option_Set := (Peek_Only, Process_OOB_Data, Wait_For_All_Data, Do_Not_Route); begin for I in A'Range loop for J in A'Range loop Assert (A (I) /= A (J) or I = J, "A017"); end loop; end loop; exception when E : others => Unexpected_Exception (E, "A018"); end; ----------------------------------------------------------------------- -- All Message_Status_Set options are unique Test ("Message_Status_Set [18.4.1.3]"); declare A : constant array (1 .. 4) of Message_Status_Set := (Received_OOB_Data, End_Of_Message, Message_Truncated, Ancillary_Data_Lost); begin for I in A'Range loop for J in A'Range loop Assert (A (I) /= A (J) or I = J, "A019"); end loop; end loop; exception when E : others => Unexpected_Exception (E, "A020"); end; ----------------------------------------------------------------------- -- A Socket properly filled in socket is created Test ("Create [18.4.5]"); begin Test_Create (Error1 => "A021", Error3 => "A022", Error4 => "A023"); end; ----------------------------------------------------------------------- -- A Socket that uses the default parameter is created Test ("Create, useing default parameter [18.4.5]"); declare Sock : POSIX_IO.File_Descriptor := 0; begin Sock := Create (PF_INET, Stream_Socket); Assert (Sock /= 0, "A024"); exception when E : others => Unexpected_Exception (E, "A025"); end; ----------------------------------------------------------------------- -- A bad protocol family creates the Protocol_Not_Supported -- POSIX_Error code Test ("Create Error Checking : PNS_PF [18.4.5.3]"); begin Test_Create (Family => PF_OSI, Expected => Protocol_Not_Supported, Error1 => "A026", Error2 => "A027", Error3 => "A028", Error4 => "A029"); end; ----------------------------------------------------------------------- -- A bad protocol number creates the Protocol_Not_Supported -- POSIX_Error code Test ("Create Error Checking : PNS_PN [18.4.5.3]"); begin Test_Create (Protocol => 12, Expected => Protocol_Not_Supported, Error1 => "A030", Error2 => "A031", Error3 => "A032", Error4 => "A033"); end; ----------------------------------------------------------------------- -- A bad socket type causes a Socket_Not_Supported POSOIX_Error code Test ("Create Error Checking : STNS [18.4.5.3]"); begin Test_Create (Soc_Type => 5, Expected => Socket_Not_Supported, Error1 => "A034", Error2 => "A035", Error3 => "A036", Error4 => "A037"); end; ----------------------------------------------------------------------- -- A pair of connected sockets is created Test ("Create_Pair [18.4.6]"); begin Test_Create_Pair (Error1 => "A038", Error3 => "A039", Error4 => "A040"); end; ----------------------------------------------------------------------- -- A pair of connected sockets is created with a default -- protocol number Test ("Create_Pair, useing default parameter [18.4.6]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket); Assert (Peer1 /= 0 and Peer2 /= 0, "A041"); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E : others => Unexpected_Exception (E, "A042"); end; ----------------------------------------------------------------------- -- Trying to create a socket pair with a protocol family that doesn't -- support pair creation gives an Option_Not_Supported -- POSIX_Error code Test ("Create_Pair Error Checking : ONS [18.4.6.3]"); begin Test_Create_Pair (Family => PF_INET, Expected => Option_Not_Supported, Error1 => "A043", Error2 => "A044", Error3 => "A045", Error4 => "A046"); end; ----------------------------------------------------------------------- -- Trying to create a socket pair with an invalid protocol number -- gives a Protocol_Not_Supported POSIX_Error code Test ("Create_Pair Error Checking : PNS_PN [18.4.5.3]"); begin Test_Create_Pair (Protocol => 18, Expected => Protocol_Not_Supported, Error1 => "A047", Error2 => "A048", Error3 => "A049", Error4 => "A050"); end; ----------------------------------------------------------------------- -- Trying to create a socket pair with an invalid protocol family -- gives a Protocol_Not_Supported POSIX_Error code Test ("Create_Pair Error Checking : PNS_PF [18.4.5.3]"); begin Test_Create_Pair (Family => PF_ISO, Expected => Protocol_Not_Supported, Error1 => "A051", Error2 => "A052", Error3 => "A053", Error4 => "A054"); end; ----------------------------------------------------------------------- -- The Address_Flags options are all unique Test ("Address_Flags type [18.4.7]"); declare A : constant array (1 .. 2) of Address_Flags := (Use_For_Binding, Canonical_Name); begin for I in A'Range loop for J in A'Range loop Assert (A (I) /= A (J) or I = J, "A055"); end loop; end loop; exception when E : others => Unexpected_Exception (E, "A056"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the get and set -- methods are consistent Test ("Set/Get_Flags Test [18.4.7]"); declare Info_Item : Socket_Address_Info; Flags : Address_Flags; begin Flags := Canonical_Name; Set_Flags (Info_Item, Flags); Flags := Use_For_Binding; -- The Assert statement is used to garauntee that the optimizer -- doesn't remove the previous assignment due to it being dead code. Assert (Flags = Use_For_Binding, "A057"); Flags := Get_Flags (Info_Item); Assert (Flags = Canonical_Name, "A058"); exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A059"); when E2 : others => Unexpected_Exception (E2, "A060"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the get and set -- methods are consistent Test ("Set/Get_Family Test [18.4.7]"); declare Info_Item : Socket_Address_Info; Family : Protocol_Family; begin Family := PF_INET; Set_Family (Info_Item, Family); Family := PF_UNIX; -- The Assert statement is used to garauntee that the optimizer -- doesn't remove the previous assignment due to it being dead code. Assert (Family = PF_UNIX, "A061"); Family := Get_Family (Info_Item); Assert (Family = PF_INET, "A062"); exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A063"); when E2 : others => Unexpected_Exception (E2, "A064"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the Set and Get -- methods are consistent Test ("Set/Get_Socket_Type Test [18.4.7]"); declare Info_Item : Socket_Address_Info; To : Socket_Type; begin To := Stream_Socket; Set_Socket_Type (Info_Item, To); To := Raw_Socket; -- The Assert statement is used to garauntee that the optimizer -- doesn't remove the previous assignment due to it being dead code. Assert (To = Raw_Socket, "A065"); To := Get_Socket_Type (Info_Item); Assert (To = Stream_Socket, "A066"); exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A067"); when E2 : others => Unexpected_Exception (E2, "A068"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the Get and Set -- methods are consistent Test ("Set/Get_Protocol_Number Test [18.4.7]"); declare Info_Item : Socket_Address_Info; Protocol : Protocol_Number; begin Protocol := IPPROTO_TCP; Set_Protocol_Number (Info_Item, Protocol); Protocol := IPPROTO_UDP; -- The Assert statement is used to garauntee that the optimizer -- doesn't remove the previous assignment due to it being dead code. Assert (Protocol = 17, "A069"); Protocol := Get_Protocol_Number (Info_Item); Assert (Protocol = 6, "A070"); exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A071"); when E2 : others => Unexpected_Exception (E2, "A072"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then Info is filled -- up with the appropriate information Test ("Get_Socket_Address_Info (3-param version) [18.4.7]"); begin Test_Get_Socket_Address_Info_3Param (Error2 => "A073", Error3 => "A074"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then Info is filled -- up with the appropriate information Test ("Get_Socket_Address_Info (3-param with null Name) [18.4.7]"); begin Test_Get_Socket_Address_Info_3Param (Name => "", Error2 => "A075", Error3 => "A076"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then Info is filled -- up with the appropriate information Test ("Get_Socket_Address_Info (3-param with null Service) [18.4.7]"); begin Test_Get_Socket_Address_Info_3Param (Service => "", Error2 => "A077", Error3 => "A078"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Name_Not_Known POSIX_Error code will be raised Test ("Get_Socket_Address_Info (3-param) Error NNK_Nam [18.4.7.3]"); begin Test_Get_Socket_Address_Info_3Param (Name => "xi.csfsu.edu", Expected => Name_Not_Known, Error1 => "A079", Error2 => "A080", Error3 => "A081"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Name_Not_Known POSIX_Error code will be raised Test ("Get_Socket_Address_Info (3-param) Error NNK_Ser [18.4.7.3]"); begin Test_Get_Socket_Address_Info_3Param (Service => "retelnet", Expected => Name_Not_Known, Error1 => "A082", Error2 => "A083", Error3 => "A084"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Name_Not_Known POSIX_Error code will be raised Test ("Get_Socket_Address_Info (3-param) Error NNK_Nul [18.4.7.3]"); begin Test_Get_Socket_Address_Info_3Param (Name => "", Service => "", Expected => Name_Not_Known, Error1 => "A085", Error2 => "A086", Error3 => "A087"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the Info object -- will be emptied Test ("Make_Empty [18.4.7]"); declare Info : Socket_Address_Info_List; begin Get_Socket_Address_Info (Valid_Internet_Name, "telnet", Info); Make_Empty (Info); exception when E1 : POSIX_Error => Optional (Network_Management_Option, Operation_Not_Implemented, E1, "A088"); when E2 : others => Unexpected_Exception (E2, "A089"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then Info is filled -- up with the appropriate information Test ("Get_Socket_Address_Info (4-param version) [18.4.7]"); begin Test_Get_Socket_Address_Info_4Param (Error1 => "A090", Error2 => "A091"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then Info is filled -- up with the appropriate information Test ("Get_Socket_Address_Info (4-param with null Name) [18.4.7]"); begin Test_Get_Socket_Address_Info_4Param ("", Error1 => "A092", Error2 => "A093"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then Info is filled -- up with the appropriate information Test ("Get_Socket_Address_Info (4-param with null Service) [18.4.7]"); begin Test_Get_Socket_Address_Info_4Param (Service => "", Error1 => "A094", Error2 => "A095"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Name_Not_Known POSIX_Error code will be raised Test ("Get_Socket_Address_Info (4-param) Error NNK_Nul [18.4.7]"); begin Test_Get_Socket_Address_Info_4Param (Name => "", Service => "", Expected => Name_Not_Known, Error1 => "A096", Error2 => "A097", Error3 => "A098"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Service_Not_Supported POSIX_Error code will be raised since the -- socket type doesn't have the requested service Test ("Get_Socket_Address_Info (4-param) Error SNS [18.4.7]"); begin Test_Get_Socket_Address_Info_4Param (Valid_Internet_Name, "retelnet", Expected => Service_Not_Supported, Error1 => "A099", Error2 => "A100", Error3 => "A101"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Name_Not_Known POSIX_Error code will be raised Test ("Get_Socket_Address_Info (4-param) Error NNK_Nam [18.4.7]"); begin Test_Get_Socket_Address_Info_4Param ("@#$%^&*()", Expected => Name_Not_Known, Error1 => "A102", Error2 => "A103", Error3 => "A104"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Invalid_Flags POSIX_Error code should be raised Test ("Ivalid_Flags Error [18.4.7.3]"); begin Test_Get_Socket_Address_Info_4Param (Flags => Empty_Set - Canonical_Name, Expected => Invalid_Flags, Error1 => "A105", Error2 => "A106", Error3 => "A107"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Unknown_Protocol_Family POSIX_Error code will be raised Test ("Unknown_Protocol_Family [18.4.7.3]"); begin Test_Get_Socket_Address_Info_4Param (Family => PF_OSI, Expected => Unknown_Protocol_Family, Error1 => "A108", Error2 => "A109", Error3 => "A110"); end; ----------------------------------------------------------------------- -- If the Network Management option is supported then the -- Unknown_Socket_type POSIX_Error code will be raised -- ... This test is not working at the moment. The error occurs in -- ... the getaddrinfo.c file under a bad socket type. The problem -- ... occurs when dereferencing the ai_addr pointer. Not for sure -- ... what the exact cause is. Raises STRORAGE Errror. -- Test ("Unknown_Socket_Type [18.4.7.3]"); -- begin -- Test_Get_Socket_Address_Info_4Param -- (To => 5, Expected => Unknown_Socket_Type, -- Error1 => "A111", Error2 => "A112", Error3 => "A113"); -- end; ----------------------------------------------------------------------- -- If the socket has a pending error it will be returned and the -- error status shall be set to 0 Test ("Get_Socket_Error_Status [18.4.8]"); declare Sock : POSIX_IO.File_Descriptor := 0; Error : POSIX.Error_Code := 0; begin Sock := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Error := Get_Socket_Error_Status (Sock); if Error /= 0 then Comment ("Socket returned and error; Expected"); end if; exception when E : others => Unexpected_Exception (E, "A114"); end; ----------------------------------------------------------------------- -- Since the socket was never created Get_Socket_Error_Status will -- return Not_A_Socket Test ("Not_A_Socket [18.4.8.3]"); declare Sock : POSIX_IO.File_Descriptor := 0; Error : POSIX.Error_Code := 0; begin Error := Get_Socket_Error_Status (Sock); Expect_Exception ("A115"); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A116"); end if; when E2 : others => Unexpected_Exception (E2, "A117"); end; ----------------------------------------------------------------------- -- A socket type of Stream_Socket will be returned Test ("Get_Socket_Type [18.4.8]"); declare Sock : POSIX_IO.File_Descriptor := 0; Type_Of_Socket : Socket_Type := Datagram_Socket; begin Sock := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Type_Of_Socket := Get_Socket_Type (Sock); Assert (Type_Of_Socket = Stream_Socket, "A118"); exception when E : others => Unexpected_Exception (E, "A119"); end; ----------------------------------------------------------------------- -- Since the socket was never created an error of Not_A_Socket will -- be raised Test ("Get_Socket_Type [18.4.8]"); declare Sock : POSIX_IO.File_Descriptor := 0; Type_Of_Socket : Socket_Type := Datagram_Socket; begin Type_Of_Socket := Get_Socket_Type (Sock); Assert (Type_Of_Socket = Stream_Socket, "A120"); Expect_Exception ("A121"); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A122"); end if; when E2 : others => Unexpected_Exception (E2, "A123"); end; ----------------------------------------------------------------------- -- Socket_Option_Values are set and in the proper order Test ("Socket_Option_Values [18.4.9]"); declare Option_Value : Socket_Option_Value := Enabled; begin Option_Value := Disabled; Assert (Socket_Option_Value'First = Enabled and Socket_Option_Value'Last = Disabled, "A124"); exception when E : others => Unexpected_Exception (E, "A125"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Broadcast method tests declare procedure Test_Socket_Broadcast is new Testit (Socket_Option_Value, Get_Socket_Broadcast, Set_Socket_Broadcast); begin Test_Socket_Broadcast ("Socket_Broadcast", Enabled, Disabled, "A126", "A127", "A128", "A129", "A130", "A131", "A132", "A133", "A134", "A135", "A136", "A137"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Debugging method tests declare procedure Test_Socket_Debugging is new Testit (Socket_Option_Value, Get_Socket_Debugging, Set_Socket_Debugging); begin Test_Socket_Debugging ("Socket_Debugging", Enabled, Disabled, "A138", "A139", "A140", "A141", "A142", "A143", "A144", "A145", "A146", "A147", "A148", "A149"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Routing method tests declare procedure Test_Socket_Routing is new Testit (Socket_Option_Value, Get_Socket_Routing, Set_Socket_Routing); begin Test_Socket_Routing ("Socket_Routing", Disabled, Enabled, "A150", "A151", "A152", "A153", "A154", "A155", "A156", "A157", "A158", "A159", "A160", "A161"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Keep_Alive method tests declare procedure Test_Socket_Keep_Alive is new Testit (Socket_Option_Value, Get_Socket_Keep_Alive, Set_Socket_Keep_Alive); begin Test_Socket_Keep_Alive ("Socket_Keep_Alive", Enabled, Disabled, "A162", "A163", "A164", "A165", "A166", "A167", "A168", "A169", "A170", "A171", "A172", "A173"); end; ----------------------------------------------------------------------- -- Subtype Linger_Time has the appropriate bounds Test ("Linger_Time subtype bounds [18.4.9]"); declare L_Time : Linger_Time; begin L_Time := 2; Assert (Linger_Time'First = 0, "A174"); Assert (Linger_Time'Last = POSIX.Seconds'Last, "A175"); exception when E : others => Unexpected_Exception (E, "A176"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Linger_Time method tests declare procedure Test_Socket_Linger_Time is new Testit (Linger_Time, Get_Socket_Linger_Time, Set_Socket_Linger_Time); begin Test_Socket_Linger_Time ("Socket_Linger_Time", 2, 0, "A177", "A178", "A179", "A180", "A181", "A182", "A183", "A184", "A185", "A186", "A187", "A188"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_OOB_Data_Inline method tests declare procedure Test_Socket_OOB_Data_Inline is new Testit (Socket_Option_Value, Get_Socket_OOB_Data_Inline, Set_Socket_OOB_Data_Inline); begin Test_Socket_OOB_Data_Inline ("Socket_OOB_Data_Inline", Enabled, Disabled, "A189", "A190", "A191", "A192", "A193", "A194", "A195", "A196", "A197", "A198", "A199", "A200"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Receive_Buffer_Size methods are consistent -- Doesn't work with a conenction mode socket -- Has to many special cases to use generic Test ("Set/Get_Socket_Receive_Buffer_Size [18.4.9]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 16; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Receive_Buffer_Size (Socket, 32); Comment ("Socket receive buffer size set to 32"); To := Get_Socket_Receive_Buffer_Size (Socket); Assert (To = 32, "A201"); exception when E : others => Unexpected_Exception (E, "A202"); end; ----------------------------------------------------------------------- -- The Get_Socket_Receive_Buffer_Size method has a protocol defined -- default value, wich is verly unlikly to be 0 Test ("Get_Socket_Receive_Buffer_Size (Default) [18.4.9.2]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 0; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); To := Get_Socket_Receive_Buffer_Size (Socket); Assert (To /= 0, "A203"); exception when E : others => Unexpected_Exception (E, "A204"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Buffer_Size causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Set_Socket_Receive_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 256; begin Set_Socket_Receive_Buffer_Size (Socket, To); Expect_Exception ("A205"); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A206"); end if; when E2 : others => Unexpected_Exception (E2, "A207"); end; ----------------------------------------------------------------------- -- The Get_Socket_Receive_Buffer_Size causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Get_Socket_Receive_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 256; begin To := Get_Socket_Receive_Buffer_Size (Socket); Expect_Exception ("A208"); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A209"); end if; when E2 : others => Unexpected_Exception (E2, "A210"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Buffer_Size may cause the -- Is_Already_Connected POSIX error to be raised when the socket -- is already connected Test ("Is_Already_Connected (Set_Socket_Receive_Buffer_Size) [18.4.9.3]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 256; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket, IPPROTO_IP); Set_Socket_Receive_Buffer_Size (Peer1, To); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "A211"); else Comment ("Connected Socket caused an error"); end if; when E2 : others => Unexpected_Exception (E2, "A212"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Buffer_Size causes a No_Buffer_Space -- Error when the requested buffer is too big Test ("No_Buffer_Space (Set_Socket_Receive_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor; To : POSIX.IO_Count := 10000000; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set_Socket_Receive_Buffer_Size (Socket, To); Expect_Exception ("A213"); exception when E1 : POSIX_Error => if Get_Error_Code /= No_Buffer_Space then Unexpected_Exception (E1, "A214"); end if; when E2 : others => Unexpected_Exception (E2, "A215"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Receive_Low_Water_Mark methods are -- consistent if the implementation allows the value to be set. -- Otherwise the Permission_Denied Error will be raised -- If a system does not even support the Receive_Low_Water_Mark -- then the Unknown_Protocol_Option error will be raised Test ("Set/Get_Socket_Receive_Low_Water_Mark [18.4.9]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Receive_Low_Water_Mark (Socket, 3); Comment ("Socket receive buffer size set to 3"); To := Get_Socket_Receive_Low_Water_Mark (Socket); Assert (To = 3, "A216"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); else Unexpected_Exception (E1, "A217"); end if; when E2 : others => Unexpected_Exception (E2, "A218"); end; ----------------------------------------------------------------------- -- The Get_Socket_Receive_Low_Water_Mark method has a default value -- of 1 Test ("Get_Socket_Receive_Low_Water_Mark (Default) [18.4.9.2]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 0; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); To := Get_Socket_Receive_Low_Water_Mark (Socket); Assert (To = 1, "A219"); exception when E1 : others => Unexpected_Exception (E1, "A220"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Low_Water_Mark method causes the -- Not_A_Socket POSIX error to be raised when the socket -- has not been created (See above for other cases) Test ("Not_A_Socket (Set_Socket_Receive_Low_Water_Mark) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin Set_Socket_Receive_Low_Water_Mark (Socket, To); Expect_Exception ("A221"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A222"); end if; when E2 : others => Unexpected_Exception (E2, "A223"); end; ----------------------------------------------------------------------- -- The Get_Socket_Receive_Low_Water_Mark method causes the -- Not_A_Socket POSIX error to be raised when the socket has not -- been created (see above for other cases) Test ("Not_A_Socket (Get_Socket_Receive_Low_Water_Mark) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin To := Get_Socket_Receive_Buffer_Size (Socket); Expect_Exception ("A224"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A225"); end if; when E2 : others => Unexpected_Exception (E2, "A226"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Low_Water_Mark may cause the -- Is_Already_Connected POSIX error to be raised when the socket -- is already connected (see above for other cases) Test ("Is_Already_Connected (Set_Socket_Receive_Low_Water_Mark) [18.4.9.3]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket, IPPROTO_IP); Set_Socket_Receive_Low_Water_Mark (Peer1, To); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "A227"); else Comment ("Connected Socket caused an error"); end if; when E2 : others => Unexpected_Exception (E2, "A228"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Receive_Timeout methods are consistent Test ("Set/Get_Socket_Receive_Timeout [18.4.9]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : Duration := 16.0; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Receive_Timeout (Socket, 32.0); Comment ("Socket receive timout set to 32"); To := Get_Socket_Receive_Timeout (Socket); Assert (To = 32.0, "A229"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); else Unexpected_Exception (E1, "A230"); end if; when E2 : others => Unexpected_Exception (E2, "A231"); end; ----------------------------------------------------------------------- -- The Get_Socket_Receive_Timeout method has a defined -- default value of 0 Test ("Get_Socket_Receive_Timeout (Default) [18.4.9.2]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : Duration := 2.0; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); To := Get_Socket_Receive_Timeout (Socket); Assert (To = 0.0, "A232"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); else Unexpected_Exception (E1, "A233"); end if; when E2 : others => Unexpected_Exception (E2, "A234"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Timeout causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Set_Socket_Receive_Timout) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; To : Duration := 3.0; begin Set_Socket_Receive_Timeout (Socket, To); Expect_Exception ("A235"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A236"); end if; when E2 : others => Unexpected_Exception (E2, "A237"); end; ----------------------------------------------------------------------- -- The Get_Socket_Receive_Timeout causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Get_Socket_Receive_Timeout) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 3; To : Duration := 2.0; begin To := Get_Socket_Receive_Timeout (Socket); Expect_Exception ("A238"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A239"); end if; when E2 : others => Unexpected_Exception (E2, "A240"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Timout may cause the -- Is_Already_Connected POSIX error to be raised when the socket -- is already connected Test ("Is_Already_Connected (Set_Socket_Receive_Timeout) [18.4.9.3]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; To : Duration := 3.0; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket, IPPROTO_IP); Set_Socket_Receive_Timeout (Peer1, To); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "A241"); else Comment ("Connected Socket caused an error"); end if; when E2 : others => Unexpected_Exception (E2, "A242"); end; ----------------------------------------------------------------------- -- The Set_Socket_Receive_Timout causes a Domain_Error -- Error when the requested buffer is too big Test ("Domain_Error (Set_Socket_Receive_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor; To : Duration := 10000000.0; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Receive_Timeout (Socket, To); Expect_Exception ("A243"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= No_Buffer_Space then Unexpected_Exception (E1, "A244"); end if; when E2 : others => Unexpected_Exception (E2, "A245"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Reuse_Addresses method tests declare procedure Test_Socket_Reuse_Addresses is new Testit (Socket_Option_Value, Get_Socket_Reuse_Addresses, Set_Socket_Reuse_Addresses); begin Test_Socket_Reuse_Addresses ("Reuse_Addresses", Enabled, Disabled, "A246", "A247", "A248", "A249", "A250", "A251", "A252", "A253", "A254", "A255", "A256", "A257"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Send_Buffer_Size methods are consistent -- Doesn't work with a conenction mode sockete Test ("Set/Get_Socket_Send_Buffer_Size [18.4.9]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 16; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Send_Buffer_Size (Socket, 32); Comment ("Socket Send buffer size set to 32"); To := Get_Socket_Send_Buffer_Size (Socket); Assert (To = 32, "A258"); exception when E : others => Unexpected_Exception (E, "A259"); end; ----------------------------------------------------------------------- -- The Get_Socket_Send_Buffer_Size method has a protocol defined -- default value, wich is verly unlikly to be 0 Test ("Get_Socket_Send_Buffer_Size (Default) [18.4.9.2]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 0; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); To := Get_Socket_Send_Buffer_Size (Socket); Assert (To /= 0, "A260"); exception when E : others => Unexpected_Exception (E, "A261"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Buffer_Size causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Set_Socket_Send_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 256; begin Set_Socket_Send_Buffer_Size (Socket, To); Expect_Exception ("A262"); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A263"); end if; when E2 : others => Unexpected_Exception (E2, "A264"); end; ----------------------------------------------------------------------- -- The Get_Socket_Send_Buffer_Size causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Get_Socket_Send_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 256; begin To := Get_Socket_Send_Buffer_Size (Socket); Expect_Exception ("A265"); exception when E1 : POSIX_Error => if Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A266"); end if; when E2 : others => Unexpected_Exception (E2, "A267"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Buffer_Size may cause the -- Is_Already_Connected POSIX error to be raised when the socket -- is already connected Test ("Is_Already_Connected (Set_Socket_Send_Buffer_Size) [18.4.9.3]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 256; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket, IPPROTO_IP); Set_Socket_Send_Buffer_Size (Peer1, To); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "A268"); else Comment ("Connected Socket caused an error"); end if; when E2 : others => Unexpected_Exception (E2, "A269"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Buffer_Size causes a No_Buffer_Space -- Error when the requested buffer is too big Test ("No_Buffer_Space (Set_Socket_Send_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor; To : POSIX.IO_Count := 10000000; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set_Socket_Send_Buffer_Size (Socket, To); Expect_Exception ("A270"); exception when E1 : POSIX_Error => if Get_Error_Code /= No_Buffer_Space then Unexpected_Exception (E1, "A271"); end if; when E2 : others => Unexpected_Exception (E2, "A272"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Send_Low_Water_Mark methods are -- consistent if the implementation allows the value to be set. -- Otherwise the Permission_Denied Error will be raised -- If a system does not even support the Send_Low_Water_Mark -- then the Unknown_Protocol_Option error will be raised Test ("Set/Get_Socket_Send_Low_Water_Mark [18.4.9]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Send_Low_Water_Mark (Socket, 3); Comment ("Socket Send buffer size set to 3"); To := Get_Socket_Send_Low_Water_Mark (Socket); Assert (To = 3, "A273"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); else Unexpected_Exception (E1, "A274"); end if; when E2 : others => Unexpected_Exception (E2, "A275"); end; ----------------------------------------------------------------------- -- The Get_Socket_Send_Low_Water_Mark method has a default value -- of 1 Test ("Get_Socket_Send_Low_Water_Mark (Default) [18.4.9.2]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 0; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); To := Get_Socket_Send_Low_Water_Mark (Socket); Assert (To = 1, "A276"); exception when E1 : others => Unexpected_Exception (E1, "A277"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Low_Water_Mark method causes the -- Not_A_Socket POSIX error to be raised when the socket -- has not been created (See above for other cases) Test ("Not_A_Socket (Set_Socket_Send_Low_Water_Mark) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin Set_Socket_Send_Low_Water_Mark (Socket, To); Expect_Exception ("A278"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A279"); end if; when E2 : others => Unexpected_Exception (E2, "A280"); end; ----------------------------------------------------------------------- -- The Get_Socket_Send_Low_Water_Mark method causes the -- Not_A_Socket POSIX error to be raised when the socket has not -- been created (see above for other cases) Test ("Not_A_Socket (Get_Socket_Send_Low_Water_Mark) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin To := Get_Socket_Send_Buffer_Size (Socket); Expect_Exception ("A281"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A282"); end if; when E2 : others => Unexpected_Exception (E2, "A283"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Low_Water_Mark may cause the -- Is_Already_Connected POSIX error to be raised when the socket -- is already connected (see above for other cases) Test ("Is_Already_Connected (Set_Socket_Send_Low_Water_Mark) [18.4.9.3]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; To : POSIX.IO_Count := 2; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket, IPPROTO_IP); Set_Socket_Send_Low_Water_Mark (Peer1, To); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "A284"); else Comment ("Connected Socket caused an error"); end if; when E2 : others => Unexpected_Exception (E2, "A285"); end; ----------------------------------------------------------------------- -- The Set and Get_Socket_Send_Timeout methods are consistent Test ("Set/Get_Socket_Send_Timeout [18.4.9]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : Duration := 16.0; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Send_Timeout (Socket, 32.0); Comment ("Socket Send timout set to 32"); To := Get_Socket_Send_Timeout (Socket); Assert (To = 32.0, "A286"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); else Unexpected_Exception (E1, "A287"); end if; when E2 : others => Unexpected_Exception (E2, "A288"); end; ----------------------------------------------------------------------- -- The Get_Socket_Send_Timeout method has a defined -- default value of 0 Test ("Get_Socket_Send_Timeout (Default) [18.4.9.2]"); declare Socket : POSIX_IO.File_Descriptor := 0; To : Duration := 2.0; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); To := Get_Socket_Send_Timeout (Socket); Assert (To = 0.0, "A289"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); else Unexpected_Exception (E1, "A290"); end if; when E2 : others => Unexpected_Exception (E2, "A291"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Timeout causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Set_Socket_Send_Timout) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; To : Duration := 3.0; begin Set_Socket_Send_Timeout (Socket, To); Expect_Exception ("A292"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A293"); end if; when E2 : others => Unexpected_Exception (E2, "A294"); end; ----------------------------------------------------------------------- -- The Get_Socket_Send_Timeout causes the Not_A_Socket -- POSIX error to be raised when the socket has not been created Test ("Not_A_Socket (Get_Socket_Send_Timeout) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor := 3; To : Duration := 2.0; begin To := Get_Socket_Send_Timeout (Socket); Expect_Exception ("A295"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Not_A_Socket then Unexpected_Exception (E1, "A296"); end if; when E2 : others => Unexpected_Exception (E2, "A297"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Timout may cause the -- Is_Already_Connected POSIX error to be raised when the socket -- is already connected Test ("Is_Already_Connected (Set_Socket_Send_Timeout) [18.4.9.3]"); declare Peer1, Peer2 : POSIX_IO.File_Descriptor := 0; To : Duration := 3.0; begin Create_Pair (Peer1, Peer2, PF_UNIX, Stream_Socket, IPPROTO_IP); Set_Socket_Send_Timeout (Peer1, To); POSIX_IO.Close (Peer1); POSIX_IO.Close (Peer2); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "A298"); else Comment ("Connected Socket caused an error"); end if; when E2 : others => Unexpected_Exception (E2, "A299"); end; ----------------------------------------------------------------------- -- The Set_Socket_Send_Timout causes a Domain_Error -- Error when the requested buffer is too big Test ("Domain_Error (Set_Socket_Send_Buffer_Size) [18.4.9.3]"); declare Socket : POSIX_IO.File_Descriptor; To : Duration := 10000000.0; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_Socket_Send_Timeout (Socket, To); Expect_Exception ("A300"); exception when E1 : POSIX_Error => if Get_Error_Code = Permission_Denied then Comment ("Set not allowed -- Test not valid"); elsif Get_Error_Code /= No_Buffer_Space then Unexpected_Exception (E1, "A301"); end if; when E2 : others => Unexpected_Exception (E2, "A302"); end; ----------------------------------------------------------------------- -- The Is_A_Socket function returns a value of True if the input is -- a socket and False otherwise Test ("Is_A_Socket [18.4.10]"); declare Socket : POSIX_IO.File_Descriptor := 0; Is_A : Boolean; begin Is_A := Is_A_Socket (Socket); Assert (Is_A = FALSE, "A303"); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Is_A := Is_A_Socket (Socket); Assert (Is_A = TRUE, "A304"); exception when E : others => Unexpected_Exception (E, "A305"); end; ----------------------------------------------------------------------- -- A closed socket will cause Is_A_Socket to raise the -- Bad_File_Desriptor error code. Test ("Bad_File_Descriptor [18.4.10]"); declare Socket : POSIX_IO.File_Descriptor := 0; Is_A : Boolean; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Close (Socket); Is_A := Is_A_Socket (Socket); Expect_Exception ("A306"); exception when E1 : POSIX_Error => if Get_Error_Code /= Bad_File_Descriptor then Unexpected_Exception (E1, "A307"); end if; when E2 : others => Unexpected_Exception (E2, "A308"); end; ----------------------------------------------------------------------- -- Connection_Queue_Length/_Maximum have the appropriate values Test ("Connection_Queue_Length/_Maximum [18.4.11]"); declare Queue_Length : Connection_Queue_Length; begin Queue_Length := 3; Assert (Connection_Queue_Length_Maximum = 5, "A309"); Assert (Connection_Queue_Length'First = 0, "A310"); Assert (Connection_Queue_Length'Last = 5, "A311"); exception when E : others => Unexpected_Exception (E, "A312"); end; ----------------------------------------------------------------------- -- Shutdown_Mode has the appropriate values Test ("Shutdown_Mode [18.4.11]"); declare Mode : Shutdown_Mode; begin Mode := Further_Receives_Disallowed; Assert (Further_Receives_Disallowed = Shutdown_Mode'First and Shutdown_Mode'Pos (Further_Sends_Disallowed) = 1 and Further_Sends_And_Receives_Disallowed = Shutdown_Mode'Last, "A313"); exception when E : others => Unexpected_Exception (E, "A314"); end; ----------------------------------------------------------------------- -- The other functions are protocol dependent and will be tested in -- the appropriate child package ----------------------------------------------------------------------- Done; exception when E : others => Fatal_Exception (E, "A999"); end p180400; libflorist-2025.1.0/tests/sockets/p180400.ads000066400000000000000000000061751473553204100203510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] procedure p180400; libflorist-2025.1.0/tests/sockets/p180401.adb000066400000000000000000001007541473553204100203270ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 1 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_IO, Unchecked_Conversion, System; procedure p180401 is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Bind_Tests ( Socket : in POSIX_IO.File_Descriptor; Port : in Internet_Port := Unspecified_Internet_Port; Address : in Internet_Address := Unspecified_Internet_Address; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String); procedure Connect_Tests ( Socket : in POSIX_IO.File_Descriptor; Port : in Internet_Port := 23; Address : in Internet_Address := String_To_Internet_Address ("127.0.0.1"); Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String); procedure Specify_Peer_Tests ( Socket : in POSIX_IO.File_Descriptor; Port : in Internet_Port := 23; Address : in Internet_Address := String_To_Internet_Address ("127.0.0.1"); Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String); procedure Unspecify_Peer_Tests ( Socket : in POSIX_IO.File_Descriptor; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String); procedure Listen_Tests ( Socket : in POSIX_IO.File_Descriptor; Backlog : in Connection_Queue_Length := Connection_Queue_Length'Last; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String; Close_Socket : in boolean := false); procedure Shutdown_Tests ( Socket : in POSIX_IO.File_Descriptor; Mode : in Shutdown_Mode; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String; Close_Socket : in boolean := false; Should_Connect : in boolean := true); procedure Bind_Tests ( Socket : in POSIX_IO.File_Descriptor; Port : in Internet_Port := Unspecified_Internet_Port; Address : in Internet_Address := Unspecified_Internet_Address; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String) is Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, Address); Bind (Socket, +Name); if Error1 /= "A000" then Expect_Exception (Error1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error2); end if; when E2 : others => Unexpected_Exception (E2, Error3); end Bind_Tests; procedure Connect_Tests ( Socket : in POSIX_IO.File_Descriptor; Port : in Internet_Port := 23; Address : in Internet_Address := String_To_Internet_Address ("127.0.0.1"); Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String) is Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, Address); Connect (Socket, +Name); if Error1 /= "A000" then Expect_Exception (Error1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error2); end if; when E2 : others => Unexpected_Exception (E2, Error3); end Connect_Tests; procedure Specify_Peer_Tests ( Socket : in POSIX_IO.File_Descriptor; Port : in Internet_Port := 23; Address : in Internet_Address := String_To_Internet_Address ("127.0.0.1"); Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String) is Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, Address); Specify_Peer (Socket, +Name); if Error1 /= "A000" then Expect_Exception (Error1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error2); end if; when E2 : others => Unexpected_Exception (E2, Error3); end Specify_Peer_Tests; procedure Unspecify_Peer_Tests ( Socket : in POSIX_IO.File_Descriptor; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String) is begin Unspecify_Peer (Socket); if Error1 /= "A000" then Expect_Exception (Error1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error2); end if; when E2 : others => Unexpected_Exception (E2, Error3); end Unspecify_Peer_Tests; procedure Listen_Tests ( Socket : in POSIX_IO.File_Descriptor; Backlog : in Connection_Queue_Length := Connection_Queue_Length'Last; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String; Close_Socket : in boolean := false) is Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Bind (Socket, +Name); if Close_Socket = true then Close (Socket); end if; Listen (Socket, Backlog); if Error1 /= "A000" then Expect_Exception (Error1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error2); end if; when E2 : others => Unexpected_Exception (E2, Error3); end Listen_Tests; procedure Shutdown_Tests ( Socket : in POSIX_IO.File_Descriptor; Mode : in Shutdown_Mode; Expected : in Error_Code := No_Error; Error1, Error2, Error3 : in String; Close_Socket : in boolean := false; Should_Connect : in boolean := true) is Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 23); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); if Should_Connect = true then Connect (Socket, +Name); end if; if Close_Socket = true then Close (Socket); end if; Shutdown (Socket, Mode); if Error1 /= "A000" then Expect_Exception (Error1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Error2); end if; when E2 : others => Unexpected_Exception (E2, Error3); end Shutdown_Tests; -------------------------------------------------------------------------- -- Begin Tests begin Header ("p180401"); Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- A Socket can be bound Test ("Bind [18.4.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind_Tests (Socket, Error1 => "A000", Error2 => "A001", Error3 => "A002"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to bind a socket to a port that is reserved results in the -- Permission_Denied error code. Test ("Permission_Denied [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind_Tests (Socket, Port => 23, Expected => Permission_Denied, Error1 => "A003", Error2 => "A004", Error3 => "A005"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to bind a socket to a port already in use results in the -- Already_In_Use error code. Test ("Already_In_Use [18.4.3.3]"); declare Socket1 : POSIX_IO.File_Descriptor; Socket2 : POSIX_IO.File_Descriptor; begin Socket1 := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind_Tests (Socket1, Port => 1530, Error1 => "A000", Error2 => "A006", Error3 => "A007"); Socket2 := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind_Tests (Socket2, Port => 1530, Expected => Address_In_Use, Error1 => "A008", Error2 => "A009", Error3 => "A010"); Close (Socket1); Close (Socket2); end; ----------------------------------------------------------------------- -- Trying to bind a socket to an address that doesn't exist results -- in the Address_Not_Available error code. Test ("Address_Not_Available [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind_Tests (Socket, Address => String_To_Internet_Address ("@#$%^&*()"), Expected => Address_Not_Available, Error1 => "A011", Error2 => "A012", Error3 => "A013"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to bind a closed socket results -- in the Bad_File_Descriptor error code. Test ("Bad_File_Descriptor [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Close (Socket); Bind_Tests (Socket, Expected => Bad_File_Descriptor, Error1 => "A014", Error2 => "A015", Error3 => "A016"); end; ----------------------------------------------------------------------- -- Trying to bind a non socket results -- in the Not_A_Socket error code. Test ("Not_A_Socket [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Bind_Tests (Socket, Expected => Not_A_Socket, Error1 => "A017", Error2 => "A018", Error3 => "A019"); end; ----------------------------------------------------------------------- -- Trying to bind to a socket with a different type of object results -- in the Inappropriate_Family error code. This error is not in the -- the standard but I get it in what I think is the place of -- Incorrect_Address_Type. Test ("Inappropriate_Family [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Socket := Create (PF_UNIX, Stream_Socket, IPPROTO_IP); Bind_Tests (Socket, Expected => Inappropriate_Family, Error1 => "A020", Error2 => "A021", Error3 => "A022"); end; ----------------------------------------------------------------------- -- Trying to bind a socket with a bad Address pointer results -- in the Invalid_Argument error code. Test ("Invalid_Argument [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor; Name : Internet_Socket_Address_Pointer; Junk : Internet_Address; function To_Internet_Socket_Address_Pointer is new Unchecked_Conversion (System.Address, Internet_Socket_Address_Pointer); begin Name := To_Internet_Socket_Address_Pointer (Junk'Address); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Expect_Exception ("A023"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Unexpected_Exception (E1, "A024"); end if; when E2 : others => Unexpected_Exception (E2, "A025"); end; ----------------------------------------------------------------------- -- Connecting a socket to local machines telnet port Test ("Connect [18.4.4]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Connect_Tests (Socket, 23, String_To_Internet_Address ("127.0.0.1"), No_Error, "A000", "A026", "A027"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to bind a socket to a port that is reserved results in the -- Permission_Denied error code. Since connect choses the port this -- error message cannot be systematicaly created. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- Trying to bind a socket already in use results in the -- Already_In_Use error code. Since connect choses the port to bind -- to this error message cannot by systematicaly created. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- Trying to connect a socket already in connected results in the -- Is_Already_Connected error code. Test ("Is_Already_Connected [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Connect_Tests (Socket, Error1 => "A000", Error2 => "A028", Error3 => "A029"); Connect_Tests (Socket, Expected => Is_Already_Connected, Error1 => "A030", Error2 => "A031", Error3 => "A032"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to connect a socket to an address that doesn't exist results -- in the Network_Unreachable error code. Test ("Network_Unreachable [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Connect_Tests (Socket, Address => String_To_Internet_Address ("@#$%^&*()"), Expected => Network_Unreachable, Error1 => "A033", Error2 => "A034", Error3 => "A035"); Close (Socket); end; ----------------------------------------------------------------------- -- Address_Not_Available is an error code generated by the bind -- portion of connect. In all createable cases this error is -- supercided by the Network_Unreachabe error code. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- Trying to connect a closed socket results -- in the Bad_File_Descriptor error code. Test ("Bad_File_Descriptor [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Close (Socket); Connect_Tests (Socket, Expected => Bad_File_Descriptor, Error1 => "A036", Error2 => "A037", Error3 => "A038"); end; ----------------------------------------------------------------------- -- Trying to connect a non socket results -- in the Not_A_Socket error code. Test ("Not_A_Socket [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Connect_Tests (Socket, Expected => Not_A_Socket, Error1 => "A039", Error2 => "A040", Error3 => "A041"); end; ----------------------------------------------------------------------- -- Trying to connect to a socket with a different type of object -- results in the Inappropriate_Family error code. This error is not -- in the the standard but I get it in what I think is the place of -- Incorrect_Address_Type. Test ("Inappropriate_Family [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Socket := Create (PF_UNIX, Stream_Socket, IPPROTO_IP); Connect_Tests (Socket, Expected => Inappropriate_Family, Error1 => "A042", Error2 => "A043", Error3 => "A044"); end; ----------------------------------------------------------------------- -- Trying to connect with a bad Address pointer results -- in the Invalid_Argument error code. Test ("Invalid_Argument [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; Name : Internet_Socket_Address_Pointer; Junk : Internet_Address; function To_Internet_Socket_Address_Pointer is new Unchecked_Conversion (System.Address, Internet_Socket_Address_Pointer); begin Name := To_Internet_Socket_Address_Pointer (Junk'Address); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Connect (Socket, +Name); Expect_Exception ("A045"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Unexpected_Exception (E1, "A046"); end if; when E2 : others => Unexpected_Exception (E2, "A047"); end; ----------------------------------------------------------------------- -- Trying to connect twice to a non-reponding address causes the -- Operation_In_Progress error code. Test ("Operation_In_Progress [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 23); -- www.microsoft.com should take forever to make connection Set_Internet_Address (Int_Add, String_To_Internet_Address ("207.46.130.149")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set_File_Control (Socket, Non_Blocking); Connect (Socket, +Name); Connect (Socket, +Name); Expect_Exception ("A048"); exception when E1 : POSIX_Error => if Get_Error_Code /= Operation_In_Progress then Unexpected_Exception (E1, "A049"); end if; when E2 : others => Unexpected_Exception (E2, "A050"); end; ----------------------------------------------------------------------- -- The Operation_In_Progress error code seem to supercede the -- Already_Awaiting_Connection error code. Therefore there is no -- way to create an Alredy_Awaiting_Connection error code. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- Trying to connect to a restricted port causes -- the Connection_Refused error code. -- ... port 53 is a common Internet service (domain) that is often -- ... restricted. Test ("Connection_Refused [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Connect_Tests (Socket, Port => 53, Expected => Connection_Refused, Error1 => "A051", Error2 => "A052", Error3 => "A053"); end; ----------------------------------------------------------------------- -- ??? Host_Unreachable and Network_Unreachable appear to be the -- ??? same thing. Either that or connect would simply block. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- Any signal that would cause Interrupted_Argument on a single -- threaded process will stop the process. Therefore this case -- cannot be recreated. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- The Network_Down error code cannot accuratly be created due to -- it the unreliability of a network being down. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- The No_Buffer_Space error code cannot be accuratly created due to -- the need of buffer space for the rest of the test. ----------------------------------------------------------------------- ----------------------------------------------------------------------- -- Trying to connect to a non-reponding address causes the -- Timed_Out error code after a period of time. Test ("Timed_Out (This may take a few minutes) [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; begin -- www.microsoft.com should take forever to make connection Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Connect_Tests (Socket, Address => String_To_Internet_Address ("207.46.130.149"), Expected => Timed_Out, Error1 => "A054", Error2 => "A055", Error3 => "A056"); end; ----------------------------------------------------------------------- -- Specifying Peer as local machines telnet port Test ("Specify_Peer [18.4.4]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Specify_Peer_Tests (Socket, 23, String_To_Internet_Address ("127.0.0.1"), No_Error, "A000", "A057", "A058"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to specify a peer using a closed socket results -- in the Bad_File_Descriptor error code. Test ("Bad_File_Descriptor [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Close (Socket); Specify_Peer_Tests (Socket, Expected => Bad_File_Descriptor, Error1 => "A059", Error2 => "A060", Error3 => "A061"); end; ----------------------------------------------------------------------- -- Trying to specify a peer using a non socket results -- in the Not_A_Socket error code. Test ("Not_A_Socket [18.4.3.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Specify_Peer_Tests (Socket, Expected => Not_A_Socket, Error1 => "A062", Error2 => "A063", Error3 => "A064"); end; ----------------------------------------------------------------------- -- Trying to specify a peer useing a socket with a different type of -- object results in the Inappropriate_Family error code. This error -- is not in the the standard but I get it in what I think is the -- place of Incorrect_Address_Type. Test ("Inappropriate_Family [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Socket := Create (PF_UNIX, Stream_Socket, IPPROTO_IP); Specify_Peer_Tests (Socket, Expected => Inappropriate_Family, Error1 => "A065", Error2 => "A066", Error3 => "A067"); end; ----------------------------------------------------------------------- -- Trying to specify a peer with a bad Address pointer results -- in the Invalid_Argument error code. Test ("Invalid_Argument [18.4.4.3]"); declare Socket : POSIX_IO.File_Descriptor; Name : Internet_Socket_Address_Pointer; Junk : Internet_Address; function To_Internet_Socket_Address_Pointer is new Unchecked_Conversion (System.Address, Internet_Socket_Address_Pointer); begin Name := To_Internet_Socket_Address_Pointer (Junk'Address); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Specify_Peer (Socket, +Name); Expect_Exception ("A068"); exception when E1 : POSIX_Error => if Get_Error_Code /= Invalid_Argument then Unexpected_Exception (E1, "A069"); end if; when E2 : others => Unexpected_Exception (E2, "A070"); end; ----------------------------------------------------------------------- -- Unspecify a peer that is the local machines telnet port Test ("Unpecify_Peer [18.4.4]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Specify_Peer_Tests (Socket, 23, String_To_Internet_Address ("127.0.0.1"), No_Error, "A000", "A071", "A072"); Unspecify_Peer_Tests (Socket, Error1 => "A000", Error2 => "A073", Error3 => "A074"); Close (Socket); end; ----------------------------------------------------------------------- -- Unspecify a peer that hasn't been specified give the -- Invalid_Argument error code. Test ("Invalid_Argument [18.4.4]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Unspecify_Peer_Tests (Socket, Expected => Invalid_Argument, Error1 => "A000", Error2 => "A075", Error3 => "A076"); Close (Socket); end; ----------------------------------------------------------------------- -- Set socket to listen on system chosen port Test ("Listen [18.4.11]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Listen_Tests (Socket, Error1 => "A000", Error2 => "A077", Error3 => "A078"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to listen on a closes socket results in the -- Bad_File_Desriptor error code Test ("Bad_File_Desriptor [18.4.11.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Listen_Tests (Socket, Expected => Bad_File_Descriptor, Error1 => "A079", Error2 => "A080", Error3 => "A081", Close_Socket => true); end; ----------------------------------------------------------------------- -- Trying to listen on a non-socket results in the -- Not_A_Socket error code Test ("Not_A_Socket [18.4.11.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Listen_Tests (Socket, Expected => Not_A_Socket, Error1 => "A082", Error2 => "A083", Error3 => "A084", Close_Socket => true); end; ----------------------------------------------------------------------- -- Trying to listen on a UDP socket results in the -- Option_Not_Supported error code Test ("Option_Not_Supported [18.4.11.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Listen_Tests (Socket, Expected => Option_Not_Supported, Error1 => "A085", Error2 => "A086", Error3 => "A087"); end; ----------------------------------------------------------------------- -- Shutdown a connection Test ("Shutdown [18.4.14]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Shutdown_Tests (Socket, Mode => Further_Sends_And_Receives_Disallowed, Error1 => "A000", Error2 => "A088", Error3 => "A089"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to shutdown a closed socket results in the -- Bad_File_Desriptor error code. Test ("Bad_File_Descriptor [18.4.14.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Shutdown_Tests (Socket, Expected => Bad_File_Descriptor, Mode => Further_Sends_And_Receives_Disallowed, Close_Socket => true, Error1 => "A090", Error2 => "A091", Error3 => "A092"); end; ----------------------------------------------------------------------- -- Trying to shutdown using a non-connected socket results in the -- Not_Connected error code. Test ("Not_Connected [18.4.14.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Shutdown_Tests (Socket, Mode => Further_Sends_Disallowed, Error1 => "A093", Error2 => "A094", Error3 => "A095", Expected => Not_Connected, Should_Connect => false); end; ----------------------------------------------------------------------- -- Trying to shutdown using a non-socket results in the -- Not_A_Socket error code. Test ("Not_A_Socket [18.4.14.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Shutdown_Tests (Socket, Mode => Further_Sends_Disallowed, Error1 => "A096", Error2 => "A097", Error3 => "A098", Expected => Not_A_Socket, Should_Connect => false); end; -- =============================================================== -- -- == == -- -- == The few remaining functions require multiple processes == -- -- == to be used to test them. Please refer to the p180402 == -- -- == test files. == -- -- == == -- -- =============================================================== -- Done; exception when E : others => Fatal_Exception (E, "A999"); end p180401; libflorist-2025.1.0/tests/sockets/p180401.ads000066400000000000000000000061551473553204100203500ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 1 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180401; libflorist-2025.1.0/tests/sockets/p180402.adb000066400000000000000000001625201473553204100203270ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_IO, POSIX_Process_Primitives, Unchecked_Conversion, -- Test_Parameters, System, POSIX_Process_Environment, POSIX_Process_Identification; -- with Ada.Integer_Text_IO; -- with Ada.Text_IO; use Ada.Text_IO; procedure p180402 is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Primitives, POSIX_Process_Identification, POSIX_Process_Environment, -- Test_Parameters, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Accept_Connection_Procedure ( Socket : in POSIX_IO.File_Descriptor; Address : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Accept_Connection_Function ( Socket : in POSIX_IO.File_Descriptor; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Receive1_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Receive2_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Receive3_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; From : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Receive4_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; From : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Receive_Message1_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : in out Socket_Message; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Receive_Message2_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : in out Socket_Message; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String); procedure Accept_Connection_Procedure ( Socket : in POSIX_IO.File_Descriptor; Address : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Connection_Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Connect_Name : Socket_Address_Pointer := +(Int_Add'Unchecked_Access); begin if Address /= Null_Socket_Address then Connect_Name := Address; end if; Accept_Connection (Socket, Connection_Socket, Connect_Name); if Er1 /= "A000" then Expect_Exception (Er1); else Assert (Connection_Socket /= 0, Er2); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Accept_Connection_Procedure; procedure Accept_Connection_Function ( Socket : in POSIX_IO.File_Descriptor; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Connection_Socket : POSIX_IO.File_Descriptor := 0; begin Connection_Socket := Accept_Connection (Socket); if Er1 /= "A000" then Expect_Exception (Er1); else Assert (Connection_Socket /= 0, Er2); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Accept_Connection_Function; procedure Receive1_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Octets : POSIX_String (1 .. 40); Buffer : System.Address := Octets'Address; Requested : POSIX.IO_Count := 40; Received : POSIX.IO_Count := 0; Mask : POSIX.Signal_Masking := All_Signals; begin Comment ("Receive 1"); Receive (Socket, Buffer, Requested, Received, Mask, Options); Comment ("received octets = " & Integer'Image (Integer (Received))); if Er1 = "A000" then Assert (Received = 11 and Octets (1 .. 11) = "Send 1 test", Er2); else Expect_Exception (Er1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Receive1_Tests; procedure Receive2_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Octets : POSIX_String (1 .. 40); Buffer : System.Address := Octets'Address; Requested : POSIX.IO_Count := 40; Received : POSIX.IO_Count := 0; begin Comment ("Receive 2"); Receive (Socket, Buffer, Requested, Received, Options); Comment ("received octets = " & Integer'Image (Integer (Received))); if Er1 = "A000" then Assert (Received = 11 and Octets (1 .. 11) = "Send 2 test", Er2); else Expect_Exception (Er1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Receive2_Tests; procedure Receive3_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; From : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Octets : POSIX_String (1 .. 40); Buffer : System.Address := Octets'Address; Requested : POSIX.IO_Count := 40; Received : POSIX.IO_Count := 0; Mask : POSIX.Signal_Masking := All_Signals; begin Comment ("Receive 3"); Receive (Socket, Buffer, Requested, Received, From, Mask, Options); Comment ("received octets = " & Integer'Image (Integer (Received))); if Er1 = "A000" then Assert (Received = 11 and Octets (1 .. 11) = "Send 3 test", Er2); else Expect_Exception (Er1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Receive3_Tests; procedure Receive4_Tests ( Socket : in POSIX_IO.File_Descriptor; Options : in Message_Option_Set := Empty_Set; From : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Octets : POSIX_String (1 .. 40); Buffer : System.Address := Octets'Address; Requested : POSIX.IO_Count := 40; Received : POSIX.IO_Count := 0; begin Comment ("Receive 4"); Receive (Socket, Buffer, Requested, Received, From, Options); Comment ("received octets = " & Integer'Image (Integer (Received))); if Er1 = "A000" then Assert (Received = 11 and Octets (1 .. 11) = "Send 4 test", Er2); else Expect_Exception (Er1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Receive4_Tests; procedure Receive_Message1_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : in out Socket_Message; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Received : POSIX.IO_Count := 0; Mask : POSIX.Signal_Masking := All_Signals; begin Comment ("Receive Message 1"); Receive_Message (Socket, Message, Received, Mask, Options); Comment ("received octets = " & Integer'Image (Integer (Received))); if Er1 = "A000" then Assert (Received /= 0, Er2); else Expect_Exception (Er1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Receive_Message1_Tests; procedure Receive_Message2_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : in out Socket_Message; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3, Er4 : in String) is Received : POSIX.IO_Count := 0; begin Comment ("Receive Message 1"); Receive_Message (Socket, Message, Received, Options); Comment ("received octets = " & Integer'Image (Integer (Received))); if Er1 = "A000" then Assert (Received /= 0, Er2); else Expect_Exception (Er1); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er3); end if; when E2 : others => Unexpected_Exception (E2, Er4); end Receive_Message2_Tests; -------------------------------------------------------------------------- -- Begin Tests begin Header ("p180402"); Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Accept an incoming connection Test ("Accept_Connection Procedure [18.4.2]"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); Listen (Socket); POSIX.Append (List, "p180402a"); -- Have to send the second argument to the secondary program -- exeception simple takes care of the case where no argument -- was entered. begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402a", Template, List); Close_Template (Template); Accept_Connection_Procedure (Socket, Er1 => "A000", Er2 => "A001", Er3 => "A002", Er4 => "A003"); Close (Socket); exception when E : others => Unexpected_Exception (E, "A004"); end; ----------------------------------------------------------------------- -- An address object of an incorrect type for the address format of -- this socket raises the Incorrect_Address_Type error code. -- ... Shoud be able to get the correct error when other protocols -- ... can be used. Test (" Incorrect_Address_Type [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; Junk : Internet_Address; Address : Socket_Address_Pointer; function To_Socket_Address_Pointer is new Unchecked_Conversion (System.Address, Socket_Address_Pointer); Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Address := To_Socket_Address_Pointer (Junk'Address); Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Listen (Socket); Accept_Connection_Procedure (Socket, Address => Address, -- Expected => Incorrect_Address_Type, Er1 => "A005", Er2 => "A006", Er3 => "A007", Er4 => "A008"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to accept a connection on a closed socket results in the -- Bad_File_Descriptor error code. Test (" Bad_File_Descriptor [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Close (Socket); Accept_Connection_Procedure (Socket, Expected => Bad_File_Descriptor, Er1 => "A009", Er2 => "A0010", Er3 => "A011", Er4 => "A012"); end; ----------------------------------------------------------------------- -- Trying to accept a connection from a non listening socket -- raises the Invalid_Argument error code. Test (" Invalid_Argument [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Accept_Connection_Procedure (Socket, Expected => Invalid_Argument, Er1 => "A013", Er2 => "A014", Er3 => "A015", Er4 => "A016"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to accept a connection from a non-socket -- raises the Not_A_Socket error code. Test (" Not_A_Socket [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Accept_Connection_Procedure (Socket, Expected => Not_A_Socket, Er1 => "A017", Er2 => "A018", Er3 => "A019", Er4 => "A020"); end; ----------------------------------------------------------------------- -- Trying to accept a connection from an socket that does not support -- the Accept_Connection operation raises the -- Option_Not_Supported error code. Test (" Option_Not_Supported [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Accept_Connection_Procedure (Socket, Expected => Option_Not_Supported, Er1 => "A021", Er2 => "A022", Er3 => "A023", Er4 => "A024"); Close (Socket); end; ----------------------------------------------------------------------- -- A non-blocking socket will cause the Would_Block error code -- when Accept_Connection would normaly block. Test (" Would_Block [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set_File_Control (Socket, Non_Blocking); Bind (Socket, +Name); Listen (Socket); Accept_Connection_Procedure (Socket, Expected => Would_Block, Er1 => "A025", Er2 => "A026", Er3 => "A027", Er4 => "A028"); Close (Socket); end; ----------------------------------------------------------------------- -- Accept an incoming connection Test ("Accept_Connection Function [18.4.2]"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); Listen (Socket); POSIX.Append (List, "p180402a"); begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402a", Template, List); Close_Template (Template); Accept_Connection_Function (Socket, Er1 => "A000", Er2 => "A029", Er3 => "A030", Er4 => "A031"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to accept a connection on a closed socket results in the -- Bad_File_Descriptor error code. Test (" Bad_File_Descriptor [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Close (Socket); Accept_Connection_Function (Socket, Expected => Bad_File_Descriptor, Er1 => "A032", Er2 => "A033", Er3 => "A034", Er4 => "A035"); end; ----------------------------------------------------------------------- -- Trying to accept a connection from a non listening socket -- raises the Invalid_Argument error code. Test (" Invalid_Argument [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Accept_Connection_Function (Socket, Expected => Invalid_Argument, Er1 => "A036", Er2 => "A037", Er3 => "A038", Er4 => "A039"); Close (Socket); end; ----------------------------------------------------------------------- -- Trying to accept a connection from a non-socket -- raises the Not_A_Socket error code. Test (" Not_A_Socket [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Accept_Connection_Function (Socket, Expected => Not_A_Socket, Er1 => "A040", Er2 => "A041", Er3 => "A042", Er4 => "A043"); end; ----------------------------------------------------------------------- -- Trying to accept a connection from an socket that does not support -- the Accept_Connection operation raises the -- Option_Not_Supported error code. Test (" Option_Not_Supported [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Accept_Connection_Function (Socket, Expected => Option_Not_Supported, Er1 => "A044", Er2 => "A045", Er3 => "A046", Er4 => "A047"); Close (Socket); end; ----------------------------------------------------------------------- -- A non-blocking socket will cause the Would_Block error code -- when Accept_Connection would normaly block. Test (" Would_Block [18.4.2.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set_File_Control (Socket, Non_Blocking); Bind (Socket, +Name); Listen (Socket); Accept_Connection_Function (Socket, Expected => Would_Block, Er1 => "A048", Er2 => "A049", Er3 => "A050", Er4 => "A051"); Close (Socket); end; -- =============================================================== -- -- == == -- -- == The remaining Accept_Connection errors cannont be tested == -- -- == due to their dependence on either system resources or == -- -- == race conditions. == -- -- == == -- -- =============================================================== -- ----------------------------------------------------------------------- -- Receive a message sent to local socket Test ("Receive 1 [18.4.12] (<-)"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Connection_Socket : POSIX_IO.File_Descriptor := 0; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); Listen (Socket); POSIX.Append (List, "p180402b"); begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402b", Template, List); Close_Template (Template); Connection_Socket := Accept_Connection (Socket); Receive1_Tests (Connection_Socket, Er1 => "A000", Er2 => "A052", Er3 => "A053", Er4 => "A054"); Close (Socket); end; ----------------------------------------------------------------------- -- A non-blocking socket that should block on a Receive generates -- the Would_Block error code Test ("<- Would_Block [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set_File_Control (Socket, Non_Blocking); Connect (Socket, +Name); Receive1_Tests (Socket, Expected => Would_Block, Er1 => "A055", Er2 => "A056", Er3 => "A057", Er4 => "A058"); end; ----------------------------------------------------------------------- -- Trying to receive on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("<- Bad_File_Destriptor [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Close (Socket); Receive1_Tests (Socket, Expected => Bad_File_Descriptor, Er1 => "A059", Er2 => "A060", Er3 => "A061", Er4 => "A062"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-connected socket generates -- the Not_Connected error code. Test ("<- Not_Connected [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Receive1_Tests (Socket, Expected => Not_Connected, Er1 => "A063", Er2 => "A064", Er3 => "A065", Er4 => "A066"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-socket generates -- the Not_A_Socket error code. Test ("<- Not_A_Socket [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; begin Receive1_Tests (Socket, Expected => Not_A_Socket, Er1 => "A067", Er2 => "A068", Er3 => "A069", Er4 => "A070"); end; ----------------------------------------------------------------------- -- Trying to receive using the Process_OOB_Data option on a socket -- type that doesn't allow it generate the -- Option_Not_Supported error code. Test ("<- Option_Not_Supported [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Receive1_Tests (Socket, Options => Process_OOB_Data, Expected => Option_Not_Supported, Er1 => "A080", Er2 => "A081", Er3 => "A082", Er4 => "A083"); end; ----------------------------------------------------------------------- -- Receive a message sent to local socket Test ("Receive 2 [18.4.12] (<-)"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Connection_Socket : POSIX_IO.File_Descriptor := 0; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); Listen (Socket); POSIX.Append (List, "p180402e"); begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402e", Template, List); Close_Template (Template); Connection_Socket := Accept_Connection (Socket); Receive2_Tests (Connection_Socket, Er1 => "A000", Er2 => "A084", Er3 => "A085", Er4 => "A086"); end; ----------------------------------------------------------------------- -- A non-blocking socket that should block on a Receive generates -- the Would_Block error code Test ("<- Would_Block [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Set_File_Control (Socket, Non_Blocking); Connect (Socket, +Name); Receive2_Tests (Socket, Expected => Would_Block, Er1 => "A087", Er2 => "A088", Er3 => "A089", Er4 => "A090"); end; ----------------------------------------------------------------------- -- Trying to receive on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("<- Bad_File_Destriptor [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; begin Close (Socket); Receive2_Tests (Socket, Expected => Bad_File_Descriptor, Er1 => "A091", Er2 => "A092", Er3 => "A093", Er4 => "A094"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-connected socket generates -- the Not_Connected error code. Test ("<- Not_Connected [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Receive2_Tests (Socket, Expected => Not_Connected, Er1 => "A095", Er2 => "A096", Er3 => "A097", Er4 => "A098"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-socket generates -- the Not_A_Socket error code. Test ("<- Not_A_Socket [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; begin Receive2_Tests (Socket, Expected => Not_A_Socket, Er1 => "A099", Er2 => "A100", Er3 => "A101", Er4 => "A102"); end; ----------------------------------------------------------------------- -- Trying to receive using the Process_OOB_Data option on a socket -- type that doesn't allow it generate the -- Option_Not_Supported error code. Test ("<- Option_Not_Supported [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Receive2_Tests (Socket, Options => Process_OOB_Data, Expected => Option_Not_Supported, Er1 => "A103", Er2 => "A104", Er3 => "A105", Er4 => "A106"); end; ----------------------------------------------------------------------- -- Receive a message sent to local socket Test ("Receive 3 [18.4.12] (<-)"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); POSIX.Append (List, "p180402c"); begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402c", Template, List); Close_Template (Template); Receive3_Tests (Socket, From => +Name, Er1 => "A000", Er2 => "A107", Er3 => "A108", Er4 => "A109"); end; ----------------------------------------------------------------------- -- A non-blocking socket that should block on a Receive generates -- the Would_Block error code Test ("<- Would_Block [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_File_Control (Socket, Non_Blocking); Connect (Socket, +Name); Receive3_Tests (Socket, From => +Name, Expected => Would_Block, Er1 => "A110", Er2 => "A111", Er3 => "A112", Er4 => "A113"); end; ----------------------------------------------------------------------- -- Trying to receive on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("<- Bad_File_Destriptor [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Close (Socket); Receive3_Tests (Socket, From => +Name, Expected => Bad_File_Descriptor, Er1 => "A114", Er2 => "115", Er3 => "A116", Er4 => "117"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-connected socket generates -- the Not_Connected error code. Test ("<- Not_Connected [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Receive3_Tests (Socket, From => +Name, Expected => Not_Connected, Er1 => "A118", Er2 => "A119", Er3 => "A120", Er4 => "A121"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-socket generates -- the Not_A_Socket error code. Test ("<- Not_A_Socket [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Receive3_Tests (Socket, From => +Name, Expected => Not_A_Socket, Er1 => "A122", Er2 => "A123", Er3 => "A124", Er4 => "A125"); end; ----------------------------------------------------------------------- -- Trying to receive using the Process_OOB_Data option on a socket -- type that doesn't allow it generate the -- Option_Not_Supported error code. Test ("<- Option_Not_Supported [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Receive3_Tests (Socket, From => +Name, Options => Process_OOB_Data, Expected => Option_Not_Supported, Er1 => "A126", Er2 => "A127", Er3 => "A128", Er4 => "A129"); end; -- ... Add test for Incorrect_Address_Type here when testing of -- ... a non-internet protocol is completed ----------------------------------------------------------------------- -- Receive a message sent to local socket Test ("Receive 4 [18.4.12] (<-)"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); POSIX.Append (List, "p180402g"); begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402g", Template, List); Close_Template (Template); Receive4_Tests (Socket, From => +Name, Er1 => "A000", Er2 => "A130", Er3 => "A131", Er4 => "A132"); end; ----------------------------------------------------------------------- -- A non-blocking socket that should block on a Receive generates -- the Would_Block error code Test ("<- Would_Block [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_File_Control (Socket, Non_Blocking); Connect (Socket, +Name); Receive4_Tests (Socket, From => +Name, Expected => Would_Block, Er1 => "A133", Er2 => "A134", Er3 => "A135", Er4 => "A136"); end; ----------------------------------------------------------------------- -- Trying to receive on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("<- Bad_File_Destriptor [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Close (Socket); Receive4_Tests (Socket, From => +Name, Expected => Bad_File_Descriptor, Er1 => "A137", Er2 => "A138", Er3 => "A139", Er4 => "A140"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-connected socket generates -- the Not_Connected error code. Test ("<- Not_Connected [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Receive4_Tests (Socket, From => +Name, Expected => Not_Connected, Er1 => "A141", Er2 => "A142", Er3 => "A143", Er4 => "A144"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-socket generates -- the Not_A_Socket error code. Test ("<- Not_A_Socket [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Receive4_Tests (Socket, From => +Name, Expected => Not_A_Socket, Er1 => "A145", Er2 => "A146", Er3 => "A147", Er4 => "A148"); end; ----------------------------------------------------------------------- -- Trying to receive using the Process_OOB_Data option on a socket -- type that doesn't allow it generates the -- Option_Not_Supported error code. Test ("<- Option_Not_Supported [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Receive4_Tests (Socket, From => +Name, Options => Process_OOB_Data, Expected => Option_Not_Supported, Er1 => "A149", Er2 => "A150", Er3 => "A151", Er4 => "A152"); end; -- ... Add test for Incorrect_Address_Type here when testing of -- ... a non-internet protocol is completed ----------------------------------------------------------------------- -- Receive a message sent to local socket Test ("Receive_Message 1 [18.4.12] (<-)"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); POSIX.Append (List, "p180402d"); begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402d", Template, List); Close_Template (Template); Receive_Message1_Tests (Socket, Message, Er1 => "A000", Er2 => "A153", Er3 => "A154", Er4 => "A155"); Comment (To_String (Buffer)); end; ----------------------------------------------------------------------- -- A non-blocking socket that should block on a Receive generates -- the Would_Block error code Test ("<- Would_Block [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_File_Control (Socket, Non_Blocking); Receive_Message1_Tests (Socket, Message, Expected => Would_Block, Er1 => "A156", Er2 => "A157", Er3 => "A158", Er4 => "A159"); end; ----------------------------------------------------------------------- -- Trying to receive on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("<- Bad_File_Destriptor [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Close (Socket); Receive_Message1_Tests (Socket, Message, Expected => Bad_File_Descriptor, Er1 => "A160", Er2 => "A161", Er3 => "A162", Er4 => "A163"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-connected socket generates -- the Not_Connected error code. Test ("<- Not_Connected [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Receive_Message1_Tests (Socket, Message, Expected => Not_Connected, Er1 => "A164", Er2 => "A165", Er3 => "A166", Er4 => "A167"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-socket generates -- the Not_A_Socket error code. Test ("<- Not_A_Socket [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Receive_Message1_Tests (Socket, Message, Expected => Not_A_Socket, Er1 => "A168", Er2 => "A169", Er3 => "A170", Er4 => "A171"); end; ----------------------------------------------------------------------- -- Trying to receive using the Process_OOB_Data option on a socket -- type that doesn't allow it generates the -- Option_Not_Supported error code. Test ("<- Option_Not_Supported [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Receive_Message1_Tests (Socket, Message, Options => Process_OOB_Data, Expected => Option_Not_Supported, Er1 => "A172", Er2 => "A173", Er3 => "A174", Er4 => "A175"); end; -- ... Add test for Incorrect_Address_Type here when testing of -- ... a non-internet protocol is completed ----------------------------------------------------------------------- -- Receive a message sent to local socket Test ("Receive_Message 2 [18.4.12] (<-)"); declare Socket : POSIX_IO.File_Descriptor; Port : Positive; Template : Process_Template; Child : Process_ID; List : POSIX_String_List; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Port (Int_Add, Unspecified_Internet_Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Bind (Socket, +Name); Port := Integer (Get_Internet_Port (Get_Socket_Name (Socket))); POSIX.Append (List, "p180402f"); begin POSIX.Append (List, Value (Argument_List, 2)); exception when Constraint_Error => POSIX.Append (List, " "); end; POSIX.Append (List, To_POSIX_String (Integer'Image (Port))); Comment ("port is " & Integer'Image (Port)); Open_Template (Template); Start_Process (Child, "./p180402f", Template, List); Close_Template (Template); Receive_Message2_Tests (Socket, Message, Er1 => "A000", Er2 => "A176", Er3 => "A177", Er4 => "A178"); Comment (To_String (Buffer)); end; ----------------------------------------------------------------------- -- A non-blocking socket that should block on a Receive generates -- the Would_Block error code Test ("<- Would_Block [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Port (Int_Add, 9); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Set_File_Control (Socket, Non_Blocking); Receive_Message2_Tests (Socket, Message, Expected => Would_Block, Er1 => "A179", Er2 => "A180", Er3 => "A181", Er4 => "A182"); end; ----------------------------------------------------------------------- -- Trying to receive on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("<- Bad_File_Destriptor [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Close (Socket); Receive_Message2_Tests (Socket, Message, Expected => Bad_File_Descriptor, Er1 => "A183", Er2 => "A184", Er3 => "A185", Er4 => "A186"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-connected socket generates -- the Not_Connected error code. Test ("<- Not_Connected [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Receive_Message2_Tests (Socket, Message, Expected => Not_Connected, Er1 => "A187", Er2 => "A188", Er3 => "A189", Er4 => "A190"); end; ----------------------------------------------------------------------- -- Trying to receive on a non-socket generates -- the Not_A_Socket error code. Test ("<- Not_A_Socket [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Receive_Message2_Tests (Socket, Message, Expected => Not_A_Socket, Er1 => "A191", Er2 => "A192", Er3 => "A193", Er4 => "A194"); end; ----------------------------------------------------------------------- -- Trying to receive using the Process_OOB_Data option on a socket -- type that doesn't allow it generates the -- Option_Not_Supported error code. Test ("<- Option_Not_Supported [18.4.12.3]"); declare Socket : POSIX_IO.File_Descriptor; Int_Add : aliased Internet_Socket_Address; Message : Socket_Message; Buffer : POSIX_String (1 .. 80); IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 1); begin Set_Buffer (IOV_Array (1), Buffer (Buffer'First)'Address, Buffer'Length); Set_IO_Vector_Array (Message, IOV_Array); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Receive_Message2_Tests (Socket, Message, Options => Process_OOB_Data, Expected => Option_Not_Supported, Er1 => "A195", Er2 => "A196", Er3 => "A197", Er4 => "A198"); end; -- ... Add test for Incorrect_Address_Type here when testing of -- ... a non-internet protocol is completed Done; exception when E : others => Fatal_Exception (E, "A999"); end p180402; libflorist-2025.1.0/tests/sockets/p180402.ads000066400000000000000000000061551473553204100203510ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402; libflorist-2025.1.0/tests/sockets/p180402a.adb000066400000000000000000000117121473553204100204640ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 A -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_Process_Environment, POSIX_IO; procedure p180402a is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Environment, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; -------------------------------------------------------------------------- -- Begin Tests begin ----------------------------------------------------------------------- -- Make a connection Comment ("p180402a"); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Connect (Socket, +Name); Close (Socket); exception when E : others => Fatal_Exception (E, "AA01"); end p180402a; libflorist-2025.1.0/tests/sockets/p180402a.ads000066400000000000000000000061561473553204100205130ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 A -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402a; libflorist-2025.1.0/tests/sockets/p180402b.adb000066400000000000000000000222401473553204100204630ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 B -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_Process_Environment, System, POSIX_IO; procedure p180402b is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Environment, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Send1_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; Mask : POSIX.Signal_Masking := All_Signals; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := ""); procedure Send1_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; Mask : POSIX.Signal_Masking := All_Signals; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := "") is Sent : POSIX.IO_Count; begin Send (Socket, Buffer, 11, Sent, Mask); if Er1 /= "" then Expect_Exception (Er1); else Comment ("Sent " & Integer'Image (Integer (Sent)) & " octets"); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er2); end if; when E2 : others => Unexpected_Exception (E2, Er3); end Send1_Tests; -------------------------------------------------------------------------- -- Begin Tests begin -- Header ("p180402b"); -- Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Send on a socket Test ("Send 1 [18.4.13] (->)"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; -- P180402 expects the following message Buffer : POSIX_String (1 .. 11) := "Send 1 test"; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Connect (Socket, +Name); Send1_Tests (Socket, Buffer'Address); Close (Socket); exception when E : others => Unexpected_Exception (E, "Ab01"); end; ----------------------------------------------------------------------- -- Trying to send on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("-> Bad_File_Descriptor [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Buffer : POSIX_String := "test"; begin Close (Socket); Send1_Tests (Socket, Buffer'Address, Expected => Bad_File_Descriptor, Er1 => "Ab02", Er2 => "Ab03", Er3 => "Ab04"); exception when E : others => Unexpected_Exception (E, "Ab05"); end; ----------------------------------------------------------------------- -- Trying to send on a socket that is not connected generates -- the Not_Connected error code. Test ("-> Not_Connected [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor; Buffer : POSIX_String := "test"; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Send1_Tests (Socket, Buffer'Address, Expected => Not_Connected, Er1 => "Ab06", Er2 => "Ab07", Er3 => "Ab08"); exception when E : others => Unexpected_Exception (E, "Ab09"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Not_A_Socket [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Buffer : POSIX_String := "test"; begin Send1_Tests (Socket, Buffer'Address, Expected => Not_A_Socket, Er1 => "Ab10", Er2 => "Ab11", Er3 => "Ab12"); exception when E : others => Unexpected_Exception (E, "Ab13"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Is_Already_Connected"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; -- P180402 expects the following message begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Connect (Socket, +Name); Connect (Socket, +Name); Close (Socket); exception when E1 : POSIX_Error => if Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "Ab14"); end if; when E2 : others => Unexpected_Exception (E2, "Ab15"); end; Done; exception when E : others => Fatal_Exception (E, "Ab17"); end p180402b; libflorist-2025.1.0/tests/sockets/p180402b.ads000066400000000000000000000061561473553204100205140ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 B -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402b; libflorist-2025.1.0/tests/sockets/p180402c.adb000066400000000000000000000260751473553204100204760ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 C -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_Process_Environment, System, POSIX_IO; procedure p180402c is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Environment, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Send3_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; To : in Socket_Address_Pointer := Null_Socket_Address; Mask : POSIX.Signal_Masking := All_Signals; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := ""); procedure Send3_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; To : in Socket_Address_Pointer := Null_Socket_Address; Mask : POSIX.Signal_Masking := All_Signals; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := "") is Sent : POSIX.IO_Count; begin Send (Socket, Buffer, 11, Sent, To, Mask); if Er1 /= "" then Expect_Exception (Er1); else Comment ("Sent " & Integer'Image (Integer (Sent)) & " octets"); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er2); end if; when E2 : others => Unexpected_Exception (E2, Er3); end Send3_Tests; -------------------------------------------------------------------------- -- Begin Tests begin -- Header ("p180402c"); -- Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Send on a socket Test ("Send 3 [18.4.13] (->)"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; -- P180402 expects the following message Buffer : POSIX_String (1 .. 11) := "Send 3 test"; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Send3_Tests (Socket, Buffer'Address, To => +Name); Close (Socket); exception when E : others => Unexpected_Exception (E, "Ac01"); end; ----------------------------------------------------------------------- -- Trying to send on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("-> Bad_File_Descriptor [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Buffer : POSIX_String := "test"; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Close (Socket); Send3_Tests (Socket, Buffer'Address, To => +Name, Expected => Bad_File_Descriptor, Er1 => "Ac02", Er2 => "Ac04", Er3 => "Ac05"); exception when E : others => Unexpected_Exception (E, "Ac06"); end; ----------------------------------------------------------------------- -- Trying to send on a socket that is not connected generates -- the Not_Connected error code. Test ("-> Not_Connected [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor; Buffer : POSIX_String := "test"; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Send3_Tests (Socket, Buffer'Address, To => +Name, Expected => Not_Connected, Er1 => "Ac07", Er2 => "Ac08", Er3 => "Ac09"); exception when E : others => Unexpected_Exception (E, "Ac10"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Not_A_Socket [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Buffer : POSIX_String := "test"; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Send3_Tests (Socket, Buffer'Address, To => +Name, Expected => Not_A_Socket, Er1 => "Ac11", Er2 => "Ac12", Er3 => "Ac13"); exception when E : others => Unexpected_Exception (E, "Ac14"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. -- Test ("-> Is_Already_Connected"); -- declare -- Socket : POSIX_IO.File_Descriptor := 0; -- Int_Add : aliased Internet_Socket_Address; -- Name : Internet_Socket_Address_Pointer := -- Int_Add'Unchecked_Access; -- Port : Internet_Port; -- begin -- Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); -- Port := Internet_Port (Integer'Value -- (To_String (Value (Argument_List, 3)))); -- Set_Internet_Port (Int_Add, Port); -- Set_Internet_Address (Int_Add, -- String_To_Internet_Address ("127.0.0.1")); -- Connect (Socket, +Name); -- Connect (Socket, +Name); -- Close (Socket); -- exception -- when E1 : POSIX_Error => -- if Get_Error_Code /= Is_Already_Connected then -- Unexpected_Exception (E1, "Ac15"); -- end if; -- when E2 : others => Unexpected_Exception (E2, "Ac16"); -- end; ----------------------------------------------------------------------- -- ??? what causes this -- Test ("-> Incorrect_Address_Type [18.4.13]"); -- declare -- Socket : POSIX_IO.File_Descriptor := 0; -- Int_Add : aliased Internet_Socket_Address; -- Name : Internet_Socket_Address_Pointer := -- Int_Add'Unchecked_Access; -- Port : Internet_Port; -- -- P180402 expects the following message -- Buffer : POSIX_String (1 .. 11) := "Send 3 test"; -- begin -- Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); -- Port := Internet_Port (Integer'Value -- (To_String (Value (Argument_List, 3)))); -- Set_Internet_Port (Int_Add, Port); -- Set_Internet_Address (Int_Add, -- String_To_Internet_Address ("127.0.0.1.7")); -- Send3_Tests (Socket, Buffer'Address, To => +Name, -- Expected => Invalid_Argument, Er1 => "Ac17", -- Er2 => "Ac18", Er3 => "Ac19"); -- Close (Socket); -- exception -- when E : others => Unexpected_Exception (E, "Ac20"); -- end; Done; exception when E : others => Fatal_Exception (E, "Ac21"); end p180402c; libflorist-2025.1.0/tests/sockets/p180402c.ads000066400000000000000000000061561473553204100205150ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 C -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402c; libflorist-2025.1.0/tests/sockets/p180402d.adb000066400000000000000000000213541473553204100204720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 D -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_Process_Environment, POSIX_IO; procedure p180402d is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Environment, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Send_Message1_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : Socket_Message; Options : in Message_Option_Set := Empty_Set; Mask : POSIX.Signal_Masking := All_Signals; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := ""); procedure Send_Message1_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : Socket_Message; Options : in Message_Option_Set := Empty_Set; Mask : POSIX.Signal_Masking := All_Signals; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := "") is Sent : POSIX.IO_Count; begin Send_Message (Socket, Message, Sent, Mask); if Er1 /= "" then Expect_Exception (Er1); else Comment ("Sent " & Integer'Image (Integer (Sent)) & " octets"); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er2); end if; when E2 : others => Unexpected_Exception (E2, Er3); end Send_Message1_Tests; -------------------------------------------------------------------------- -- Begin Tests begin -- Header ("p180402d"); -- Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Send a message on a connection-less socket Test ("Send Message 1 [18.4.13] (->)"); declare Socket : POSIX_IO.File_Descriptor := 0; Message : Socket_Message; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; Buffer1 : POSIX_String := "Test message. "; Buffer2 : POSIX_String := "This is a UDP/IP message. "; Buffer3 : POSIX_String := "It was sent using Send_Message1. "; IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 3); begin Set_Buffer (IOV_Array (1), Buffer1 (Buffer1'First)'Address, Buffer1'Length); Set_Buffer (IOV_Array (2), Buffer2 (Buffer2'First)'Address, Buffer2'Length); Set_Buffer (IOV_Array (3), Buffer3 (Buffer3'First)'Address, Buffer3'Length); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Set_Socket_Name (Message, +Name); Set_IO_Vector_Array (Message, IOV_Array); Send_Message1_Tests (Socket, Message, Er2 => "Ad01", Er3 => "Ad02"); Close (Socket); exception when E : others => Unexpected_Exception (E, "Ad03"); end; ----------------------------------------------------------------------- -- Trying to send on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("-> Bad_File_Descriptor [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Message : Socket_Message; begin Close (Socket); Send_Message1_Tests (Socket, Message, Expected => Bad_File_Descriptor, Er1 => "Ad04", Er2 => "Ad05", Er3 => "Ad06"); exception when E : others => Unexpected_Exception (E, "Ad07"); end; ----------------------------------------------------------------------- -- Trying to send on a socket that is not connected generates -- the Not_Connected error code. Test ("-> Not_Connected [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor; Message : Socket_Message; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Send_Message1_Tests (Socket, Message, Expected => Not_Connected, Er1 => "Ad08", Er2 => "Ad09", Er3 => "Ad10"); exception when E : others => Unexpected_Exception (E, "Ad11"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Not_A_Socket [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Message : Socket_Message; begin Send_Message1_Tests (Socket, Message, Expected => Not_A_Socket, Er1 => "Ad12", Er2 => "Ad13", Er3 => "Ad14"); exception when E : others => Unexpected_Exception (E, "Ad15"); end; Done; exception when E : others => Fatal_Exception (E, "Ad16"); end p180402d; libflorist-2025.1.0/tests/sockets/p180402d.ads000066400000000000000000000061561473553204100205160ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 D -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402d; libflorist-2025.1.0/tests/sockets/p180402e.adb000066400000000000000000000220561473553204100204730ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 E -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_Process_Environment, System, POSIX_IO; procedure p180402e is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Environment, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Send2_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := ""); procedure Send2_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := "") is Sent : POSIX.IO_Count; begin Send (Socket, Buffer, 11, Sent); if Er1 /= "" then Expect_Exception (Er1); else Comment ("Sent " & Integer'Image (Integer (Sent)) & " octets"); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er2); end if; when E2 : others => Unexpected_Exception (E2, Er3); end Send2_Tests; -------------------------------------------------------------------------- -- Begin Tests begin -- Header ("p180402e"); -- Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Send on a socket Test ("Send 2 [18.4.13] (->)"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; -- P180402 expects the following message Buffer : POSIX_String (1 .. 11) := "Send 2 test"; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Connect (Socket, +Name); Send2_Tests (Socket, Buffer'Address); Close (Socket); exception when E : others => Unexpected_Exception (E, "Ae01"); end; ----------------------------------------------------------------------- -- Trying to send on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("-> Bad_File_Descriptor [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Buffer : POSIX_String := "test"; begin Close (Socket); Send2_Tests (Socket, Buffer'Address, Expected => Bad_File_Descriptor, Er1 => "Ae02", Er2 => "Ae03", Er3 => "Ae04"); exception when E : others => Unexpected_Exception (E, "Ae05"); end; ----------------------------------------------------------------------- -- Trying to send on a socket that is not connected generates -- the Not_Connected error code. Test ("-> Not_Connected [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor; Buffer : POSIX_String := "test"; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Send2_Tests (Socket, Buffer'Address, Expected => Not_Connected, Er1 => "Ae06", Er2 => "Ae07", Er3 => "Ae08"); exception when E : others => Unexpected_Exception (E, "Ae09"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Not_A_Socket [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Buffer : POSIX_String := "test"; begin Send2_Tests (Socket, Buffer'Address, Expected => Not_A_Socket, Er1 => "Ae10", Er2 => "Ae11", Er3 => "Ae12"); exception when E : others => Unexpected_Exception (E, "Ae13"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Is_Already_Connected"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; -- P180402 expects the following message begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Connect (Socket, +Name); Connect (Socket, +Name); Close (Socket); exception when E1 : POSIX_Error => if Get_Error_Code /= Is_Already_Connected then Unexpected_Exception (E1, "Ae14"); end if; when E2 : others => Unexpected_Exception (E2, "Ad15"); end; Done; exception when E : others => Fatal_Exception (E, "Ae16"); end p180402e; libflorist-2025.1.0/tests/sockets/p180402e.ads000066400000000000000000000061561473553204100205170ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 E -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402e; libflorist-2025.1.0/tests/sockets/p180402f.adb000066400000000000000000000211721473553204100204720ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 F -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_Process_Environment, POSIX_IO; procedure p180402f is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Environment, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Send_Message2_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : Socket_Message; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := ""); procedure Send_Message2_Tests ( Socket : in POSIX_IO.File_Descriptor; Message : Socket_Message; Options : in Message_Option_Set := Empty_Set; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := "") is Sent : POSIX.IO_Count; begin Send_Message (Socket, Message, Sent); if Er1 /= "" then Expect_Exception (Er1); else Comment ("Sent " & Integer'Image (Integer (Sent)) & " octets"); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er2); end if; when E2 : others => Unexpected_Exception (E2, Er3); end Send_Message2_Tests; -------------------------------------------------------------------------- -- Begin Tests begin -- Header ("p180402f"); -- Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Send a message on a connection-less socket Test ("Send Message 2 [18.4.13] (->)"); declare Socket : POSIX_IO.File_Descriptor := 0; Message : Socket_Message; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; Buffer1 : POSIX_String := "Test message. "; Buffer2 : POSIX_String := "This is a UDP/IP message. "; Buffer3 : POSIX_String := "It was sent using Send_Message2. "; IOV_Array : IO_Vector_Array_Pointer := new IO_Vector_Array (1 .. 3); begin Set_Buffer (IOV_Array (1), Buffer1 (Buffer1'First)'Address, Buffer1'Length); Set_Buffer (IOV_Array (2), Buffer2 (Buffer2'First)'Address, Buffer2'Length); Set_Buffer (IOV_Array (3), Buffer3 (Buffer3'First)'Address, Buffer3'Length); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Set_Socket_Name (Message, +Name); Set_IO_Vector_Array (Message, IOV_Array); Send_Message2_Tests (Socket, Message, Er2 => "Af01", Er3 => "Af02"); Close (Socket); exception when E : others => Unexpected_Exception (E, "Af03"); end; ----------------------------------------------------------------------- -- Trying to send on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("-> Bad_File_Descriptor [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Message : Socket_Message; begin Close (Socket); Send_Message2_Tests (Socket, Message, Expected => Bad_File_Descriptor, Er1 => "Af04", Er2 => "Af05", Er3 => "Af06"); exception when E : others => Unexpected_Exception (E, "Af07"); end; ----------------------------------------------------------------------- -- Trying to send on a socket that is not connected generates -- the Not_Connected error code. Test ("-> Not_Connected [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor; Message : Socket_Message; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Send_Message2_Tests (Socket, Message, Expected => Not_Connected, Er1 => "Af08", Er2 => "Af09", Er3 => "Af10"); exception when E : others => Unexpected_Exception (E, "Af11"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Not_A_Socket [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Message : Socket_Message; begin Send_Message2_Tests (Socket, Message, Expected => Not_A_Socket, Er1 => "Af12", Er2 => "Af13", Er3 => "Af14"); exception when E : others => Unexpected_Exception (E, "Af15"); end; Done; exception when E : others => Fatal_Exception (E, "Af16"); end p180402f; libflorist-2025.1.0/tests/sockets/p180402f.ads000066400000000000000000000061561473553204100205200ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 F -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402f; libflorist-2025.1.0/tests/sockets/p180402g.adb000066400000000000000000000236031473553204100204740ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 G -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Multiprocess integrated test for package POSIX_Sockets -- in IEEE Std 1003.5c Section 18.4 with package -- POSIX_Sockets_Interent. -- This test covers only features that depend only on -- the packages (POSIX_Sockets/_Interent) and features from -- other packages that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_Process_Environment, System, POSIX_IO; procedure p180402g is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_IO, POSIX_Process_Environment, POSIX_Report; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; procedure Send4_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; To : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := ""); procedure Send4_Tests ( Socket : in POSIX_IO.File_Descriptor; Buffer : in System.Address; Options : in Message_Option_Set := Empty_Set; To : in Socket_Address_Pointer := Null_Socket_Address; Expected : in Error_Code := No_Error; Er1, Er2, Er3 : in String := "") is Sent : POSIX.IO_Count; begin Send (Socket, Buffer, 11, Sent, To); if Er1 /= "" then Expect_Exception (Er1); else Comment ("Sent " & Integer'Image (Integer (Sent)) & " octets"); end if; exception when E1 : POSIX_Error => if Get_Error_Code /= Expected then Unexpected_Exception (E1, Er2); end if; when E2 : others => Unexpected_Exception (E2, Er3); end Send4_Tests; -------------------------------------------------------------------------- -- Begin Tests begin -- Header ("p180402g"); -- Test ("package POSIX.Sockets"); ----------------------------------------------------------------------- -- Send on a socket Test ("Send 4 [18.4.13] (->)"); declare Socket : POSIX_IO.File_Descriptor := 0; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; Port : Internet_Port; -- P180402 expects the following message Buffer : POSIX_String (1 .. 11) := "Send 4 test"; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_UDP); Port := Internet_Port (Integer'Value (To_String (Value (Argument_List, 3)))); Set_Internet_Port (Int_Add, Port); Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Send4_Tests (Socket, Buffer'Address, To => +Name); Close (Socket); exception when E : others => Unexpected_Exception (E, "Ag01"); end; ----------------------------------------------------------------------- -- Trying to send on a closed file descriptor generates -- the Bad_File_Desriptor error code. Test ("-> Bad_File_Descriptor [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 0; Buffer : POSIX_String := "test"; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Close (Socket); Send4_Tests (Socket, Buffer'Address, To => +Name, Expected => Bad_File_Descriptor, Er1 => "Ag02", Er2 => "Ag03", Er3 => "Ag04"); exception when E : others => Unexpected_Exception (E, "Ag05"); end; ----------------------------------------------------------------------- -- Trying to send on a socket that is not connected generates -- the Not_Connected error code. Test ("-> Not_Connected [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor; Buffer : POSIX_String := "test"; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Send4_Tests (Socket, Buffer'Address, To => +Name, Expected => Not_Connected, Er1 => "Ag06", Er2 => "Ag07", Er3 => "Ag08"); exception when E : others => Unexpected_Exception (E, "Ag09"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. Test ("-> Not_A_Socket [18.4.13.3]"); declare Socket : POSIX_IO.File_Descriptor := 1; Buffer : POSIX_String := "test"; Int_Add : aliased Internet_Socket_Address; Name : Internet_Socket_Address_Pointer := Int_Add'Unchecked_Access; begin Set_Internet_Address (Int_Add, String_To_Internet_Address ("127.0.0.1")); Send4_Tests (Socket, Buffer'Address, To => +Name, Expected => Not_A_Socket, Er1 => "Ag10", Er2 => "Ag12", Er3 => "Ag13"); exception when E : others => Unexpected_Exception (E, "Ag14"); end; ----------------------------------------------------------------------- -- Trying to send on a file descriptor that is not a socket generates -- the Not_A_Socket error code. -- Test ("-> Is_Already_Connected"); -- declare -- Socket : POSIX_IO.File_Descriptor := 0; -- Int_Add : aliased Internet_Socket_Address; -- Name : Internet_Socket_Address_Pointer := -- Int_Add'Unchecked_Access; -- Port : Internet_Port; -- begin -- Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); -- Port := Internet_Port (Integer'Value -- (To_String (Value (Argument_List, 3)))); -- Set_Internet_Port (Int_Add, Port); -- Set_Internet_Address (Int_Add, -- String_To_Internet_Address ("127.0.0.1")); -- Connect (Socket, +Name); -- Connect (Socket, +Name); -- Close (Socket); -- exception -- when E1 : POSIX_Error => -- if Get_Error_Code /= Is_Already_Connected then -- Unexpected_Exception (E1, "Ag15"); -- end if; -- when E2 : others => Unexpected_Exception (E2, "Ag16"); -- end; Done; exception when E : others => Fatal_Exception (E, "Ag17"); end p180402g; libflorist-2025.1.0/tests/sockets/p180402g.ads000066400000000000000000000061561473553204100205210ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P 1 8 0 4 0 2 G -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure p180402g; libflorist-2025.1.0/tests/sockets/pdd0100.adb000066400000000000000000000754021473553204100204630ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P D D 0 1 0 0 -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- Basic test for package POSIX_Sockets_Internet, -- in IEEE Std 1003.5c Section D.1.3 -- This test covers only features that depend only on -- the package itself and features from other packages -- that are required to be supported. with POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, POSIX_IO, System, Unchecked_Conversion, Test_Parameters; procedure pdd0100 is use POSIX, POSIX_Sockets, POSIX_Sockets_Internet, POSIX_Report, Test_Parameters; -- These are declared in Posix.C but not intended to be used from there PF_MAX : constant := 25; PF_UNSPEC : constant := 0; PF_LOCAL : constant := 1; PF_UNIX : constant := 1; PF_INET : constant := 2; PF_OSI : constant := 19; -- *** MISSING: PF_ISO *** -- PF_ISO : constant := 0; IPPROTO_IP : constant := 0; IPPROTO_ICMP : constant := 1; IPPROTO_TCP : constant := 6; IPPROTO_UDP : constant := 17; IPPROTO_RAW : constant := 255; -- ===== Procedure and Function Prototypes ========================== -- procedure Action (Alias_Name : in POSIX_String; Quit : in out Boolean); generic type T is (<>); with function Get (Socket : POSIX_IO.File_Descriptor) return T; with procedure Set (Socket : in POSIX_IO.File_Descriptor; To : in T); procedure TCP_Tests (Name : in String; To : in T; Default : in T; Er0 : in String := "A000"; Er1, Er2, Er3 : in String); generic type T is (<>); with function Get (Socket : POSIX_IO.File_Descriptor) return T; with procedure Set (Socket : in POSIX_IO.File_Descriptor; To : in T); procedure IP_Tests (Name : in String; To : in T; Default : in T; Er0 : in String := "A000"; Er1, Er2 : in String); -- ===== Procedure and Function Body ================================ -- procedure Action (Alias_Name : in POSIX_String; Quit : in out Boolean) is begin if Alias_Name = "" then Quit := True; end if; Comment ("Alias name is : " & To_String (Alias_Name)); end Action; procedure TCP_Tests (Name : in String; To : in T; Default : in T; Er0 : in String := "A000"; Er1, Er2, Er3 : in String) is Socket : POSIX_IO.File_Descriptor; Result : T; begin Test ("Get/Set_" & Name &" [D.1.3.4]"); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); if Er0 /= "A000" then Assert (Get (Socket) = Default, Er0); end if; Set (Socket, To); Comment ("Socket's " & Name & " has been set"); Result := Get (Socket); Assert (Result = To, Er1); exception when E1 : POSIX_Error => Optional (Internet_Stream_Option, Unknown_Protocol_Option, E1, Er2); when E2 : others => Unexpected_Exception (E2, Er3); end TCP_Tests; procedure IP_Tests (Name : in String; To : in T; Default : in T; Er0 : in String := "A000"; Er1, Er2 : in String) is Socket : POSIX_IO.File_Descriptor; Result : T; begin Test ("Get/Set_" & Name &" [D.1.3.6]"); Socket := Create (PF_INET, Datagram_Socket, IPPROTO_IP); if Er0 /= "A000" then Assert (Get (Socket) = Default, Er0); end if; Set (Socket, To); Comment ("Socket's " & Name & " has been set"); Result := Get (Socket); Assert (Result = To, Er1); exception when E : others => Unexpected_Exception (E, Er2); end IP_Tests; -------------------------------------------------------------------------- -- Begin Tests begin Header ("pdd0100"); Test ("package POSIX.Sockets.Internet"); ----------------------------------------------------------------------- -- Constants Test ("Constants [D.1.3.1]"); begin Assert (Internet_Protocol = PF_INET, "A001"); Assert (ICMP = IPPROTO_ICMP, "A002"); Assert (TCP = IPPROTO_TCP, "A003"); Assert (UDP = IPPROTO_UDP, "A004"); Assert (Raw = IPPROTO_RAW, "A005"); exception when E : others => Unexpected_Exception (E, "A006"); end; ----------------------------------------------------------------------- -- Internet Socket Address Pointer arithmatic + operators return -- the proper types. Test ("Internet Socket Address [D.1.3.1]"); declare Int_Ptr : Internet_Socket_Address_Pointer := null; Soc_Ptr : Socket_Address_Pointer := Null_Socket_Address; begin Soc_Ptr := +Int_Ptr; Int_Ptr := +Soc_Ptr; Assert (Int_Ptr = null, "A007"); exception when E1 : POSIX_Error => Optional (Sockets_DNI_Option, Internet_Protocol_Option, No_Error, E1, "A008"); when E2 : others => Unexpected_Exception (E2, "A009"); end; ----------------------------------------------------------------------- -- Internet Port consants are correct and the Get/Set Internet_Port -- methods are consistent. Test ("Internet Port (Get/Set) [D.1.3.1]"); declare Name : Internet_Socket_Address; Port : Internet_Port := 21; -- ftp port begin Assert (Unspecified_Internet_Port = 0, "A010"); Set_Internet_Port (Name, 23); -- telnet port Comment ("Internet port set to 23"); Port := Get_Internet_Port (Name); Assert (Port = 23, "A011"); exception when E1 : POSIX_Error => Optional (Sockets_DNI_Option, Internet_Protocol_Option, No_Error, E1, "A012"); when E2 : others => Unexpected_Exception (E2, "A013"); end; ----------------------------------------------------------------------- -- String_To_Internet_Address and Internet_Address_To_String are -- consistent. Is_Internet_Address returns the appropriate boolean -- value. -- This section is out of order because it is needed to test methods -- that occur in an earlier section. Test ("String/Internet_Address conversions [D.1.3.2]"); declare type POSIX_String_Ptr is access POSIX_String; Name : POSIX_String_Ptr; Address : Internet_Address; begin Assert (Is_Internet_Address ("555.1280.367.666") = False, "A014"); Assert (Is_Internet_Address (Valid_Internet_Address) = True, "A015"); Address := String_To_Internet_Address (Valid_Internet_Address); Comment ("Internet address set to " & To_String (Valid_Internet_Address)); Name := new POSIX_String'(Internet_Address_To_String (Address)); Comment ("Name = " & To_String (Name.all)); Assert (Name.all = Valid_Internet_Address, "A016"); exception when E1 : POSIX_Error => Optional (Network_Management_Option, No_Error, E1, "A017"); when E2 : others => Unexpected_Exception (E2, "A018"); end; ----------------------------------------------------------------------- -- Get/Set Internet_Address methods are consistent. Test ("Internet Port (Get/Set) [D.1.3.1]"); declare Name : Internet_Socket_Address; Address : Internet_Address; begin Address := String_To_Internet_Address (Valid_Internet_Address); Set_Internet_Address (Name, Address); Comment ("Internet address set to " & To_String (Valid_Internet_Address)); Address := Get_Internet_Address (Name); Assert (Internet_Address_To_String (Address) = Valid_Internet_Address, "A019"); exception when E1 : POSIX_Error => Optional (Sockets_DNI_Option, Internet_Protocol_Option, No_Error, E1, "A020"); when E2 : others => Unexpected_Exception (E2, "A021"); end; ----------------------------------------------------------------------- -- Is_Internet_Socket_Address returns true if the object is an -- Internet_Socket_Address. The false case cannot be tested without -- the use of other protocols (will be done in a sperate test program) Test ("Is_Internet_Socket_Address [D.1.3.1]"); declare Name : aliased Internet_Socket_Address; Address : Internet_Address; begin Address := String_To_Internet_Address (Valid_Internet_Address); Set_Internet_Address (Name, Address); Assert (Is_Internet_Socket_Address (+(Name'Unchecked_Access)), "A022"); exception when E1 : POSIX_Error => Optional (Sockets_DNI_Option, Internet_Protocol_Option, No_Error, E1, "A023"); when E2 : others => Unexpected_Exception (E2, "A024"); end; ----------------------------------------------------------------------- -- Get_Socket_Name return the correct value. Test ("Get_Socket_Name [D.1.3.1]"); declare Name_Ptr : Internet_Socket_Address_Pointer; Address : Internet_Address; Message : Socket_Message; Name : Internet_Socket_Address; begin Name_Ptr := new Internet_Socket_Address; Address := String_To_Internet_Address (Valid_Internet_Address); Set_Internet_Address (Name_Ptr.all, Address); Set_Socket_Name (Message, +Name_Ptr); Comment ("Socket Name Set"); Name := Get_Socket_Name (Message); Address := Get_Internet_Address (Name); Assert (Internet_Address_To_String (Address) = Valid_Internet_Address, "A025"); exception when E1 : POSIX_Error => Optional (Sockets_DNI_Option, Internet_Protocol_Option, No_Error, E1, "A026"); when E2 : others => Unexpected_Exception (E2, "A027"); end; ----------------------------------------------------------------------- -- Get_Address return the correct value. Test ("Get_Address [D.1.3.1]"); declare Name : Internet_Address; Address : Internet_Socket_Address; Info_Item : Socket_Address_Info; Info : Socket_Address_Info_List; type Socket_Address_Info_Ptr is access all Socket_Address_Info; Info_Ptr : Socket_Address_Info_Ptr; function To_sock_addr_info_ptr is new Unchecked_Conversion (System.Address, Socket_Address_Info_Ptr); begin begin Set_Flags (Info_Item, Canonical_Name); Set_Family (Info_Item, PF_INET); Set_Socket_Type (Info_Item, Stream_Socket); Set_Protocol_Number (Info_Item, IPPROTO_TCP); Get_Socket_Address_Info (Valid_Internet_Address, "telnet", Info_Item, Info); exception when E : POSIX_Error => Optional (Network_Management_Option, No_Error, E, "A028"); end; Info_Ptr := To_sock_addr_info_ptr (Info'Address); Address := Get_Address (Info_Ptr.all); Name := Get_Internet_Address (Address); Assert (Internet_Address_To_String (Name) = Valid_Internet_Address, "A029"); exception when E1 : POSIX_Error => Optional (Sockets_DNI_Option, Internet_Protocol_Option, No_Error, E1, "A030"); when E2 : others => Unexpected_Exception (E2, "A031"); end; ----------------------------------------------------------------------- -- String_To_Internet_Address accepts all the proper dot notations -- and raises the appropriate error messages when an inproper -- string is used Test ("String_To_Internet_Address [D.1.3.2]"); declare type POSIX_String_Ptr is access POSIX_String; Name : POSIX_String_Ptr; Address : Internet_Address; begin -- 3 dot notation tested previously, see above Address := String_To_Internet_Address ("128.186.31017"); Name := new POSIX_String'(Internet_Address_To_String (Address)); Assert (Name.all = "128.186.121.41", "A032"); Address := String_To_Internet_Address ("128.12220713"); Name := new POSIX_String'(Internet_Address_To_String (Address)); Assert (Name.all = "128.186.121.41", "A033"); Address := String_To_Internet_Address ("2159704361"); Name := new POSIX_String'(Internet_Address_To_String (Address)); Assert (Name.all = "128.186.121.41", "A034"); exception when E1 : POSIX_Error => Optional (Network_Management_Option, No_Error, E1, "A035"); when E2 : others => Unexpected_Exception (E2, "A036"); end; ----------------------------------------------------------------------- -- Get_Network_Info_By_Name/By_Address and -- Get_Name/Family/Network_Number are consitent. Test ("Get_Network_Info [D.1.3.2]"); declare Info : Network_Info; Storage : Database_Array_Pointer := new Database_Array (1 .. 50); begin Info := Get_Network_Info_By_Name ("arpanet", Storage); Assert (Get_Name (Info) = "arpanet", "A037"); Assert (Get_Family (Info) = PF_INET, "A038"); Assert (Get_Network_Number (Info) = 10, "A039"); Info := Get_Network_Info_By_Address (10, PF_INET, Storage); Assert (Get_Name (Info) = "arpanet", "A040"); Assert (Get_Family (Info) = PF_INET, "A041"); Assert (Get_Network_Number (Info) = 10, "A042"); Info := Get_Network_Info_By_Name ("@#$%^&*()", Storage); Assert (Get_Name (Info) = "", "A043"); Info := Get_Network_Info_By_Address (999, PF_INET, Storage); Assert (Get_Name (Info) = "", "A044"); begin Storage := new Database_Array (1 .. 2); Info := Get_Network_Info_By_Name ("arpanet", Storage); Expect_Exception ("A045"); exception when Constraint_Error => null; end; begin Info := Get_Network_Info_By_Address (10, PF_INET, Storage); Expect_Exception ("A046"); exception when Constraint_Error => null; end; exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A047"); when E2 : others => Unexpected_Exception (E2, "A048"); end; ----------------------------------------------------------------------- -- For_Every_Network_Alias calls Action for every alias. -- Action places the alias name in a Comment. Test ("For_Every_Network_Alias [D.1.3.2]"); declare Info : Network_Info; Storage : Database_Array_Pointer := new Database_Array (1 .. 50); procedure Every_Net_Alias is new For_Every_Network_Alias (Action); begin Info := Get_Network_Info_By_Name ("arpanet", Storage); Every_Net_Alias (Info); exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A049"); when E2 : others => Unexpected_Exception (E2, "A050"); end; ----------------------------------------------------------------------- -- Open/Close_Network_Database_Connection open and closes a -- connection to the network database. Test ("Open/Close_Network_Database_Connection [D.1.3.2]"); declare Info : Network_Info; Storage : Database_Array_Pointer := new Database_Array (1 .. 50); begin Open_Network_Database_Connection (False); Info := Get_Network_Info_By_Name ("arpanet", Storage); Assert (Get_Name (Info) = "arpanet", "A051"); Close_Network_Database_Connection; Open_Network_Database_Connection (False); Info := Get_Network_Info_By_Name ("loopback", Storage); Info := Get_Network_Info_By_Name ("arpanet", Storage); Assert (Get_Name (Info) = "arpanet", "A052"); Close_Network_Database_Connection; Open_Network_Database_Connection (True); Info := Get_Network_Info_By_Name ("loopback", Storage); Info := Get_Network_Info_By_Name ("arpanet", Storage); Assert (Get_Name (Info) = "arpanet", "A053"); Close_Network_Database_Connection; exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A054"); when E2 : others => Unexpected_Exception (E2, "A055"); end; ----------------------------------------------------------------------- -- Get_Protocol_Info_By_Name/Number and -- Get_Name/Protocol_Number are consitent. Test ("Get_Protocol_Info [D.1.3.2]"); declare Info : Protocol_Info; Storage : Database_Array_Pointer := new Database_Array (1 .. 50); begin Info := Get_Protocol_Info_By_Name ("TCP", Storage); Assert (Get_Name (Info) = "tcp", "A056"); Assert (Get_Protocol_Number (Info) = 6, "A057"); Info := Get_Protocol_Info_By_Number (6, Storage); Assert (Get_Name (Info) = "tcp", "A058"); Assert (Get_Protocol_Number (Info) = 6, "A059"); Info := Get_Protocol_Info_By_Name ("@#$%^&*()", Storage); Assert (Get_Name (Info) = "", "A060"); Info := Get_Protocol_Info_By_Number (999, Storage); Assert (Get_Name (Info) = "", "A061"); begin Storage := new Database_Array (1 .. 2); Info := Get_Protocol_Info_By_Name ("tcp", Storage); Expect_Exception ("A062"); exception when Constraint_Error => null; end; begin Info := Get_Protocol_Info_By_Number (6, Storage); Expect_Exception ("A063"); exception when Constraint_Error => null; end; exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A064"); when E2 : others => Unexpected_Exception (E2, "A065"); end; ----------------------------------------------------------------------- -- For_Every_Protocol_Alias calls Action for every alias. -- Action places the alias name in a Comment. Test ("For_Every_Protocol_Alias [D.1.3.2]"); declare Info : Protocol_Info; Storage : Database_Array_Pointer := new Database_Array (1 .. 50); procedure Every_Proto_Alias is new For_Every_Protocol_Alias (Action); begin Info := Get_Protocol_Info_By_Name ("tcp", Storage); Every_Proto_Alias (Info); exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A066"); when E2 : others => Unexpected_Exception (E2, "A067"); end; ----------------------------------------------------------------------- -- Open/Close_Protocol_Database_Connection open and closes a -- connection to the protocol database. Test ("Open/Close_Protocol_Database_Connection [D.1.3.2]"); declare Info : Protocol_Info; Storage : Database_Array_Pointer := new Database_Array (1 .. 50); begin Open_Protocol_Database_Connection (False); Info := Get_Protocol_Info_By_Name ("tcp", Storage); Assert (Get_Name (Info) = "tcp", "A068"); Close_Protocol_Database_Connection; Open_Protocol_Database_Connection (False); Info := Get_Protocol_Info_By_Name ("upd", Storage); Info := Get_Protocol_Info_By_Name ("tcp", Storage); Assert (Get_Name (Info) = "tcp", "A069"); Close_Protocol_Database_Connection; Open_Protocol_Database_Connection (True); Info := Get_Protocol_Info_By_Name ("udp", Storage); Info := Get_Protocol_Info_By_Name ("tcp", Storage); Assert (Get_Name (Info) = "tcp", "A070"); Close_Protocol_Database_Connection; exception when E1 : POSIX_Error => Optional (Network_Management_Option, Unknown_Protocol_Option, E1, "A071"); when E2 : others => Unexpected_Exception (E2, "A072"); end; ----------------------------------------------------------------------- -- TCP Constants and types Test ("TCP Constants and types [D.1.3.4]"); begin Assert (Keep_Alive_Time'First = 1, "A073"); Assert (Keep_Alive_Time'Last = POSIX.Seconds'Last, "A074"); Assert (Socket_Retransmit_Time'First = -1, "A075"); Assert (Socket_Retransmit_Time'Last = POSIX.Seconds'Last, "A076"); Assert (Wait_Forever = -1, "A077"); Assert (Retransmit_Time_Default = 0, "A078"); exception when E : others => Unexpected_Exception (E, "A079"); end; ----------------------------------------------------------------------- -- Get/Set_Keep_Alive_Interval are consistent. declare procedure Keep_Alive_Interval_Test is new TCP_Tests (Keep_Alive_Time, Get_Keep_Alive_Interval, Set_Keep_Alive_Interval); begin -- Default must be 7200 or greater, but don't know exact value Keep_Alive_Interval_Test ("Keep_Alive_Interval", 5, 7200, "A000", "A080", "A081", "A082"); end; ----------------------------------------------------------------------- -- Get/Set_No_Delay are consistent. declare procedure No_Delay_Test is new TCP_Tests (Socket_Option_Value, Get_No_Delay, Set_No_Delay); begin No_Delay_Test ("No_Delay", Enabled, Disabled, "A083", "A084", "A085", "A086"); end; ----------------------------------------------------------------------- -- Get/Set_Retransmit_Time_Maximum are consistent. declare procedure Retransmit_Time_Maximum_Test is new TCP_Tests (Socket_Retransmit_Time, Get_Retransmit_Time_Maximum, Set_Retransmit_Time_Maximum); begin Retransmit_Time_Maximum_Test ("Retransmit_Time_Maxmimum", 5, Retransmit_Time_Default, "A087", "A088", "A089", "A090"); end; ----------------------------------------------------------------------- -- Get/Set_Standardized_Urgent_Data are consistent. declare procedure Standardized_Urgent_Data_Test is new TCP_Tests (Socket_Option_Value, Get_Standardized_Urgent_Data, Set_Standardized_Urgent_Data); begin Standardized_Urgent_Data_Test ("Standardized_Urgent_Data", Enabled, Disabled, "A091", "A092", "A093", "A094"); end; ----------------------------------------------------------------------- -- Get_Segment_Size_Maximum returns the current segement size, in -- octets, of the TCP connection. Test ("Get_Segment_Size_Maximum [D.1.3.4]"); declare Socket : POSIX_IO.File_Descriptor; begin Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Assert (Get_Segment_Size_Maximum (Socket) /= 0, "A095"); exception when E1 : POSIX_Error => Optional (Internet_Stream_Option, Unknown_Protocol_Option, E1, "A096"); when E2 : others => Unexpected_Exception (E2, "A097"); end; -- ================================================================ -- -- == == -- -- == Section D.1.3.5 does not contain any information that is == -- -- == protocol dependend. == -- -- == == -- -- ================================================================ -- ----------------------------------------------------------------------- -- IP Constants and types Test ("IP Constants and types [D.1.3.6]"); begin Assert (Time_To_Live'First = 0, "A098"); Assert (Time_To_Live'Last = 255, "A099"); exception when E : others => Unexpected_Exception (E, "A100"); end; ----------------------------------------------------------------------- -- Get/Set_First_Hop are consistent. Test ("Set/Get_First_Hop [D.1.3.6]"); declare Options : IP_Options_Buffer; begin Set_First_Hop (Options, String_To_Internet_Address (Valid_Internet_Address)); Comment ("First Hop Set"); Assert (Get_First_Hop (Options) = String_To_Internet_Address (Valid_Internet_Address), "A101"); exception when E : others => Unexpected_Exception (E, "A102"); end; ----------------------------------------------------------------------- -- Get/Set_IP_Options are consistent. Test ("Set/Get_IP_Options [D.1.3.6]"); declare Options : IP_Options_Buffer; Buffer : POSIX.Octet_Array (1 .. 40); begin Buffer (1 .. 4) := (116, 101, 115, 116); Set_IP_Options (Options, Buffer); Comment ("IP Options Set"); Assert (Get_IP_Options (Options) = Buffer, "A103"); exception when E : others => Unexpected_Exception (E, "A104"); end; ----------------------------------------------------------------------- -- Get/Set_IP_Header_Options are consistent. -- IP_Header_Options_In_Use returns true when header options are in -- use and flase otherwise. -- Reset_IP_Header_Options removes any header options that are in -- effect. Test ("IP_Header_Options [D.1.3.6]"); declare Options, Result : IP_Options_Buffer; Buffer : POSIX.Octet_Array (1 .. 40); Socket : POSIX_IO.File_Descriptor; begin Buffer (1 .. 4) := (116, 101, 115, 116); Set_IP_Options (Options, Buffer); Set_First_Hop (Options, String_To_Internet_Address (Valid_Internet_Address)); Socket := Create (PF_INET, Stream_Socket, IPPROTO_TCP); Assert (IP_Header_Options_In_Use (Socket) = False, "A105"); Set_IP_Header_Options (Socket, Options); Comment ("IP Options Set"); Result := Get_IP_Header_Options (Socket); Assert (Options = Result, "A106"); Assert (IP_Header_Options_In_Use (Socket) = True, "A107"); Reset_IP_Header_Options (Socket); Assert (IP_Header_Options_In_Use (Socket) = False, "A108"); exception when E : others => Unexpected_Exception (E, "A109"); end; ----------------------------------------------------------------------- -- Get/Set_Type_Of_Service are consistent. Test ("Get/Set_Type_Of_Service [D.1.3.6]"); declare Socket : POSIX_IO.File_Descriptor; Result : IP_Type_Of_Service; begin Socket := Create (PF_INET, Datagram_Socket, IPPROTO_IP); -- Default value is Unspecified Assert (Get_Type_Of_Service (Socket) = Unspecified, "A110"); Set_Type_Of_Service (Socket, High_Throughput); Comment ("Socket's Type_Of_Service has been set"); Result := Get_Type_Of_Service (Socket); Assert (Result = High_Throughput, "A111"); exception when E : others => Unexpected_Exception (E, "A112"); end; ----------------------------------------------------------------------- -- Get/Set_Initial_Time_To_Live are consistent. declare procedure Initial_Time_To_Live_Test is new IP_Tests (Time_To_Live, Get_Initial_Time_To_Live, Set_Initial_Time_To_Live); begin -- Default is implementation specific Initial_Time_To_Live_Test ("Intial_Time_To_Live", 5, 0, "A000", "A113", "A114"); end; ----------------------------------------------------------------------- -- Get/Set_Receive_Destination_Address are consistent. declare procedure Receive_Destination_Address_Test is new IP_Tests (Socket_Option_Value, Get_Receive_Destination_Address, Set_Receive_Destination_Address); begin -- Default value is Disabled Receive_Destination_Address_Test ("Receive_Destination_Address", Enabled, Disabled, "A115", "A116", "A117"); end; -- ================================================================== -- -- == == -- -- == Set_Ancillary_Data and Get_Destination_Address cannont be == -- -- == properly tested without an application. Therefore their == -- -- == testing will be done in one of the p1804 series of tests. == -- -- == == -- -- ================================================================== -- ----------------------------------------------------------------------- -- Get/Set_Type_Of_Service are consistent. Test ("Get/Set_Header_Included [D.1.3.6]"); declare Socket : POSIX_IO.File_Descriptor; Result : Socket_Option_Value; begin -- Currently cannot create a socket of type Raw Socket := Create (PF_INET, Raw_Socket, IPPROTO_IP); -- Default value is Disabled Assert (Get_Header_Included (Socket) = Disabled, "A118"); Set_Header_Included (Socket, Enabled); Comment ("Socket's Header_Included has been enabled"); Result := Get_Header_Included (Socket); Assert (Result = Enabled, "A119"); exception when E1 : POSIX_Error => if Get_Error_Code /= Option_Not_Supported then Unexpected_Exception (E1, "A120"); end if; when E2 : others => Unexpected_Exception (E2, "A121"); end; Done; exception when E : others => Fatal_Exception (E, "A122"); end pdd0100; libflorist-2025.1.0/tests/sockets/pdd0100.ads000066400000000000000000000061551473553204100205030ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5c VALIDATION TEST SUITE -- -- -- -- P D D 0 1 0 0 -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1995-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ procedure pdd0100; libflorist-2025.1.0/tests/sockets/test_addrinfo.adb000066400000000000000000000064371473553204100222420ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; with Ada.Text_IO; with Text_IO; procedure Test_Addrinfo is procedure Print_Item (Info: in Socket_Address_Information; Quit: in out Boolean) is Name: constant POSIX_String := Get_Canonical_Name (Info); Flags: constant Address_Flags := Get_Flags (Info); begin if Verbose then Put_Line ("...Canonical name: " & To_String(Name)); case Get_Family (Info) is when Internet_Protocol => Put_Line ("...Protocol Family: Internet_Domain"); declare Addr: constant Internet_Socket_Address := Get_Address (Info); In_Addr: constant Internet_Address := Get_Internet_Address (Addr); Dot_Address: constant POSIX_String := Internet_Address_To_String (In_Addr); begin Put_Line (" addr=" & To_String (Dot_Address)); Put (" port="); Put (integer(Get_Internet_Port (Addr))); New_line; end; when Others => Put_Line ("...Address Family: Unknown_Domain"); end case; case Get_Socket_Type (Info) is when Stream_Socket => Put_Line ("...Socket type: Stream Socket"); when Datagram_Socket => Put_Line ("...Socket type: Datagram Socket"); when Raw_Socket => Put_Line ("...Socket type: Raw Socket"); when Sequenced_Packet_Socket => Put_Line ("...Socket type: Sequenced Packet Socket"); when Others => Put_Line ("...Socket type: Unknown"); end case; Put ("...Protocol Number: "); Put (integer(Get_Protocol_Number (Info))); New_line; end if; end Print_Item; procedure Print_Every_Item is new POSIX.Sockets.For_Every_Item (Print_Item); Addr_Info: Socket_Address_Information; Request_Info: Socket_Address_Information; begin Test ("Get_Socket_Address_Information"); Comment ("Get Socket Address Information by Name"); Addr_Info := Get_Socket_Address_Information ( Name => "129.190.223.103", Service => ""); Print_Every_Item (Addr_Info); Comment ("Again, with some hints in the request parameter"); Set_Flags (Request_Info, Canonical_Name+Use_For_Binding); Set_Family (Request_Info, Internet_Protocol); Set_Socket_Type (Request_Info, Stream_Socket); Set_Protocol_Number (Request_Info, Default_Protocol); Addr_Info := Get_Socket_Address_Information ( Name => "129.190.223.103", Service => "", Request => Request_Info); Comment ("Completed Get_Socket_Address_Information"); Print_Every_Item (Addr_Info); Comment ("Get Socket Address Information by Service"); Addr_Info := Get_Socket_Address_Information ( Name => "", Service => "telnet"); Print_Every_Item (Addr_Info); Done; -- exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); exception when E : others => Fail (E); end Test_Addrinfo; libflorist-2025.1.0/tests/sockets/test_ancillary_listen.adb000066400000000000000000000033341473553204100240010ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Local; use POSIX.Sockets.Local; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; procedure Test_Ancillary_Listen is Listening_Socket : File_Descriptor; Accepting_Socket : File_Descriptor; Socket_Name : Local_Socket_Address; Socket_Path : Pathname := "a_local_socket"; Last : POSIX.IO_Count; SGV_Array : Socket_Message_Array_Pointer := new Socket_Message_Array (1 .. 1); -- note this is born null Files : Fd_Array (1 .. 3); Message : Socket_Message; begin ----------------------------------------------- -- Receive ancillary data on a local socket -- ----------------------------------------------- Test ("Receive ancillary data on local socket"); Listening_Socket := Create (Local_Protocol, Stream_Socket); Set_Socket_Path (Socket_Name, Socket_Path); Bind (Listening_Socket, Socket_Name); Listen (Listening_Socket, 1); Accepting_Socket := Accept_Connection (Listening_Socket); Comment ("Receive message with ancillary data only..."); Set_Ancillary_Data (Message, Files'Address); Set_Socket_Message_Array (Message, SGV_Array); Receive_Message (Accepting_Socket, Message, Last); -- Files := Get_Ancillary_Data (Message); if Verbose then Put ("...Ancillary data received:"); Put (Integer(Files.all(1))); Put (", "); Put (Integer(Files.all(2))); Put (", "); Put (Integer(Files.all(3))); New_Line; end if; Unlink (Socket_Path); Done; exception when E : others => Fail (E); end Test_Ancillary_Listen; libflorist-2025.1.0/tests/sockets/test_ancillary_talk.adb000066400000000000000000000026271473553204100234420ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Local; use POSIX.Sockets.Local; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; procedure Test_Ancillary_Talk is Talking_Socket : File_Descriptor; Socket_Name : Local_Socket_Address; Socket_Path : Pathname := "a_local_socket"; Last : POSIX.IO_Count; SGV_Array : Socket_Message_Array_Pointer := new Socket_Message_Array (1 .. 1); -- note this is born null Files : Fd_Array_Access := new Fd_Array (1 .. 3); Message : Socket_Message; begin -------------------------------------------- -- Send ancillary data on a local socket -- -------------------------------------------- Test ("Send ancillary data on local socket"); Talking_Socket := Create (Local_Protocol, Stream_Socket); Set_Socket_Path (Socket_Name, Socket_Path); Connect (Talking_Socket, Socket_Name); Comment ("Send message with ancillary data only..."); Files.all (1) := Talking_Socket; Files.all (2) := 222; Files.all (3) := 333; Set_Ancillary_Data (Message, Files); Set_Socket_Message_Array (Message, SGV_Array); Send_Message (Talking_Socket, Message, Last); Close (Talking_Socket); Done; exception when E : others => Fail (E); end Test_Ancillary_Talk; libflorist-2025.1.0/tests/sockets/test_database.adb000066400000000000000000000110221473553204100222020ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; with Text_IO; with Ada.Text_IO; Procedure Test_Database is Procedure Display_Network_Info (Net_Info: Network_Information) is Temp: String (1 .. 5); package Net_IO is new Text_IO.Integer_IO (Network_Number); begin declare Name: constant POSIX_String := Get_Name (Net_Info); Sname: constant String := To_String(Name); begin Comment ("...Network Name: " & Sname); end; -- case Get_Address_Family (Net_Info) is -- when Internet_Domain => -- Comment ("...Address Family: Internet_Domain"); -- when Others => -- Comment ("...Address Family: Unknown_Domain"); -- end case; Net_IO.Put (Temp, Get_Network_Number (Net_Info)); Comment ("...Network Number: " & Temp); declare procedure Print_Alias (Name: in POSIX_String; Quit: in out Boolean) is begin if Verbose then Put (To_String(Name) & " "); end if; end Print_Alias; procedure Print_Every_Alias is new For_Every_Network_Alias(Print_Alias); begin if Verbose then Put (" ...Network Aliases: "); end if; Print_Every_Alias (Net_Info); if Verbose then New_Line; end if; end; end Display_Network_Info; Procedure Display_Protocol_Info (Pro_Info: Protocol_Information) is Temp: String (1 .. 5); package Pro_IO is new Ada.Text_IO.Integer_IO (Protocol_Number); begin declare Name: constant POSIX_String := Get_Name (Pro_Info); Sname: constant String := To_String(Name); begin Comment ("...Protocol Name: " & Sname); end; Pro_IO.Put (Temp, Get_Protocol_Number (Pro_Info)); Comment ("...Protocol Number: " & Temp); declare procedure Print_Alias (Name: in POSIX_String; Quit: in out Boolean) is begin if Verbose then Put (To_String(Name) & " "); end if; end Print_Alias; procedure Print_Every_Alias is new For_Every_Protocol_Alias(Print_Alias); begin if Verbose then Put (" ...Protocol Aliases: "); end if; Print_Every_Alias (Pro_Info); if Verbose then New_Line; end if; end; end Display_Protocol_Info; Net_Info: Network_Information; Pro_Info: Protocol_Information; Storage : POSIX.Sockets.Internet.Database_Array_Pointer := new POSIX.Sockets.Internet.Database_Array (0 .. 1023); begin ----------------------- -- Network Database -- ----------------------- Test ("Network Database"); Comment ("Open Network Database"); Open_Network_Database_Connection (True); Comment ("Get Network Information by Name"); Net_Info := Get_Network_Information_By_Name ("loopback", Storage); Display_Network_Info (Net_Info); Comment ("Get Network Information by Address"); Net_Info := Get_Network_Information_By_Address (127, Internet_Protocol, Storage); Display_Network_Info (Net_Info); Comment ("Try a non-existent network"); Net_Info := Get_Network_Information_By_Name ("garbage", Storage); Display_Network_Info (Net_Info); Comment ("Close Network Database"); Close_Network_Database_Connection; ------------------------ -- Protocol Database -- ------------------------ Test ("Protocol Database"); Comment ("Open Protocol Database"); Open_Protocol_Database_Connection (True); Comment ("Get Protocol Information by Name"); Pro_Info := Get_Protocol_Information_By_Name ("tcp", Storage); Display_Protocol_Info (Pro_Info); Pro_Info := Get_Protocol_Information_By_Name ("udp", Storage); Display_Protocol_Info (Pro_Info); Comment ("Get Protocol Information by Number"); Pro_Info := Get_Protocol_Information_By_Number (1, Storage); Display_Protocol_Info (Pro_Info); Comment ("Try a non-existent protocol"); Pro_Info := Get_Protocol_Information_By_Name ("garbage", Storage); Display_Protocol_Info (Pro_Info); Comment ("Close Protocol Database"); Close_Protocol_Database_Connection; Done; exception when E : others => Fail (E); end Test_Database; libflorist-2025.1.0/tests/sockets/test_local_listen.adb000066400000000000000000000043161473553204100231160ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Local; use POSIX.Sockets.Local; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; Procedure Test_Local_Listen is Listening_Socket: File_Descriptor; Accepting_Socket: File_Descriptor; Socket_Name: Local_Socket_Address; Test_Name: Local_Socket_Address; Socket_Path: Pathname:="a_local_socket"; Buffer: string (1 .. 80); Last: POSIX.IO_Count; begin --------------------------------------------------------------- -- Listen on a local (UNIX) connection-mode (Stream) socket -- --------------------------------------------------------------- Test ("Listen on local socket"); Comment ("Create file descriptor for a local stream socket"); Listening_Socket := Create (Local_Protocol, Stream_Socket); Comment ("Put a pathname into a local socket address and read it back"); Set_Socket_Path (Socket_Name, Socket_Path); Comment ("socket path:" & To_String(Get_Socket_Path (Socket_Name))); Comment ("Bind the address to the file descriptor"); Bind (Listening_Socket, Socket_Name); Comment ("Listen for connections on the socket"); Listen (Listening_Socket, 1); Comment ("Accept (wait) for connection..."); Accepting_Socket := Accept_Connection (Listening_Socket); Comment ("Get accepting socket name"); Test_Name := Get_Socket_Name (Accepting_Socket); Comment (" listening socket path:" & To_String(Get_Socket_Path (Test_Name))); Comment ("Get talking (peer) socket name"); Test_Name := Get_Peer_Name (Accepting_Socket); Comment (" talking socket path:" & To_String(Get_Socket_Path (Test_Name))); Comment ("Receive data from the connection until it stops sending"); loop Receive (Accepting_Socket, Buffer (Buffer'First)'Address, POSIX.IO_Count (Buffer'Length), Last); exit when Last = 0; Comment ("Received:" & Buffer(1..integer(Last))); end loop; Comment ("remove the socket from the file system"); unlink (Socket_Path); Done; exception when E : others => Fail (E); end Test_Local_Listen; libflorist-2025.1.0/tests/sockets/test_local_ltime.adb000066400000000000000000000025711473553204100227330ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Local; use POSIX.Sockets.Local; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; Procedure Test_Local_Ltime is Listening_Socket: File_Descriptor; Accepting_Socket: File_Descriptor; Socket_Name: Local_Socket_Address; Socket_Path: Pathname:="a_local_socket"; Buffer: string (1 .. 80); Last: POSIX.IO_Count; Count: Integer:=0; begin ---------------------------------------------------------- -- Time a local (UNIX) connection-mode (Stream) socket -- ---------------------------------------------------------- Listening_Socket := Create (Local_Protocol, Stream_Socket); Set_Socket_Path (Socket_Name, Socket_Path); Bind (Listening_Socket, Socket_Name); Listen (Listening_Socket, 1); Put_Line ("Waiting for Data..."); Accepting_Socket := Accept_Connection (Listening_Socket); loop Receive (Accepting_Socket, Buffer (Buffer'First)'Address, Buffer'Length, Last); Count := Count + Integer(Last); exit when Last = 0; end loop; unlink (Socket_Path); Put ("...Received "); Put (Count); Put_Line (" characters"); Done; exception when E : others => Fail (E); end Test_Local_Ltime; libflorist-2025.1.0/tests/sockets/test_local_talk.adb000066400000000000000000000034631473553204100225550ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Local; use POSIX.Sockets.Local; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; Procedure Test_Local_Talk is Talking_Socket: File_Descriptor; Socket_Name: Local_Socket_Address; Test_Name: Local_Socket_Address; Socket_Path: Pathname:="a_local_socket"; Last: POSIX.IO_Count; Message : string (1 .. 11) := "Hello World"; begin ------------------------------------------------------------- -- Talk on a local (UNIX) connection-mode (Stream) socket -- ------------------------------------------------------------- Test ("Talk on local socket"); Comment ("Create file descriptor for a local stream socket"); Talking_Socket := Create (Local_Protocol, Stream_Socket); Comment ("Put a pathname into a local socket address and read it back"); Set_Socket_Path (Socket_Name, Socket_Path); Comment ("socket path:" & To_String(Get_Socket_Path (Socket_Name))); Comment ("Connect to the socket (which should be listening)"); Connect (Talking_Socket, Socket_Name); Comment ("Get connected socket name"); Test_Name := Get_Socket_Name (Talking_Socket); Comment (" listening socket path:" & To_String(Get_Socket_Path (Test_Name))); Comment ("Get listening (peer) socket name"); Test_Name := Get_Peer_Name (Talking_Socket); Comment (" talking socket path:" & To_String(Get_Socket_Path (Test_Name))); Comment ("Send some data to the connection"); Send (Talking_Socket, Message'Address, Message'Length, Last); Comment ("Close the connection"); close (Talking_Socket); Done; exception when E : others => Fail (E); end Test_Local_Talk; libflorist-2025.1.0/tests/sockets/test_local_ttime.adb000066400000000000000000000022751473553204100227440ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Local; use POSIX.Sockets.Local; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; Procedure Test_Local_Ttime is LOOPS: constant := 100000; BUFSIZE: constant := 10; Talking_Socket: File_Descriptor; Socket_Name: Local_Socket_Address; Socket_Path: Pathname:="a_local_socket"; Last: POSIX.IO_Count; Buffer: Stream_Element_Array(1..BUFSIZE):=(others=>0); begin ------------------------------ -- Time a local connection -- ------------------------------ Talking_Socket := Create (Local_Protocol, Stream_Socket); Set_Socket_Path (Socket_Name, Socket_Path); Connect (Talking_Socket, Socket_Name); Put ("Sending "); Put (LOOPS*BUFSIZE); Put_Line (" bytes..."); for I in 1 .. LOOPS loop Send (Talking_Socket, Buffer (Buffer'First)'Address, Buffer'Length, Last); end loop; Put_Line ("...Close the connection"); close (Talking_Socket); Done; exception when E : others => Fail (E); end Test_Local_Ttime; libflorist-2025.1.0/tests/sockets/test_poll_listen.adb000066400000000000000000000065231473553204100227740ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Event_Management; use POSIX.Event_Management; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; procedure Test_Poll_Listen is Listening_Socket1 : File_Descriptor; Listening_Socket2 : File_Descriptor; Listening_Socket3 : File_Descriptor; Accepting_Socket : File_Descriptor; Socket_Name1 : Internet_Socket_Address; Socket_Name2 : Internet_Socket_Address; Socket_Name3 : Internet_Socket_Address; Events : Poll_Events := Empty_Set; Returned_Events : Poll_Events := Empty_Set; Files : Poll_File_Descriptor_Set (1..3); Response_Count : Natural := 0; Buffer : string (1 .. 80); Last : POSIX.IO_Count; begin --------------------------------------------- -- Poll several listening TCP/IP sockets -- --------------------------------------------- -- -- Create 3 sockets Listening_Socket1 := Create (Internet_Protocol, Stream_Socket); Listening_Socket2 := Create (Internet_Protocol, Stream_Socket); Listening_Socket3 := Create (Internet_Protocol, Stream_Socket); -- Bind them to 3 different ports and set them listening Set_Internet_Address (Socket_Name1, Unspecified_Internet_Address); Set_Internet_Address (Socket_Name2, Unspecified_Internet_Address); Set_Internet_Address (Socket_Name3, Unspecified_Internet_Address); Set_Internet_Port (Socket_Name1, 2000); Set_Internet_Port (Socket_Name2, 2001); Set_Internet_Port (Socket_Name3, 2002); Bind (Listening_Socket1, Socket_Name1); Bind (Listening_Socket2, Socket_Name2); Bind (Listening_Socket3, Socket_Name3); Listen (Listening_Socket1, 3); Listen (Listening_Socket2, 3); Listen (Listening_Socket3, 3); -- Put the descriptors in a set suitable for Poll Set_File (Files(1), Listening_Socket1); Set_File (Files(2), Listening_Socket2); Set_File (Files(3), Listening_Socket3); -- Set Poll events to check for incoming connections -- and/or normal data Set_Events (Files(1), Read_Normal+Read_Not_High); Set_Events (Files(2), Read_Normal+Read_Not_High); Set_Events (Files(3), Read_Normal+Read_Not_High); -- Poll should indicate all listening sockets with incoming -- connections as readable (i.e., Accept_Connection will not block) -- Poll for files with incoming connections (i.e., ready for reading) Comment ("...Poll Files (block)..."); Poll (Files, Response_Count); -- Process all the incoming connections Comment ("...Something's ready...Accept all Connections..."); for i in Files'range loop if (Get_Returned_Events (Files(i)) > Read_Normal) or (Get_Returned_Events (Files(i)) > Read_Not_High) then Comment ("...Accept connection..."); Accepting_Socket := Accept_Connection (Get_File (Files(i))); Comment ("...Receive something on accepted connection..."); Receive (Accepting_Socket, Buffer (Buffer'First)'Address, Buffer'Length, Last); if (Last > 0) then Comment ("...Received:" & Buffer (1 .. integer (Last))); end if; end if; end loop; exception when E : others => Fail (E); end Test_Poll_Listen; libflorist-2025.1.0/tests/sockets/test_select_listen.adb000066400000000000000000000077771473553204100233210ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Event_Management; use POSIX.Event_Management; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; procedure Test_Select_Listen is Listening_Socket1 : Select_File_Descriptor; Listening_Socket2 : Select_File_Descriptor; Listening_Socket3 : Select_File_Descriptor; Accepting_Socket : File_Descriptor; Socket_Name1 : Internet_Socket_Address; Socket_Name2 : Internet_Socket_Address; Socket_Name3 : Internet_Socket_Address; Read_Set : File_Descriptor_Set := Empty_File_Descriptor_Set; Write_Set : File_Descriptor_Set := Empty_File_Descriptor_Set; Ex_Set : File_Descriptor_Set := Empty_File_Descriptor_Set; Files_Selected : Natural := 0; Buffer : string (1 .. 80); Last : POSIX.IO_Count; begin ---------------------------------------------------- -- Select from several listening TCP/IP sockets -- ---------------------------------------------------- -- -- Create 3 sockets Listening_Socket1 := Select_File_Descriptor (Create (Internet_Protocol, Stream_Socket)); Listening_Socket2 := Select_File_Descriptor (Create (Internet_Protocol, Stream_Socket)); Listening_Socket3 := Select_File_Descriptor (Create (Internet_Protocol, Stream_Socket)); -- Bind them to 3 different ports and set them listening Set_Internet_Address (Socket_Name1, Unspecified_Internet_Address); Set_Internet_Address (Socket_Name2, Unspecified_Internet_Address); Set_Internet_Address (Socket_Name3, Unspecified_Internet_Address); Set_Internet_Port (Socket_Name1, 2000); Set_Internet_Port (Socket_Name2, 2001); Set_Internet_Port (Socket_Name3, 2002); Bind (File_Descriptor(Listening_Socket1), Socket_Name1); Bind (File_Descriptor(Listening_Socket2), Socket_Name2); Bind (File_Descriptor(Listening_Socket3), Socket_Name3); Listen (File_Descriptor(Listening_Socket1), 3); Listen (File_Descriptor(Listening_Socket2), 3); Listen (File_Descriptor(Listening_Socket3), 3); -- Put the descriptors in a set suitable for Select_File Make_Empty (Read_Set); Add_File_Descriptor_To_Set (Read_Set, Listening_Socket1); Add_File_Descriptor_To_Set (Read_Set, Listening_Socket2); Add_File_Descriptor_To_Set (Read_Set, Listening_Socket3); -- Select_File should indicate all listening sockets with incoming -- connections as readable (i.e., Accept_Connection will not block) declare procedure Accept_One (File : in Select_File_Descriptor; Quit : in out Boolean) is begin if (File = Listening_Socket1) then Comment ("...Accept connection on port 2000..."); elsif (File = Listening_Socket2) then Comment ("...Accept connection on port 2001..."); elsif (File = Listening_Socket3) then Comment ("...Accept connection on port 2002..."); else Comment ("...unknown fd in set?"); end if; Accepting_Socket := Accept_Connection (File_Descriptor(File)); Comment ("...Receive something on accepted connection..."); Receive (Accepting_Socket, Buffer (Buffer'First)'Address, Buffer'Length, Last); if (Last > 0) then Comment ("...Received:" & Buffer (1 .. integer (Last))); end if; end Accept_One; procedure Accept_All_Connections is new For_Every_File_In (Accept_One); begin -- Select all files with incoming connections (i.e., ready for reading) Comment ("...Select Files (block)..."); Select_File (Read_Set, Write_Set, Ex_Set, Files_Selected); -- Process all the incoming connections Comment ("...Something's ready...Accept all Connections..."); Accept_All_Connections (Read_Set); Done; end; exception when E : others => Fail (E); end Test_Select_Listen; libflorist-2025.1.0/tests/sockets/test_tcp_listen.adb000066400000000000000000000057241473553204100226160ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; procedure Test_TCP_Listen is Listening_Socket : File_Descriptor; Accepting_Socket : File_Descriptor; Socket_Name : Internet_Socket_Address; Test_Name : Internet_Socket_Address; Test_Address : Internet_Address; Buffer : string (1 .. 80); Last : POSIX.IO_Count; begin -------------------------------- -- Listen on a TCP/IP socket -- -------------------------------- Test ("Listen on TCP/IP socket"); Comment ("Create file descriptor for a TCP/IP socket"); Listening_Socket := Create (Internet_Protocol, Stream_Socket); Comment ("Specify any address for the Internet address"); Set_Internet_Address (Socket_Name, Unspecified_Internet_Address); Comment ("Specify any port (0) for the Internet address"); Set_Internet_Port (Socket_Name, 16#FF00#); Comment ("Bind the address to the file descriptor"); Bind (Listening_Socket, Socket_Name); Comment ("Get the Port Number bound to the address"); Socket_Name := Get_Socket_Name (Listening_Socket); Put (" ===>Test_TCP_Listen: Listening on port number ("); Put (integer (Get_Internet_Port (Socket_Name))); Put_Line (")"); Comment ("Listen for connections on the socket"); Listen (Listening_Socket, 1); Comment ("Accept (wait) for connection..."); Accepting_Socket := Accept_Connection (Listening_Socket); Comment ("Get accepting socket name"); Test_Name := Get_Socket_Name (Accepting_Socket); Comment ("Extract the Internet address"); Test_Address := Get_Internet_Address (Test_Name); Put (" ===>Test_TCP_Listen: Accepting on ("); declare Dot_Address : constant POSIX_String := Internet_Address_To_String (Test_Address); begin Put (To_String (Dot_Address)); end; Put (") port ("); Put (integer (Get_Internet_Port (Test_Name))); Put_Line (")"); Comment ("Get talking (peer) socket name"); Test_Name := Get_Peer_Name (Accepting_Socket); Comment ("Extract the Internet address"); Test_Address := Get_Internet_Address (Test_Name); Put (" ===>Test_TCP_Listen: Accepted from ("); declare Dot_Address : constant POSIX_String := Internet_Address_To_String (Test_Address); begin Put (To_String (Dot_Address)); end; Put (") port ("); Put (integer (Get_Internet_Port (Test_Name))); Put_Line (")"); Comment ("Receive data from the connection until it stops sending"); loop Receive (Accepting_Socket, Buffer (Buffer'First)'Address, POSIX.IO_Count (Buffer'Length), Last); exit when Last = 0; Comment ("Received:" & Buffer (1 .. integer (Last))); end loop; Done; exception when E : others => Fail (E); end Test_TCP_Listen; libflorist-2025.1.0/tests/sockets/test_tcp_ltime.adb000066400000000000000000000025301473553204100224220ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; Procedure Test_TCP_Ltime is Listening_Socket: File_Descriptor; Accepting_Socket: File_Descriptor; Socket_Name: Internet_Socket_Address; Buffer: string (1 .. 80); Last: POSIX.IO_Count; Count: Integer:=0; begin -------------------------- -- Time a TCP/IP socket -- -------------------------- Listening_Socket := Create (Internet_Protocol, Stream_Socket); Set_Internet_Address (Socket_Name, Unspecified_Internet_Address); Set_Internet_Port (Socket_Name, 1234); Bind (Listening_Socket, Socket_Name); Listen (Listening_Socket, 1); Put_Line ("Waiting for Data on port 1234..."); Accepting_Socket := Accept_Connection (Listening_Socket); loop Receive (Accepting_Socket, Buffer (Buffer'First)'Address, Buffer'Length, Last); Count := Count + Integer(Last); exit when Last = 0; Comment ("Received:" & Buffer(1..integer(Last))); end loop; Put ("...Received "); Put (Count); Put_Line (" characters"); Done; exception when E : others => Fail (E); end Test_TCP_Ltime; libflorist-2025.1.0/tests/sockets/test_tcp_options.adb000066400000000000000000000107001473553204100230010ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; Procedure Test_TCP_Options is TCP_Socket: File_Descriptor; Socket_Name: Internet_Socket_Address; Err: Error_Code := No_Error; procedure Option_Status (on_off:Socket_Option) is begin if on_off = Enabled then if Verbose then Put_Line ("Enabled"); end if; else if Verbose then Put_Line ("Disabled"); end if; end if; end; procedure Option_Status (op_val:Natural) is begin if Verbose then Put (op_val); New_Line; end if; end; procedure Display_Socket_Options (Socket: in File_Descriptor) is begin -- First, all the Enabled/Disabled options at socket level begin if Verbose then Put (" ...Broadcast: "); end if; Option_Status (Get_Socket_Broadcast (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...Debugging: "); end if; Option_Status (Get_Socket_Debugging (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...No_Routing: "); end if; Option_Status (Get_Socket_Routing (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...Keepalive: "); end if; Option_Status (Get_Socket_Keep_Alive (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...OOB_Data_Inline: "); end if; Option_Status (Get_Socket_OOB_Data_Inline (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...Reuse_Addresses: "); end if; Option_Status (Get_Socket_Reuse_Addresses (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; -- Then, the ones with other data types begin if Verbose then Put (" ...Linger_Time: "); end if; Option_Status (Get_Socket_Linger_Time (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; -- Then, all the Enabled/Disabled options at TCP level begin if Verbose then Put (" ...(TCP) No_Delay: "); end if; Option_Status (Get_No_Delay (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...(TCP) Standardized_Urgent_Data: "); end if; Option_Status (Get_Standardized_Urgent_Data (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; -- Then, all the Enabled/Disabled options at IP level begin if Verbose then Put (" ...(IP) Receive_Destination_Address: "); end if; Option_Status (Get_Receive_Destination_Address (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...(IP) Header_Included: "); end if; Option_Status (Get_Header_Included (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; end; begin --------------------------- -- TCP/IP socket options -- --------------------------- Test ("Test TCP/IP socket options"); Comment ("Create & Bind file descriptor for a TCP/IP socket"); TCP_Socket := Create (Internet_Protocol, Stream_Socket); Set_Internet_Address (Socket_Name, Unspecified_Internet_Address); Set_Internet_Port (Socket_Name, 0); Bind (TCP_Socket, Socket_Name); Display_Socket_Options (TCP_Socket); Comment ("Test Set Options..."); Set_Socket_Broadcast (TCP_Socket, Enabled); Set_Socket_Routing (TCP_Socket, Enabled); Set_Socket_OOB_Data_InLine (TCP_Socket, Enabled); Set_Socket_Linger_Time (TCP_Socket, 123); Display_Socket_Options (TCP_Socket); Comment ("Test Reset Options..."); Set_Socket_Broadcast (TCP_Socket, Disabled); Set_Socket_Routing (TCP_Socket, Disabled); Set_Socket_OOB_Data_InLine (TCP_Socket, Disabled); Set_Socket_Linger_Time (TCP_Socket, 0); Display_Socket_Options (TCP_Socket); Done; end Test_TCP_Options; libflorist-2025.1.0/tests/sockets/test_tcp_talk.adb000066400000000000000000000066141473553204100222520ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; with Text_IO; Procedure Test_TCP_Talk is Talking_Socket: File_Descriptor; Socket_Name: Internet_Socket_Address; Test_Name: Internet_Socket_Address; Test_Address: Internet_Address; Last: POSIX.IO_Count; Arg_Host: Positive; Arg_Port: Positive; Arg_Last: Positive; Port_Num: Internet_Port; Message : string (1 .. 11) := "Hello World"; package Port_IO is new Ada.Text_IO.Modular_IO (Internet_Port); begin ------------------------------ -- Talk on a TCP/IP socket -- ------------------------------ Test ("Talk on TCP/IP socket"); Comment ("Create file descriptor for a TCP/IP socket"); Talking_Socket := Create (Internet_Protocol, Stream_Socket); Comment ("Specify the address and port from command line"); -- Arguments 1 and 2 (or 2 and 3 if "-v" was entered) if Verbose then Arg_Host := 2; Arg_Port := 3; else Arg_Host := 1; Arg_Port := 2; end if; if not Is_Internet_Address (To_POSIX_String (Argument (Arg_Host))) then Text_IO.Put_Line ("Bad Internet Address"); end if; Test_Address := String_To_Internet_Address ( To_POSIX_String (Argument (Arg_Host))); Set_Internet_Address ( Name => Socket_Name, Address_Value => Test_Address ); Text_IO.Put (" Remote Host: "); Text_IO.Put (Argument (Arg_Host)); Port_IO.Get (Argument (Arg_Port), Port_Num, Arg_Last); Text_IO.Put (" Port #"); Port_IO.Put (Port_Num); Text_IO.Put (" IP "); -- Text_IO.Put (To_String (Internet_Address_To_String (Test_Address))); Text_IO.Put (To_String (Internet_Address_To_String (Get_Internet_Address (Socket_Name)))); Text_IO.New_Line; Set_Internet_Port (Socket_Name, Port_Num); Comment ("Connect to the socket (which should be listening)"); Connect (Talking_Socket, Socket_Name); Comment ("Get connected socket name"); Test_Name := Get_Socket_Name (Talking_Socket); Comment ("Extract the Internet address"); Test_Address := Get_Internet_Address (Test_Name); Put (" ===>Test_TCP_Talk: Connecting on ("); declare Dot_Address: constant POSIX_String := Internet_Address_To_String (Test_Address); begin Put (To_String (Dot_Address)); end; Put (") port ("); Put (integer(Get_Internet_Port (Test_Name))); Put_Line (")"); Comment ("Get listening (peer) socket name"); Test_Name := Get_Peer_Name (Talking_Socket); Comment ("Extract the Internet address"); Test_Address := Get_Internet_Address (Test_Name); Put (" ===>Test_TCP_Talk: Connecting from ("); declare Dot_Address: constant POSIX_String := Internet_Address_To_String (Test_Address); begin Put (To_String (Dot_Address)); end; Put (") port ("); Put (integer(Get_Internet_Port (Test_Name))); Put_Line (")"); Comment ("Send some data to the connection"); Send (Talking_Socket, Message'Address, Message'Length, Last); Comment ("Close the connection"); close (Talking_Socket); Done; exception when E : others => Fail (E); end Test_TCP_Talk; libflorist-2025.1.0/tests/sockets/test_tcp_ttime.adb000066400000000000000000000025131473553204100224330ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with test_pkg; use test_pkg; with Gnat.IO; use Gnat.IO; with Ada.Streams; use Ada.Streams; with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; Procedure Test_TCP_Ttime is LOOPS: constant := 100000; BUFSIZE: constant := 10; Talking_Socket: File_Descriptor; Socket_Name: Internet_Socket_Address; Last: POSIX.IO_Count; Buffer: Stream_Element_Array(1..BUFSIZE):=(others=>0); begin ------------------------------ -- Talk on a TCP/IP socket -- ------------------------------ Talking_Socket := Create (Internet_Protocol, Stream_Socket); Set_Internet_Address ( Name => Socket_Name, Address_Value => String_To_Internet_Address ("129.218.154.50")); Set_Internet_Port (Socket_Name, 1234); Connect (Talking_Socket, Socket_Name); Put ("Sending "); Put (LOOPS*BUFSIZE); Put_Line (" bytes..."); for I in 1 .. LOOPS loop Send (Talking_Socket, Buffer (Buffer'First)'Address, Buffer'Length, Last); end loop; Put_Line ("...Close the connection"); close (Talking_Socket); Done; exception when E : others => Fail (E); end Test_TCP_Ttime; libflorist-2025.1.0/tests/sockets/test_udp_listen.adb000066400000000000000000000061271473553204100226160ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; procedure Test_UDP_Listen is Receiving_Socket : File_Descriptor; Socket_Name : Internet_Socket_Address; Callers_Name : Internet_Socket_Address; Buffer : Stream_Element_Array (1 .. 80); Last : POSIX.IO_Count; Message : Socket_Message; Buffer1 : Stream_Element_Array (1 .. 20); Buffer2 : Stream_Element_Array (1 .. 20); Buffer3 : Stream_Element_Array (1 .. 20); Buffer4 : Stream_Element_Array (1 .. 20); Buffer5 : Stream_Element_Array (1 .. 20); SM_Array : Socket_Message_Array_Pointer := new Socket_Message_Array (1 .. 5); begin ---------------------------------- -- Receive on a UDP/IP socket -- ---------------------------------- Test ("Receive on UDP/IP socket"); Set_Internet_Address (Socket_Name, Unspecified_Internet_Address); Set_Internet_Port (Socket_Name, 2000); Receiving_Socket := Create (Internet_Protocol, Datagram_Socket); Bind (Receiving_Socket, Socket_Name); Comment ("Receive datagrams from bound address until '@' ..."); loop Receive (Receiving_Socket, Buffer(Buffer'First)'Address, Buffer'Length, Last); exit when Buffer (1) = 64; Comment ("Received:" & POSIX.To_String (To_POSIX_String (Buffer (1 .. Ada.Streams.Stream_Element_Offset (Last))))); end loop; Comment ("Receive datagrams (and the caller's address) until '@' ..."); loop Receive (Receiving_Socket, Buffer (Buffer'First)'Address, Buffer'Length, Last, Callers_Name); exit when Buffer (1) = 64; Comment ("Received:" & POSIX.To_String (To_POSIX_String (Buffer (1 .. Ada.Streams.Stream_Element_Offset (Last))))); Comment (" (from):" & POSIX.To_String (Internet_Address_To_String (Get_Internet_Address (Callers_Name)))); end loop; Comment ("Receive and gather datagrams as a message ..."); Set_Segment (SM_Array(1), Buffer1'Address, Buffer1'Length); Set_Segment (SM_Array(2), Buffer2'Address, Buffer2'Length); Set_Segment (SM_Array(3), Buffer3'Address, Buffer3'Length); Set_Segment (SM_Array(4), Buffer4'Address, Buffer4'Length); Set_Segment (SM_Array(5), Buffer5'Address, Buffer5'Length); Set_Socket_Name (Message, Callers_Name); Set_Socket_Message_Array (Message, SM_Array); Receive_Message (Receiving_Socket, Message, Last); Comment ("Received:" & POSIX.To_String (To_POSIX_String (Buffer1))); Comment (" :" & POSIX.To_String (To_POSIX_String (Buffer2))); Comment (" :" & POSIX.To_String (To_POSIX_String (Buffer3))); Comment (" :" & POSIX.To_String (To_POSIX_String (Buffer4))); Comment (" :" & POSIX.To_String (To_POSIX_String (Buffer5))); Done; exception when E : others => Fail (E); end Test_UDP_Listen; libflorist-2025.1.0/tests/sockets/test_udp_options.adb000066400000000000000000000043021473553204100230040ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; Procedure Test_UDP_Options is UDP_Socket: File_Descriptor; Socket_Name: Internet_Socket_Address; Err: Error_Code := No_Error; procedure Option_Status (on_off:Socket_Option) is begin if on_off = Enabled then if Verbose then Put_Line ("Enabled"); end if; else if Verbose then Put_Line ("Disabled"); end if; end if; end; procedure Option_Status (op_val:Natural) is begin if Verbose then Put (op_val); New_Line; end if; end; procedure Display_Socket_Options (Socket: in File_Descriptor) is begin -- All the Enabled/Disabled options at IP level begin if Verbose then Put (" ...(IP) Receive_Destination_Address: "); end if; Option_Status (Get_Receive_Destination_Address (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; begin if Verbose then Put (" ...(IP) Header_Included: "); end if; Option_Status (Get_Header_Included (Socket)); exception when POSIX_Error => Put_Line (Image(Get_Error_Code)); end; end; begin --------------------------- -- UDP/IP socket options -- --------------------------- Test ("Test UDP/IP socket options"); Comment ("Create & Bind file descriptor for a UDP/IP socket"); UDP_Socket := Create (Internet_Protocol, Datagram_Socket); Set_Internet_Address (Socket_Name, Unspecified_Internet_Address); Set_Internet_Port (Socket_Name, 2000); Bind (UDP_Socket, Socket_Name); Display_Socket_Options (UDP_Socket); Comment ("Test Set Options..."); Set_Receive_Destination_Address (UDP_Socket, Enabled); Set_Header_Included (UDP_Socket, Enabled); Display_Socket_Options (UDP_Socket); Comment ("Test Reset Options..."); Set_Receive_Destination_Address (UDP_Socket, Disabled); Set_Header_Included (UDP_Socket, Disabled); Display_Socket_Options (UDP_Socket); Done; end Test_UDP_Options; libflorist-2025.1.0/tests/sockets/test_udp_talk.adb000066400000000000000000000065211473553204100222510ustar00rootroot00000000000000with POSIX; use POSIX; with POSIX.IO; use POSIX.IO; with POSIX.Files; use POSIX.Files; with POSIX.Sockets; use POSIX.Sockets; with POSIX.Sockets.Internet; use POSIX.Sockets.Internet; with Test_Pkg; use Test_Pkg; with GNAT.IO; use GNAT.IO; with Ada.Streams; use Ada.Streams; with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; procedure Test_UDP_Talk is Talking_Socket : File_Descriptor; Peer_Name : Internet_Socket_Address; Last : POSIX.IO_Count; Message : Socket_Message; Buffer1 : Stream_Element_Array (1 .. 30); Buffer2 : Stream_Element_Array (1 .. 30); Buffer3 : Stream_Element_Array (1 .. 30); Buffer4 : Stream_Element_Array (1 .. 30); SM_Array : Socket_Message_Array_Pointer := new Socket_Message_Array (1 .. 3); begin ------------------------------- -- Talk on a UDP/IP socket -- ------------------------------- Test ("Talk on UDP/IP socket"); Set_Internet_Address (Peer_Name, Loopback_Internet_Address); Set_Internet_Port (Peer_Name, 2000); Buffer1 := POSIX.To_Stream_Element_Array ("This is a UDP/IP socket with "); Buffer2 := POSIX.To_Stream_Element_Array ("the peer specified in the "); Buffer3 := POSIX.To_Stream_Element_Array ("Connect() "); Buffer4 := POSIX.To_Stream_Element_Array ("@ "); -- Test case 1: Prespecify the peer Talking_Socket := Create (Internet_Protocol, Datagram_Socket); Connect (Talking_Socket, Peer_Name); Send (Talking_Socket, Buffer1 (Buffer1'First)'Address, Buffer1'Length, Last); Send (Talking_Socket, Buffer2 (Buffer2'First)'Address, Buffer2'Length, Last); Send (Talking_Socket, Buffer3 (Buffer3'First)'Address, Buffer3'Length, Last); Send (Talking_Socket, Buffer4 (Buffer4'First)'Address, Buffer4'Length, Last); Close (Talking_Socket); Buffer1 := POSIX.To_Stream_Element_Array ("This is a UDP/IP socket with "); Buffer2 := POSIX.To_Stream_Element_Array ("the peer in the Send() "); Buffer3 := POSIX.To_Stream_Element_Array ("@ "); -- Test case 2: Specify the peer via Send with the parameter Talking_Socket := Create (Internet_Protocol, Datagram_Socket); Send (Talking_Socket, Buffer1 (Buffer1'First)'Address, Buffer1'Length, Last, Peer_Name); Send (Talking_Socket, Buffer2 (Buffer2'First)'Address, Buffer2'Length, Last, Peer_Name); Send (Talking_Socket, Buffer3 (Buffer3'First)'Address, Buffer3'Length, Last, Peer_Name); -- Test case 3: Specify the peer via a Socket_Message Buffer1 := POSIX.To_Stream_Element_Array ("This is a UDP/IP socket with t"); Buffer2 := POSIX.To_Stream_Element_Array ("he peer & buffers specified in"); Buffer3 := POSIX.To_Stream_Element_Array (" a Socket_Message object "); Set_Segment (SM_Array (1), Buffer1 (Buffer1'First)'Address, Buffer1'Length); Set_Segment (SM_Array (2), Buffer2 (Buffer2'First)'Address, Buffer2'Length); Set_Segment (SM_Array (3), Buffer3 (Buffer3'First)'Address, Buffer3'Length); Set_Socket_Name (Message, Peer_Name); Set_Socket_Message_Array (Message, SM_Array); Send_Message (Talking_Socket, Message, Last); Close (Talking_Socket); Done; exception when E : others => Fail (E); end Test_UDP_Talk; libflorist-2025.1.0/tests/test_parameters.adb000066400000000000000000000402061473553204100211340ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- T e s t _ P a r a m e t e r s -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1997-1999 Florida State University (FSU). All Rights -- -- Reserved. -- -- Copyright (C) 2000-2022, AdaCore -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- The POSIX standards provide considerable leeway for variation -- among implementations. For example, an implementation may impose -- arbitrary restrictions on the form of the name of a message queue. -- In order to accommodate these variations, the tests are -- parameterized. All the implementation-dependences (such as valid -- message queue names) are encapsulated in this package body. -- The specification of this package shall not be modified. -- The body may be edited to fit each implementation being tested. -- The only with-clause dependences permitted for the body are on -- packages that are defined by the Ada language and POSIX/Ada -- standards. Whatever modifications are made to the package body -- shall be consistent with the comments in the package -- specification. -- In general, the body of this package will need modification to fit the -- specifics of the execution environment to be tested. -- The following is the package body that was used in checking out the -- tests on Solairs 7 (SunOS 5.7), and also on Linux 2.2 with Linuxthreads -- using the Gnat 3.12p Ada implementation. (Not all tests passed.) -- No one should expect to be able to use this package body as-is for -- any other combination of compiler, Ada runtime system, -- POSIX/Ada binding implementation, -- and execution platform, but it may be useful as an example. -- The person verifying the administration of the tests should review -- the version of this package body to verify that whatever tailoring has -- been done is consistent with the intent of the comments in the -- package specification and with the standards. with Ada.Text_IO, Ada.Characters.Handling, Ada.Strings.Unbounded, POSIX, POSIX_Signals, Unchecked_Conversion; package body Test_Parameters is use Ada.Text_IO, Ada.Characters.Handling, Ada.Strings.Unbounded, POSIX, POSIX_Signals; function Valid_MQ_Name (N : Positive) return POSIX_String is S : constant String := Integer'Image (N); begin return "/mq_" & To_POSIX_String (S (S'First + 1 .. S'Last)); end Valid_MQ_Name; function Invalid_MQ_Name (N : Positive) return POSIX_String is begin if N = 1 then return "(#@!$%^~??||++"; else return "~!@#$%^&*()_++_}{{.//"; end if; end Invalid_MQ_Name; function Valid_Shared_Memory_Object_Name (N : Positive) return POSIX_String is S : constant String := Integer'Image (N); begin return "/shm_" & To_POSIX_String (S (S'First + 1 .. S'Last)); end Valid_Shared_Memory_Object_Name; function Invalid_Shared_Memory_Object_Name (N : Positive) return POSIX_String is begin if N = 1 then return "(#@!$%^~??||++"; else return "~!@#$%^&*()_++_}{{.//"; end if; end Invalid_Shared_Memory_Object_Name; function Valid_Block_Device_Name return POSIX_String is File : File_Type; Buf : String (1 .. 128); Last : Integer; begin begin Open (File, In_File, "/etc/mnttab"); exception when others => begin Open (File, In_File, "/etc/mtab"); exception when others => return "could_not_find_block_device"; end; end; -- Try searching /etc/mnttab or /etc/mtab for a device name. loop Get_Line (File, Buf, Last); if Last >= 4 and Buf (1 .. 4) = "/dev" then for I in 1 .. Last loop if not Is_Alphanumeric (Buf (I)) and then not Is_Special (Buf (I)) then return To_POSIX_String (Buf (1 .. I - 1)); end if; end loop; end if; end loop; end Valid_Block_Device_Name; function Valid_Character_Special_File_Name return POSIX_String is begin return "/dev/tty"; end Valid_Character_Special_File_Name; function Valid_Nonexistent_File_Name return POSIX_String is begin return "Nonexistent_File"; end Valid_Nonexistent_File_Name; function Default_Action (Sig : Signal) return Signal_Action is begin case Sig is when SIGCHLD => return Ignore; when SIGCONT => return Continue; when SIGSTOP | SIGTSTP | SIGTTIN | SIGTTOU => return Stop; when SIGHUP | SIGINT | SIGKILL | SIGPIPE | SIGQUIT | SIGTERM | SIGUSR1 | SIGUSR2 => return Termination; --! # if SunOS then --! when 19 -- SIGPWR --! | 20 -- SIGWINCH --! | 21 -- SIGURG --! | 32 -- SIGWAITING --! | 33 -- SIGLWP --! | 34 -- SIGFREEZE --! | 35 -- SIGTHAW --! | 36 -- SIGCANCEL --! => return Ignore; --! when others => return Termination; --! # else when others => return Unspecified; --! # end if; end case; end Default_Action; function Is_Reserved_Signal (Sig : Signal) return Boolean is begin case Sig is -- The required reserved signals when SIGILL | SIGABRT | SIGFPE | SIGBUS | SIGSEGV | SIGALRM => return True; --! # if Linux then -- Additional reserved signals for GNAT with Leroy Linux threads when SIGUSR1 | SIGUSR2 | SIGINT | 5 -- SIGTRAP | 26 -- SIGVTALRM | 31 -- SIGUNUSED => return True; --! # elsif SunOS then --! -- The following are correct values for gnat 3.12 --! -- and Solaris 2.7. They may need modification for other --! -- configurations. --! when 5 -- SIGTRAP --! | 29 -- SIGPROF --! | 32 -- SIGWAITING --! | 33 -- SIGLWP --! | 36 -- SIGCANCEL --! => return True; --! # end if; when others => return False; end case; end Is_Reserved_Signal; function Action_Cannot_Be_Set (Sig : Signal) return Boolean is begin case Sig is -- The required reserved signals, and SIGNULL when SIGILL | SIGABRT | SIGFPE | SIGKILL | SIGBUS | SIGSEGV | SIGALRM | SIGSTOP | SIGNULL => return True; --! # if HAVE_Leroy_Threads then --! -- Additional reserved signals for GNAT with Leroy Linux threads --! when SIGUSR1 | SIGUSR2 | SIGINT --! | 5 -- SIGTRAP --! | 26 -- SIGVTALRM --! | 31 -- SIGUNUSED --! => return True; --! # elsif SunOS then --! -- Additional reserved signals for GNAT with Solaris 2.6 --! -- The following are correct values for gnat 3.12 --! -- and Solaris 2.7. They may need modification for other --! -- configurations. --! when --! 5 -- SIGTRAP -- not named in POSIX.5 --! | 29 -- SIGPROF -- not named in POSIX.5 --! | 32 -- SIGWAITING -- not named in POSIX.5 --! | 33 -- SIGLWP -- not named in POSIX.5 --! | 36 -- SIGCANCEL -- not named in POSIX.5 --! => return True; --! # end if; when others => return False; end case; end Action_Cannot_Be_Set; function Default_Is_Ignore (Sig : POSIX_Signals.Signal) return Boolean is begin case Sig is -- The required reserved signals, and SIGNULL when SIGCHLD | SIGIO | SIGURG | SIGCONT | SIGSTOP | SIGTSTP | SIGTTIN | SIGTTOU => return True; --! # if SunOS then --! when --! 19 -- SIGPWR --! | 20 -- SIGWINCH --! | 32 -- SIGWAITING --! | 33 -- SIGLWP --! | 34 -- SIGFREEZE --! | 35 -- SIGTHAW --! => return True; --! # end if; when others => return False; end case; end Default_Is_Ignore; function Signal_Mask_Is_Process_Wide return Boolean is begin return True; end Signal_Mask_Is_Process_Wide; function Try_Install_Empty_Handler (Sig : POSIX_Signals.Signal) return Boolean is begin POSIX_Signals.Install_Empty_Handler (Sig); return True; end Try_Install_Empty_Handler; function Valid_Semaphore_Name (N : Positive) return POSIX_String is S : constant String := Integer'Image (N); begin return "/sem_" & To_POSIX_String (S (S'First + 1 .. S'Last)); end Valid_Semaphore_Name; function Invalid_Semaphore_Name (N : Positive) return POSIX_String is begin if N = 1 then return "(#@!$%^~??||++"; else return "~!@#$%^&*()_++_}{{.//"; end if; end Invalid_Semaphore_Name; function Delay_Unit return Duration is begin --! # if Linux then -- For DOS & Linux on PC return 0.1; --! # elsif SunOS then --! return 0.02; --! # else --! return 0.02; --! # end if; end Delay_Unit; function New_Process_Startup return Duration is begin --! # if Linux then -- For DOS & Linux on PC return 0.5; --! # elsif SunOS then --! return 0.5; --! # else --! return 0.02; --! # end if; end New_Process_Startup; function Short_Watchdog_Timeout return Duration is begin return 15.0; end Short_Watchdog_Timeout; function Unused_Group_Name return POSIX_String is begin return "not_a_group_name"; end Unused_Group_Name; function Invalid_Clock_ID return POSIX_Timers.Clock_ID is use POSIX_Timers; type Char_Array is array (1 .. Clock_ID'Size / Character'Size) of Character; type Clock_ID_Ptr is access all Clock_ID; type Char_Array_Ptr is access all Char_Array; function To_Clock_ID_Ptr is new Unchecked_Conversion (Char_Array_Ptr, Clock_ID_Ptr); F : aliased Char_Array; begin for I in Char_Array'Range loop F (I) := Character'Val (I); end loop; return To_Clock_ID_Ptr (F'Access).all; -- By bad luck, this could be a valid clock ID on some system. -- If so, replace this by appropriate code for that system. end Invalid_Clock_ID; function Invalid_Timespec return POSIX.Timespec is type Char_Array is array (1 .. Timespec'Size / Character'Size) of Character; type Timespec_Ptr is access all Timespec; type Char_Array_Ptr is access all Char_Array; function To_Timespec_Ptr is new Unchecked_Conversion (Char_Array_Ptr, Timespec_Ptr); F : aliased Char_Array; begin for I in Char_Array'Range loop F (I) := Character'Val (255); end loop; return To_Timespec_Ptr (F'Access).all; end Invalid_Timespec; function Valid_Internet_Address return POSIX.POSIX_String is File : File_Type; Buf : String (1 .. 128); Last : Integer; Ubuf : Unbounded_String; begin begin Open (File, In_File, "/etc/inet/hosts"); exception when others => begin Open (File, In_File, "/etc/hosts"); exception when others => return "127.0.0.1"; end; end; -- Try searching /etc/inet/hosts or /etc/hosts for a device name. loop Get_Line (File, Buf, Last); Ubuf := To_Unbounded_String (Buf); if Last > 4 and Ada.Strings.Unbounded.Count (Ubuf, "localhost") = 0 then Ubuf := To_Unbounded_String (Slice (Ubuf, 1, Last)); if Index (Ubuf, ".") /= 0 then if Index (Ubuf, "" & ASCII.HT) /= 0 then Ubuf := To_Unbounded_String (Slice (Ubuf, 1, Index (Ubuf, "" & ASCII.HT) - 1)); elsif Index (Ubuf, " ") /= 0 then Ubuf := To_Unbounded_String (Slice (Ubuf, 1, Index (Ubuf, " ") - 1)); end if; Close (File); return To_POSIX_String (To_String (Ubuf)); end if; end if; end loop; end Valid_Internet_Address; function Valid_Internet_Name return POSIX.POSIX_String is File : File_Type; Buf : String (1 .. 128); Last : Integer; Temp : Unbounded_String; Ubuf : Unbounded_String; begin begin Open (File, In_File, "/etc/inet/hosts"); exception when others => begin Open (File, In_File, "/etc/hosts"); exception when others => return "localhost"; end; end; -- Try searching /etc/inet/hosts or /etc/hosts for a device name. loop Get_Line (File, Buf, Last); Ubuf := To_Unbounded_String (Buf); if Last > 4 and then Ada.Strings.Unbounded.Count (Ubuf, "localhost") = 0 then Ubuf := To_Unbounded_String (Slice (Ubuf, 1, Last)); if Index (Ubuf, ".") /= 0 then Temp := To_Unbounded_String (Slice (Ubuf, Index (Ubuf, " ", Going => Ada.Strings.Backward) + 1, Last)); Temp := To_Unbounded_String (Slice (Temp, 1, Length (Temp))); Close (File); return To_POSIX_String (To_String (Temp)); end if; end if; end loop; end Valid_Internet_Name; function Continue_Generates_Signal return Boolean is begin return True; end Continue_Generates_Signal; end Test_Parameters; libflorist-2025.1.0/tests/test_parameters.ads000066400000000000000000000214561473553204100211630ustar00rootroot00000000000000------------------------------------------------------------------------------ -- -- -- POSIX.5b VALIDATION TEST SUITE -- -- -- -- T e s t _ P a r a m e t e r s -- -- -- -- S p e c -- -- -- -- -- -- Copyright (c) 1997-1998 Florida State University (FSU). All Rights -- -- Reserved. -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. This software 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 distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- Under contract GS-35F-4506G, the U. S. Government obtained unlimited -- -- rights in the software and documentation contained herein. Unlimited -- -- rights are defined in DFAR 252,227-7013(a)(19). By making this public -- -- release, the Government intends to confer upon all recipients -- -- unlimited rights equal to those held by the Government. These rights -- -- include rights to use, duplicate, release or disclose the released -- -- data an computer software in whole or in part, in any manner and for -- -- any purpose whatsoever, and to have or permit others to do so. -- -- -- -- DISCLAIMER -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE -- -- AVAILABLE OR DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR -- -- IMPLIED WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS -- -- OF THE SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE -- -- AVAILABLE OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS -- -- FOR A PARTICULAR PURPOSE OF SAID MATERIAL. -- -- -- ------------------------------------------------------------------------------ -- [$Revision$] -- This package encapsulates implementation-dependences -- from the tests. The specification should not be modified, -- but the body will need to be tailored to each implementation. -- The Valid_XX_Name functions must return -- a distinct name for each positive value N. -- The Invalid_XX_Name functions should return -- at least two distinct names, for N=0 and N=1. with POSIX, POSIX_Signals, POSIX_Timers; package Test_Parameters is use POSIX; function Valid_MQ_Name (N : Positive) return POSIX_String; -- A string that is a valid message queue name. -- Should be different for each value of N. function Invalid_MQ_Name (N : Positive) return POSIX_String; -- A string that is not a valid message queue name. -- Should be different for each value of N. function Valid_Shared_Memory_Object_Name (N : Positive) return POSIX_String; -- A string that is a valid shared memory object name. -- Should be different for each value of N. function Invalid_Shared_Memory_Object_Name (N : Positive) return POSIX_String; -- A string that is not a valid shared memory object name. -- Should be different for each value of N. function Valid_Block_Device_Name return POSIX_String; -- Name of a file that is a block special device. function Valid_Character_Special_File_Name return POSIX_String; -- Name of a file that is a character special device. function Valid_Nonexistent_File_Name return POSIX_String; -- String that is a valid filename, but for which no file exists -- in the directory where the tests are run. type Signal_Action is (Unspecified, Ignore, Continue, Stop, Termination); function Default_Action (Sig : POSIX_Signals.Signal) return Signal_Action; -- Returns the default action of Sig. -- SIGCHLD => Ignore -- SIGCONT => Continue -- SIGSTOP | SIGTSTP | SIGTTIN | SIGTTOU => Stop -- SIGHUP | SIGINT | SIGKILL | SIGPIPE | -- SIGQUIT | SIGTERM | SIGUSR1 | SIGUSR2 => Termination -- others => implementation-dependent function Is_Reserved_Signal (Sig : POSIX_Signals.Signal) return Boolean; -- Returns True only for signals that are reserved by the -- implementation. See [2.2.2.117]. -- These must include SIGABRT, SIGALRM, SIGFPE, SIGILL, -- SIGSEGV, and SIGBUS. -- The only other signals allowed to be reserved are those that are -- not named in POSIX.5 that are not in the realtime range. -- This applies to Await_Signal [3.3.15] function Action_Cannot_Be_Set (Sig : POSIX_Signals.Signal) return Boolean; -- Signals for which "action is not permitted to be set by the -- application", as in the description of Ignore_Signal [3.3.9]. -- We assume these are the same as the -- signals that are "not permitted to be accepted or caught", -- as in the description of Enable_Queueing [3.3.14]. -- Since [3.3.2] says -- "an implementation shall not impose restrictions on the ability -- of an application to send, accept, block, or ignore the signals -- defined by this standard, except as specified in this standard" -- we conclude that these signals are just SIGKILL and SIGSTOP, -- plus the reserved signals and SIGNULL. function Default_Is_Ignore (Sig : POSIX_Signals.Signal) return Boolean; -- Signals for which the default action is to ignore the signal, -- including signals that stop or continue the process. -- These must include SIGCHLD, SIGURG, SIGIO, SIGCONT, -- SIGSTOP, SIGTSTP, SIGTTIN, SIGTTOU. -- The only other signals allowed here are signals not named -- in POSIX.5 that are not in the realtime range, that the -- implementation chooses to ignore by default. function Try_Install_Empty_Handler (Sig : POSIX_Signals.Signal) return Boolean; -- If POSIX.5c is supported: call Install_Empty_Handler and return True; -- else just return False. function Signal_Mask_Is_Process_Wide return Boolean; -- See [3.3.1] function Valid_Semaphore_Name (N : Positive) return POSIX_String; -- Returns a valid semaphore name. -- The values must be distinct for values of N in the range -- 1 .. POSIX_Limits.Portable_Semaphores_Maximum. function Invalid_Semaphore_Name (N : Positive) return POSIX_String; -- Returns an invalid semaphore name. function Delay_Unit return Duration; -- A value that is at least as large as the minimum delay -- granularity, but small enough that delaying this amount -- repeatedly will not cause a test to give the impression of -- hanging. function Short_Watchdog_Timeout return Duration; -- A value that is long enough that if a "short" test -- test does not complete within it we can assume the test has hung. function New_Process_Startup return Duration; -- A value that is large enough to allow a new process to -- be loaded (from disk) and start up. function Unused_Group_Name return POSIX_String; -- A string that has no corresponding group. function Invalid_Clock_ID return POSIX_Timers.Clock_ID; -- An invalid clock ID. function Invalid_Timespec return POSIX.Timespec; -- An invalid value of type Timespec, preferably with -- the nanoseconds component outside the range 0 .. 1.0E9; function Valid_Internet_Address return POSIX.POSIX_String; -- A valid internet address in dotted decimal notation function Valid_Internet_Name return POSIX.POSIX_String; -- A valid internet (network) name function Continue_Generates_Signal return Boolean; -- This returns True iff continuation of a stopped process -- generates an instance of SIGCHLD for the parent process, -- when SA_NOCLDSTOP is not specified for the parent. end Test_Parameters; libflorist-2025.1.0/tests/test_timers.adb000066400000000000000000000144751473553204100203050ustar00rootroot00000000000000-------------------------------------------------------------------------- -- Copyright (C) 1995, 1996 by the Florida State University -- -- -- -- 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 2 of -- -- the License, or (at your option) any later version. -- -------------------------------------------------------------------------- -- [$Revision$] -- Test package POSIX_Timers. with POSIX; with POSIX_Options; with POSIX_Process_Identification; with POSIX_Report; with POSIX_Signals; with POSIX_Timers; procedure Test_Timers is use POSIX; use POSIX_Process_Identification; use POSIX_Report; use POSIX_Signals; use POSIX_Timers; Signal_Delivered : Boolean := False; Event : Signal_Event; Tid : Timer_ID; Timer_State1, New_State : Timer_State; Initial, Interval : Timespec; task Handler is entry Done; for Done use at Signal_User_2_Ref; end Handler; task body Handler is begin loop select accept Done do Signal_Delivered := true; end Done; or terminate; end select; end loop; end Handler; begin Header ("Test_Timers"); ----------------------------------------------------------------------- Signal_Delivered := False; Test ("initialize signal event variable"); Set_Signal (Event, SIGUSR2); Set_Notification (Event, Signal_Notification); ----------------------------------------------------------------------- Test ("get clock resolution"); declare T : Timespec := To_Timespec (999, 999); S : Seconds; NS : Nanoseconds; begin T := Get_Resolution (Clock_Realtime); Split (T, S, NS); Assert (S /= 999); Comment ("real-time clock resolution = " & Seconds'Image (S) & "ns + " & Nanoseconds'Image (NS) & "ns"); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1); when E2 : others => Fail (E2); end; ----------------------------------------------------------------------- Test ("get real-time clock value"); declare T : Timespec := To_Timespec (999, 999); S : Seconds; NS : Nanoseconds; begin T := Get_Time; Split (T, S, NS); Assert (S /= 999); Comment ("current time = " & Seconds'Image (S) & "ns + " & Nanoseconds'Image (NS) & "ns"); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1); when E2 : others => Fail (E2); end; ----------------------------------------------------------------------- Test ("set real-time clock"); declare T1, T2 : Timespec := To_Timespec (999, 999); S : Seconds; NS : Nanoseconds; EC : Error_Code; begin Set_Time (T1); T2 := Get_Time; Assert (T1 = T2); exception when E1 : POSIX_Error => Privileged (Set_Time_Privilege, Timers_Option, Operation_Not_Implemented, E1); when E2 : others => Fail (E2); end; ----------------------------------------------------------------------- Test ("initialize timer state variable"); POSIX.Set_Seconds (Initial, 1); POSIX.Set_Nanoseconds (Initial, 1); POSIX.Set_Seconds (Interval, 0); POSIX.Set_Nanoseconds (Interval, 0); Set_Initial (New_State, Initial); Set_Interval (New_State, Interval); -- Since Absolute_Timer is specified, timer is set to expire to -- Epoch+1 seconds, so it will generate a signal immediately. -- Interval = 0, thus it only generates the signal once. ----------------------------------------------------------------------- Test ("create timer"); begin Tid := Create_Timer (Clock_Realtime, Event); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Supported, E1); when E2 : others => Fail (E2); end; ----------------------------------------------------------------------- Test ("arm timer for single shot"); -- .... This test stops by receiving a signal due to the -- "sigwaitinfo/timer_settime" malfunction (Solaris). See s_timer.c begin Arm_Timer (Tid, Absolute_Timer, New_State); -- Should generate signal immediately exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1); when E2 : others => Fail (E2); end; ----------------------------------------------------------------------- Test ("get timer state"); begin Timer_State1 := Get_Timer_State (Tid); Assert (Get_Seconds (Get_Initial (Timer_State1)) = 0, "initial value should be zero"); Assert (Get_Seconds (Get_Interval (Timer_State1)) = 0, "interval should be zero"); ----------------------------------------------------------------------- Test ("get timer overruns"); for I in 1 .. 10 loop Assert (Get_Timer_Overruns (Tid) = 0, "overruns"); exit when Signal_Delivered; delay 1.0; end loop; ----------------------------------------------------------------------- if not Signal_Delivered then Fail ("timer signal delivery"); end if; exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1); when E2 : others => Fail (E2); end; -- ???? need additional test, for periodic timer ----------------------------------------------------------------------- Test ("disarm timer"); begin Disarm_Timer (Tid); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1); when E2 : others => Fail (E2); end; ----------------------------------------------------------------------- Test ("delete timer"); begin Delete_Timer (Tid); exception when E1 : POSIX_Error => Optional (Timers_Option, Operation_Not_Supported, E1); when E2 : others => Fail (E2); end; ----------------------------------------------------------------------- Done; exception when E1 : POSIX.POSIX_Error => Optional (Timers_Option, Operation_Not_Implemented, E1); Done; when E2 : others => Fatal_Exception (E2); end Test_Timers; libflorist-2025.1.0/tests/test_timers.ads000066400000000000000000000000271473553204100203120ustar00rootroot00000000000000procedure Test_Timers; libflorist-2025.1.0/tests/xti/000077500000000000000000000000001473553204100160645ustar00rootroot00000000000000libflorist-2025.1.0/tests/xti/Makefile000066400000000000000000000006711473553204100175300ustar00rootroot00000000000000include ../../Config GNATMAKEFLAGS = -c -gnatg -largs -L$(FLORISTLIBSDIR) $(LIBS) GNATMAKEFLAGS2 = -largs -L$(FLORISTLIBSDIR) $(LIBS) TEST_FILES=\ test_tcp_listen.adb\ test_tcp_connect.adb TESTS=\ test_tcp_listen\ test_tcp_connect all: $(TESTS) tcp: test_tcp_listen test_tcp_connect $(TESTS): $(TEST_FILES) $(POSIX_FILES) gnatmake $@ $(GNATMAKEFLAGS2) neat: co -l RCS/* clean: rm -f *.o *.ali test_tcp_connect test_tcp_listen libflorist-2025.1.0/tests/xti/test_tcp_connect.adb000066400000000000000000000626771473553204100221140ustar00rootroot00000000000000with POSIX; with POSIX.Files; with POSIX.IO; with POSIX.XTI; use POSIX.XTI; with POSIX.XTI.Internet; use POSIX.XTI.Internet; with Text_IO; with Ada.Calendar; use Ada.Calendar; with POSIX.Process_Environment; procedure Test_TCP_Connect is type Test_Buffer_Type is record int : integer; flt : float; arr : POSIX.Octet_Array (1 .. 4000); end record; Test_Buffer : aliased Test_Buffer_Type; Test_Buffer_Return : aliased Test_Buffer_Type; function To_Buffer_Pointer is new POSIX.XTI.To_Buffer_Pointer (Test_Buffer_Type); function To_Buffer_Pointer is new POSIX.XTI.To_Buffer_Pointer (POSIX.Octet); Internet_Addr : POSIX.XTI.Internet.Internet_XTI_Address; Response_Addr : aliased POSIX.XTI.Internet.Internet_XTI_Address; Endpoint : POSIX.IO.File_Descriptor; Options : POSIX.IO.Open_Option_Set; Response_INET_Addr : POSIX.XTI.Internet.Internet_Address; Connect_Send_Info : POSIX.XTI.Connection_Information; Connect_Receive_Info : POSIX.XTI.Connection_Information; Buffer : aliased POSIX.Octet_Array (1 .. 4000); Bytes : POSIX.IO_Count; Flags : POSIX.XTI.XTI_Flags; Total : POSIX.IO_Count; Start_Time : Ada.Calendar.Day_Duration; End_Time : Ada.Calendar.Day_Duration; Option : POSIX.XTI.Protocol_Option; Option_List : aliased POSIX.XTI.Protocol_Option_List; Option_Buffer : POSIX.XTI.Octet_Buffer_Pointer := new POSIX.Octet_Array (1 .. 256); Option_Result : POSIX.XTI.Option_Status; Linger : POSIX.XTI.Linger_Information; Remote_INET_Addr : POSIX.XTI.Internet.Internet_Address := POSIX.XTI.Internet.Loopback_Internet_Address; -- by default Arg_Number : integer := 1; procedure Parse (Item : in POSIX.POSIX_String; Quit : in out Boolean) is begin if (Arg_Number = 2) then Remote_INET_Addr := POSIX.XTI.Internet.String_To_Internet_Address (Item); Text_IO.Put ("Will connect to: "); Text_IO.Put_Line (POSIX.To_String ( (POSIX.XTI.Internet.Internet_Address_To_String (Remote_INET_Addr)))); end if; Arg_Number := 2; exception when others => Text_IO.Put_Line ("POSIX.XTI.Internet.String_To_Internet_Address FAILED"); end Parse; procedure For_Every_Item is new POSIX.For_Every_Item (Parse); package Int_IO is new Text_IO.Integer_IO (integer); use Int_IO; package Float_IO is new Text_IO.Float_IO (Float); use Float_IO; procedure Print_Option (Info : in Protocol_Option; Quit : in out Boolean) is Name : POSIX.XTI.Option_Name; Level : POSIX.XTI.Option_Level; Value : POSIX.XTI.Option_Value; No_Delay : POSIX.XTI.Internet.XTI_Option; Linger : POSIX.XTI.Linger_Information; Keep_Alive : POSIX.XTI.Internet.Keep_Alive_Information; IP_Ops : POSIX.XTI.Internet.IP_Option_List (0 .. 1023); Count : Natural; begin Text_IO.Put ("Option "); Name := Get_Name (Info); Level := Get_Level (Info); if Level = XTI_Protocol_Level then case Name is when POSIX.XTI.Enable_Debugging => Text_IO.Put ("Enable_Debugging, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.New_Line; when POSIX.XTI.Linger_On_Close_If_Data_Present => Text_IO.Put ( "Linger_On_Close_If_Data_Present, Linger on/off is "); Linger := POSIX.XTI.Get_Value (Info); if (POSIX.XTI.Get_Status (Linger) = POSIX.XTI.Linger_Off) then Text_IO.Put_Line ("OFF"); else Text_IO.Put ("ON, Period is "); if (POSIX.XTI.Period_Is_Unspecified (Linger)) then Text_IO.Put_Line ("UNSPECIFIED"); elsif (POSIX.XTI.Period_Is_Infinite (Linger)) then Text_IO.Put_Line ("INFINITE"); else Int_IO.Put (integer (POSIX.XTI.Get_Period (Linger))); Text_IO.Put_Line (" Seconds"); end if; end if; when POSIX.XTI.Receive_Buffer_Size => Text_IO.Put ("Receive_Buffer_Size, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.Put_Line (" Bytes"); when POSIX.XTI.Receive_Low_Water_Mark => Text_IO.Put ("Receive_Low_Water_Mark, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.Put_Line (" Bytes"); when POSIX.XTI.Send_Buffer_Size => Text_IO.Put ("Send_Buffer_Size, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.Put_Line (" Bytes"); when POSIX.XTI.Send_Low_Water_Mark => Text_IO.Put ("Send_Low_Water_Mark, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.Put_Line (" Bytes"); when others => Text_IO.Put_Line ("UNKNOWN XTI Level Option"); end case; elsif Level = TCP_Level then case Name is when TCP_Keep_Alive_Interval => Text_IO.Put ("TCP_Keep_Alive_Interval, Status is "); Keep_Alive := POSIX.XTI.Internet.Get_Value (Info); if POSIX.XTI.Internet.Get_Status (Keep_Alive) = POSIX.XTI.Internet.Keep_Alive_On then Text_IO.Put ("ON, Timeout "); Int_IO.Put (integer ( POSIX.XTI.Internet.Get_Keep_Alive_Timeout (Keep_Alive))); elsif POSIX.XTI.Internet.Get_Status (Keep_Alive) = POSIX.XTI.Internet.Keep_Alive_Off then Text_IO.Put ("Off"); end if; Text_IO.New_Line; when TCP_Segment_Size_Maximum => Text_IO.Put ("TCP_Segment_Size_Maximum, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.Put (" Bytes"); Text_IO.New_Line; when TCP_No_Delay => Text_IO.Put ("TCP_No_Delay, Option is "); No_Delay := POSIX.XTI.Internet.Get_Value (Info); if (No_Delay = POSIX.XTI.Internet.Enabled) then Text_IO.Put (" ENABLED"); else Text_IO.Put (" DISABLED"); end if; Text_IO.New_Line; when others => Text_IO.Put_Line ("UNKNOWN TCP Level Option"); end case; elsif Level = IP_Level then case Name is when IP_Options => Text_IO.Put ("IP_Options, Value is "); POSIX.XTI.Internet.Get_Value (Info, IP_Ops, Count); if Count > 0 then for i in IP_Ops'First .. (integer (IP_Ops'First) + Count) loop Int_IO.Put (integer (IP_Ops (i))); end loop; else Text_IO.Put ("NO IP OPTIONS"); end if; Text_IO.New_Line; when IP_Type_Of_Service => Text_IO.Put ("IP_Type_Of_Service, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.New_Line; when IP_Time_To_Live => Text_IO.Put ("IP_Time_To_Live, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value), Base => 16); Text_IO.New_Line; when IP_Reuse_Address => Text_IO.Put ("IP_Reuse_Address, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.New_Line; when IP_Dont_Route => Text_IO.Put ("IP_Dont_Route, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.New_Line; when IP_Permit_Broadcast => Text_IO.Put ("IP_Permit_Broadcast, Value is "); Value := POSIX.XTI.Get_Value (Info); Int_IO.Put (integer (Value)); Text_IO.New_Line; when others => Text_IO.Put_Line ("UNKNOWN IP Level Option"); end case; end if; end Print_Option; procedure For_Every_Item is new POSIX.XTI.For_Every_Item (Print_Option); Quit : boolean; begin For_Every_Item (POSIX.Process_Environment.Argument_List); if (POSIX.Files.Is_Character_Special_File ("/dev/inet_cots")) then POSIX.XTI.Open (Endpoint, "/dev/inet_cots", POSIX.IO.Read_Write, Options); elsif (POSIX.Files.Is_Character_Special_File ("/dev/ticots")) then POSIX.XTI.Open (Endpoint, "/dev/ticots", POSIX.IO.Read_Write, Options); end if; Text_IO.Put_Line ("Opened endpoint"); ------------------------------------------------------------------------ -- -- Need to do this to set the netbuf parameters in the implementation -- Need to fix implemenation BUG. -- POSIX.XTI.Internet.Set_Internet_Port (Response_Addr, 16#00#); ------------------------------------------------------------------------ POSIX.XTI.Bind (Endpoint, Response_Addr'access); Text_IO.Put_Line ("Completed Bind"); Text_IO.Put (" Port: "); Int_IO.Put (integer (POSIX.XTI.Internet.Get_Internet_Port (Response_Addr))); Text_IO.New_Line; Response_INET_Addr := POSIX.XTI.Internet.Get_Internet_Address (Response_Addr); Text_IO.Put ("Response Address is: "); Text_IO.Put (POSIX.To_String ( (POSIX.XTI.Internet.Internet_Address_To_String (Response_INET_Addr)))); Text_IO.New_Line; -- -- Set the Port and Internet Address. Note that the Remote_INET_Addr -- was set above by either using the default Loopback or Resolving -- the name in the second parameter of the Argument_List. -- POSIX.XTI.Internet.Set_Internet_Port (Internet_Addr, 16#FF00#); POSIX.XTI.Internet.Set_Internet_Address (Internet_Addr, Remote_INET_Addr); POSIX.XTI.Set_Address (Connect_Send_Info, Internet_Addr); POSIX.XTI.Set_Address (Connect_Receive_Info, Response_Addr); Text_IO.Put_Line ("Calling Connect, expect to be REJECTED"); begin POSIX.XTI.Connect (Endpoint, Connect_Send_Info); Text_IO.Put_Line ("Connected Clean, should have been REJECTED!!!"); exception when POSIX.POSIX_Error => if (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Disconnect_Request_Received) then Text_IO.Put_Line ("Connect Rejected by Remote Node"); else Text_IO.Put_Line ("Some other event"); end if; end; delay 1.0; Text_IO.Put_Line ("Calling Connect Again"); POSIX.XTI.Close (Endpoint); if (POSIX.Files.Is_Character_Special_File ("/dev/inet_cots")) then POSIX.XTI.Open (Endpoint, "/dev/inet_cots", POSIX.IO.Read_Write, Options); elsif (POSIX.Files.Is_Character_Special_File ("/dev/ticots")) then POSIX.XTI.Open (Endpoint, "/dev/ticots", POSIX.IO.Read_Write, Options); end if; POSIX.XTI.Bind (Endpoint); POSIX.XTI.Internet.Set_Internet_Port (Internet_Addr, 16#FF00#); POSIX.XTI.Internet.Set_Internet_Address (Internet_Addr, Remote_INET_Addr); POSIX.XTI.Set_Address (Connect_Send_Info, Internet_Addr); POSIX.XTI.Connect (Endpoint, Connect_Send_Info); Text_IO.Put_Line ("Connected"); -- POSIX.XTI.Confirm_Connection (Endpoint, Connect_Receive_Info); -- Text_IO.Put_Line ("Confirmed Connection"); POSIX.XTI.Set_Buffer (Option_List, Option_Buffer); -- POSIX.XTI.Set_Option_Buffer_Maximum_Length (Option_Buffer'Last, -- Option_List); -- -- Set the TCP Level options -- -- -- Set TCP No_Delay -- -- POSIX.XTI.Set_Level (Option, POSIX.XTI.Internet.TCP_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.Internet.TCP_No_Delay); -- POSIX.XTI.Internet.Set_Value (Option, POSIX.XTI.Internet.Enabled); POSIX.XTI.Internet.Set_Option (Option, POSIX.XTI.Internet.TCP_Level, POSIX.XTI.Internet.TCP_No_Delay, POSIX.XTI.Internet.Enabled); POSIX.XTI.Append (Option_List, Option); POSIX.XTI.Manage_Options (Endpoint, Option_List, POSIX.XTI.Negotiate_Options, Option_List'access, Option_Result); Text_IO.Put ("The Result of Manage Options (Set TCP NODELAY) was "); if (Option_Result = Success) then Text_IO.Put_Line ("Success"); elsif (Option_Result = Partial_Success) then Text_IO.Put_Line ("Partial Success"); elsif (Option_Result = Failure) then Text_IO.Put_Line ("Failure"); elsif (Option_Result = Read_Only) then Text_IO.Put_Line ("Read Only"); elsif (Option_Result = Not_Supported) then Text_IO.Put_Line ("Not Supported"); end if; -- -- Set the XTI Level Options -- POSIX.XTI.Make_Empty (Option_List); -- -- Set RCV Buffer Size -- -- POSIX.XTI.Set_Level (Option, POSIX.XTI.XTI_Protocol_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.Receive_Buffer_Size); -- POSIX.XTI.Set_Value (Option, (255 * 1024)); POSIX.XTI.Set_Option (Option, POSIX.XTI.XTI_Protocol_Level, POSIX.XTI.Receive_Buffer_Size, (255 * 1024)); POSIX.XTI.Append (Option_List, Option); -- -- Set SND Buffer Size -- -- POSIX.XTI.Set_Level (Option, POSIX.XTI.XTI_Protocol_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.Send_Buffer_Size); -- POSIX.XTI.Set_Value (Option, (255 * 1024)); POSIX.XTI.Set_Option (Option, POSIX.XTI.XTI_Protocol_Level, POSIX.XTI.Send_Buffer_Size, (255 * 1024)); POSIX.XTI.Append (Option_List, Option); -- -- Set Linger Time -- -- POSIX.XTI.Set_Level (Option, POSIX.XTI.XTI_Protocol_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.Linger_On_Close_If_Data_Present); -- POSIX.XTI.Set_Status (Linger, POSIX.XTI.Linger_On); -- POSIX.XTI.Set_Period (Linger, 10); -- POSIX.XTI.Set_Value (Option, Linger); POSIX.XTI.Set_Option (Option, POSIX.XTI.XTI_Protocol_Level, POSIX.XTI.Linger_On_Close_If_Data_Present, Linger); POSIX.XTI.Append (Option_List, Option); Text_IO.Put_Line ("Added Options to Option_List, Calling Manage_Options"); POSIX.XTI.Manage_Options (Endpoint, Option_List, POSIX.XTI.Negotiate_Options, Option_List'access, Option_Result); Text_IO.Put ( "The Result of Manage Options (Set RCV & SND BUF and LINGER) was "); if (Option_Result = Success) then Text_IO.Put_Line ("Success"); elsif (Option_Result = Partial_Success) then Text_IO.Put_Line ("Partial Success"); elsif (Option_Result = Failure) then Text_IO.Put_Line ("Failure"); elsif (Option_Result = Read_Only) then Text_IO.Put_Line ("Read Only"); elsif (Option_Result = Not_Supported) then Text_IO.Put_Line ("Not Supported"); end if; -- -- Let's Test the Get_Current_Options portion of the Manage_Options -- and print that out using the iterator. -- POSIX.XTI.Make_Empty (Option_List); -- Get All Options -- POSIX.XTI.Set_Level (Option, POSIX.XTI.XTI_Protocol_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.All_Options); -- POSIX.XTI.Set_Value (Option, Unspecified); POSIX.XTI.Set_Option (Option, POSIX.XTI.XTI_Protocol_Level, POSIX.XTI.All_Options, Unspecified); POSIX.XTI.Append (Option_List, Option); begin POSIX.XTI.Manage_Options (Endpoint, Option_List, POSIX.XTI.Get_Current_Options, Option_List'access, Option_Result); Text_IO.Put ("The Result of Manage Options (Get_Current_Options) was "); if (Option_Result = Success) then Text_IO.Put_Line ("Success"); elsif (Option_Result = Partial_Success) then Text_IO.Put_Line ("Partial Success"); elsif (Option_Result = Failure) then Text_IO.Put_Line ("Failure"); elsif (Option_Result = Read_Only) then Text_IO.Put_Line ("Read Only"); elsif (Option_Result = Not_Supported) then Text_IO.Put_Line ("Not Supported"); end if; -- -- Let's get the number of options -- Text_IO.Put ("There are "); Int_IO.Put (POSIX.XTI.Number_Of_Options (Option_List), 2); Text_IO.Put_Line (" XTI Level Options, They are:"); -- -- Iterate the Option List -- For_Every_Item (Option_List); -- -- Check out Get_Option -- Text_IO.Put_Line ("Here are the Options again using Get_Option:"); for i in 1 .. POSIX.XTI.Number_Of_Options (Option_List) loop POSIX.XTI.Get_Option (Option_List, i, Option); Quit := False; Print_Option (Option, Quit); end loop; exception when others => Text_IO.Put_Line ("Got an error after Manage_Options"); end; -- -- Let's Test the Get_Current_Options for IP Level Options -- POSIX.XTI.Make_Empty (Option_List); -- Get All IP Options -- POSIX.XTI.Set_Level (Option, POSIX.XTI.Internet.IP_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.All_Options); -- POSIX.XTI.Set_Value (Option, Unspecified); POSIX.XTI.Set_Option (Option, POSIX.XTI.Internet.IP_Level, POSIX.XTI.All_Options, Unspecified); POSIX.XTI.Append (Option_List, Option); begin POSIX.XTI.Manage_Options (Endpoint, Option_List, POSIX.XTI.Get_Current_Options, Option_List'access, Option_Result); Text_IO.Put ("The Result of Manage Options (Get_Current_Options) was "); if (Option_Result = Success) then Text_IO.Put_Line ("Success"); elsif (Option_Result = Partial_Success) then Text_IO.Put_Line ("Partial Success"); elsif (Option_Result = Failure) then Text_IO.Put_Line ("Failure"); elsif (Option_Result = Read_Only) then Text_IO.Put_Line ("Read Only"); elsif (Option_Result = Not_Supported) then Text_IO.Put_Line ("Not Supported"); end if; -- -- Let's get the number of options -- Text_IO.Put ("There are "); Int_IO.Put (POSIX.XTI.Number_Of_Options (Option_List), 2); Text_IO.Put_Line (" IP Level Options, They are:"); -- -- Iterate the Option List -- For_Every_Item (Option_List); exception when others => raise; -- Text_IO.Put_Line ("Got an error after Manage_Options"); end; -- -- Let's Test the Get_Current_Options for TCP Level Options -- POSIX.XTI.Make_Empty (Option_List); -- Get All IP Options -- POSIX.XTI.Set_Level (Option, POSIX.XTI.Internet.TCP_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.All_Options); -- POSIX.XTI.Set_Value (Option, Unspecified); POSIX.XTI.Set_Option (Option, POSIX.XTI.Internet.TCP_Level, POSIX.XTI.All_Options, Unspecified); POSIX.XTI.Append (Option_List, Option); begin POSIX.XTI.Manage_Options (Endpoint, Option_List, POSIX.XTI.Get_Current_Options, Option_List'access, Option_Result); Text_IO.Put ("The Result of Manage Options (Get_Current_Options) was "); if (Option_Result = Success) then Text_IO.Put_Line ("Success"); elsif (Option_Result = Partial_Success) then Text_IO.Put_Line ("Partial Success"); elsif (Option_Result = Failure) then Text_IO.Put_Line ("Failure"); elsif (Option_Result = Read_Only) then Text_IO.Put_Line ("Read Only"); elsif (Option_Result = Not_Supported) then Text_IO.Put_Line ("Not Supported"); end if; -- -- Let's get the number of options -- Text_IO.Put ("There are "); Int_IO.Put (POSIX.XTI.Number_Of_Options (Option_List), 2); Text_IO.Put_Line (" TCP Level Options, They are:"); -- -- Iterate the Option List -- For_Every_Item (Option_List); exception when others => Text_IO.Put_Line ("Got an error after Manage_Options"); end; -- -- -- Set the data to a known pattern -- Test_Buffer.int := 1234; Test_Buffer.flt := 1234.1234; for i in Test_Buffer.arr'First .. Test_Buffer.arr'Last loop Test_Buffer.arr (i) := POSIX.Octet (i); end loop; -- -- Send data and wait for wrap back -- POSIX.XTI.Send (Endpoint, To_Buffer_Pointer (Test_Buffer'Access), POSIX.IO_Count (Test_Buffer'Size / POSIX.Octet'Size), Flags, Bytes); if (Integer (Bytes) = (Test_Buffer'Size / POSIX.Octet'Size)) then -- -- Wait for data to come back -- POSIX.XTI.Receive (Endpoint, To_Buffer_Pointer (Test_Buffer_Return'Access), POSIX.IO_Count (Test_Buffer_Return'Size / POSIX.Octet'Size), Bytes, Flags); else Text_IO.Put_Line ("Bad Send, didn't send all data"); end if; if (Integer (Bytes) = (Test_Buffer'Size / POSIX.Octet'Size)) then -- -- Check and make sure data is correct -- if not (Test_Buffer.int = Test_Buffer_Return.int) then Text_IO.Put_Line ("Data Integer is not the same as sent!!!"); end if; if not (Test_Buffer.flt = Test_Buffer_Return.flt) then Text_IO.Put_Line ("Data Float is not the same as sent!!!"); end if; for i in Test_Buffer_Return.arr'First .. Test_Buffer_Return.arr'Last loop if not (Integer (Test_Buffer.arr (i)) = Integer (Test_Buffer_Return.arr (i))) then Text_IO.Put ("Data is not the same as sent, was "); Int_IO.Put (Integer (Test_Buffer_Return.arr (i))); Text_IO.Put (", suppose to be "); Int_IO.Put (Integer (Test_Buffer.arr (i))); Text_IO.New_Line; exit; end if; if (i = Test_Buffer_Return.arr'Last) then Text_IO.Put_Line ("Data is good!!!!"); end if; end loop; end if; delay 2.0; Text_IO.Put_Line ("Starting Send Timing..."); Total := 0; Start_Time := Seconds (Clock); for i in 1 .. 100000 loop POSIX.XTI.Send (Endpoint, To_Buffer_Pointer (Buffer (Buffer'First)'Access), POSIX.IO_Count (Buffer'Last), Flags, Bytes); Total := POSIX.IO_Count (Integer (Total) + Integer (Bytes)); end loop; End_Time := Seconds (Clock); Text_IO.Put ("Sent "); Int_IO.Put (integer (Total)); Text_IO.Put (" bytes in "); Float_IO.Put (float (End_Time - Start_Time)); Text_IO.Put (" seconds"); Text_IO.New_Line; delay 2.0; Text_IO.Put_Line ("Sending Disconnect"); POSIX.XTI.Send_Disconnect_Request (Endpoint); POSIX.XTI.Close (Endpoint); Text_IO.Put_Line ("Performed Close"); exception when POSIX.POSIX_Error => if (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Disconnect_Request_Received) then Text_IO.Put_Line ("Endpoint Closed by Remote Node"); elsif (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Connect_Request_Received) then Text_IO.Put_Line ("Connect Request Received"); elsif (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Connect_Response_Received) then Text_IO.Put_Line ("Connect Response Received"); elsif (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Error_In_Previously_Sent_Datagram) then Text_IO.Put_Line ("Error in Previously Sent Datagram"); elsif (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Expedited_Data_Received) then Text_IO.Put_Line ("Expedited Data Received"); elsif (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Normal_Data_Received) then Text_IO.Put_Line ("Normal Data Received"); elsif (POSIX.XTI.Look (Endpoint) = POSIX.XTI.Orderly_Release_Request_Received) then Text_IO.Put_Line ("Orderly Release Request Received"); else Text_IO.Put_Line ("Some other event"); end if; end Test_TCP_Connect; libflorist-2025.1.0/tests/xti/test_tcp_listen.adb000066400000000000000000000315661473553204100217520ustar00rootroot00000000000000with POSIX; with POSIX.Files; with POSIX.IO; with POSIX.XTI; use POSIX.XTI; with POSIX.XTI.Internet; with Text_IO; with Ada_Streams; use Ada_Streams; procedure Test_TCP_Listen is type Test_Buffer_Type is record Item1 : integer; Item2 : float; Item3 : POSIX.Octet_Array (1 .. 4000); end record; Test_Buffer : aliased Test_Buffer_Type; function To_Buffer_Pointer is new POSIX.XTI.To_Buffer_Pointer (Test_Buffer_Type); function To_Buffer_Pointer is new POSIX.XTI.To_Buffer_Pointer (POSIX.Octet); Comm_Provider_Info : aliased POSIX.XTI.Communications_Provider_Information; Internet_Addr : aliased POSIX.XTI.Internet.Internet_XTI_Address; Response_Addr : aliased POSIX.XTI.Internet.Internet_XTI_Address; Connection_Addr : aliased POSIX.XTI.Internet.Internet_XTI_Address; Endpoint : POSIX.IO.File_Descriptor; Connected_Endpoint : POSIX.IO.File_Descriptor; Options : POSIX.IO.Open_Option_Set; Response_Qlen : integer; Response_INET_Addr : POSIX.XTI.Internet.Internet_Address; Connect_Info : aliased POSIX.XTI.Connection_Information; Buffer : POSIX.Octet_Array (1 .. 4000); Bytes : POSIX.IO_Count; Flags : POSIX.XTI.XTI_Flags; Total : POSIX.IO_Count; Option : POSIX.XTI.Protocol_Option; Option_List : aliased POSIX.XTI.Protocol_Option_List; Option_Buffer : POSIX.XTI.Octet_Buffer_Pointer := new POSIX.Octet_Array (1 .. 256); Option_Result : POSIX.XTI.Option_Status; package Int_IO is new Text_IO.Integer_IO (integer); use Int_IO; begin if (POSIX.Files.Is_Character_Special_File ("/dev/inet_cots")) then POSIX.XTI.Open (Endpoint, "/dev/inet_cots", POSIX.IO.Read_Write, Options); elsif (POSIX.Files.Is_Character_Special_File ("/dev/ticots")) then POSIX.XTI.Open (Endpoint, "/dev/ticots", POSIX.IO.Read_Write, Options); end if; Text_IO.Put_Line ("Opened endpoint"); -- -- Let's get some Info about the Communications Provider -- POSIX.XTI.Get_Information (Endpoint, Comm_Provider_Info'access); Text_IO.Put_Line ("Some Info on the Communications Provider:"); Text_IO.Put (" Protocol Addresses are "); if (POSIX.XTI.Protocol_Addresses_Are_Valid (Comm_Provider_Info) = True) then Text_IO.Put ("Valid, Max Size is "); Int_IO.Put (POSIX.XTI.Get_Max_Size_Protocol_Address (Comm_Provider_Info)); Text_IO.New_Line; else Text_IO.Put_Line ("NOT Valid"); end if; Text_IO.Put (" Protocol Options are "); if (POSIX.XTI.Protocol_Options_Are_Valid (Comm_Provider_Info) = True) then Text_IO.Put ("Valid, Max Size is "); Int_IO.Put (POSIX.XTI.Get_Max_Size_Protocol_Options (Comm_Provider_Info)); Text_IO.New_Line; else Text_IO.Put_Line ("NOT Valid"); end if; Text_IO.Put (" SDU is "); if (POSIX.XTI.SDU_Is_Supported (Comm_Provider_Info) = True) then Text_IO.Put ("Supported,"); if (POSIX.XTI.SDU_Is_Infinite (Comm_Provider_Info) = True) then Text_IO.Put (" Infinite,"); else Text_IO.Put (" NOT Infinite,"); end if; if (POSIX.XTI.SDU_Is_Valid (Comm_Provider_Info) = True) then Text_IO.Put (" Valid,"); else Text_IO.Put (" NOT Valid,"); end if; Text_IO.Put (" Max Size is "); Int_IO.Put (POSIX.XTI.Get_Max_Size_SDU (Comm_Provider_Info)); Text_IO.New_Line; else Text_IO.Put_Line ("NOT Supported"); end if; Text_IO.Put (" SEDU is "); if (POSIX.XTI.SEDU_Is_Supported (Comm_Provider_Info) = True) then Text_IO.Put ("Supported,"); if (POSIX.XTI.SEDU_Is_Infinite (Comm_Provider_Info) = True) then Text_IO.Put (" Infinite,"); else Text_IO.Put (" NOT Infinite,"); end if; if (POSIX.XTI.SEDU_Is_Valid (Comm_Provider_Info) = True) then Text_IO.Put (" Valid,"); else Text_IO.Put (" NOT Valid,"); end if; Text_IO.Put (" Max Size is "); Int_IO.Put (POSIX.XTI.Get_Max_Size_SEDU (Comm_Provider_Info)); Text_IO.New_Line; else Text_IO.Put_Line ("NOT Supported"); end if; Text_IO.Put (" Connect Data is "); if (POSIX.XTI.Connect_Data_Is_Valid (Comm_Provider_Info) = True) then Text_IO.Put_Line ("Valid, Max Size is "); Int_IO.Put (POSIX.XTI.Get_Max_Size_Connect_Data (Comm_Provider_Info)); else Text_IO.Put_Line ("NOT Valid"); end if; Text_IO.Put (" Disconnect Data is "); if (POSIX.XTI.Disconnect_Data_Is_Valid (Comm_Provider_Info) = True) then Text_IO.Put_Line ("Valid, Max Size is "); Int_IO.Put (POSIX.XTI.Get_Max_Size_Disconnect_Data (Comm_Provider_Info)); else Text_IO.Put_Line ("NOT Valid"); end if; Text_IO.Put (" Service Type is "); if (POSIX.XTI.Get_Service_Type (Comm_Provider_Info) = POSIX.XTI.Connection_Mode) then Text_IO.Put_Line ("Connection Mode"); elsif (POSIX.XTI.Get_Service_Type (Comm_Provider_Info) = POSIX.XTI.Connection_Mode_With_Orderly_Release) then Text_IO.Put_Line ("Connection Mode With Orderly Release"); elsif (POSIX.XTI.Get_Service_Type (Comm_Provider_Info) = POSIX.XTI.Connectionless_Mode) then Text_IO.Put_Line ("Connectionless Mode"); end if; -- -- Set up the Protocol Address -- POSIX.XTI.Internet.Set_Internet_Port (Internet_Addr, 16#FF00#); POSIX.XTI.Internet.Set_Internet_Address (Internet_Addr, POSIX.XTI.Internet.Unspecified_Internet_Address); Text_IO.Put_Line ("Set Port and Internet Address in Internet_XTI_Address"); -- -- Need to do this to set the netbuf parameters in the implementation -- Need to fix implemenation. -- POSIX.XTI.Internet.Set_Internet_Port (Response_Addr, 16#00#); POSIX.XTI.Bind (Endpoint, Internet_Addr, 5, Response_Addr'access, Response_Qlen); Text_IO.Put_Line ("Completed Bind"); Text_IO.Put (" Port: "); Int_IO.Put (integer (POSIX.XTI.Internet.Get_Internet_Port (Internet_Addr))); Text_IO.New_Line; Text_IO.Put (" Queue Length: "); Int_IO.Put (Response_Qlen); Text_IO.New_Line; Response_INET_Addr := POSIX.XTI.Internet.Get_Internet_Address (Response_Addr); Text_IO.Put (" Address: "); Text_IO.Put (POSIX.To_String ( (POSIX.XTI.Internet.Internet_Address_To_String (Response_INET_Addr)))); Text_IO.New_Line; POSIX.XTI.Set_Address (Connect_Info, Internet_Addr); POSIX.XTI.Listen (Endpoint, Connect_Info'access); Text_IO.Put ("Got a Connection Request from "); Response_INET_Addr := POSIX.XTI.Internet.Get_Internet_Address (Internet_Addr); Text_IO.Put (POSIX.To_String ( (POSIX.XTI.Internet.Internet_Address_To_String (Response_INET_Addr)))); Text_IO.Put_Line (", REJECTING"); -- -- Reject the first connect just to test Send_Disconnect_Request with -- Sequence_Number -- POSIX.XTI.Send_Disconnect_Request (Endpoint, POSIX.XTI.Get_Sequence_Number (Connect_Info)); Text_IO.Put_Line ("Doing some more Listening..."); -- -- Do some more Listening -- POSIX.XTI.Listen (Endpoint, Connect_Info'access); Text_IO.Put ("Got a Connection Request from "); Response_INET_Addr := POSIX.XTI.Internet.Get_Internet_Address (Internet_Addr); Text_IO.Put (POSIX.To_String ( (POSIX.XTI.Internet.Internet_Address_To_String (Response_INET_Addr)))); Text_IO.New_Line; POSIX.XTI.Open (Connected_Endpoint, "/dev/inet_cots", POSIX.IO.Read_Write, Options); Text_IO.Put_Line ("Opened Connection endpoint"); POSIX.XTI.Bind (Connected_Endpoint, Response_Addr'access); Text_IO.Put_Line ("Completed Bind on Connection endpoint"); POSIX.XTI.Internet.Set_Internet_Port (Connection_Addr, 16#FF00#); POSIX.XTI.Internet.Set_Internet_Address (Connection_Addr, POSIX.XTI.Internet.Unspecified_Internet_Address); POSIX.XTI.Set_Address (Connect_Info, Connection_Addr); POSIX.XTI.Accept_Connection (Endpoint, Connected_Endpoint, Connect_Info); Text_IO.Put_Line ("Accepted Connection"); -- -- Set options on Connected_Endpoint -- POSIX.XTI.Set_Buffer (Option_List, Option_Buffer); -- POSIX.XTI.Set_Option_Buffer_Maximum_Length (Option_Buffer'Last, -- Option_List); -- -- Set RCV Buffer Size -- -- POSIX.XTI.Set_Level (Option, POSIX.XTI.XTI_Protocol_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.Receive_Buffer_Size); -- POSIX.XTI.Set_Value (Option, (255 * 1024)); POSIX.XTI.Set_Option (Option, POSIX.XTI.XTI_Protocol_Level, POSIX.XTI.Receive_Buffer_Size, (255 * 1024)); POSIX.XTI.Append (Option_List, Option); -- -- Set SND Buffer Size -- -- POSIX.XTI.Set_Level (Option, POSIX.XTI.XTI_Protocol_Level); -- POSIX.XTI.Set_Name (Option, POSIX.XTI.Send_Buffer_Size); -- POSIX.XTI.Set_Value (Option, (255 * 1024)); POSIX.XTI.Set_Option (Option, POSIX.XTI.XTI_Protocol_Level, POSIX.XTI.Send_Buffer_Size, (255 * 1024)); POSIX.XTI.Append (Option_List, Option); Text_IO.Put_Line ("Added Options to Option_List, Calling Manage_Options"); POSIX.XTI.Manage_Options (Connected_Endpoint, Option_List, POSIX.XTI.Negotiate_Options, Option_List'access, Option_Result); Text_IO.Put ("The Result of Manage Options (Set SND & RCV buf) was "); if (Option_Result = Success) then Text_IO.Put_Line ("Success"); elsif (Option_Result = Partial_Success) then Text_IO.Put_Line ("Partial Success"); elsif (Option_Result = Failure) then Text_IO.Put_Line ("Failure"); elsif (Option_Result = Read_Only) then Text_IO.Put_Line ("Read Only"); elsif (Option_Result = Not_Supported) then Text_IO.Put_Line ("Not Supported"); end if; -- -- Test wrap message first -- POSIX.XTI.Receive (Connected_Endpoint, To_Buffer_Pointer (Test_Buffer'Access), POSIX.IO_Count (Test_Buffer'Size / POSIX.Octet'Size), Bytes, Flags); -- Send it back POSIX.XTI.Send (Connected_Endpoint, To_Buffer_Pointer (Test_Buffer'Access), Bytes, Flags, Bytes); Text_IO.Put_Line ("Wrapped Message, Doing Receive..."); Total := 0; loop POSIX.XTI.Receive (Connected_Endpoint, To_Buffer_Pointer (Buffer (Buffer'First)'Access), POSIX.IO_Count (Buffer'Last), Bytes, Flags); Total := POSIX.IO_Count (Integer (Total) + Integer (Bytes)); end loop; Text_IO.Put ("Received "); Int_IO.Put (integer (Total)); Text_IO.Put (" bytes"); Text_IO.New_Line; delay 2.0; POSIX.XTI.Close (Connected_Endpoint); POSIX.XTI.Close (Endpoint); Text_IO.Put_Line ("Performed Close"); exception when POSIX.POSIX_Error => if (POSIX.XTI.Look (Connected_Endpoint) = POSIX.XTI.Disconnect_Request_Received) then Text_IO.Put_Line ("Endpoint Closed by Remote Node"); elsif (POSIX.XTI.Look (Connected_Endpoint) = POSIX.XTI.Connect_Request_Received) then Text_IO.Put_Line ("Connect Request Received"); elsif (POSIX.XTI.Look (Connected_Endpoint) = POSIX.XTI.Connect_Response_Received) then Text_IO.Put_Line ("Connect Response Received"); elsif (POSIX.XTI.Look (Connected_Endpoint) = POSIX.XTI.Error_In_Previously_Sent_Datagram) then Text_IO.Put_Line ("Error in Previously Sent Datagram"); elsif (POSIX.XTI.Look (Connected_Endpoint) = POSIX.XTI.Expedited_Data_Received) then Text_IO.Put_Line ("Expedited Data Received"); elsif (POSIX.XTI.Look (Connected_Endpoint) = POSIX.XTI.Normal_Data_Received) then Text_IO.Put_Line ("Normal Data Received"); elsif (POSIX.XTI.Look (Connected_Endpoint) = POSIX.XTI.Orderly_Release_Request_Received) then Text_IO.Put_Line ("Orderly Release Request Received"); else Text_IO.Put_Line ("Some other event"); end if; Text_IO.Put ("Received "); Int_IO.Put (integer (Total)); Text_IO.Put (" bytes"); Text_IO.New_Line; POSIX.XTI.Close (Connected_Endpoint); POSIX.XTI.Close (Endpoint); end Test_TCP_Listen;