[svn:parrot] r46259 - in trunk: . examples/pir examples/tutorial runtime/parrot/library/ProfTest src/dynpmc src/pmc t/dynpmc t/oo t/pmc tools/dev tools/util
coke at svn.parrot.org
coke at svn.parrot.org
Tue May 4 00:27:03 UTC 2010
Author: coke
Date: Tue May 4 00:27:02 2010
New Revision: 46259
URL: https://trac.parrot.org/parrot/changeset/46259
Log:
Migrate File and OS PMCs to dynamic PMCs.
Resolves TT #448.
Added:
trunk/src/dynpmc/file.pmc
- copied, changed from r46243, trunk/src/pmc/file.pmc
trunk/src/dynpmc/os.pmc
- copied, changed from r46243, trunk/src/pmc/os.pmc
trunk/t/dynpmc/file.t
- copied, changed from r46243, trunk/t/pmc/file.t
trunk/t/dynpmc/os.t
- copied, changed from r46243, trunk/t/pmc/os.t
Deleted:
trunk/src/pmc/file.pmc
trunk/src/pmc/os.pmc
trunk/t/pmc/file.t
trunk/t/pmc/os.t
Modified:
trunk/DEPRECATED.pod
trunk/MANIFEST
trunk/PBC_COMPAT
trunk/examples/pir/io.pir
trunk/examples/tutorial/40_file_ops.pir
trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp
trunk/src/dynpmc/Defines.in
trunk/src/dynpmc/Rules.in
trunk/src/pmc/pmc.num
trunk/t/oo/methods.t
trunk/t/pmc/eval.t
trunk/tools/dev/pbc_to_exe.pir
trunk/tools/util/pgegrep
Modified: trunk/DEPRECATED.pod
==============================================================================
--- trunk/DEPRECATED.pod Mon May 3 23:18:58 2010 (r46258)
+++ trunk/DEPRECATED.pod Tue May 4 00:27:02 2010 (r46259)
@@ -45,18 +45,6 @@
L<https://trac.parrot.org/parrot/ticket/1599>
-=item File [eligible in 1.1]
-
-Move from static PMC to dynamic PMC
-
-L<https://trac.parrot.org/parrot/ticket/448>
-
-=item OS [eligible in 1.1]
-
-Move from static PMC to dynamic PMC
-
-L<https://trac.parrot.org/parrot/ticket/448>
-
=item multiple dispatch within core PMCs [eligible in 1.1]
L<https://trac.parrot.org/parrot/ticket/452>
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Mon May 3 23:18:58 2010 (r46258)
+++ trunk/MANIFEST Tue May 4 00:27:02 2010 (r46259)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Mon May 3 05:14:11 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon May 3 20:01:25 2010 UT
#
# See below for documentation on the format of this file.
#
@@ -1238,10 +1238,12 @@
src/dynpmc/Rules.in []
src/dynpmc/dynlexpad.pmc []
src/dynpmc/ext.pir []
+src/dynpmc/file.pmc []
src/dynpmc/foo.pmc []
src/dynpmc/foo2.pmc []
src/dynpmc/gziphandle.pmc []
src/dynpmc/main.pasm []
+src/dynpmc/os.pmc []
src/dynpmc/pccmethod_test.pmc []
src/dynpmc/rational.pmc []
src/dynpmc/rotest.pmc []
@@ -1338,7 +1340,6 @@
src/pmc/exception.pmc []
src/pmc/exceptionhandler.pmc []
src/pmc/exporter.pmc []
-src/pmc/file.pmc []
src/pmc/filehandle.pmc []
src/pmc/fixedbooleanarray.pmc []
src/pmc/fixedfloatarray.pmc []
@@ -1368,7 +1369,6 @@
src/pmc/oplib.pmc []
src/pmc/orderedhash.pmc []
src/pmc/orderedhashiterator.pmc []
-src/pmc/os.pmc []
src/pmc/packfile.pmc []
src/pmc/packfileannotation.pmc []
src/pmc/packfileannotations.pmc []
@@ -1616,9 +1616,11 @@
t/dynoplibs/math.t [test]
t/dynoplibs/obscure.t [test]
t/dynpmc/dynlexpad.t [test]
+t/dynpmc/file.t [test]
t/dynpmc/foo.t [test]
t/dynpmc/foo2.t [test]
t/dynpmc/gziphandle.t [test]
+t/dynpmc/os.t [test]
t/dynpmc/pccmethod_test.t [test]
t/dynpmc/rational.t [test]
t/dynpmc/rotest.t [test]
@@ -1809,7 +1811,6 @@
t/pmc/exception.t [test]
t/pmc/exceptionhandler.t [test]
t/pmc/exporter.t [test]
-t/pmc/file.t [test]
t/pmc/filehandle.t [test]
t/pmc/fixedbooleanarray.t [test]
t/pmc/fixedfloatarray.t [test]
@@ -1850,7 +1851,6 @@
t/pmc/oplib.t [test]
t/pmc/orderedhash.t [test]
t/pmc/orderedhashiterator.t [test]
-t/pmc/os.t [test]
t/pmc/packfile.t [test]
t/pmc/packfileannotation.t [test]
t/pmc/packfileannotations.t [test]
Modified: trunk/PBC_COMPAT
==============================================================================
--- trunk/PBC_COMPAT Mon May 3 23:18:58 2010 (r46258)
+++ trunk/PBC_COMPAT Tue May 4 00:27:02 2010 (r46259)
@@ -27,6 +27,7 @@
# please insert tab separated entries at the top of the list
+6.13 2010.05.03 coke move File/OS pmcs to src/dynpmc
6.12 2010.05.02 plobsing store constant PMC strings as top level constant strings
6.11 2010.04.29 tewk remove ParrotRunningThread
6.10 2010.04.29 NotFound packfiledebug.pmc
Modified: trunk/examples/pir/io.pir
==============================================================================
--- trunk/examples/pir/io.pir Mon May 3 23:18:58 2010 (r46258)
+++ trunk/examples/pir/io.pir Tue May 4 00:27:02 2010 (r46259)
@@ -37,6 +37,7 @@
print $S0
# now clean up after ourselves.
+ $P0 = loadlib 'os'
$P1 = new "OS"
$P1."rm"(test_fn)
Modified: trunk/examples/tutorial/40_file_ops.pir
==============================================================================
--- trunk/examples/tutorial/40_file_ops.pir Mon May 3 23:18:58 2010 (r46258)
+++ trunk/examples/tutorial/40_file_ops.pir Tue May 4 00:27:02 2010 (r46259)
@@ -20,6 +20,7 @@
close filein
# Be nice and remove the temporary file we created.
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$P1.'rm'('40_file_ops_data.txt')
.end
Modified: trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp
==============================================================================
--- trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp Mon May 3 23:18:58 2010 (r46258)
+++ trunk/runtime/parrot/library/ProfTest/PIRProfile.nqp Tue May 4 00:27:02 2010 (r46259)
@@ -92,6 +92,7 @@
my $pprof_fh := pir::new__p_sc('FileHandle');
self<profile> := $pprof_fh.readall($tmp_pprof);
+ pir::loadlib__ps('os');
pir::new__p_sc('OS').rm($tmp_pir);
pir::new__p_sc('OS').rm($tmp_pprof);
}
Modified: trunk/src/dynpmc/Defines.in
==============================================================================
--- trunk/src/dynpmc/Defines.in Mon May 3 23:18:58 2010 (r46258)
+++ trunk/src/dynpmc/Defines.in Tue May 4 00:27:02 2010 (r46259)
@@ -4,7 +4,9 @@
DYNPMC_TARGETS = \
#IF(has_zlib): $(DYNEXT_DIR)/gziphandle$(LOAD_EXT) \
$(DYNEXT_DIR)/dynlexpad$(LOAD_EXT) \
+ $(DYNEXT_DIR)/file$(LOAD_EXT) \
$(DYNEXT_DIR)/foo_group$(LOAD_EXT) \
+ $(DYNEXT_DIR)/os$(LOAD_EXT) \
$(DYNEXT_DIR)/pccmethod_test$(LOAD_EXT) \
$(DYNEXT_DIR)/rotest$(LOAD_EXT) \
$(DYNEXT_DIR)/rational$(LOAD_EXT) \
Modified: trunk/src/dynpmc/Rules.in
==============================================================================
--- trunk/src/dynpmc/Rules.in Mon May 3 23:18:58 2010 (r46258)
+++ trunk/src/dynpmc/Rules.in Tue May 4 00:27:02 2010 (r46259)
@@ -14,6 +14,23 @@
src/dynpmc/dynlexpad.dump: src/dynpmc/dynlexpad.pmc vtable.dump $(CLASS_O_FILES)
$(PMC2CD) src/dynpmc/dynlexpad.pmc
+
+
+$(DYNEXT_DIR)/file$(LOAD_EXT): src/dynpmc/file$(O)
+ $(LD) @ld_out@$(DYNEXT_DIR)/file$(LOAD_EXT) src/dynpmc/file$(O) $(LINKARGS)
+#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
+#IF(cygwin or hpux): $(CHMOD) 0775 $@
+
+src/dynpmc/file$(O): src/dynpmc/file.c $(DYNPMC_H_FILES)
+
+src/dynpmc/file.c: src/dynpmc/file.dump
+ $(PMC2CC) src/dynpmc/file.pmc
+
+src/dynpmc/file.dump: src/dynpmc/file.pmc vtable.dump $(CLASS_O_FILES)
+ $(PMC2CD) src/dynpmc/file.pmc
+
+
+
$(DYNEXT_DIR)/foo_group$(LOAD_EXT): $(DYNPMC_FOO_OBJS) src/dynpmc/foo_group$(O)
$(LD) @ld_out@$(DYNEXT_DIR)/foo_group$(LOAD_EXT) src/dynpmc/foo_group$(O) $(DYNPMC_FOO_OBJS) $(LINKARGS)
#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
@@ -42,6 +59,38 @@
src/dynpmc/foo2.dump: src/dynpmc/foo2.pmc src/dynpmc/foo.dump vtable.dump $(CLASS_O_FILES)
$(PMC2CD) src/dynpmc/foo2.pmc
+
+
+$(DYNEXT_DIR)/gziphandle$(LOAD_EXT): src/dynpmc/gziphandle$(O)
+ $(LD) @ld_out@$(DYNEXT_DIR)/gziphandle$(LOAD_EXT) src/dynpmc/gziphandle$(O) $(LINKARGS) $(LIB_ZLIB)
+#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
+#IF(cygwin or hpux): $(CHMOD) 0775 $@
+
+src/dynpmc/gziphandle$(O): src/dynpmc/gziphandle.c $(DYNPMC_H_FILES)
+
+src/dynpmc/gziphandle.c: src/dynpmc/gziphandle.dump
+ $(PMC2CC) src/dynpmc/gziphandle.pmc
+
+src/dynpmc/gziphandle.dump: src/dynpmc/gziphandle.pmc vtable.dump $(CLASS_O_FILES)
+ $(PMC2CD) src/dynpmc/gziphandle.pmc
+
+
+
+$(DYNEXT_DIR)/os$(LOAD_EXT): src/dynpmc/os$(O)
+ $(LD) @ld_out@$(DYNEXT_DIR)/os$(LOAD_EXT) src/dynpmc/os$(O) $(LINKARGS)
+#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
+#IF(cygwin or hpux): $(CHMOD) 0775 $@
+
+src/dynpmc/os$(O): src/dynpmc/os.c $(DYNPMC_H_FILES)
+
+src/dynpmc/os.c: src/dynpmc/os.dump
+ $(PMC2CC) src/dynpmc/os.pmc
+
+src/dynpmc/os.dump: src/dynpmc/os.pmc vtable.dump $(CLASS_O_FILES)
+ $(PMC2CD) src/dynpmc/os.pmc
+
+
+
$(DYNEXT_DIR)/pccmethod_test$(LOAD_EXT): src/dynpmc/pccmethod_test$(O)
$(LD) @ld_out@$(DYNEXT_DIR)/pccmethod_test$(LOAD_EXT) src/dynpmc/pccmethod_test$(O) $(LINKARGS)
#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
@@ -54,6 +103,8 @@
src/dynpmc/pccmethod_test.dump: src/dynpmc/pccmethod_test.pmc vtable.dump $(CLASS_O_FILES)
$(PMC2CD) src/dynpmc/pccmethod_test.pmc
+
+
$(DYNEXT_DIR)/rotest$(LOAD_EXT): src/dynpmc/rotest$(O)
$(LD) @ld_out@$(DYNEXT_DIR)/rotest$(LOAD_EXT) src/dynpmc/rotest$(O) $(LINKARGS)
#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
@@ -67,6 +118,8 @@
src/dynpmc/rotest.dump: src/dynpmc/rotest.pmc vtable.dump $(CLASS_O_FILES)
$(PMC2CD) src/dynpmc/rotest.pmc
+
+
$(DYNEXT_DIR)/rational$(LOAD_EXT): src/dynpmc/rational$(O)
$(LD) @ld_out@$(DYNEXT_DIR)/rational$(LOAD_EXT) src/dynpmc/rational$(O) $(LINKARGS)
#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
@@ -80,6 +133,8 @@
src/dynpmc/rational.dump: src/dynpmc/rational.pmc vtable.dump $(CLASS_O_FILES)
$(PMC2CD) src/dynpmc/rational.pmc
+
+
$(DYNEXT_DIR)/subproxy$(LOAD_EXT): src/dynpmc/subproxy$(O)
$(LD) @ld_out@$(DYNEXT_DIR)/subproxy$(LOAD_EXT) src/dynpmc/subproxy$(O) $(LINKARGS)
#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
@@ -92,17 +147,3 @@
src/dynpmc/subproxy.dump: src/dynpmc/subproxy.pmc vtable.dump $(CLASS_O_FILES)
$(PMC2CD) src/dynpmc/subproxy.pmc
-
-$(DYNEXT_DIR)/gziphandle$(LOAD_EXT): src/dynpmc/gziphandle$(O)
- $(LD) @ld_out@$(DYNEXT_DIR)/gziphandle$(LOAD_EXT) src/dynpmc/gziphandle$(O) $(LINKARGS) $(LIB_ZLIB)
-#IF(win32): if exist $@.manifest mt.exe -nologo -manifest $@.manifest -outputresource:$@;2
-#IF(cygwin or hpux): $(CHMOD) 0775 $@
-
-src/dynpmc/gziphandle$(O): src/dynpmc/gziphandle.c $(DYNPMC_H_FILES)
-
-src/dynpmc/gziphandle.c: src/dynpmc/gziphandle.dump
- $(PMC2CC) src/dynpmc/gziphandle.pmc
-
-src/dynpmc/gziphandle.dump: src/dynpmc/gziphandle.pmc vtable.dump $(CLASS_O_FILES)
- $(PMC2CD) src/dynpmc/gziphandle.pmc
-
Copied and modified: trunk/src/dynpmc/file.pmc (from r46243, trunk/src/pmc/file.pmc)
==============================================================================
--- trunk/src/pmc/file.pmc Mon May 3 17:53:28 2010 (r46243, copy source)
+++ trunk/src/dynpmc/file.pmc Tue May 4 00:27:02 2010 (r46259)
@@ -29,7 +29,7 @@
/* TT #1050 apparently, strerror_r is thread-safe and should be used instead.*/
static PMC *File_PMC;
-pmclass File singleton {
+pmclass File dynpmc singleton {
/*
Copied and modified: trunk/src/dynpmc/os.pmc (from r46243, trunk/src/pmc/os.pmc)
==============================================================================
--- trunk/src/pmc/os.pmc Mon May 3 17:53:28 2010 (r46243, copy source)
+++ trunk/src/dynpmc/os.pmc Tue May 4 00:27:02 2010 (r46259)
@@ -39,7 +39,7 @@
/* HEADERIZER END: static */
static PMC *OS_PMC;
-pmclass OS singleton {
+pmclass OS dynpmc singleton {
/*
Deleted: trunk/src/pmc/file.pmc
==============================================================================
--- trunk/src/pmc/file.pmc Tue May 4 00:27:02 2010 (r46258)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,287 +0,0 @@
-/*
-Copyright (C) 2001-2010, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/pmc/file.pmc - File PMC
-
-=head1 DESCRIPTION
-
-C<File> is a singleton class which provides access to File functions.
-
-=head2 Methods
-
-=over 4
-
-=cut
-
-*/
-
-#ifdef WIN32
-# include <direct.h>
-#endif
-
-/* HEADERIZER HFILE: none */
-/* HEADERIZER BEGIN: static */
-/* HEADERIZER END: static */
-
-/* TT #1050 apparently, strerror_r is thread-safe and should be used instead.*/
-
-static PMC *File_PMC;
-pmclass File singleton {
-
-/*
-
-=item C<void *get_pointer()>
-
-=item C<void set_pointer(void *ptr)>
-
-These two functions are part of the singleton creation interface. For more
-information see F<src/pmc.c>.
-
-=cut
-
-*/
- void class_init() {
- File_PMC = NULL;
- }
-
- VTABLE void *get_pointer() {
- return File_PMC;
- }
-
- VTABLE void set_pointer(void *ptr) {
- File_PMC = (PMC *)ptr;
- }
-
-/*
-
-=item C<INTVAL exists(STRING *file)>
-
-Returns a true value (1) if the supplied file or directory exists.
-
-=cut
-
-*/
-
- METHOD exists(STRING *path) {
- struct stat info;
- char * const cpath = Parrot_str_to_cstring(interp, path);
-#ifdef WIN32
- const int error = stat(cpath, &info);
-#else
- const int error = lstat(cpath, &info);
-#endif
- Parrot_str_free_cstring(cpath);
-
- if (error)
- RETURN(INTVAL 0);
-
- RETURN(INTVAL 1);
- }
-
-/*
-
-=item C<INTVAL is_dir(STRING *path)>
-
-Returns a true value (1) if the supplied path is a directory.
-
-=cut
-
-*/
-
- METHOD is_dir(STRING *path) {
- struct stat info;
- char * const cpath = Parrot_str_to_cstring(interp, path);
-#ifdef WIN32
- const int error = stat(cpath, &info);
-#else
- const int error = lstat(cpath, &info);
-#endif
- Parrot_str_free_cstring(cpath);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-
- if (S_ISDIR(info.st_mode))
- RETURN(INTVAL 1);
- else
- RETURN(INTVAL 0);
- }
-
-/*
-
-=item C<INTVAL is_file(STRING *path)>
-
-Returns a true value (1) if the supplied path is a plain file.
-
-=cut
-
-*/
-
- METHOD is_file(STRING *path) {
- struct stat info;
- char * const cpath = Parrot_str_to_cstring(interp, path);
-#ifdef WIN32
- int error = stat(cpath, &info);
-#else
- int error = lstat(cpath, &info);
-#endif
- Parrot_str_free_cstring(cpath);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-
- if (S_ISREG(info.st_mode))
- RETURN(INTVAL 1);
- else
- RETURN(INTVAL 0);
- }
-
-/*
-
-=item C<INTVAL is_link(STRING *path)>
-
-Returns a true value (1) if the supplied path is a link.
-
-=cut
-
-*/
-
- METHOD is_link(STRING *path) {
-#ifdef WIN32
- /* I love win32 implementations */
- RETURN(INTVAL 0);
-#else
- struct stat info;
-
- char * const cpath = Parrot_str_to_cstring(interp, path);
- const int error = lstat(cpath, &info);
-
- Parrot_str_free_cstring(cpath);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-
- if (S_ISLNK(info.st_mode))
- RETURN(INTVAL 1);
- else
- RETURN(INTVAL 0);
-#endif
- }
-
-/*
-
-=item C<void copy(STRING *from, STRING *to)>
-
-Copy the contents from file represented by path C<from> to the path
-C<to>.
-
-Uses the "work everywhere method". It is good enough to start with.
-
-NOTE: I'm sure that there should be more efficient ways to do this. Be
-free to change or give me hints on how to change it. -- ambs
-
-=cut
-
-*/
-
- METHOD copy(STRING *from, STRING *to) {
-#define CHUNK_SIZE 1024
-
- char * const cfrom = Parrot_str_to_cstring(interp, from);
- FILE * const source = fopen(cfrom, "rb");
-
- Parrot_str_free_cstring(cfrom);
-
- if (source) {
- char * const cto = Parrot_str_to_cstring(interp, to);
- FILE * const target = fopen(cto, "w+b");
-
- Parrot_str_free_cstring(cto);
-
- if (target) {
- while (!feof(source)) {
- char buf[CHUNK_SIZE];
- const size_t bytes_read = fread(buf, 1, CHUNK_SIZE, source);
-
- if (bytes_read) {
- const size_t bytes_written = fwrite(buf, 1, bytes_read, target);
- if (bytes_read != bytes_written) {
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_EXTERNAL_ERROR, "Error writing file");
- break;
- }
- }
- }
- fclose(target);
- }
- else {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- fclose(source);
- }
- else {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-#undef CHUNK_SIZE
- }
-
-/*
-
-=item C<void rename(STRING *from, STRING *to)>
-
-Rename a file C<from> to the path C<to>.
-
-=cut
-
-*/
-
- METHOD rename(STRING *from, STRING *to) {
- char * const cfrom = Parrot_str_to_cstring(interp, from);
- char * const cto = Parrot_str_to_cstring(interp, to);
- const int error = rename(cfrom, cto);
-
- Parrot_str_free_cstring(cfrom);
- Parrot_str_free_cstring(cto);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- }
-}
-
-/*
-
-=back
-
-=head1 SEE ALS0
-
- stat(2), rename(2)
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/pmc/os.pmc
==============================================================================
--- trunk/src/pmc/os.pmc Tue May 4 00:27:02 2010 (r46258)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,612 +0,0 @@
-/*
-Copyright (C) 2001-2010, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/pmc/os.pmc - Files and Directories PMC
-
-=head1 DESCRIPTION
-
-C<OS> is a singleton class which provides access to the filesystem
-files and directories.
-
-=head2 Methods
-
-=over 4
-
-=cut
-
-*/
-
-#if defined(_MSC_VER)
-# include <direct.h>
-# include <io.h>
-# include <tchar.h>
-# include <windows.h>
-#elif defined(__BORLANDC__)
-# include <dir.h>
-# include <dirent.h>
-#else
-# include <dirent.h>
-#endif
-
-/* XXX Check if we need to deallocate strerror strings */
-/* XXX apparently, strerror_r is thread-safe and should be used instead.*/
-
-/* HEADERIZER HFILE: none */
-/* HEADERIZER BEGIN: static */
-/* HEADERIZER END: static */
-
-static PMC *OS_PMC;
-pmclass OS singleton {
-
-/*
-
-=item C<void *get_pointer()>
-
-=item C<void set_pointer(void *ptr)>
-
-These two functions are part of the singleton creation interface. For more
-information see F<src/pmc.c>.
-
-=cut
-
-*/
-
- void class_init() {
- OS_PMC = NULL;
- }
-
- VTABLE void *get_pointer() {
- return OS_PMC;
- }
-
- VTABLE void set_pointer(void *ptr) {
- OS_PMC = (PMC *)ptr;
- }
-
-
-/*
-
-=item C<STRING *cwd()>
-
-Returns the current working directory.
-
-=cut
-
-*/
-
- METHOD cwd() {
- char *cwd;
-#ifdef _MSC_VER
- cwd = _getcwd(NULL, 0);
- /* capitalize the drive letter */
- cwd[0] = (char)toupper((unsigned char)cwd[0]);
-#else
-# ifdef PATH_MAX
- cwd = getcwd(NULL, PATH_MAX+1);
-# else
- cwd = getcwd(NULL, 0);
-# endif
-#endif
- if (cwd) {
- STRING * const scwd = Parrot_str_new(INTERP, cwd, strlen(cwd));
- free(cwd);
- RETURN(STRING *scwd);
- }
- else {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- }
-
-/*
-
-=item C<void chdir(STRING *path)>
-
-Changes the current working directory to the one specified by C<path>.
-
-=cut
-
-*/
-
- METHOD chdir(STRING *path) {
- int error;
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
-#ifdef _MSC_VER
- error = _chdir(cpath);
-#else
- error = chdir(cpath);
-#endif
- Parrot_str_free_cstring(cpath);
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- }
-
-/*
-
-=item C<void rm(STRING *path)>
-
-Calls C<remove> to remove the file or empty directory specified by
-C<path>.
-
-=cut
-
-*/
-
- METHOD rm(STRING *path) {
- struct stat info;
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
- int error = stat(cpath, &info);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_str_free_cstring(cpath);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-
- if (S_ISDIR(info.st_mode)) {
-#ifdef _MSC_VER
- error = _rmdir(cpath);
-#else
- error = rmdir(cpath);
-#endif
- Parrot_str_free_cstring(cpath);
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- }
- else {
- error = remove(cpath);
- Parrot_str_free_cstring(cpath);
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- }
- }
-
-/*
-
-=item C<void mkdir(STRING *path, STRING *mode)>
-
-Creates a directory specified by C<path> with mode C<mode>.
-
-=cut
-
-*/
-
- METHOD mkdir(STRING *path, INTVAL mode) {
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
- /* should we validate mode? */
-#ifdef WIN32
- const int error = _mkdir(cpath);
-#else
- const int error = mkdir(cpath, (mode_t)mode);
-#endif
- Parrot_str_free_cstring(cpath);
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- }
-
-/*
-
-=item C<fixedpmcarray *stat(STRING *path)>
-
-Stats a file, and returns a 13 position array as in Perl:
-
- 0 dev device number of filesystem
- 1 ino inode number
- 2 mode file mode (type and permissions)
- 3 nlink number of (hard) links to the file
- 4 uid numeric user ID of file's owner
- 5 gid numeric group ID of file's owner
- 6 rdev the device identifier (special files only)
- 7 size total size of file, in bytes
- 8 atime last access time in seconds since the epoch
- 9 mtime last modify time in seconds since the epoch
- 10 ctime inode change time in seconds since the epoch (*)
- 11 blksize preferred block size for file system I/O
- 12 blocks actual number of blocks allocated
-
-11 and 12 are not available under Windows.
-
-=cut
-
-TT #849: Provide a mechanism for setting 'mtime' and 'atime':
-https://trac.parrot.org/parrot/ticket/849
-
-*/
-
- METHOD stat(STRING *path) {
- struct stat info;
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
- const int error = stat(cpath, &info);
-
- Parrot_str_free_cstring(cpath);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- else {
- PMC * const array = Parrot_pmc_new(INTERP, enum_class_FixedPMCArray);
- VTABLE_set_integer_native(INTERP, array, 13);
-
- VTABLE_set_integer_keyed_int(INTERP, array, 0,
- (INTVAL)info.st_dev);
- VTABLE_set_integer_keyed_int(INTERP, array, 1,
- (INTVAL)info.st_ino);
- VTABLE_set_integer_keyed_int(INTERP, array, 2,
- (INTVAL)info.st_mode);
- VTABLE_set_integer_keyed_int(INTERP, array, 3,
- (INTVAL)info.st_nlink);
- VTABLE_set_integer_keyed_int(INTERP, array, 4,
- (INTVAL)info.st_uid);
- VTABLE_set_integer_keyed_int(INTERP, array, 5,
- (INTVAL)info.st_gid);
- VTABLE_set_integer_keyed_int(INTERP, array, 6,
- (INTVAL)info.st_rdev);
- VTABLE_set_integer_keyed_int(INTERP, array, 7,
- (INTVAL)info.st_size);
- VTABLE_set_integer_keyed_int(INTERP, array, 8,
- (INTVAL)info.st_atime);
- VTABLE_set_integer_keyed_int(INTERP, array, 9,
- (INTVAL)info.st_mtime);
- VTABLE_set_integer_keyed_int(INTERP, array, 10,
- (INTVAL)info.st_ctime);
-#ifndef WIN32
- VTABLE_set_integer_keyed_int(INTERP, array, 11,
- (INTVAL)info.st_blksize);
- VTABLE_set_integer_keyed_int(INTERP, array, 12,
- (INTVAL)info.st_blocks);
-#endif
- RETURN(PMC *array);
- }
- }
-
-/*
-
-=item C<fixedpmcarray *lstat(STRING *path)>
-
-Stats a file, and returns a 13 position array as in Perl:
-
- 0 dev device number of filesystem
- 1 ino inode number
- 2 mode file mode (type and permissions)
- 3 nlink number of (hard) links to the file
- 4 uid numeric user ID of file's owner
- 5 gid numeric group ID of file's owner
- 6 rdev the device identifier (special files only)
- 7 size total size of file, in bytes
- 8 atime last access time in seconds since the epoch
- 9 mtime last modify time in seconds since the epoch
- 10 ctime inode change time in seconds since the epoch (*)
- 11 blksize preferred block size for file system I/O
- 12 blocks actual number of blocks allocated
-
-11 and 12 are not available under Windows.
-
-=cut
-
-*/
-
- METHOD lstat(STRING *path) {
- struct stat info;
-
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
-#ifdef WIN32
- const int error = stat(cpath, &info);
-#else
- const int error = lstat(cpath, &info);
-#endif
- Parrot_str_free_cstring(cpath);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- else {
- PMC * const array = Parrot_pmc_new(INTERP, enum_class_FixedPMCArray);
- VTABLE_set_integer_native(INTERP, array, 13);
-
- VTABLE_set_integer_keyed_int(INTERP, array, 0,
- (INTVAL)info.st_dev);
- VTABLE_set_integer_keyed_int(INTERP, array, 1,
- (INTVAL)info.st_ino);
- VTABLE_set_integer_keyed_int(INTERP, array, 2,
- (INTVAL)info.st_mode);
- VTABLE_set_integer_keyed_int(INTERP, array, 3,
- (INTVAL)info.st_nlink);
- VTABLE_set_integer_keyed_int(INTERP, array, 4,
- (INTVAL)info.st_uid);
- VTABLE_set_integer_keyed_int(INTERP, array, 5,
- (INTVAL)info.st_gid);
- VTABLE_set_integer_keyed_int(INTERP, array, 6,
- (INTVAL)info.st_rdev);
- VTABLE_set_integer_keyed_int(INTERP, array, 7,
- (INTVAL)info.st_size);
- VTABLE_set_integer_keyed_int(INTERP, array, 8,
- (INTVAL)info.st_atime);
- VTABLE_set_integer_keyed_int(INTERP, array, 9,
- (INTVAL)info.st_mtime);
- VTABLE_set_integer_keyed_int(INTERP, array, 10,
- (INTVAL)info.st_ctime);
-#ifndef WIN32
- VTABLE_set_integer_keyed_int(INTERP, array, 11,
- (INTVAL)info.st_blksize);
- VTABLE_set_integer_keyed_int(INTERP, array, 12,
- (INTVAL)info.st_blocks);
-#endif
- RETURN(PMC *array);
- }
- }
-
-/*
-
-=item C<void symlink(STRING *from, STRING *to)>
-
-Creates a symlink, where available
-
-=cut
-
-*/
-
- METHOD symlink(STRING *from, STRING *to) {
-#ifndef WIN32
- char * const cfrom = Parrot_str_to_cstring(INTERP, from);
- char * const cto = Parrot_str_to_cstring(INTERP, to);
- const int error = symlink(cfrom, cto);
-
- Parrot_str_free_cstring(cfrom);
- Parrot_str_free_cstring(cto);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-#else
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
- "Win32 does not support symlinks!");
-#endif
- }
-
-/*
-
-=item C<void link(STRING *from, STRING *to)>
-
-Creates a hard link, where available(?)
-
-=cut
-
-*/
-
- METHOD link(STRING *from, STRING *to) {
-#ifndef WIN32
- char * const cfrom = Parrot_str_to_cstring(INTERP, from);
- char * const cto = Parrot_str_to_cstring(INTERP, to);
- const int error = link(cfrom, cto);
-
- Parrot_str_free_cstring(cfrom);
- Parrot_str_free_cstring(cto);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- "link() failed for OS PMC: %s\n", errmsg);
- }
-#else
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
- "Win32 is not POSIX. Need win32 developer!");
-#endif
- }
-
-/*
-
-=item C<INTVAL umask(INTVAL mask)>
-
-umask sets the process's file mode creation mask (and returns the
-previous one).
-
-=cut
-
-*/
-
- METHOD umask(INTVAL mask) {
-#ifndef _MSC_VER
- const INTVAL old = umask((mode_t)mask);
- RETURN(INTVAL old);
-#else
- Parrot_ex_throw_from_c_args(INTERP, NULL,
- EXCEPTION_UNIMPLEMENTED,
- "Win32 is not POSIX. Need Win32 developer!");
-#endif
- }
-
-/*
-
-=item C<INTVAL chroot(STRING *path)>
-
-it makes the named directory the new root directory for all further
-pathnames that begin with a "/" by your process and all its children.
-
-B<NOTE>: perl restricts this operation to superusers. It might be a good
-idea to do the same with parrot.
-
-=cut
-
-*/
-
- METHOD chroot(STRING *path) {
-#ifndef WIN32
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
- const int error = chroot(cpath);
-
- Parrot_str_free_cstring(cpath);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-#else
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
- "Win32 is not POSIX. Need Win32 developer!");
-#endif
- }
-
-
-/*
-
-=item C<PMC *readdir(STRING *path)>
-
-reads entries from a directory.
-
-=cut
-
-*/
- METHOD readdir(STRING *path) {
- PMC * array = Parrot_pmc_new(INTERP, enum_class_ResizableStringArray);
-#ifndef _MSC_VER
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
- DIR *dir = opendir(cpath);
- struct dirent *dirent;
- STRING *retval;
-
- Parrot_str_free_cstring(cpath);
-
- if (!dir) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
-
- while ((dirent = readdir(dir)) != NULL) {
- retval = Parrot_str_new(INTERP, dirent->d_name, 0) ;
- VTABLE_push_string(INTERP, array, retval);
- }
-
- closedir(dir);
-#else
- WIN32_FIND_DATA file_find_data;
- char * cpath;
- HANDLE hFind = INVALID_HANDLE_VALUE;
-
- /* Add \* to the directory name and start search. */
- STRING *last_char = Parrot_str_substr(interp, path,
- Parrot_str_length(interp, path) - 1, 1, NULL, 0);
- int trailing_slash = Parrot_str_equal(interp, last_char, string_from_literal(interp, "\\"))
- ||
- Parrot_str_equal(interp, last_char, string_from_literal(interp, "/"));
- cpath = Parrot_str_to_cstring(interp, Parrot_str_concat(interp,
- path, string_from_literal(interp, trailing_slash ? "*" : "\\*"), 0));
- hFind = FindFirstFile(cpath, &file_find_data);
- Parrot_str_free_cstring(cpath);
- if (hFind == INVALID_HANDLE_VALUE)
- {
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- "Unable to readdir");
- }
-
- /* Loop over all directories and add to result array. */
- do
- {
- VTABLE_push_string(INTERP, array, Parrot_str_new(INTERP,
- file_find_data.cFileName, 0));
- }
- while (FindNextFile(hFind, &file_find_data) != 0);
- if (GetLastError() != ERROR_NO_MORE_FILES)
- {
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- "Error during readdir");
- }
- FindClose(hFind);
-#endif
- RETURN(PMC *array);
- }
-/*
-=item C<rename(STRING *oldpath, STRING *newpath)>
-
-This method is a wrapper for rename(2). On error a SystemError exception is
-thrown.
-
-=cut
-
-*/
- METHOD rename(STRING *oldpath, STRING *newpath) {
- char * const coldpath = Parrot_str_to_cstring(INTERP, oldpath);
- char * const cnewpath = Parrot_str_to_cstring(INTERP, newpath);
- const int ret = rename(coldpath, cnewpath);
-
- Parrot_str_free_cstring(coldpath);
- Parrot_str_free_cstring(cnewpath);
-
- if (ret < 0) {
- const char * const errmsg = strerror(errno) ;
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- "%s", errmsg);
- }
- }
-
-/*
-
-=item C<chmod(STRING *path, INTVAL mode)>
-
-=cut
-
-*/
-
- METHOD chmod(STRING *path, INTVAL mode) {
- char * const cpath = Parrot_str_to_cstring(INTERP, path);
-
-#ifndef WIN32
- const int error = chmod(cpath, mode);
-#else
- const int error = _chmod(cpath, mode);
-#endif
-
- Parrot_str_free_cstring(cpath);
-
- if (error) {
- const char * const errmsg = strerror(errno);
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
- errmsg);
- }
- }
-
-}
-
-/*
-
-=back
-
-=head1 SEE ALS0
-
- chdir(2), getcwd(3), unlink(2), mkdir(2), stat(2), lstat(2),
- symlink(2), link(2), umask(2), chroot(2)
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: trunk/src/pmc/pmc.num
==============================================================================
--- trunk/src/pmc/pmc.num Mon May 3 23:18:58 2010 (r46258)
+++ trunk/src/pmc/pmc.num Tue May 4 00:27:02 2010 (r46259)
@@ -77,8 +77,5 @@
parrotclass.pmc 49
parrotobject.pmc 50
-os.pmc 51
-file.pmc 52
-
-oplib.pmc 53
-opcode.pmc 54
+oplib.pmc 51
+opcode.pmc 52
Copied and modified: trunk/t/dynpmc/file.t (from r46243, trunk/t/pmc/file.t)
==============================================================================
--- trunk/t/pmc/file.t Mon May 3 17:53:28 2010 (r46243, copy source)
+++ trunk/t/dynpmc/file.t Tue May 4 00:27:02 2010 (r46259)
@@ -47,6 +47,7 @@
# test is_dir
pir_output_is( <<"CODE", <<"OUT", "Test is_dir" );
.sub main :main
+ \$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$xpto'
@@ -78,6 +79,7 @@
# test is_dir
pir_error_output_like( <<"CODE", <<"OUT", "Test is_dir error" );
.sub main :main
+ \$P0 = loadlib 'file'
\$P1 = new ['File']
#make a filename that's long enough to cause lstat to fail
@@ -98,6 +100,7 @@
# test is_file
pir_output_is( <<"CODE", <<"OUT", "Test is_file" );
.sub main :main
+ \$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$xpto'
@@ -129,6 +132,7 @@
# test is_file
pir_error_output_like( <<"CODE", <<"OUT", "Test is_file error" );
.sub main :main
+ \$P0 = loadlib 'file'
\$P1 = new ['File']
#make a filename that's long enough to cause lstat to fail
@@ -155,6 +159,7 @@
# test is_link
pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to files" );
.sub main :main
+ \$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$lotpx'
@@ -190,6 +195,7 @@
# test is_link
pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to directories" );
.sub main :main
+ \$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$xptol'
@@ -223,6 +229,8 @@
\$S1 = '$otpx'
\$S2 = '$otpxcopy'
+ \$P0 = loadlib 'file'
+ \$P0 = loadlib 'os'
\$P1 = new ['File']
\$P2 = new ['OS']
@@ -256,6 +264,8 @@
\$S1 = '$otpx'
\$S2 = '$otpxcopy'
+ \$P0 = loadlib 'file'
+ \$P0 = loadlib 'os'
\$P1 = new ['File']
\$P2 = new ['OS']
@@ -286,6 +296,7 @@
# test exists
pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
.sub main :main
+ \$P0 = loadlib 'file'
\$P1 = new ['File']
\$I1 = \$P1.'exists'( '$otpxcopy' )
Copied and modified: trunk/t/dynpmc/os.t (from r46243, trunk/t/pmc/os.t)
==============================================================================
--- trunk/t/pmc/os.t Mon May 3 17:53:28 2010 (r46243, copy source)
+++ trunk/t/dynpmc/os.t Tue May 4 00:27:02 2010 (r46259)
@@ -42,6 +42,7 @@
$cwd = lc($cwd);
pir_output_is( <<'CODE', <<"OUT", 'Test cwd' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = $P1."cwd"()
$S2 = downcase $S1
@@ -56,6 +57,7 @@
else {
pir_output_is( <<'CODE', <<"OUT", 'Test cwd' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = $P1."cwd"()
print $S1
@@ -78,6 +80,7 @@
pir_output_is( <<'CODE', <<"OUT", 'Test chdir' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "src"
@@ -104,6 +107,7 @@
else {
pir_output_is( <<'CODE', <<"OUT", 'Test chdir' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "src"
@@ -135,6 +139,7 @@
pir_output_is( <<'CODE', <<"OUT", 'Test mkdir' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
@@ -163,6 +168,7 @@
else {
pir_output_is( <<'CODE', <<"OUT", 'Test mkdir' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
@@ -192,6 +198,7 @@
pir_output_is( <<'CODE', <<'OUT', 'Test rm call in a directory' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
@@ -227,6 +234,7 @@
$stat = sprintf("0x%08x\n" x 11, @s);
pir_output_is( <<'CODE', $stat, 'Test OS.stat' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
$P2 = $P1."stat"($S1)
@@ -246,6 +254,7 @@
$stat = sprintf("0x%08x\n" x 13, @s);
pir_output_is( <<'CODE', $stat, 'Test OS.stat' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
$P2 = $P1."stat"($S1)
@@ -270,6 +279,7 @@
my $entries = join( ' ', @entries ) . "\n";
pir_output_is( <<'CODE', $entries, 'Test OS.readdir' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$P2 = $P1.'readdir'('docs')
@@ -286,6 +296,7 @@
close $FILE;
pir_output_is( <<'CODE', <<"OUT", 'Test OS.rename' );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$P1.'rename'('____some_test_file', '___some_other_file')
$I0 = stat '___some_other_file', 0
@@ -314,6 +325,7 @@
$lstat = sprintf( "0x%08x\n" x 13, @s );
pir_output_is( <<'CODE', $lstat, "Test OS.lstat" );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
$P2 = $P1."lstat"($S1)
@@ -330,6 +342,7 @@
# Test remove on a file
pir_output_is( <<'CODE', <<"OUT", "Test rm call in a file" );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
@@ -352,6 +365,7 @@
pir_output_is( <<'CODE', <<"OUT", "Test symlink" );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
@@ -376,6 +390,7 @@
pir_output_is( <<'CODE', <<"OUT", "Test link" );
.sub main :main
+ $P0 = loadlib 'os'
$P1 = new ['OS']
$S1 = "xpto"
@@ -403,6 +418,7 @@
.sub main :main
.local pmc os
.local string xpto, tools
+ \$P0 = loadlib 'os'
os = new ['OS']
xpto = "xpto"
tools = "tools"
Modified: trunk/t/oo/methods.t
==============================================================================
--- trunk/t/oo/methods.t Mon May 3 23:18:58 2010 (r46258)
+++ trunk/t/oo/methods.t Tue May 4 00:27:02 2010 (r46259)
@@ -54,6 +54,7 @@
.sub delete_library
.local pmc os
+ $P0 = loadlib 'os'
os = new 'OS'
$S0 = "method_library.pir"
os.'rm'($S0)
Modified: trunk/t/pmc/eval.t
==============================================================================
--- trunk/t/pmc/eval.t Mon May 3 23:18:58 2010 (r46258)
+++ trunk/t/pmc/eval.t Tue May 4 00:27:02 2010 (r46259)
@@ -329,6 +329,7 @@
print io, \$S0
close io
load_bytecode "$temp_pbc"
+ \$P0 = loadlib 'os'
os = new ['OS']
os.'rm'("$temp_pbc")
f2 = compi("foo_2", "hello from foo_2")
Deleted: trunk/t/pmc/file.t
==============================================================================
--- trunk/t/pmc/file.t Tue May 4 00:27:02 2010 (r46258)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,327 +0,0 @@
-#! perl
-# Copyright (C) 2001-2006, Parrot Foundation.
-# $Id$
-
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-
-use Test::More;
-use Parrot::Test tests => 9;
-
-use Parrot::Config;
-
-use Cwd;
-use File::Temp;
-use File::Spec::Functions;
-
-my $tempdir = File::Temp::tempdir( CLEANUP => 1 );
-
-our ( $MSWin32, $cygwin );
-$MSWin32 = 1 if $^O =~ m!MSWin32!;
-$cygwin = 1 if $^O =~ m!cygwin!;
-
-=head1 NAME
-
-t/pmc/file.t - Files functions
-
-=head1 SYNOPSIS
-
- % prove t/pmc/file.t
-
-=head1 DESCRIPTION
-
-Tests the C<File> PMC.
-
-=cut
-
-my $xpto = catdir( $tempdir, 'xpto' );
-mkdir $xpto unless -d $xpto;
-
-my $otpx = catfile( $xpto, 'otpx' );
-
-open my $fh, '>', $otpx or die $!;
-print $fh 'xpto';
-close $fh;
-
-# test is_dir
-pir_output_is( <<"CODE", <<"OUT", "Test is_dir" );
-.sub main :main
- \$P1 = new ['File']
-
- \$S1 = '$xpto'
- \$I1 = \$P1."is_dir"(\$S1)
-
- if \$I1 goto ok1
- print "not "
-
-ok1:
- print "ok 1\\n"
-
- \$S1 = '$otpx'
- \$I1 = \$P1."is_dir"(\$S1)
- \$I1 = !\$I1
-
- if \$I1 goto ok2
- print "not "
-
-ok2:
- print "ok 2\\n"
-
- end
-.end
-CODE
-ok 1
-ok 2
-OUT
-
-# test is_dir
-pir_error_output_like( <<"CODE", <<"OUT", "Test is_dir error" );
-.sub main :main
- \$P1 = new ['File']
-
- #make a filename that's long enough to cause lstat to fail
- \$I0 = 1000
-loop:
- \$S0 = concat \$S0, "1234567890"
- \$I0 = \$I0 - 1
- if \$I0 goto loop
-
- \$I1 = \$P1."is_dir"(\$S0)
-
- end
-.end
-CODE
-/^[\\w \t\r\n]+current instr\.:/
-OUT
-
-# test is_file
-pir_output_is( <<"CODE", <<"OUT", "Test is_file" );
-.sub main :main
- \$P1 = new ['File']
-
- \$S1 = '$xpto'
- \$I1 = \$P1."is_file"(\$S1)
- \$I1 = !\$I1
-
- if \$I1 goto ok1
- print "not "
-
-ok1:
- print "ok 1\\n"
-
- \$S1 = '$otpx'
- \$I1 = \$P1."is_file"(\$S1)
-
- if \$I1 goto ok2
- print "not "
-
-ok2:
- print "ok 2\\n"
-
- end
-.end
-CODE
-ok 1
-ok 2
-OUT
-
-# test is_file
-pir_error_output_like( <<"CODE", <<"OUT", "Test is_file error" );
-.sub main :main
- \$P1 = new ['File']
-
- #make a filename that's long enough to cause lstat to fail
- \$I0 = 1000
-loop:
- \$S0 = concat \$S0, "1234567890"
- \$I0 = \$I0 - 1
- if \$I0 goto loop
-
- \$I1 = \$P1."is_file"(\$S0)
-
- end
-.end
-CODE
-/^[\\w \t\r\n]+current instr\.:/
-OUT
-
-SKIP: {
- skip "Links not available under Windows", 1 if $MSWin32;
-
- my $lotpx = catfile( $xpto, 'lotpx' );
- symlink $otpx, $lotpx;
-
- # test is_link
- pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to files" );
-.sub main :main
- \$P1 = new ['File']
-
- \$S1 = '$lotpx'
- \$I1 = \$P1."is_link"(\$S1)
-
- if \$I1 goto ok1
- print "not "
-ok1:
- print "ok 1\\n"
-
- \$S1 = '$otpx'
- \$I1 = \$P1."is_link"(\$S1)
- \$I1 = !\$I1
- if \$I1 goto ok2
- print "not "
-ok2:
- print "ok 2\\n"
- end
-.end
-CODE
-ok 1
-ok 2
-OUT
-
-}
-
-SKIP: {
- skip "Links not available under Windows", 1 if $MSWin32;
-
- my $xptol = catdir( $xpto, 'xptol' );
- symlink $xpto, $xptol;
-
- # test is_link
- pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to directories" );
-.sub main :main
- \$P1 = new ['File']
-
- \$S1 = '$xptol'
- \$I1 = \$P1."is_link"(\$S1)
-
- if \$I1 goto ok1
- print "not "
-ok1:
- print "ok 1\\n"
-
- \$S1 = '$xpto'
- \$I1 = \$P1."is_link"(\$S1)
- \$I1 = !\$I1
- if \$I1 goto ok2
- print "not "
-ok2:
- print "ok 2\\n"
- end
-.end
-CODE
-ok 1
-ok 2
-OUT
-}
-
-my $otpxcopy = catdir( $xpto, 'otpxcopy' );
-
-# test copy
-pir_output_is( <<"CODE", <<"OUT", "Test copy for files" );
-.sub main :main
- \$S1 = '$otpx'
- \$S2 = '$otpxcopy'
-
- \$P1 = new ['File']
- \$P2 = new ['OS']
-
- \$P1."copy"(\$S1,\$S2)
- print "ok\\n"
-
- \$P3 = \$P2."stat"(\$S1)
- \$P4 = \$P2."stat"(\$S2)
-
- \$I1 = \$P3[7]
- \$I2 = \$P4[7]
-
- if \$I1 == \$I2 goto ok
- print "not "
-ok:
- print "ok\\n"
-
- end
-.end
-CODE
-ok
-ok
-OUT
-
-# test rename
-SKIP: {
- skip 'file exists', 1 if $MSWin32;
-
- pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
-.sub main :main
- \$S1 = '$otpx'
- \$S2 = '$otpxcopy'
-
- \$P1 = new ['File']
- \$P2 = new ['OS']
-
- \$P3 = \$P2."stat"(\$S1)
- \$I1 = \$P3[7]
-
- \$P1."rename"(\$S1,\$S2)
- print "ok\\n"
-
- \$P4 = \$P2."stat"(\$S2)
- \$I2 = \$P4[7]
-
- if \$I1 == \$I2 goto ok
- print "not "
-ok:
- print "ok\\n"
-
- end
-.end
-CODE
-ok
-ok
-OUT
-}
-
-my $bad_file = catfile( $xpto, 'not a file' );
-
-# test exists
-pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
-.sub main :main
- \$P1 = new ['File']
- \$I1 = \$P1.'exists'( '$otpxcopy' )
-
- if \$I1 goto file_exists
- print "not "
-
- file_exists:
- print "ok 1 - file exists\\n"
-
- \$I1 = \$P1.'exists'( '$xpto' )
-
- if \$I1 goto dir_exists
- print "not "
-
- dir_exists:
- print "ok 2 - directory exists\\n"
-
- \$I1 = \$P1.'exists'( '$bad_file' )
-
- if \$I1 == 0 goto file_does_not_exist
- print "not "
-
- file_does_not_exist:
- print "ok 3 - file does not exist\\n"
-
- end
-.end
-CODE
-ok 1 - file exists
-ok 2 - directory exists
-ok 3 - file does not exist
-OUT
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Deleted: trunk/t/pmc/os.t
==============================================================================
--- trunk/t/pmc/os.t Tue May 4 00:27:02 2010 (r46258)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,447 +0,0 @@
-#! perl
-# Copyright (C) 2001-2009, Parrot Foundation.
-# $Id$
-
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 16;
-use Parrot::Config;
-use Cwd;
-use File::Spec;
-
-my $MSWin32 = $^O =~ m!MSWin32!;
-my $cygwin = $^O =~ m!cygwin!;
-my $solaris = $^O =~ m!solaris!;
-my $MSVC = $PConfig{cc} =~ m/\bcl(?:\.exe)?/i;
-
-=head1 NAME
-
-t/pmc/os.t - Files and Dirs
-
-=head1 SYNOPSIS
-
- % prove t/pmc/os.t
-
-=head1 DESCRIPTION
-
-Tests the C<OS> PMC.
-
-=cut
-
-END {
- # Clean up environment on exit
- rmdir "xpto" if -d "xpto";
- unlink "xpto" if -f "xpto";
-}
-
-# test 'cwd'
-my $cwd = File::Spec->canonpath(getcwd);
-if (File::Spec->case_tolerant(substr($cwd,0,2))) {
- $cwd = lc($cwd);
- pir_output_is( <<'CODE', <<"OUT", 'Test cwd' );
-.sub main :main
- $P1 = new ['OS']
- $S1 = $P1."cwd"()
- $S2 = downcase $S1
- print $S2
- print "\n"
- end
-.end
-CODE
-$cwd
-OUT
-}
-else {
- pir_output_is( <<'CODE', <<"OUT", 'Test cwd' );
-.sub main :main
- $P1 = new ['OS']
- $S1 = $P1."cwd"()
- print $S1
- print "\n"
- end
-.end
-CODE
-$cwd
-OUT
-}
-
-# TEST chdir
-chdir "src";
-my $upcwd = File::Spec->canonpath(getcwd);
-chdir '..';
-
-if (File::Spec->case_tolerant(substr($cwd,0,2))) {
- $cwd = lc($cwd);
- $upcwd = lc($upcwd);
-
- pir_output_is( <<'CODE', <<"OUT", 'Test chdir' );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "src"
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- $S2 = downcase $S1
- say $S2
-
- $S1 = ".."
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- $S2 = downcase $S1
- say $S2
-
- end
-.end
-CODE
-$upcwd
-$cwd
-OUT
-}
-else {
- pir_output_is( <<'CODE', <<"OUT", 'Test chdir' );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "src"
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- say $S1
-
- $S1 = ".."
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- say $S1
-
- end
-.end
-CODE
-$upcwd
-$cwd
-OUT
-}
-
-# Test mkdir
-
-my $xpto = $upcwd;
-$xpto =~ s/src([\/\\]?)$/xpto$1/;
-
-if (File::Spec->case_tolerant(substr($cwd,0,2))) {
-
- pir_output_is( <<'CODE', <<"OUT", 'Test mkdir' );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "xpto"
- $I1 = 0o555
- $P1."mkdir"($S1,$I1)
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- $S2 = downcase $S1
- say $S2
-
- $S1 = ".."
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- $S2 = downcase $S1
- say $S2
-
- end
-.end
-CODE
-$xpto
-$cwd
-OUT
-}
-else {
- pir_output_is( <<'CODE', <<"OUT", 'Test mkdir' );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "xpto"
- $I1 = 0o555
- $P1."mkdir"($S1,$I1)
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- say $S1
-
- $S1 = ".."
- $P1."chdir"($S1)
-
- $S1 = $P1."cwd"()
- say $S1
-
- end
-.end
-CODE
-$xpto
-$cwd
-OUT
-}
-
-# Test remove on a directory
-mkdir "xpto" unless -d "xpto";
-
-pir_output_is( <<'CODE', <<'OUT', 'Test rm call in a directory' );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "xpto"
- $P1."rm"($S1)
-
- print "ok\n"
-
- end
-.end
-CODE
-ok
-OUT
-
-ok( !-d $xpto, "Test that rm removed the directory" );
-rmdir $xpto if -d $xpto; # this way next test doesn't fail if this one does
-
-# test stat
-
-open my $X, '>', "xpto";
-print $X "xpto";
-close $X;
-
-my $stat;
-
-my $count = $MSWin32 ? 11 : 13;
-my @s = stat('xpto');
-if ( $cygwin ) {
- # Mask inode number (fudge it)
- $s[1] &= 0xffffffff;
-}
-
-if ( $MSWin32 ) {
- $stat = sprintf("0x%08x\n" x 11, @s);
- pir_output_is( <<'CODE', $stat, 'Test OS.stat' );
-.sub main :main
- $P1 = new ['OS']
- $S1 = "xpto"
- $P2 = $P1."stat"($S1)
-
- $S1 = repeat "0x%08x\n", 11
- $S2 = sprintf $S1, $P2
- print $S2
-done:
- end
-.end
-CODE
-}
-else {
- SKIP: {
- skip 'broken test TT #457', 1 if $solaris;
-
- $stat = sprintf("0x%08x\n" x 13, @s);
- pir_output_is( <<'CODE', $stat, 'Test OS.stat' );
-.sub main :main
- $P1 = new ['OS']
- $S1 = "xpto"
- $P2 = $P1."stat"($S1)
-
- $S1 = repeat "0x%08x\n", 13
- $S2 = sprintf $S1, $P2
- print $S2
-done:
- end
-.end
-CODE
-}
-}
-
-# test readdir
-SKIP: {
- skip 'not implemented on windows yet', 1 if ( $MSWin32 && $MSVC );
-
- opendir my $IN, 'docs';
- my @entries = readdir $IN;
- closedir $IN;
- my $entries = join( ' ', @entries ) . "\n";
- pir_output_is( <<'CODE', $entries, 'Test OS.readdir' );
-.sub main :main
- $P1 = new ['OS']
- $P2 = $P1.'readdir'('docs')
-
- $S0 = join ' ', $P2
- print $S0
- print "\n"
-.end
-CODE
-}
-
-# test rename
-SKIP: {
- open my $FILE, ">", "____some_test_file";
- close $FILE;
- pir_output_is( <<'CODE', <<"OUT", 'Test OS.rename' );
-.sub main :main
- $P1 = new ['OS']
- $P1.'rename'('____some_test_file', '___some_other_file')
- $I0 = stat '___some_other_file', 0
- print $I0
- print "\n"
- $P1.'rm'('___some_other_file')
-.end
-CODE
-1
-OUT
-}
-
-# test lstat
-
-my $lstat;
-
-SKIP: {
- skip 'lstat not on Win32', 1 if $MSWin32;
- skip 'broken test TT #457', 1 if $solaris;
-
- my @s = lstat('xpto');
- if ($cygwin) {
- # Mask inode number (fudge it)
- $s[1] &= 0xffffffff;
- }
- $lstat = sprintf( "0x%08x\n" x 13, @s );
- pir_output_is( <<'CODE', $lstat, "Test OS.lstat" );
-.sub main :main
- $P1 = new ['OS']
- $S1 = "xpto"
- $P2 = $P1."lstat"($S1)
-
- $S1 = repeat "0x%08x\n", 13
- $S2 = sprintf $S1, $P2
- print $S2
-
- end
-.end
-CODE
-}
-
-# Test remove on a file
-pir_output_is( <<'CODE', <<"OUT", "Test rm call in a file" );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "xpto"
- $P1."rm"($S1)
-
- print "ok\n"
-
- end
-.end
-CODE
-ok
-OUT
-
-ok( !-f $xpto, "Test that rm removed file" );
-rmdir $xpto if -f $xpto; # this way next test doesn't fail if this one does
-
-# Test symlink
-SKIP: {
- skip "Symlinks not available under Windows", 2 if $MSWin32;
-
- pir_output_is( <<'CODE', <<"OUT", "Test symlink" );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "xpto"
- $S2 = "MANIFEST"
- $P1."symlink"($S2, $S1)
-
- print "ok\n"
-
- end
-.end
-CODE
-ok
-OUT
-
- ok( -l "xpto", "symlink was really created" );
- unlink "xpto" if -f "xpto";
-}
-
-# Test link to file. May require root permissions
-SKIP: {
- skip "Hardlinks to files not possible on Windows", 2 if $MSWin32 or $cygwin;
-
- pir_output_is( <<'CODE', <<"OUT", "Test link" );
-.sub main :main
- $P1 = new ['OS']
-
- $S1 = "xpto"
- $S2 = "myconfig"
- $P1."link"($S2, $S1)
-
- print "ok\n"
-
- end
-.end
-CODE
-ok
-OUT
-
- my $nl = [ stat("myconfig") ]->[3];
- ok( $nl > 1, "hard link to file was really created" );
- unlink "xpto" if -f "xpto";
-}
-
-SKIP: {
- skip "Hardlinks to files not possible on Windows", 1 if $MSWin32 or $cygwin;
-
- my $prevnl = [ stat("tools") ]->[3];
- pir_output_like( <<"CODE", <<"OUT", "Test dirlink" );
-.sub main :main
- .local pmc os
- .local string xpto, tools
- os = new ['OS']
- xpto = "xpto"
- tools = "tools"
-
- push_eh no_root_perms
- os."link"(tools, xpto)
- pop_eh
-
- .local pmc statvals
- statvals = os.'stat'(tools)
-
- # nlink
- .local int nlink
- nlink = statvals[3]
-
- gt nlink, $prevnl, is_okay
- end
-
- no_root_perms:
- .local pmc e
- .local string message
- .get_results( e )
- pop_eh
- message = e['message']
- say message
- end
-
- is_okay:
- say "ok"
- end
-.end
-CODE
-/link.* failed for OS PMC:/
-OUT
-}
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Modified: trunk/tools/dev/pbc_to_exe.pir
==============================================================================
--- trunk/tools/dev/pbc_to_exe.pir Mon May 3 23:18:58 2010 (r46258)
+++ trunk/tools/dev/pbc_to_exe.pir Tue May 4 00:27:02 2010 (r46259)
@@ -660,6 +660,7 @@
check_manifest:
# Check if there is a MSVC app manifest
.local pmc file
+ $P0 = loadlib 'file'
file = new 'File'
.local string manifest_file_name
manifest_file_name = clone exefile
Modified: trunk/tools/util/pgegrep
==============================================================================
--- trunk/tools/util/pgegrep Mon May 3 23:18:58 2010 (r46258)
+++ trunk/tools/util/pgegrep Tue May 4 00:27:02 2010 (r46259)
@@ -130,7 +130,9 @@
filecount = files
# define with-filename if there's more than one file
.If(filecount >= 2, { opts['with-filename'] = 1 })
+ $P0 = loadlib 'file'
File = new 'File'
+ $P0 = loadlib 'os'
OS = new 'OS'
# This must be here, or else it'll get filled with junk data we use stdin...
i = 0
More information about the parrot-commits
mailing list