├── .github ├── FUNDING.yml └── workflows │ ├── freebsd.yaml │ ├── linux.yaml │ ├── osx.yaml │ └── windows.yaml ├── .gitignore ├── Build.PL ├── Changes ├── LICENSE ├── MANIFEST.SKIP ├── META.json ├── README.md ├── cpanfile ├── eg └── benchmark.pl ├── lib └── Readonly.pm ├── minil.toml └── t ├── bugs ├── 001_assign.t └── 007_implicit_undef.t └── general ├── array.t ├── clone.t ├── deepa.t ├── deeph.t ├── deeps.t ├── docs.t ├── export.t ├── hash.t ├── readonly.t ├── reassign.t ├── scalar.t └── tie.t /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: sanko # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: # Replace with a single Patreon username 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | otechie: # Replace with a single Otechie username 12 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 13 | -------------------------------------------------------------------------------- /.github/workflows/freebsd.yaml: -------------------------------------------------------------------------------- 1 | name: BSD 2 | 3 | on: [push] 4 | 5 | jobs: 6 | test: 7 | runs-on: ubuntu-latest 8 | name: ${{ matrix.os.name }} 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - name: freebsd 14 | architecture: x86-64 15 | version: '14.0' 16 | pkg: sudo pkg install -y perl5 17 | 18 | - name: netbsd 19 | architecture: x86-64 20 | version: '9.3' 21 | # https://ftp.netbsd.org/pub/pkgsrc/current/pkgsrc/lang/perl5/index.html 22 | pkg: sudo pkgin -y install perl-5.38.2 23 | 24 | steps: 25 | - uses: actions/checkout@v4 26 | - name: Test on ${{ matrix.os.name }} 27 | uses: cross-platform-actions/action@v0.23.0 28 | env: 29 | MY_ENV1: MY_ENV1 30 | MY_ENV2: MY_ENV2 31 | with: 32 | environment_variables: MY_ENV1 MY_ENV2 33 | operating_system: ${{ matrix.os.name }} 34 | architecture: ${{ matrix.os.architecture }} 35 | version: ${{ matrix.os.version }} 36 | shell: bash 37 | memory: 5G 38 | cpu_count: 4 39 | run: | 40 | uname -a 41 | echo $SHELL 42 | pwd 43 | ls -lah 44 | whoami 45 | env | sort 46 | ${{ matrix.os.pkg }} p5-App-cpanminus 47 | perl -V 48 | cpanm -v --mirror http://cpan.cpantesters.org/ . 49 | -------------------------------------------------------------------------------- /.github/workflows/linux.yaml: -------------------------------------------------------------------------------- 1 | name: Linux 2 | 3 | on: 4 | push: 5 | branches: '*' 6 | pull_request: 7 | branches: '*' 8 | 9 | jobs: 10 | perl-job: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | runner: [ubuntu-latest] 15 | perl: [ '5.20', '5.26', '5.30', '5.32', 'latest' ] 16 | 17 | runs-on: ${{matrix.runner}} 18 | name: OS ${{matrix.runner}} Perl ${{matrix.perl}} 19 | 20 | #container: 21 | # image: perl:${{ matrix.perl-version }} 22 | 23 | steps: 24 | - uses: actions/checkout@v4 25 | 26 | - name: Set up perl 27 | uses: shogo82148/actions-setup-perl@v1 28 | with: 29 | perl-version: ${{ matrix.perl }} 30 | 31 | - name: perl -V 32 | run: perl -V 33 | 34 | - name: Regular Tests 35 | run: | 36 | cpanm -v --mirror http://cpan.cpantesters.org/ . 37 | - name: Show content of log files on Linux 38 | if: ${{ failure() && startsWith( matrix.runner, 'ubuntu-' ) }} 39 | run: cat /home/runner/.cpanm/work/*/build.log 40 | 41 | - name: Show content of log files on Mac 42 | if: ${{ failure() && startsWith( matrix.runner, 'macos-' ) }} 43 | run: cat /Users/runner/.cpanm/work/*/build.log 44 | 45 | - name: Show content of log files on Windows 46 | if: ${{ failure() && startsWith( matrix.runner, 'windows-' ) }} 47 | run: cat C:\Users\RUNNER~1\.cpanm\work\*\build.log 48 | -------------------------------------------------------------------------------- /.github/workflows/osx.yaml: -------------------------------------------------------------------------------- 1 | name: OSX 2 | 3 | on: 4 | push: 5 | branches: '*' 6 | pull_request: 7 | branches: '*' 8 | 9 | jobs: 10 | perl-job: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | runner: [macos-latest] 15 | perl: [ '5.20', '5.26', '5.30', '5.32', 'latest' ] 16 | 17 | runs-on: ${{matrix.runner}} 18 | name: OS ${{matrix.runner}} Perl ${{matrix.perl}} 19 | 20 | #container: 21 | # image: perl:${{ matrix.perl-version }} 22 | 23 | steps: 24 | - uses: actions/checkout@v4 25 | 26 | - name: Set up perl 27 | uses: shogo82148/actions-setup-perl@v1 28 | with: 29 | perl-version: ${{ matrix.perl }} 30 | 31 | - name: perl -V 32 | run: perl -V 33 | 34 | - name: Install dependencies 35 | run: | 36 | cpanm --installdeps -v -n --mirror http://cpan.cpantesters.org/ . 37 | 38 | - name: Regular Tests 39 | run: | 40 | cpanm -v --test-only . 41 | 42 | - name: Show content of log files on Linux 43 | if: ${{ failure() && startsWith( matrix.runner, 'ubuntu-' ) }} 44 | run: cat /home/runner/.cpanm/work/*/build.log 45 | 46 | - name: Show content of log files on Mac 47 | if: ${{ failure() && startsWith( matrix.runner, 'macos-' ) }} 48 | run: cat /Users/runner/.cpanm/work/*/build.log 49 | 50 | - name: Show content of log files on Windows 51 | if: ${{ failure() && startsWith( matrix.runner, 'windows-' ) }} 52 | run: cat C:\Users\RUNNER~1\.cpanm\work\*\build.log 53 | -------------------------------------------------------------------------------- /.github/workflows/windows.yaml: -------------------------------------------------------------------------------- 1 | name: Windows 2 | 3 | on: 4 | push: 5 | branches: '*' 6 | pull_request: 7 | branches: '*' 8 | 9 | jobs: 10 | perl-job: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | runner: [windows-latest] 15 | perl: [ '5.20', '5.26', '5.30', '5.32', 'latest' ] 16 | dist: [ 'default', 'strawberry' ] 17 | 18 | runs-on: ${{matrix.runner}} 19 | name: OS ${{matrix.runner}} Perl ${{matrix.perl}} ${{matrix.dist}} 20 | 21 | #container: 22 | # image: perl:${{ matrix.perl-version }} 23 | 24 | steps: 25 | - uses: actions/checkout@v4 26 | 27 | - name: Set up perl ${{ matrix.dist }} ${{ matrix.perl }} 28 | uses: shogo82148/actions-setup-perl@v1 29 | with: 30 | perl-version: ${{ matrix.perl }} 31 | distribution: ${{ matrix.dist }} 32 | 33 | - name: perl -V 34 | run: perl -V 35 | 36 | - name: Install dependencies 37 | run: | 38 | cpanm --installdeps -v -n --mirror http://cpan.cpantesters.org/ . 39 | 40 | - name: Regular Tests 41 | run: | 42 | cpanm -v --test-only . 43 | 44 | - name: Show content of log files on Linux 45 | if: ${{ failure() && startsWith( matrix.runner, 'ubuntu-' ) }} 46 | run: cat /home/runner/.cpanm/work/*/build.log 47 | 48 | - name: Show content of log files on Mac 49 | if: ${{ failure() && startsWith( matrix.runner, 'macos-' ) }} 50 | run: cat /Users/runner/.cpanm/work/*/build.log 51 | 52 | - name: Show content of log files on Windows 53 | if: ${{ failure() && startsWith( matrix.runner, 'windows-' ) }} 54 | run: cat C:\Users\RUNNER~1\.cpanm\work\*\build.log 55 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | blib/ 2 | .build/ 3 | _build/ 4 | cover_db/ 5 | inc/ 6 | Build 7 | !Build/ 8 | Build.bat 9 | .last_cover_stats 10 | Makefile 11 | Makefile.old 12 | MANIFEST.bak 13 | META.yml 14 | MYMETA.yml 15 | MYMETA.json 16 | nytprof.out 17 | pm_to_blib 18 | *.bak 19 | *.tar.gz 20 | _bugs/ 21 | _build_params 22 | eg/stupidity.pl 23 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | # ========================================================================= 2 | # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. 3 | # DO NOT EDIT DIRECTLY. 4 | # ========================================================================= 5 | 6 | use 5.008_001; 7 | use strict; 8 | 9 | use Module::Build::Tiny 0.035; 10 | 11 | Build_PL(); 12 | 13 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl extension Readonly. 2 | 3 | {{$NEXT}} 4 | - Workaround argument count message change around perl 5.26 (according to failing CPAN Tester 5 | reports such as https://www.cpantesters.org/cpan/report/846799aa-9e78-11e9-8bc6-d738850d707a) 6 | 7 | 2.05 2016-06-10T17:03:28Z 8 | - Fix deref when using the stupid and utterly unnecessary Readonly::Clone 9 | 10 | 2.04 2016-05-07T15:38:37Z 11 | - Quiet compile time warnings about function prototypes and vars being 12 | used only once 13 | 14 | 2.03 2016-05-06T22:27:44Z 15 | - Rewording some documentation 16 | - No longer require an explicit version of perl in META.json or cpanfile 17 | 18 | 2.02 2016-05-06T21:56:10Z 19 | - Create mutable clones of readonly structures with Readonly::Clone 20 | - Still not convinced this is useful but... fixes #13 21 | - Minor typo patch from Gregor Herrmann fixes #21 22 | 23 | 2.01 2016-02-24T16:01:12Z 24 | - Disallow initialization of Readonly variables by assignment 25 | allowed by Perl prototype changes in v5.16. Assignment initialization 26 | of scalars sets scalar variables to undef and lists and hashes 27 | initialized by assignment are not read only. 28 | 29 | 2.00 2014-06-30T11:15:05Z 30 | - Deprecation of Readonly::XS as a requirement for fast, readonly 31 | scalars is complete. Report any lingering issues on the tracker 32 | ASAP. 33 | 34 | 1.61 2014-06-28T11:22:13Z 35 | - Normal constants (strings, numbers) do not appear to be read only to 36 | Internals::SvREADONLY($) but perl itself doesn't miss a beat when you 37 | attempt to assign a value to them. Fixing test regression in 38 | t/general/reassign.t 39 | 40 | 1.60 2014-06-27T15:59:27Z 41 | - Fix array and hash tie() while in XS mode (exposed by Params::Validate tests) 42 | - Fix implicit undef value regression resolves #8 43 | - Minor documentation fixes (spell check, etc.) 44 | - Patch from Gregor Herrmann resolves #7 45 | 46 | v1.500.0 2014-06-25T19:56:18Z 47 | - PLEASE NOTE: Readonly::XS is no longer needed! 48 | - Again, Readonly::XS is no longer needed. 49 | - Merged typo fix from David Steinbrunner RT#86350/#2 50 | - Merged patch (w/ tests, yay!) from Daniel P. Risse RT#37864 51 | - Upstream magic related bugs were reported to p5p and fixed in perl 52 | itself so we can resolve the following local issues: RT#70167, RT#57382, 53 | RT#29487, RT#36653, RT#24216. 54 | - Reported RT#120122 (tie + smartmatch bug) upstream to p5p. Will 55 | eventually resolve local [RT#59256]. 56 | - Note: Resolved RT#16167 (benchmark.pl being installed) in 1.04. 57 | - Use readonly support exposed in Internals on perl >=5.8.x 58 | - Have I mentioned you don't need to install Readonly::XS anymore? 59 | - Checking $Readonly::XSokay is no longer suggested. ...never should have been 60 | 61 | 1.04 2013-11-26T01:20:38Z 62 | - Module now maintained by Sanko Robinson. Please see TODO for a possible 63 | set of changes to this module that may effect code written for old, pre- 64 | perl 5.14.0 platforms!!! 65 | 66 | 1.03 2004 April 20 67 | - Changed the prototype for Readonly, to make the usage cleaner. 68 | Unfortunately, this breaks backwards-compatability for this 69 | function. Users of this function who have Perl 5.8 or later 70 | will have to change their source code. Also, users of this 71 | function who upgrade to perl 5.8+ will have to change their 72 | usage. Having discussed this feature change with a number of 73 | people, I felt that breaking compatability was worth the gain 74 | in simplicity of usage. 75 | (Thanks to Damian Conway for the suggestion). 76 | - Removed "use warnings" so the module will work in perl 5.005. 77 | 78 | 1.02 2003 May 13 79 | - If Readonly::XS is installed, Readonly will use it for 80 | making scalars read-only. 81 | - Callers are now forbidden to tie variables directly. This 82 | prevents sneaky callers from reassigning a variable via 83 | tie. 84 | - Error messages have been changed to be more like Perl's 85 | own "Modification of a read-only value attempted at..." 86 | - Catch and return an error if user tries to pass a constant 87 | to Readonly::Scalar (eg Readonly::Scalar 'hello', 'goodbye') 88 | - Include a simple benchmark script. 89 | - Add a few more test cases. You can never have too many. 90 | - Add a simple benchmark program. 91 | 92 | 1.01 2003 February 14 93 | - Add some checking to prevent reassignment of Readonly variables. 94 | - Changed my email address in the docs. 95 | 96 | 1.00 2003 January 7 97 | - No code changes. No bugs or suggestions have been reported 98 | for six months, so the version number is changing to 1.00. 99 | 100 | 0.07 2002 June 25 101 | - Clean up the code somewhat; remove redundancies; delay 102 | loading Carp.pm until it's needed. 103 | - Fixed the list of EXPORT_OK symbols. 104 | 105 | 0.06 2002 June 16 106 | - Add Readonly function, to provide a unified (and shorter) way to 107 | create readonly variables. (Thanks to Slaven Rezic for the idea). 108 | - Scalar, Array, and Hash now mark entire data structures as Readonly. 109 | Added Scalar1, Array1, and Hash1 for shallow Readonly protection. 110 | (Thanks to Ernest Lergon for the idea). 111 | - Switch to Test::More and Test::Harness. 134 tests now! 112 | 113 | 0.05 2002 March 15 114 | - Change name from Constant.pm to Readonly.pm, due to file 115 | naming conflict under Windows. 116 | - Changed docs to match. 117 | - Allow Readonly::Hash to accept a hash reference parameter. 118 | - Works better with older versions of Perl. 119 | - Add many, many test cases to test.pl. 120 | 121 | 0.04 2002 March 7 122 | - Add top-level Scalar, Array, and Hash functions, so callers 123 | don't have to tie the variables themselves. 124 | 125 | 0.03 2001 September 9 126 | - documentation changes only. 127 | 128 | 0.02 2001 September 9 129 | - documentation changes only. 130 | 131 | 0.01 2001 August 30 132 | - Constant.pm, original version. 133 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This software is copyright (c) 2013 by Sanko Robinson . 2 | 3 | This is free software; you can redistribute it and/or modify it under 4 | the same terms as the Perl 5 programming language system itself. 5 | 6 | Terms of the Perl programming language system itself 7 | 8 | a) the GNU General Public License as published by the Free 9 | Software Foundation; either version 1, or (at your option) any 10 | later version, or 11 | b) the "Artistic License" 12 | 13 | --- The GNU General Public License, Version 1, February 1989 --- 14 | 15 | This software is Copyright (c) 2013 by Sanko Robinson . 16 | 17 | This is free software, licensed under: 18 | 19 | The GNU General Public License, Version 1, February 1989 20 | 21 | GNU GENERAL PUBLIC LICENSE 22 | Version 1, February 1989 23 | 24 | Copyright (C) 1989 Free Software Foundation, Inc. 25 | 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA 26 | 27 | Everyone is permitted to copy and distribute verbatim copies 28 | of this license document, but changing it is not allowed. 29 | 30 | Preamble 31 | 32 | The license agreements of most software companies try to keep users 33 | at the mercy of those companies. By contrast, our General Public 34 | License is intended to guarantee your freedom to share and change free 35 | software--to make sure the software is free for all its users. The 36 | General Public License applies to the Free Software Foundation's 37 | software and to any other program whose authors commit to using it. 38 | You can use it for your programs, too. 39 | 40 | When we speak of free software, we are referring to freedom, not 41 | price. Specifically, the General Public License is designed to make 42 | sure that you have the freedom to give away or sell copies of free 43 | software, that you receive source code or can get it if you want it, 44 | that you can change the software or use pieces of it in new free 45 | programs; and that you know you can do these things. 46 | 47 | To protect your rights, we need to make restrictions that forbid 48 | anyone to deny you these rights or to ask you to surrender the rights. 49 | These restrictions translate to certain responsibilities for you if you 50 | distribute copies of the software, or if you modify it. 51 | 52 | For example, if you distribute copies of a such a program, whether 53 | gratis or for a fee, you must give the recipients all the rights that 54 | you have. You must make sure that they, too, receive or can get the 55 | source code. And you must tell them their rights. 56 | 57 | We protect your rights with two steps: (1) copyright the software, and 58 | (2) offer you this license which gives you legal permission to copy, 59 | distribute and/or modify the software. 60 | 61 | Also, for each author's protection and ours, we want to make certain 62 | that everyone understands that there is no warranty for this free 63 | software. If the software is modified by someone else and passed on, we 64 | want its recipients to know that what they have is not the original, so 65 | that any problems introduced by others will not reflect on the original 66 | authors' reputations. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | GNU GENERAL PUBLIC LICENSE 72 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 73 | 74 | 0. This License Agreement applies to any program or other work which 75 | contains a notice placed by the copyright holder saying it may be 76 | distributed under the terms of this General Public License. The 77 | "Program", below, refers to any such program or work, and a "work based 78 | on the Program" means either the Program or any work containing the 79 | Program or a portion of it, either verbatim or with modifications. Each 80 | licensee is addressed as "you". 81 | 82 | 1. You may copy and distribute verbatim copies of the Program's source 83 | code as you receive it, in any medium, provided that you conspicuously and 84 | appropriately publish on each copy an appropriate copyright notice and 85 | disclaimer of warranty; keep intact all the notices that refer to this 86 | General Public License and to the absence of any warranty; and give any 87 | other recipients of the Program a copy of this General Public License 88 | along with the Program. You may charge a fee for the physical act of 89 | transferring a copy. 90 | 91 | 2. You may modify your copy or copies of the Program or any portion of 92 | it, and copy and distribute such modifications under the terms of Paragraph 93 | 1 above, provided that you also do the following: 94 | 95 | a) cause the modified files to carry prominent notices stating that 96 | you changed the files and the date of any change; and 97 | 98 | b) cause the whole of any work that you distribute or publish, that 99 | in whole or in part contains the Program or any part thereof, either 100 | with or without modifications, to be licensed at no charge to all 101 | third parties under the terms of this General Public License (except 102 | that you may choose to grant warranty protection to some or all 103 | third parties, at your option). 104 | 105 | c) If the modified program normally reads commands interactively when 106 | run, you must cause it, when started running for such interactive use 107 | in the simplest and most usual way, to print or display an 108 | announcement including an appropriate copyright notice and a notice 109 | that there is no warranty (or else, saying that you provide a 110 | warranty) and that users may redistribute the program under these 111 | conditions, and telling the user how to view a copy of this General 112 | Public License. 113 | 114 | d) You may charge a fee for the physical act of transferring a 115 | copy, and you may at your option offer warranty protection in 116 | exchange for a fee. 117 | 118 | Mere aggregation of another independent work with the Program (or its 119 | derivative) on a volume of a storage or distribution medium does not bring 120 | the other work under the scope of these terms. 121 | 122 | 3. You may copy and distribute the Program (or a portion or derivative of 123 | it, under Paragraph 2) in object code or executable form under the terms of 124 | Paragraphs 1 and 2 above provided that you also do one of the following: 125 | 126 | a) accompany it with the complete corresponding machine-readable 127 | source code, which must be distributed under the terms of 128 | Paragraphs 1 and 2 above; or, 129 | 130 | b) accompany it with a written offer, valid for at least three 131 | years, to give any third party free (except for a nominal charge 132 | for the cost of distribution) a complete machine-readable copy of the 133 | corresponding source code, to be distributed under the terms of 134 | Paragraphs 1 and 2 above; or, 135 | 136 | c) accompany it with the information you received as to where the 137 | corresponding source code may be obtained. (This alternative is 138 | allowed only for noncommercial distribution and only if you 139 | received the program in object code or executable form alone.) 140 | 141 | Source code for a work means the preferred form of the work for making 142 | modifications to it. For an executable file, complete source code means 143 | all the source code for all modules it contains; but, as a special 144 | exception, it need not include source code for modules which are standard 145 | libraries that accompany the operating system on which the executable 146 | file runs, or for standard header files or definitions files that 147 | accompany that operating system. 148 | 149 | 4. You may not copy, modify, sublicense, distribute or transfer the 150 | Program except as expressly provided under this General Public License. 151 | Any attempt otherwise to copy, modify, sublicense, distribute or transfer 152 | the Program is void, and will automatically terminate your rights to use 153 | the Program under this License. However, parties who have received 154 | copies, or rights to use copies, from you under this General Public 155 | License will not have their licenses terminated so long as such parties 156 | remain in full compliance. 157 | 158 | 5. By copying, distributing or modifying the Program (or any work based 159 | on the Program) you indicate your acceptance of this license to do so, 160 | and all its terms and conditions. 161 | 162 | 6. Each time you redistribute the Program (or any work based on the 163 | Program), the recipient automatically receives a license from the original 164 | licensor to copy, distribute or modify the Program subject to these 165 | terms and conditions. You may not impose any further restrictions on the 166 | recipients' exercise of the rights granted herein. 167 | 168 | 7. The Free Software Foundation may publish revised and/or new versions 169 | of the General Public License from time to time. Such new versions will 170 | be similar in spirit to the present version, but may differ in detail to 171 | address new problems or concerns. 172 | 173 | Each version is given a distinguishing version number. If the Program 174 | specifies a version number of the license which applies to it and "any 175 | later version", you have the option of following the terms and conditions 176 | either of that version or of any later version published by the Free 177 | Software Foundation. If the Program does not specify a version number of 178 | the license, you may choose any version ever published by the Free Software 179 | Foundation. 180 | 181 | 8. If you wish to incorporate parts of the Program into other free 182 | programs whose distribution conditions are different, write to the author 183 | to ask for permission. For software which is copyrighted by the Free 184 | Software Foundation, write to the Free Software Foundation; we sometimes 185 | make exceptions for this. Our decision will be guided by the two goals 186 | of preserving the free status of all derivatives of our free software and 187 | of promoting the sharing and reuse of software generally. 188 | 189 | NO WARRANTY 190 | 191 | 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 192 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 193 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 194 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 195 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 196 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 197 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 198 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 199 | REPAIR OR CORRECTION. 200 | 201 | 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 202 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 203 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 204 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 205 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 206 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 207 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 208 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 209 | POSSIBILITY OF SUCH DAMAGES. 210 | 211 | END OF TERMS AND CONDITIONS 212 | 213 | Appendix: How to Apply These Terms to Your New Programs 214 | 215 | If you develop a new program, and you want it to be of the greatest 216 | possible use to humanity, the best way to achieve this is to make it 217 | free software which everyone can redistribute and change under these 218 | terms. 219 | 220 | To do so, attach the following notices to the program. It is safest to 221 | attach them to the start of each source file to most effectively convey 222 | the exclusion of warranty; and each file should have at least the 223 | "copyright" line and a pointer to where the full notice is found. 224 | 225 | 226 | Copyright (C) 19yy 227 | 228 | This program is free software; you can redistribute it and/or modify 229 | it under the terms of the GNU General Public License as published by 230 | the Free Software Foundation; either version 1, or (at your option) 231 | any later version. 232 | 233 | This program is distributed in the hope that it will be useful, 234 | but WITHOUT ANY WARRANTY; without even the implied warranty of 235 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 236 | GNU General Public License for more details. 237 | 238 | You should have received a copy of the GNU General Public License 239 | along with this program; if not, write to the Free Software 240 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA 241 | 242 | 243 | Also add information on how to contact you by electronic and paper mail. 244 | 245 | If the program is interactive, make it output a short notice like this 246 | when it starts in an interactive mode: 247 | 248 | Gnomovision version 69, Copyright (C) 19xx name of author 249 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 250 | This is free software, and you are welcome to redistribute it 251 | under certain conditions; type `show c' for details. 252 | 253 | The hypothetical commands `show w' and `show c' should show the 254 | appropriate parts of the General Public License. Of course, the 255 | commands you use may be called something other than `show w' and `show 256 | c'; they could even be mouse-clicks or menu items--whatever suits your 257 | program. 258 | 259 | You should also get your employer (if you work as a programmer) or your 260 | school, if any, to sign a "copyright disclaimer" for the program, if 261 | necessary. Here a sample; alter the names: 262 | 263 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 264 | program `Gnomovision' (a program to direct compilers to make passes 265 | at assemblers) written by James Hacker. 266 | 267 | , 1 April 1989 268 | Ty Coon, President of Vice 269 | 270 | That's all there is to it! 271 | 272 | 273 | --- The Artistic License 1.0 --- 274 | 275 | This software is Copyright (c) 2013 by tokuhirom . 276 | 277 | This is free software, licensed under: 278 | 279 | The Artistic License 1.0 280 | 281 | The Artistic License 282 | 283 | Preamble 284 | 285 | The intent of this document is to state the conditions under which a Package 286 | may be copied, such that the Copyright Holder maintains some semblance of 287 | artistic control over the development of the package, while giving the users of 288 | the package the right to use and distribute the Package in a more-or-less 289 | customary fashion, plus the right to make reasonable modifications. 290 | 291 | Definitions: 292 | 293 | - "Package" refers to the collection of files distributed by the Copyright 294 | Holder, and derivatives of that collection of files created through 295 | textual modification. 296 | - "Standard Version" refers to such a Package if it has not been modified, 297 | or has been modified in accordance with the wishes of the Copyright 298 | Holder. 299 | - "Copyright Holder" is whoever is named in the copyright or copyrights for 300 | the package. 301 | - "You" is you, if you're thinking about copying or distributing this Package. 302 | - "Reasonable copying fee" is whatever you can justify on the basis of media 303 | cost, duplication charges, time of people involved, and so on. (You will 304 | not be required to justify it to the Copyright Holder, but only to the 305 | computing community at large as a market that must bear the fee.) 306 | - "Freely Available" means that no fee is charged for the item itself, though 307 | there may be fees involved in handling the item. It also means that 308 | recipients of the item may redistribute it under the same conditions they 309 | received it. 310 | 311 | 1. You may make and give away verbatim copies of the source form of the 312 | Standard Version of this Package without restriction, provided that you 313 | duplicate all of the original copyright notices and associated disclaimers. 314 | 315 | 2. You may apply bug fixes, portability fixes and other modifications derived 316 | from the Public Domain or from the Copyright Holder. A Package modified in such 317 | a way shall still be considered the Standard Version. 318 | 319 | 3. You may otherwise modify your copy of this Package in any way, provided that 320 | you insert a prominent notice in each changed file stating how and when you 321 | changed that file, and provided that you do at least ONE of the following: 322 | 323 | a) place your modifications in the Public Domain or otherwise make them 324 | Freely Available, such as by posting said modifications to Usenet or an 325 | equivalent medium, or placing the modifications on a major archive site 326 | such as ftp.uu.net, or by allowing the Copyright Holder to include your 327 | modifications in the Standard Version of the Package. 328 | 329 | b) use the modified Package only within your corporation or organization. 330 | 331 | c) rename any non-standard executables so the names do not conflict with 332 | standard executables, which must also be provided, and provide a separate 333 | manual page for each non-standard executable that clearly documents how it 334 | differs from the Standard Version. 335 | 336 | d) make other distribution arrangements with the Copyright Holder. 337 | 338 | 4. You may distribute the programs of this Package in object code or executable 339 | form, provided that you do at least ONE of the following: 340 | 341 | a) distribute a Standard Version of the executables and library files, 342 | together with instructions (in the manual page or equivalent) on where to 343 | get the Standard Version. 344 | 345 | b) accompany the distribution with the machine-readable source of the Package 346 | with your modifications. 347 | 348 | c) accompany any non-standard executables with their corresponding Standard 349 | Version executables, giving the non-standard executables non-standard 350 | names, and clearly documenting the differences in manual pages (or 351 | equivalent), together with instructions on where to get the Standard 352 | Version. 353 | 354 | d) make other distribution arrangements with the Copyright Holder. 355 | 356 | 5. You may charge a reasonable copying fee for any distribution of this 357 | Package. You may charge any fee you choose for support of this Package. You 358 | may not charge a fee for this Package itself. However, you may distribute this 359 | Package in aggregate with other (possibly commercial) programs as part of a 360 | larger (possibly commercial) software distribution provided that you do not 361 | advertise this Package as a product of your own. 362 | 363 | 6. The scripts and library files supplied as input to or produced as output 364 | from the programs of this Package do not automatically fall under the copyright 365 | of this Package, but belong to whomever generated them, and may be sold 366 | commercially, and may be aggregated with this Package. 367 | 368 | 7. C or perl subroutines supplied by you and linked into this Package shall not 369 | be considered part of this Package. 370 | 371 | 8. The name of the Copyright Holder may not be used to endorse or promote 372 | products derived from this software without specific prior written permission. 373 | 374 | 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 375 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 376 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 377 | 378 | The End -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | 2 | #!start included C:\Strawberry\perl\lib\ExtUtils\MANIFEST.SKIP 3 | # Avoid version control files. 4 | \bRCS\b 5 | \bCVS\b 6 | \bSCCS\b 7 | ,v$ 8 | \B\.svn\b 9 | \B\.git\b 10 | \B\.gitignore\b 11 | \b_darcs\b 12 | \B\.cvsignore$ 13 | 14 | # Avoid VMS specific MakeMaker generated files 15 | \bDescrip.MMS$ 16 | \bDESCRIP.MMS$ 17 | \bdescrip.mms$ 18 | 19 | # Avoid Makemaker generated and utility files. 20 | \bMANIFEST\.bak 21 | \bMakefile$ 22 | \bblib/ 23 | \bMakeMaker-\d 24 | \bpm_to_blib\.ts$ 25 | \bpm_to_blib$ 26 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 27 | 28 | # Avoid Module::Build generated and utility files. 29 | \bBuild$ 30 | \b_build/ 31 | \bBuild.bat$ 32 | \bBuild.COM$ 33 | \bBUILD.COM$ 34 | \bbuild.com$ 35 | 36 | # Avoid temp and backup files. 37 | ~$ 38 | \.old$ 39 | \#$ 40 | \b\.# 41 | \.bak$ 42 | \.tmp$ 43 | \.# 44 | \.rej$ 45 | 46 | # Avoid OS-specific files/dirs 47 | # Mac OSX metadata 48 | \B\.DS_Store 49 | # Mac OSX SMB mount metadata files 50 | \B\._ 51 | 52 | # Avoid Devel::Cover and Devel::CoverX::Covered files. 53 | \bcover_db\b 54 | \bcovered\b 55 | 56 | # Avoid MYMETA files 57 | ^MYMETA\. 58 | #!end included C:\Strawberry\perl\lib\ExtUtils\MANIFEST.SKIP 59 | 60 | MANIFEST\.SKIP 61 | -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "Facility for creating read-only scalars, arrays, hashes", 3 | "author" : [ 4 | "Sanko Robinson - http://sankorobinson.com/" 5 | ], 6 | "dynamic_config" : 0, 7 | "generated_by" : "Minilla/v3.1.23, CPAN::Meta::Converter version 2.150010", 8 | "license" : [ 9 | "artistic_2" 10 | ], 11 | "meta-spec" : { 12 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 13 | "version" : 2 14 | }, 15 | "name" : "Readonly", 16 | "no_index" : { 17 | "directory" : [ 18 | "t", 19 | "xt", 20 | "inc", 21 | "share", 22 | "eg", 23 | "examples", 24 | "author", 25 | "builder" 26 | ] 27 | }, 28 | "prereqs" : { 29 | "configure" : { 30 | "requires" : { 31 | "Module::Build::Tiny" : "0.035" 32 | } 33 | }, 34 | "develop" : { 35 | "requires" : { 36 | "Test::CPAN::Meta" : "0", 37 | "Test::MinimumVersion::Fast" : "0.04", 38 | "Test::PAUSE::Permissions" : "0.07", 39 | "Test::Pod" : "1.41", 40 | "Test::Spellunker" : "v0.2.7" 41 | } 42 | }, 43 | "runtime" : { 44 | "requires" : { 45 | "perl" : "5.005" 46 | } 47 | }, 48 | "test" : { 49 | "requires" : { 50 | "Test::More" : "0" 51 | } 52 | } 53 | }, 54 | "release_status" : "unstable", 55 | "resources" : { 56 | "bugtracker" : { 57 | "web" : "https://github.com/sanko/readonly/issues" 58 | }, 59 | "homepage" : "https://github.com/sanko/readonly", 60 | "repository" : { 61 | "type" : "git", 62 | "url" : "https://github.com/sanko/readonly.git", 63 | "web" : "https://github.com/sanko/readonly" 64 | } 65 | }, 66 | "version" : "2.05", 67 | "x_authority" : "cpan:SANKO", 68 | "x_contributors" : [ 69 | "David Steinbrunner ", 70 | "Michael Ivanchenko ", 71 | "Peter Valdemar Mørch ", 72 | "Ronald Schmidt ", 73 | "vti " 74 | ], 75 | "x_serialization_backend" : "JSON::PP version 4.16", 76 | "x_static_install" : 1 77 | } 78 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Actions Status](https://github.com/sanko/readonly/actions/workflows/linux.yaml/badge.svg)](https://github.com/sanko/readonly/actions) [![Actions Status](https://github.com/sanko/readonly/actions/workflows/windows.yaml/badge.svg)](https://github.com/sanko/readonly/actions) [![Actions Status](https://github.com/sanko/readonly/actions/workflows/osx.yaml/badge.svg)](https://github.com/sanko/readonly/actions) [![Actions Status](https://github.com/sanko/readonly/actions/workflows/freebsd.yaml/badge.svg)](https://github.com/sanko/readonly/actions) [![MetaCPAN Release](https://badge.fury.io/pl/Readonly.svg)](https://metacpan.org/release/Readonly) 2 | # NAME 3 | 4 | Readonly - Facility for creating read-only scalars, arrays, hashes 5 | 6 | # Synopsis 7 | 8 | use Readonly; 9 | 10 | # Deep Read-only scalar 11 | Readonly::Scalar $sca => $initial_value; 12 | Readonly::Scalar my $sca => $initial_value; 13 | 14 | # Deep Read-only array 15 | Readonly::Array @arr => @values; 16 | Readonly::Array my @arr => @values; 17 | 18 | # Deep Read-only hash 19 | Readonly::Hash %has => (key => value, key => value, ...); 20 | Readonly::Hash my %has => (key => value, key => value, ...); 21 | # or: 22 | Readonly::Hash %has => {key => value, key => value, ...}; 23 | 24 | # You can use the read-only variables like any regular variables: 25 | print $sca; 26 | $something = $sca + $arr[2]; 27 | next if $has{$some_key}; 28 | 29 | # But if you try to modify a value, your program will die: 30 | $sca = 7; 31 | push @arr, 'seven'; 32 | delete $has{key}; 33 | # The error message is "Modification of a read-only value attempted" 34 | 35 | # Alternate form (Perl 5.8 and later) 36 | Readonly $sca => $initial_value; 37 | Readonly my $sca => $initial_value; 38 | Readonly @arr => @values; 39 | Readonly my @arr => @values; 40 | Readonly %has => (key => value, key => value, ...); 41 | Readonly my %has => (key => value, key => value, ...); 42 | Readonly my $sca; # Implicit undef, readonly value 43 | 44 | # Alternate form (for Perls earlier than v5.8) 45 | Readonly \$sca => $initial_value; 46 | Readonly \my $sca => $initial_value; 47 | Readonly \@arr => @values; 48 | Readonly \my @arr => @values; 49 | Readonly \%has => (key => value, key => value, ...); 50 | Readonly \my %has => (key => value, key => value, ...); 51 | 52 | # Description 53 | 54 | This is a facility for creating non-modifiable variables. This is useful for 55 | configuration files, headers, etc. It can also be useful as a development and 56 | debugging tool for catching updates to variables that should not be changed. 57 | 58 | # Variable Depth 59 | 60 | Readonly has the ability to create both deep and shallow readonly variables. 61 | 62 | If you pass a `$ref`, an `@array` or a `%hash` to corresponding functions 63 | `::Scalar()`, `::Array()` and `::Hash()`, then those functions recurse over 64 | the data structure, marking everything as readonly. The entire structure is 65 | then non-modifiable. This is normally what you want. 66 | 67 | If you want only the top level to be readonly, use the alternate (and poorly 68 | named) `::Scalar1()`, `::Array1()`, and `::Hash1()` functions. 69 | 70 | Plain `Readonly()` creates what the original author calls a "shallow" 71 | readonly variable, which is great if you don't plan to use it on anything but 72 | only one dimensional scalar values. 73 | 74 | `Readonly::Scalar()` makes the variable 'deeply' readonly, so the following 75 | snippet kills over as you expect: 76 | 77 | use Readonly; 78 | 79 | Readonly::Scalar my $ref => { 1 => 'a' }; 80 | $ref->{1} = 'b'; 81 | $ref->{2} = 'b'; 82 | 83 | While the following snippet does **not** make your structure 'deeply' readonly: 84 | 85 | use Readonly; 86 | 87 | Readonly my $ref => { 1 => 'a' }; 88 | $ref->{1} = 'b'; 89 | $ref->{2} = 'b'; 90 | 91 | # 92 | 93 | # The Past 94 | 95 | The following sections are updated versions of the previous authors 96 | documentation. 97 | 98 | ## Comparison with "use constant" 99 | 100 | Perl provides a facility for creating constant values, via the [constant](https://metacpan.org/pod/constant) 101 | pragma. There are several problems with this pragma. 102 | 103 | - The constants created have no leading sigils. 104 | - These constants cannot be interpolated into strings. 105 | - Syntax can get dicey sometimes. For example: 106 | 107 | use constant CARRAY => (2, 3, 5, 7, 11, 13); 108 | $a_prime = CARRAY[2]; # wrong! 109 | $a_prime = (CARRAY)[2]; # right -- MUST use parentheses 110 | 111 | - You have to be very careful in places where barewords are allowed. 112 | 113 | For example: 114 | 115 | use constant SOME_KEY => 'key'; 116 | %hash = (key => 'value', other_key => 'other_value'); 117 | $some_value = $hash{SOME_KEY}; # wrong! 118 | $some_value = $hash{+SOME_KEY}; # right 119 | 120 | (who thinks to use a unary plus when using a hash to scalarize the key?) 121 | 122 | - `use constant` works for scalars and arrays, not hashes. 123 | - These constants are global to the package in which they're declared; 124 | cannot be lexically scoped. 125 | - Works only at compile time. 126 | - Can be overridden: 127 | 128 | use constant PI => 3.14159; 129 | ... 130 | use constant PI => 2.71828; 131 | 132 | (this does generate a warning, however, if you have warnings enabled). 133 | 134 | - It is very difficult to make and use deep structures (complex data 135 | structures) with `use constant`. 136 | 137 | # Comparison with typeglob constants 138 | 139 | Another popular way to create read-only scalars is to modify the symbol table 140 | entry for the variable by using a typeglob: 141 | 142 | *a = \'value'; 143 | 144 | This works fine, but it only works for global variables ("my" variables have 145 | no symbol table entry). Also, the following similar constructs do **not** work: 146 | 147 | *a = [1, 2, 3]; # Does NOT create a read-only array 148 | *a = { a => 'A'}; # Does NOT create a read-only hash 149 | 150 | ## Pros 151 | 152 | Readonly.pm, on the other hand, will work with global variables and with 153 | lexical ("my") variables. It will create scalars, arrays, or hashes, all of 154 | which look and work like normal, read-write Perl variables. You can use them 155 | in scalar context, in list context; you can take references to them, pass them 156 | to functions, anything. 157 | 158 | Readonly.pm also works well with complex data structures, allowing you to tag 159 | the whole structure as nonmodifiable, or just the top level. 160 | 161 | Also, Readonly variables may not be reassigned. The following code will die: 162 | 163 | Readonly::Scalar $pi => 3.14159; 164 | ... 165 | Readonly::Scalar $pi => 2.71828; 166 | 167 | ## Cons 168 | 169 | Readonly.pm used to impose a performance penalty. It was pretty slow. How 170 | slow? Run the `eg/benchmark.pl` script that comes with Readonly. On my test 171 | system, "use constant" (const), typeglob constants (tglob), regular read/write 172 | Perl variables (normal/literal), and the new Readonly (ro/ro\_simple) are all 173 | about the same speed, the old, tie based Readonly.pm constants were about 1/22 174 | the speed. 175 | 176 | However, there is relief. There is a companion module available, Readonly::XS. 177 | You won't need this if you're using Perl 5.8.x or higher. 178 | 179 | I repeat, you do not need Readonly::XS if your environment has perl 5.8.x or 180 | higher. Please see section entitled [Internals](#internals) for more. 181 | 182 | # Functions 183 | 184 | - Readonly::Scalar $var => $value; 185 | 186 | Creates a nonmodifiable scalar, `$var`, and assigns a value of `$value` to 187 | it. Thereafter, its value may not be changed. Any attempt to modify the value 188 | will cause your program to die. 189 | 190 | A value _must_ be supplied. If you want the variable to have `undef` as its 191 | value, you must specify `undef`. 192 | 193 | If `$value` is a reference to a scalar, array, or hash, then this function 194 | will mark the scalar, array, or hash it points to as being Readonly as well, 195 | and it will recursively traverse the structure, marking the whole thing as 196 | Readonly. Usually, this is what you want. However, if you want only the 197 | `$value` marked as Readonly, use `Scalar1`. 198 | 199 | If $var is already a Readonly variable, the program will die with an error 200 | about reassigning Readonly variables. 201 | 202 | - Readonly::Array @arr => (value, value, ...); 203 | 204 | Creates a nonmodifiable array, `@arr`, and assigns the specified list of 205 | values to it. Thereafter, none of its values may be changed; the array may not 206 | be lengthened or shortened or spliced. Any attempt to do so will cause your 207 | program to die. 208 | 209 | If any of the values passed is a reference to a scalar, array, or hash, then 210 | this function will mark the scalar, array, or hash it points to as being 211 | Readonly as well, and it will recursively traverse the structure, marking the 212 | whole thing as Readonly. Usually, this is what you want. However, if you want 213 | only the hash `%@arr` itself marked as Readonly, use `Array1`. 214 | 215 | If `@arr` is already a Readonly variable, the program will die with an error 216 | about reassigning Readonly variables. 217 | 218 | - Readonly::Hash %h => (key => value, key => value, ...); 219 | - Readonly::Hash %h => {key => value, key => value, ...}; 220 | 221 | Creates a nonmodifiable hash, `%h`, and assigns the specified keys and values 222 | to it. Thereafter, its keys or values may not be changed. Any attempt to do so 223 | will cause your program to die. 224 | 225 | A list of keys and values may be specified (with parentheses in the synopsis 226 | above), or a hash reference may be specified (curly braces in the synopsis 227 | above). If a list is specified, it must have an even number of elements, or 228 | the function will die. 229 | 230 | If any of the values is a reference to a scalar, array, or hash, then this 231 | function will mark the scalar, array, or hash it points to as being Readonly 232 | as well, and it will recursively traverse the structure, marking the whole 233 | thing as Readonly. Usually, this is what you want. However, if you want only 234 | the hash `%h` itself marked as Readonly, use `Hash1`. 235 | 236 | If `%h` is already a Readonly variable, the program will die with an error 237 | about reassigning Readonly variables. 238 | 239 | - Readonly $var => $value; 240 | - Readonly @arr => (value, value, ...); 241 | - Readonly %h => (key => value, ...); 242 | - Readonly %h => {key => value, ...}; 243 | - Readonly $var; 244 | 245 | The `Readonly` function is an alternate to the `Scalar`, `Array`, and 246 | `Hash` functions. It has the advantage (if you consider it an advantage) of 247 | being one function. That may make your program look neater, if you're 248 | initializing a whole bunch of constants at once. You may or may not prefer 249 | this uniform style. 250 | 251 | It has the disadvantage of having a slightly different syntax for versions of 252 | Perl prior to 5.8. For earlier versions, you must supply a backslash, because 253 | it requires a reference as the first parameter. 254 | 255 | Readonly \$var => $value; 256 | Readonly \@arr => (value, value, ...); 257 | Readonly \%h => (key => value, ...); 258 | Readonly \%h => {key => value, ...}; 259 | 260 | You may or may not consider this ugly. 261 | 262 | Note that you can create implicit undefined variables with this function like 263 | so `Readonly my $var;` while a verbose undefined value must be passed to the 264 | standard `Scalar`, `Array`, and `Hash` functions. 265 | 266 | - Readonly::Scalar1 $var => $value; 267 | - Readonly::Array1 @arr => (value, value, ...); 268 | - Readonly::Hash1 %h => (key => value, key => value, ...); 269 | - Readonly::Hash1 %h => {key => value, key => value, ...}; 270 | 271 | These alternate functions create shallow Readonly variables, instead of deep 272 | ones. For example: 273 | 274 | Readonly::Array1 @shal => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5); 275 | Readonly::Array @deep => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5); 276 | 277 | $shal[1] = 7; # error 278 | $shal[2]{APL}='Weird'; # Allowed! since the hash isn't Readonly 279 | $deep[1] = 7; # error 280 | $deep[2]{APL}='Weird'; # error, since the hash is Readonly 281 | 282 | # Cloning 283 | 284 | When cloning using [Storable](https://metacpan.org/pod/Storable) or [Clone](https://metacpan.org/pod/Clone) you will notice that the value stays 285 | readonly, which is correct. If you want to clone the value without copying the 286 | readonly flag, use the `Clone` function: 287 | 288 | Readonly::Scalar my $scalar => {qw[this that]}; 289 | # $scalar->{'eh'} = 'foo'; # Modification of a read-only value attempted 290 | my $scalar_clone = Readonly::Clone $scalar; 291 | $scalar_clone->{'eh'} = 'foo'; 292 | # $scalar_clone is now {this => 'that', eh => 'foo'}; 293 | 294 | The new variable (`$scalar_clone`) is a mutable clone of the original 295 | `$scalar`. 296 | 297 | # Examples 298 | 299 | These are a few very simple examples: 300 | 301 | ## Scalars 302 | 303 | A plain old read-only value 304 | 305 | Readonly::Scalar $a => "A string value"; 306 | 307 | The value need not be a compile-time constant: 308 | 309 | Readonly::Scalar $a => $computed_value; 310 | 311 | ## Arrays/Lists 312 | 313 | A read-only array: 314 | 315 | Readonly::Array @a => (1, 2, 3, 4); 316 | 317 | The parentheses are optional: 318 | 319 | Readonly::Array @a => 1, 2, 3, 4; 320 | 321 | You can use Perl's built-in array quoting syntax: 322 | 323 | Readonly::Array @a => qw/1 2 3 4/; 324 | 325 | You can initialize a read-only array from a variable one: 326 | 327 | Readonly::Array @a => @computed_values; 328 | 329 | A read-only array can be empty, too: 330 | 331 | Readonly::Array @a => (); 332 | Readonly::Array @a; # equivalent 333 | 334 | ## Hashes 335 | 336 | Typical usage: 337 | 338 | Readonly::Hash %a => (key1 => 'value1', key2 => 'value2'); 339 | 340 | A read-only hash can be initialized from a variable one: 341 | 342 | Readonly::Hash %a => %computed_values; 343 | 344 | A read-only hash can be empty: 345 | 346 | Readonly::Hash %a => (); 347 | Readonly::Hash %a; # equivalent 348 | 349 | If you pass an odd number of values, the program will die: 350 | 351 | Readonly::Hash %a => (key1 => 'value1', "value2"); 352 | # This dies with "May not store an odd number of values in a hash" 353 | 354 | # Exports 355 | 356 | Historically, this module exports the `Readonly` symbol into the calling 357 | program's namespace by default. The following symbols are also available for 358 | import into your program, if you like: `Scalar`, `Scalar1`, `Array`, 359 | `Array1`, `Hash`, and `Hash1`. 360 | 361 | # Internals 362 | 363 | Some people simply do not understand the relationship between this module and 364 | Readonly::XS so I'm adding this section. Odds are, they still won't understand 365 | but I like to write so... 366 | 367 | In the past, Readonly's "magic" was performed by `tie()`-ing variables to the 368 | `Readonly::Scalar`, `Readonly::Array`, and `Readonly::Hash` packages (not 369 | to be confused with the functions of the same names) and acting on `WRITE`, 370 | `READ`, et. al. While this worked well, it was slow. Very slow. Like 20-30 371 | times slower than accessing variables directly or using one of the other 372 | const-related modules that have cropped up since Readonly was released in 373 | 2003. 374 | 375 | To 'fix' this, Readonly::XS was written. If installed, Readonly::XS used the 376 | internal methods `SvREADONLY` and `SvREADONLY_on` to lock simple scalars. On 377 | the surface, everything was peachy but things weren't the same behind the 378 | scenes. In edge cases, code performed very differently if Readonly::XS was 379 | installed and because it wasn't a required dependency in most code, it made 380 | downstream bugs very hard to track. 381 | 382 | In the years since Readonly::XS was released, the then private internal 383 | methods have been exposed and can be used in pure perl. Similar modules were 384 | written to take advantage of this and a patch to Readonly was created. We no 385 | longer need to build and install another module to make Readonly useful on 386 | modern builds of perl. 387 | 388 | - You do not need to install Readonly::XS. 389 | - You should stop listing Readonly::XS as a dependency or expect it to 390 | be installed. 391 | - Stop testing the `$Readonly::XSokay` variable! 392 | 393 | # Requirements 394 | 395 | Please note that most users of Readonly no longer need to install the 396 | companion module Readonly::XS which is recommended but not required for perl 397 | 5.6.x and under. Please do not force it as a requirement in new code and do 398 | not use the package variable `$Readonly::XSokay` in code/tests. For more, see 399 | ["Internals" in the section on Readonly's new internals](https://metacpan.org/pod/the%20section%20on%20Readonly%27s%20new%20internals#Internals). 400 | 401 | There are no non-core requirements. 402 | 403 | # Bug Reports 404 | 405 | If email is better for you, [my address is mentioned below](#author) but I 406 | would rather have bugs sent through the issue tracker found at 407 | http://github.com/sanko/readonly/issues. 408 | 409 | # Acknowledgements 410 | 411 | Thanks to Slaven Rezic for the idea of one common function (Readonly) for all 412 | three types of variables (13 April 2002). 413 | 414 | Thanks to Ernest Lergon for the idea (and initial code) for deeply-Readonly 415 | data structures (21 May 2002). 416 | 417 | Thanks to Damian Conway for the idea (and code) for making the Readonly 418 | function work a lot smoother under perl 5.8+. 419 | 420 | # Author 421 | 422 | Sanko Robinson - http://sankorobinson.com/ 423 | 424 | CPAN ID: SANKO 425 | 426 | Original author: Eric J. Roode, roode@cpan.org 427 | 428 | # License and Legal 429 | 430 | Copyright (C) 2013-2016 by Sanko Robinson 431 | 432 | Copyright (c) 2001-2004 by Eric J. Roode. All Rights Reserved. 433 | 434 | This module is free software; you can redistribute it and/or modify it under 435 | the same terms as Perl itself. 436 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | test_requires 'Test::More'; -------------------------------------------------------------------------------- /eg/benchmark.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # Very simple benchmark script to show how slow Readonly.pm is, 3 | # and how Readonly::XS solves the problem. 4 | use strict; 5 | use lib '../lib'; 6 | use Readonly; 7 | use Benchmark; 8 | use vars qw/$feedme/; 9 | # 10 | # use constant 11 | # 12 | use constant CONST_LINCOLN => 'Fourscore and seven years ago...'; 13 | 14 | sub const { 15 | $feedme = CONST_LINCOLN; 16 | } 17 | # 18 | # literal constant 19 | # 20 | sub literal { 21 | $feedme = 'Fourscore and seven years ago...'; 22 | } 23 | # 24 | # typeglob constant 25 | # 26 | use vars qw/$glob_lincoln/; 27 | *glob_lincoln = \'Fourscore and seven years ago...'; 28 | 29 | sub tglob { 30 | $feedme = $glob_lincoln; 31 | } 32 | # 33 | # Normal perl read/write scalar 34 | # 35 | use vars qw/$norm_lincoln/; 36 | $norm_lincoln = 'Fourscore and seven years ago...'; 37 | 38 | sub normal { 39 | $feedme = $norm_lincoln; 40 | } 41 | # 42 | # Readonly.pm with verbose API 43 | # 44 | use vars qw/$ro_lincoln/; 45 | Readonly::Scalar $ro_lincoln => 'Fourscore and seven years ago...'; 46 | 47 | sub ro { 48 | $feedme = $ro_lincoln; 49 | } 50 | # 51 | # Readonly.pm with simple API 52 | # 53 | use vars qw/$ro_simple_lincoln/; 54 | Readonly $ro_simple_lincoln => 'Fourscore and seven years ago...'; 55 | 56 | sub ro_simple { 57 | $feedme = $ro_simple_lincoln; 58 | } 59 | # 60 | # Readonly.pm w/o Readonly::XS 61 | # 62 | use vars qw/$rotie_lincoln/; 63 | { 64 | local $Readonly::XSokay = 0; # disable XS 65 | Readonly::Scalar $rotie_lincoln => 'Fourscore and seven years ago...'; 66 | } 67 | 68 | sub rotie { 69 | $feedme = $rotie_lincoln; 70 | } 71 | my $code = {const => \&const, 72 | literal => \&literal, 73 | tglob => \&tglob, 74 | normal => \&normal, 75 | ro => \&ro, 76 | ro_simple => \&ro_simple, 77 | rotie => \&rotie, 78 | }; 79 | unless ($Readonly::XSokay) { 80 | print "Readonly::XS module not found; skipping that test.\n"; 81 | delete $code->{roxs}; 82 | } 83 | timethese(2_000_000, $code); 84 | -------------------------------------------------------------------------------- /lib/Readonly.pm: -------------------------------------------------------------------------------- 1 | package Readonly; 2 | use 5.005; 3 | use strict; 4 | 5 | #use warnings; 6 | #no warnings 'uninitialized'; 7 | package Readonly; 8 | our $VERSION = '2.05'; 9 | $VERSION = eval $VERSION; 10 | 11 | # Autocroak (Thanks, MJD) 12 | # Only load Carp.pm if module is croaking. 13 | sub croak { 14 | require Carp; 15 | goto &Carp::croak; 16 | } 17 | 18 | # These functions may be overridden by Readonly::XS, if installed. 19 | use vars qw/$XSokay/; # Set to true in Readonly::XS, if available 20 | 21 | # Predeclare the following, so we can use them recursively 22 | sub _ARRAY (\@); 23 | sub _HASH (\%); 24 | 25 | # For perl 5.8.x or higher 26 | # These functions are exposed in perl 5.8.x (Thanks, Leon!) 27 | # They may be overridden by Readonly::XS, if installed on old perl versions 28 | if ($] < 5.008) { # 'Classic' perl 29 | *is_sv_readonly = sub ($) {0}; 30 | *make_sv_readonly 31 | = sub ($) { die "make_sv_readonly called but not overridden" }; 32 | 33 | # See if we can use the XS stuff. 34 | $Readonly::XS::MAGIC_COOKIE = $Readonly::XS::MAGIC_COOKIE 35 | = "Do NOT use or require Readonly::XS unless you're me."; 36 | eval 'use Readonly::XS'; 37 | } 38 | else { # Modern perl doesn't need Readonly::XS 39 | *is_sv_readonly = sub ($) { Internals::SvREADONLY($_[0]) }; 40 | *make_sv_readonly 41 | = sub ($) { Internals::SvREADONLY($_[0], 1) }; 42 | $XSokay = 1; # We're using the new built-ins so this is a white lie 43 | } 44 | 45 | # Undo setting readonly 46 | sub _SCALAR ($) { 47 | my ($r_var) = @_; 48 | if ($XSokay) { 49 | Internals::SvREADONLY($r_var, 0) if is_sv_readonly($r_var); 50 | } 51 | else { 52 | return if tied($r_var) !~ 'Readonly::Scalar'; 53 | my $r_scalar; 54 | { 55 | my $obj = tied $$r_var; 56 | $r_scalar = $obj; 57 | } 58 | untie $r_var; 59 | $r_var = $r_scalar; 60 | } 61 | } 62 | 63 | sub _ARRAY (\@) { 64 | my ($r_var) = @_; 65 | return if !tied(@$r_var); 66 | return if tied(@$r_var) !~ 'Readonly::Array'; 67 | my $r_array; 68 | { 69 | my $obj = tied @$r_var; 70 | $r_array = $obj; 71 | } 72 | untie @$r_var; 73 | @$r_var = @$r_array; 74 | 75 | # Recursively check child elements for references; clean if Readonly 76 | foreach (@$r_var) { 77 | my $_reftype = ref $_; 78 | if ($_reftype eq 'SCALAR') { _SCALAR($_) } 79 | elsif ($_reftype eq 'ARRAY') { 80 | _ARRAY(@$_); 81 | } 82 | elsif ($_reftype eq 'HASH') { 83 | _HASH(%$_); 84 | } 85 | } 86 | } 87 | 88 | sub _HASH (\%) { 89 | my ($r_var) = @_; 90 | return if !tied(%$r_var); 91 | return if tied(%$r_var) !~ 'Readonly::Hash'; 92 | my $r_hash; 93 | { 94 | my $obj = tied %$r_var; 95 | $r_hash = $obj; 96 | } 97 | untie %$r_var; 98 | %$r_var = %$r_hash; 99 | 100 | # Recursively check child elements for references; clean if Readonly 101 | foreach (values %$r_var) { 102 | my $_reftype = ref $_; 103 | if ($_reftype eq 'SCALAR') { _SCALAR($_) } 104 | elsif ($_reftype eq 'ARRAY') { 105 | _ARRAY(@$_); 106 | } 107 | elsif ($_reftype eq 'HASH') { 108 | _HASH(%$_); 109 | } 110 | } 111 | } 112 | 113 | # Common error messages, or portions thereof 114 | use vars qw/$MODIFY $REASSIGN $ODDHASH/; 115 | $MODIFY = 'Modification of a read-only value attempted'; 116 | $REASSIGN = 'Attempt to reassign a readonly'; 117 | $ODDHASH = 'May not store an odd number of values in a hash'; 118 | 119 | # ---------------- 120 | # Read-only scalars 121 | # ---------------- 122 | package Readonly::Scalar; 123 | 124 | sub STORABLE_freeze { 125 | my ($self, $cloning) = @_; 126 | Readonly::_SCALAR($$self) if $cloning; 127 | } 128 | 129 | sub TIESCALAR { 130 | my $whence 131 | = (caller 2)[3]; # Check if naughty user is trying to tie directly. 132 | Readonly::croak "Invalid tie" 133 | unless $whence && $whence =~ /^Readonly::(?:Scalar1?|Readonly)$/; 134 | my $class = shift; 135 | Readonly::croak "No value specified for readonly scalar" unless @_; 136 | Readonly::croak "Too many values specified for readonly scalar" 137 | unless @_ == 1; 138 | my $value = shift; 139 | return bless \$value, $class; 140 | } 141 | 142 | sub FETCH { 143 | my $self = shift; 144 | return $$self; 145 | } 146 | *STORE = *STORE = sub { Readonly::croak $Readonly::MODIFY }; 147 | *UNTIE = *UNTIE 148 | = sub { Readonly::croak $Readonly::MODIFY if caller() ne 'Readonly' }; 149 | 150 | # ---------------- 151 | # Read-only arrays 152 | # ---------------- 153 | package Readonly::Array; 154 | 155 | sub STORABLE_freeze { 156 | my ($self, $cloning) = @_; 157 | Readonly::_ARRAY(@$self) if $cloning; 158 | } 159 | 160 | sub TIEARRAY { 161 | my $whence 162 | = (caller 1)[3]; # Check if naughty user is trying to tie directly. 163 | Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Array1?$/; 164 | my $class = shift; 165 | my @self = @_; 166 | return bless \@self, $class; 167 | } 168 | 169 | sub FETCH { 170 | my $self = shift; 171 | my $index = shift; 172 | return $self->[$index]; 173 | } 174 | 175 | sub FETCHSIZE { 176 | my $self = shift; 177 | return scalar @$self; 178 | } 179 | 180 | BEGIN { 181 | eval q{ 182 | sub EXISTS 183 | { 184 | my $self = shift; 185 | my $index = shift; 186 | return exists $self->[$index]; 187 | } 188 | } if $] >= 5.006; # couldn't do "exists" on arrays before then 189 | } 190 | *STORE = *STORESIZE = *EXTEND = *PUSH = *POP = *UNSHIFT = *SHIFT = *SPLICE 191 | = *CLEAR = *STORE = *STORESIZE = *EXTEND = *PUSH = *POP = *UNSHIFT 192 | = *SHIFT = *SPLICE = *CLEAR = sub { Readonly::croak $Readonly::MODIFY}; 193 | *UNTIE = *UNTIE 194 | = sub { Readonly::croak $Readonly::MODIFY if caller() ne 'Readonly' }; 195 | 196 | # ---------------- 197 | # Read-only hashes 198 | # ---------------- 199 | package Readonly::Hash; 200 | 201 | sub STORABLE_freeze { 202 | my ($self, $cloning) = @_; 203 | Readonly::_HASH(%$self) if $cloning; 204 | } 205 | 206 | sub TIEHASH { 207 | my $whence 208 | = (caller 1)[3]; # Check if naughty user is trying to tie directly. 209 | Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Hash1?$/; 210 | my $class = shift; 211 | 212 | # must have an even number of values 213 | Readonly::croak $Readonly::ODDHASH unless (@_ % 2 == 0); 214 | my %self = @_; 215 | return bless \%self, $class; 216 | } 217 | 218 | sub FETCH { 219 | my $self = shift; 220 | my $key = shift; 221 | return $self->{$key}; 222 | } 223 | 224 | sub EXISTS { 225 | my $self = shift; 226 | my $key = shift; 227 | return exists $self->{$key}; 228 | } 229 | 230 | sub FIRSTKEY { 231 | my $self = shift; 232 | my $dummy = keys %$self; 233 | return scalar each %$self; 234 | } 235 | 236 | sub NEXTKEY { 237 | my $self = shift; 238 | return scalar each %$self; 239 | } 240 | *STORE = *DELETE = *CLEAR = *STORE = *DELETE = *CLEAR 241 | = sub { Readonly::croak $Readonly::MODIFY}; 242 | *UNTIE = *UNTIE 243 | = sub { Readonly::croak $Readonly::MODIFY if caller() ne 'Readonly'; }; 244 | 245 | # ---------------------------------------------------------------- 246 | # Main package, containing convenience functions (so callers won't 247 | # have to explicitly tie the variables themselves). 248 | # ---------------------------------------------------------------- 249 | package Readonly; 250 | use Exporter; 251 | use vars qw/@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS/; 252 | push @ISA, 'Exporter'; 253 | push @EXPORT, qw/Readonly/; 254 | push @EXPORT_OK, qw/Scalar Array Hash Scalar1 Array1 Hash1/; 255 | 256 | # Predeclare the following, so we can use them recursively 257 | sub Scalar ($$); 258 | sub Array (\@;@); 259 | sub Hash (\%;@); 260 | 261 | # Returns true if a string begins with "Readonly::" 262 | # Used to prevent reassignment of Readonly variables. 263 | sub _is_badtype { 264 | my $type = $_[0]; 265 | return lc $type if $type =~ s/^Readonly:://; 266 | return; 267 | } 268 | 269 | # Shallow Readonly scalar 270 | sub Scalar1 ($$) { 271 | croak "$REASSIGN scalar" if is_sv_readonly($_[0]); 272 | my $badtype = _is_badtype(ref tied $_[0]); 273 | croak "$REASSIGN $badtype" if $badtype; 274 | 275 | # xs method: flag scalar as readonly 276 | if ($XSokay) { 277 | $_[0] = $_[1]; 278 | make_sv_readonly($_[0]); 279 | return; 280 | } 281 | 282 | # pure-perl method: tied scalar 283 | my $tieobj = eval { tie $_[0], 'Readonly::Scalar', $_[1] }; 284 | if ($@) { 285 | croak "$REASSIGN scalar" if substr($@, 0, 43) eq $MODIFY; 286 | die $@; # some other error? 287 | } 288 | return $tieobj; 289 | } 290 | 291 | # Shallow Readonly array 292 | sub Array1 (\@;@) { 293 | my $badtype = _is_badtype(ref tied $_[0]); 294 | croak "$REASSIGN $badtype" if $badtype; 295 | my $aref = shift; 296 | return tie @$aref, 'Readonly::Array', @_; 297 | } 298 | 299 | # Shallow Readonly hash 300 | sub Hash1 (\%;@) { 301 | my $badtype = _is_badtype(ref tied $_[0]); 302 | croak "$REASSIGN $badtype" if $badtype; 303 | my $href = shift; 304 | 305 | # If only one value, and it's a hashref, expand it 306 | if (@_ == 1 && ref $_[0] eq 'HASH') { 307 | return tie %$href, 'Readonly::Hash', %{$_[0]}; 308 | } 309 | 310 | # otherwise, must have an even number of values 311 | croak $ODDHASH unless (@_ % 2 == 0); 312 | return tie %$href, 'Readonly::Hash', @_; 313 | } 314 | 315 | # Deep Readonly scalar 316 | sub Scalar ($$) { 317 | croak "$REASSIGN scalar" if is_sv_readonly($_[0]); 318 | my $badtype = _is_badtype(ref tied $_[0]); 319 | croak "$REASSIGN $badtype" if $badtype; 320 | my $value = $_[1]; 321 | 322 | # Recursively check passed element for references; if any, make them Readonly 323 | foreach ($value) { 324 | if (ref eq 'SCALAR') { Scalar my $v => $$_; $_ = \$v } 325 | elsif (ref eq 'ARRAY') { Array my @v => @$_; $_ = \@v } 326 | elsif (ref eq 'HASH') { Hash my %v => $_; $_ = \%v } 327 | } 328 | 329 | # xs method: flag scalar as readonly 330 | if ($XSokay) { 331 | $_[0] = $value; 332 | make_sv_readonly($_[0]); 333 | return; 334 | } 335 | 336 | # pure-perl method: tied scalar 337 | my $tieobj = eval { tie $_[0], 'Readonly::Scalar', $value }; 338 | if ($@) { 339 | croak "$REASSIGN scalar" if substr($@, 0, 43) eq $MODIFY; 340 | die $@; # some other error? 341 | } 342 | return $tieobj; 343 | } 344 | 345 | # Deep Readonly array 346 | sub Array (\@;@) { 347 | my $badtype = _is_badtype(ref tied @{$_[0]}); 348 | croak "$REASSIGN $badtype" if $badtype; 349 | my $aref = shift; 350 | my @values = @_; 351 | 352 | # Recursively check passed elements for references; if any, make them Readonly 353 | foreach (@values) { 354 | if (ref eq 'SCALAR') { Scalar my $v => $$_; $_ = \$v } 355 | elsif (ref eq 'ARRAY') { Array my @v => @$_; $_ = \@v } 356 | elsif (ref eq 'HASH') { Hash my %v => $_; $_ = \%v } 357 | } 358 | 359 | # Lastly, tie the passed reference 360 | return tie @$aref, 'Readonly::Array', @values; 361 | } 362 | 363 | # Deep Readonly hash 364 | sub Hash (\%;@) { 365 | my $badtype = _is_badtype(ref tied %{$_[0]}); 366 | croak "$REASSIGN $badtype" if $badtype; 367 | my $href = shift; 368 | my @values = @_; 369 | 370 | # If only one value, and it's a hashref, expand it 371 | if (@_ == 1 && ref $_[0] eq 'HASH') { 372 | @values = %{$_[0]}; 373 | } 374 | 375 | # otherwise, must have an even number of values 376 | croak $ODDHASH unless (@values % 2 == 0); 377 | 378 | # Recursively check passed elements for references; if any, make them Readonly 379 | foreach (@values) { 380 | if (ref eq 'SCALAR') { Scalar my $v => $$_; $_ = \$v } 381 | elsif (ref eq 'ARRAY') { Array my @v => @$_; $_ = \@v } 382 | elsif (ref eq 'HASH') { Hash my %v => $_; $_ = \%v } 383 | } 384 | return tie %$href, 'Readonly::Hash', @values; 385 | } 386 | 387 | sub Clone(\[$@%]) { 388 | require Storable; 389 | my $retval = Storable::dclone($_[0]); 390 | $retval = $$retval if ref $retval eq 'REF'; 391 | my $reftype = ref $retval; 392 | if ($reftype eq 'SCALAR') { 393 | _SCALAR($retval); 394 | return $$retval; 395 | } 396 | elsif ($reftype eq 'ARRAY') { 397 | _ARRAY(@$retval); 398 | } 399 | elsif ($reftype eq 'HASH') { 400 | _HASH(%$retval); 401 | return %$retval if wantarray; 402 | } 403 | return $retval; 404 | } 405 | 406 | # Common entry-point for all supported data types 407 | eval q{sub Readonly} . ($] < 5.008 ? '' : '(\[$@%]@)') . <<'SUB_READONLY'; 408 | { 409 | if (ref $_[0] eq 'SCALAR') 410 | { 411 | croak $MODIFY if is_sv_readonly ${$_[0]}; 412 | my $badtype = _is_badtype (ref tied ${$_[0]}); 413 | croak "$REASSIGN $badtype" if $badtype; 414 | croak "Readonly scalar must have only one value" if @_ > 2; 415 | 416 | # Because of problems with handling \$ prototypes declarations like 417 | # Readonly my @a = ... and Readonly my %h = ... are also caught here 418 | croak 'Invalid initialization by assignment' 419 | if @_ == 1 && defined ${$_[0]}; 420 | 421 | my $tieobj = eval {tie ${$_[0]}, 'Readonly::Scalar', $_[1]}; 422 | # Tie may have failed because user tried to tie a constant, or we screwed up somehow. 423 | if ($@) 424 | { 425 | croak $MODIFY if $@ =~ /^$MODIFY at/; # Point the finger at the user. 426 | die "$@\n"; # Not a modify read-only message; must be our fault. 427 | } 428 | return $tieobj; 429 | } 430 | elsif (ref $_[0] eq 'ARRAY') 431 | { 432 | my $aref = shift; 433 | return Array @$aref, @_; 434 | } 435 | elsif (ref $_[0] eq 'HASH') 436 | { 437 | my $href = shift; 438 | croak $ODDHASH if @_%2 != 0 && !(@_ == 1 && ref $_[0] eq 'HASH'); 439 | return Hash %$href, @_; 440 | } 441 | elsif (ref $_[0]) 442 | { 443 | croak "Readonly only supports scalar, array, and hash variables."; 444 | } 445 | else 446 | { 447 | croak "First argument to Readonly must be a reference."; 448 | } 449 | } 450 | SUB_READONLY 451 | 1; 452 | 453 | =head1 NAME 454 | 455 | Readonly - Facility for creating read-only scalars, arrays, hashes 456 | 457 | =head1 Synopsis 458 | 459 | use Readonly; 460 | 461 | # Deep Read-only scalar 462 | Readonly::Scalar $sca => $initial_value; 463 | Readonly::Scalar my $sca => $initial_value; 464 | 465 | # Deep Read-only array 466 | Readonly::Array @arr => @values; 467 | Readonly::Array my @arr => @values; 468 | 469 | # Deep Read-only hash 470 | Readonly::Hash %has => (key => value, key => value, ...); 471 | Readonly::Hash my %has => (key => value, key => value, ...); 472 | # or: 473 | Readonly::Hash %has => {key => value, key => value, ...}; 474 | 475 | # You can use the read-only variables like any regular variables: 476 | print $sca; 477 | $something = $sca + $arr[2]; 478 | next if $has{$some_key}; 479 | 480 | # But if you try to modify a value, your program will die: 481 | $sca = 7; 482 | push @arr, 'seven'; 483 | delete $has{key}; 484 | # The error message is "Modification of a read-only value attempted" 485 | 486 | # Alternate form (Perl 5.8 and later) 487 | Readonly $sca => $initial_value; 488 | Readonly my $sca => $initial_value; 489 | Readonly @arr => @values; 490 | Readonly my @arr => @values; 491 | Readonly %has => (key => value, key => value, ...); 492 | Readonly my %has => (key => value, key => value, ...); 493 | Readonly my $sca; # Implicit undef, readonly value 494 | 495 | # Alternate form (for Perls earlier than v5.8) 496 | Readonly \$sca => $initial_value; 497 | Readonly \my $sca => $initial_value; 498 | Readonly \@arr => @values; 499 | Readonly \my @arr => @values; 500 | Readonly \%has => (key => value, key => value, ...); 501 | Readonly \my %has => (key => value, key => value, ...); 502 | 503 | =head1 Description 504 | 505 | This is a facility for creating non-modifiable variables. This is useful for 506 | configuration files, headers, etc. It can also be useful as a development and 507 | debugging tool for catching updates to variables that should not be changed. 508 | 509 | =head1 Variable Depth 510 | 511 | Readonly has the ability to create both deep and shallow readonly variables. 512 | 513 | If you pass a C<$ref>, an C<@array> or a C<%hash> to corresponding functions 514 | C<::Scalar()>, C<::Array()> and C<::Hash()>, then those functions recurse over 515 | the data structure, marking everything as readonly. The entire structure is 516 | then non-modifiable. This is normally what you want. 517 | 518 | If you want only the top level to be readonly, use the alternate (and poorly 519 | named) C<::Scalar1()>, C<::Array1()>, and C<::Hash1()> functions. 520 | 521 | Plain C creates what the original author calls a "shallow" 522 | readonly variable, which is great if you don't plan to use it on anything but 523 | only one dimensional scalar values. 524 | 525 | C makes the variable 'deeply' readonly, so the following 526 | snippet kills over as you expect: 527 | 528 | use Readonly; 529 | 530 | Readonly::Scalar my $ref => { 1 => 'a' }; 531 | $ref->{1} = 'b'; 532 | $ref->{2} = 'b'; 533 | 534 | While the following snippet does B make your structure 'deeply' readonly: 535 | 536 | use Readonly; 537 | 538 | Readonly my $ref => { 1 => 'a' }; 539 | $ref->{1} = 'b'; 540 | $ref->{2} = 'b'; 541 | 542 | =head1 543 | 544 | =head1 The Past 545 | 546 | The following sections are updated versions of the previous authors 547 | documentation. 548 | 549 | =head2 Comparison with "use constant" 550 | 551 | Perl provides a facility for creating constant values, via the L 552 | pragma. There are several problems with this pragma. 553 | 554 | =over 2 555 | 556 | =item * The constants created have no leading sigils. 557 | 558 | =item * These constants cannot be interpolated into strings. 559 | 560 | =item * Syntax can get dicey sometimes. For example: 561 | 562 | use constant CARRAY => (2, 3, 5, 7, 11, 13); 563 | $a_prime = CARRAY[2]; # wrong! 564 | $a_prime = (CARRAY)[2]; # right -- MUST use parentheses 565 | 566 | =item * You have to be very careful in places where barewords are allowed. 567 | 568 | For example: 569 | 570 | use constant SOME_KEY => 'key'; 571 | %hash = (key => 'value', other_key => 'other_value'); 572 | $some_value = $hash{SOME_KEY}; # wrong! 573 | $some_value = $hash{+SOME_KEY}; # right 574 | 575 | (who thinks to use a unary plus when using a hash to scalarize the key?) 576 | 577 | =item * C works for scalars and arrays, not hashes. 578 | 579 | =item * These constants are global to the package in which they're declared; 580 | cannot be lexically scoped. 581 | 582 | =item * Works only at compile time. 583 | 584 | =item * Can be overridden: 585 | 586 | use constant PI => 3.14159; 587 | ... 588 | use constant PI => 2.71828; 589 | 590 | (this does generate a warning, however, if you have warnings enabled). 591 | 592 | =item * It is very difficult to make and use deep structures (complex data 593 | structures) with C. 594 | 595 | =back 596 | 597 | =head1 Comparison with typeglob constants 598 | 599 | Another popular way to create read-only scalars is to modify the symbol table 600 | entry for the variable by using a typeglob: 601 | 602 | *a = \'value'; 603 | 604 | This works fine, but it only works for global variables ("my" variables have 605 | no symbol table entry). Also, the following similar constructs do B work: 606 | 607 | *a = [1, 2, 3]; # Does NOT create a read-only array 608 | *a = { a => 'A'}; # Does NOT create a read-only hash 609 | 610 | =head2 Pros 611 | 612 | Readonly.pm, on the other hand, will work with global variables and with 613 | lexical ("my") variables. It will create scalars, arrays, or hashes, all of 614 | which look and work like normal, read-write Perl variables. You can use them 615 | in scalar context, in list context; you can take references to them, pass them 616 | to functions, anything. 617 | 618 | Readonly.pm also works well with complex data structures, allowing you to tag 619 | the whole structure as nonmodifiable, or just the top level. 620 | 621 | Also, Readonly variables may not be reassigned. The following code will die: 622 | 623 | Readonly::Scalar $pi => 3.14159; 624 | ... 625 | Readonly::Scalar $pi => 2.71828; 626 | 627 | =head2 Cons 628 | 629 | Readonly.pm used to impose a performance penalty. It was pretty slow. How 630 | slow? Run the C script that comes with Readonly. On my test 631 | system, "use constant" (const), typeglob constants (tglob), regular read/write 632 | Perl variables (normal/literal), and the new Readonly (ro/ro_simple) are all 633 | about the same speed, the old, tie based Readonly.pm constants were about 1/22 634 | the speed. 635 | 636 | However, there is relief. There is a companion module available, Readonly::XS. 637 | You won't need this if you're using Perl 5.8.x or higher. 638 | 639 | I repeat, you do not need Readonly::XS if your environment has perl 5.8.x or 640 | higher. Please see section entitled L for more. 641 | 642 | =head1 Functions 643 | 644 | =over 4 645 | 646 | =item Readonly::Scalar $var => $value; 647 | 648 | Creates a nonmodifiable scalar, C<$var>, and assigns a value of C<$value> to 649 | it. Thereafter, its value may not be changed. Any attempt to modify the value 650 | will cause your program to die. 651 | 652 | A value I be supplied. If you want the variable to have C as its 653 | value, you must specify C. 654 | 655 | If C<$value> is a reference to a scalar, array, or hash, then this function 656 | will mark the scalar, array, or hash it points to as being Readonly as well, 657 | and it will recursively traverse the structure, marking the whole thing as 658 | Readonly. Usually, this is what you want. However, if you want only the 659 | C<$value> marked as Readonly, use C. 660 | 661 | If $var is already a Readonly variable, the program will die with an error 662 | about reassigning Readonly variables. 663 | 664 | =item Readonly::Array @arr => (value, value, ...); 665 | 666 | Creates a nonmodifiable array, C<@arr>, and assigns the specified list of 667 | values to it. Thereafter, none of its values may be changed; the array may not 668 | be lengthened or shortened or spliced. Any attempt to do so will cause your 669 | program to die. 670 | 671 | If any of the values passed is a reference to a scalar, array, or hash, then 672 | this function will mark the scalar, array, or hash it points to as being 673 | Readonly as well, and it will recursively traverse the structure, marking the 674 | whole thing as Readonly. Usually, this is what you want. However, if you want 675 | only the hash C<%@arr> itself marked as Readonly, use C. 676 | 677 | If C<@arr> is already a Readonly variable, the program will die with an error 678 | about reassigning Readonly variables. 679 | 680 | =item Readonly::Hash %h => (key => value, key => value, ...); 681 | 682 | =item Readonly::Hash %h => {key => value, key => value, ...}; 683 | 684 | Creates a nonmodifiable hash, C<%h>, and assigns the specified keys and values 685 | to it. Thereafter, its keys or values may not be changed. Any attempt to do so 686 | will cause your program to die. 687 | 688 | A list of keys and values may be specified (with parentheses in the synopsis 689 | above), or a hash reference may be specified (curly braces in the synopsis 690 | above). If a list is specified, it must have an even number of elements, or 691 | the function will die. 692 | 693 | If any of the values is a reference to a scalar, array, or hash, then this 694 | function will mark the scalar, array, or hash it points to as being Readonly 695 | as well, and it will recursively traverse the structure, marking the whole 696 | thing as Readonly. Usually, this is what you want. However, if you want only 697 | the hash C<%h> itself marked as Readonly, use C. 698 | 699 | If C<%h> is already a Readonly variable, the program will die with an error 700 | about reassigning Readonly variables. 701 | 702 | =item Readonly $var => $value; 703 | 704 | =item Readonly @arr => (value, value, ...); 705 | 706 | =item Readonly %h => (key => value, ...); 707 | 708 | =item Readonly %h => {key => value, ...}; 709 | 710 | =item Readonly $var; 711 | 712 | The C function is an alternate to the C, C, and 713 | C functions. It has the advantage (if you consider it an advantage) of 714 | being one function. That may make your program look neater, if you're 715 | initializing a whole bunch of constants at once. You may or may not prefer 716 | this uniform style. 717 | 718 | It has the disadvantage of having a slightly different syntax for versions of 719 | Perl prior to 5.8. For earlier versions, you must supply a backslash, because 720 | it requires a reference as the first parameter. 721 | 722 | Readonly \$var => $value; 723 | Readonly \@arr => (value, value, ...); 724 | Readonly \%h => (key => value, ...); 725 | Readonly \%h => {key => value, ...}; 726 | 727 | You may or may not consider this ugly. 728 | 729 | Note that you can create implicit undefined variables with this function like 730 | so C while a verbose undefined value must be passed to the 731 | standard C, C, and C functions. 732 | 733 | =item Readonly::Scalar1 $var => $value; 734 | 735 | =item Readonly::Array1 @arr => (value, value, ...); 736 | 737 | =item Readonly::Hash1 %h => (key => value, key => value, ...); 738 | 739 | =item Readonly::Hash1 %h => {key => value, key => value, ...}; 740 | 741 | These alternate functions create shallow Readonly variables, instead of deep 742 | ones. For example: 743 | 744 | Readonly::Array1 @shal => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5); 745 | Readonly::Array @deep => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5); 746 | 747 | $shal[1] = 7; # error 748 | $shal[2]{APL}='Weird'; # Allowed! since the hash isn't Readonly 749 | $deep[1] = 7; # error 750 | $deep[2]{APL}='Weird'; # error, since the hash is Readonly 751 | 752 | =back 753 | 754 | =head1 Cloning 755 | 756 | When cloning using L or L you will notice that the value stays 757 | readonly, which is correct. If you want to clone the value without copying the 758 | readonly flag, use the C function: 759 | 760 | Readonly::Scalar my $scalar => {qw[this that]}; 761 | # $scalar->{'eh'} = 'foo'; # Modification of a read-only value attempted 762 | my $scalar_clone = Readonly::Clone $scalar; 763 | $scalar_clone->{'eh'} = 'foo'; 764 | # $scalar_clone is now {this => 'that', eh => 'foo'}; 765 | 766 | The new variable (C<$scalar_clone>) is a mutable clone of the original 767 | C<$scalar>. 768 | 769 | =head1 Examples 770 | 771 | These are a few very simple examples: 772 | 773 | =head2 Scalars 774 | 775 | A plain old read-only value 776 | 777 | Readonly::Scalar $a => "A string value"; 778 | 779 | The value need not be a compile-time constant: 780 | 781 | Readonly::Scalar $a => $computed_value; 782 | 783 | =head2 Arrays/Lists 784 | 785 | A read-only array: 786 | 787 | Readonly::Array @a => (1, 2, 3, 4); 788 | 789 | The parentheses are optional: 790 | 791 | Readonly::Array @a => 1, 2, 3, 4; 792 | 793 | You can use Perl's built-in array quoting syntax: 794 | 795 | Readonly::Array @a => qw/1 2 3 4/; 796 | 797 | You can initialize a read-only array from a variable one: 798 | 799 | Readonly::Array @a => @computed_values; 800 | 801 | A read-only array can be empty, too: 802 | 803 | Readonly::Array @a => (); 804 | Readonly::Array @a; # equivalent 805 | 806 | =head2 Hashes 807 | 808 | Typical usage: 809 | 810 | Readonly::Hash %a => (key1 => 'value1', key2 => 'value2'); 811 | 812 | A read-only hash can be initialized from a variable one: 813 | 814 | Readonly::Hash %a => %computed_values; 815 | 816 | A read-only hash can be empty: 817 | 818 | Readonly::Hash %a => (); 819 | Readonly::Hash %a; # equivalent 820 | 821 | If you pass an odd number of values, the program will die: 822 | 823 | Readonly::Hash %a => (key1 => 'value1', "value2"); 824 | # This dies with "May not store an odd number of values in a hash" 825 | 826 | =head1 Exports 827 | 828 | Historically, this module exports the C symbol into the calling 829 | program's namespace by default. The following symbols are also available for 830 | import into your program, if you like: C, C, C, 831 | C, C, and C. 832 | 833 | =head1 Internals 834 | 835 | Some people simply do not understand the relationship between this module and 836 | Readonly::XS so I'm adding this section. Odds are, they still won't understand 837 | but I like to write so... 838 | 839 | In the past, Readonly's "magic" was performed by C-ing variables to the 840 | C, C, and C packages (not 841 | to be confused with the functions of the same names) and acting on C, 842 | C, et. al. While this worked well, it was slow. Very slow. Like 20-30 843 | times slower than accessing variables directly or using one of the other 844 | const-related modules that have cropped up since Readonly was released in 845 | 2003. 846 | 847 | To 'fix' this, Readonly::XS was written. If installed, Readonly::XS used the 848 | internal methods C and C to lock simple scalars. On 849 | the surface, everything was peachy but things weren't the same behind the 850 | scenes. In edge cases, code performed very differently if Readonly::XS was 851 | installed and because it wasn't a required dependency in most code, it made 852 | downstream bugs very hard to track. 853 | 854 | In the years since Readonly::XS was released, the then private internal 855 | methods have been exposed and can be used in pure perl. Similar modules were 856 | written to take advantage of this and a patch to Readonly was created. We no 857 | longer need to build and install another module to make Readonly useful on 858 | modern builds of perl. 859 | 860 | =over 861 | 862 | =item * You do not need to install Readonly::XS. 863 | 864 | =item * You should stop listing Readonly::XS as a dependency or expect it to 865 | be installed. 866 | 867 | =item * Stop testing the C<$Readonly::XSokay> variable! 868 | 869 | =back 870 | 871 | =head1 Requirements 872 | 873 | Please note that most users of Readonly no longer need to install the 874 | companion module Readonly::XS which is recommended but not required for perl 875 | 5.6.x and under. Please do not force it as a requirement in new code and do 876 | not use the package variable C<$Readonly::XSokay> in code/tests. For more, see 877 | L. 878 | 879 | There are no non-core requirements. 880 | 881 | =head1 Bug Reports 882 | 883 | If email is better for you, L but I 884 | would rather have bugs sent through the issue tracker found at 885 | http://github.com/sanko/readonly/issues. 886 | 887 | =head1 Acknowledgements 888 | 889 | Thanks to Slaven Rezic for the idea of one common function (Readonly) for all 890 | three types of variables (13 April 2002). 891 | 892 | Thanks to Ernest Lergon for the idea (and initial code) for deeply-Readonly 893 | data structures (21 May 2002). 894 | 895 | Thanks to Damian Conway for the idea (and code) for making the Readonly 896 | function work a lot smoother under perl 5.8+. 897 | 898 | =head1 Author 899 | 900 | Sanko Robinson - http://sankorobinson.com/ 901 | 902 | CPAN ID: SANKO 903 | 904 | Original author: Eric J. Roode, roode@cpan.org 905 | 906 | =head1 License and Legal 907 | 908 | Copyright (C) 2013-2016 by Sanko Robinson 909 | 910 | Copyright (c) 2001-2004 by Eric J. Roode. All Rights Reserved. 911 | 912 | This module is free software; you can redistribute it and/or modify it under 913 | the same terms as Perl itself. 914 | 915 | =begin stopwords 916 | 917 | readonly recurse scalarize nonmodifiable typeglob tglob -ing const-related const 918 | 919 | =end stopwords 920 | 921 | =cut 922 | -------------------------------------------------------------------------------- /minil.toml: -------------------------------------------------------------------------------- 1 | name = "Readonly" 2 | badges = ["github-actions/linux.yaml", "github-actions/windows.yaml", "github-actions/osx.yaml", "github-actions/freebsd.yaml", "metacpan"]module_maker="ModuleBuildTiny" 3 | authority = "cpan:SANKO" 4 | static_install = "auto" 5 | license = "artistic_2" 6 | 7 | [release] 8 | pause_config = "C:/Strawberry/pause.upload" 9 | 10 | [ReleaseTest] 11 | MinimumVersion = false 12 | -------------------------------------------------------------------------------- /t/bugs/001_assign.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | # Verify the Readonly function rejects initialization by assignment 3 | use strict; 4 | use warnings; no warnings 'misc'; 5 | use Test::More; 6 | use Readonly; 7 | # 8 | sub ASSIGNMENT_ERR { 9 | qr/ 10 | \QInvalid initialization by assignment\E | # Readonly assignment patch 11 | \QType of arg 1 to Readonly::Readonly must be one of\E # pre v5.16 12 | /x; 13 | } 14 | SKIP: { 15 | skip 'Readonly $@% syntax is for perl 5.8 or later', 8 unless $] >= 5.008; 16 | # 17 | eval 'Readonly my $simple = 2;'; 18 | like $@ => ASSIGNMENT_ERR, 'Reject scalar initialization by assignment'; 19 | # 20 | eval 'Readonly my @a = (3, 5);'; 21 | like $@ => ASSIGNMENT_ERR, 22 | 'Reject array initialization by assignment'; 23 | # 24 | eval 'Readonly my %h = (key => 42);'; 25 | like $@ => ASSIGNMENT_ERR, 26 | 'Reject hash initialization by assignment'; 27 | # 28 | eval 'Readonly my %h = {key => 42};'; 29 | like $@ => ASSIGNMENT_ERR, 30 | 'Reject hash initialization by assignment to hash ref'; 31 | # 32 | eval 'Readonly my @a;'; 33 | is $@ => '', 'Readonly empty array OK'; 34 | eval 'Readonly my @a; $a[0] = 2;'; 35 | like $@ => qr/Modification of a read-only/, 36 | 'Readonly empty array is read only'; 37 | # 38 | eval 'Readonly my %h;'; 39 | is $@ => '', 'Readonly empty hash OK'; 40 | eval 'Readonly my %h; $h{key} = "v";'; 41 | like $@ => qr/Modification of a read-only/, 42 | 'Readonly empty hash is read only'; 43 | } 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/bugs/007_implicit_undef.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | # Verify the Readonly function accepts implicit undef values 3 | use strict; 4 | use Test::More; 5 | use Readonly; 6 | 7 | sub expected { 8 | my $line = shift; 9 | $@ =~ s/\.$//; # difference between croak and die 10 | return "Invalid tie at " . __FILE__ . " line $line\n"; 11 | } 12 | SKIP: { 13 | skip 'Readonly $@% syntax is for perl 5.8 or later', 1 unless $] >= 5.008; 14 | eval 'Readonly my $simple;'; 15 | is $@ => '', 'Simple API allows for implicit undef values'; 16 | } 17 | eval q'Readonly::Scalar my $scalar;'; 18 | like $@ => qr[Not enough arguments for .*?Readonly::Scalar], 19 | 'Readonly::Scalar does not allow implicit undef values'; 20 | # 21 | done_testing; 22 | -------------------------------------------------------------------------------- /t/general/array.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Readonly array tests 4 | 5 | use strict; 6 | use Test::More tests => 23; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | sub expected 12 | { 13 | my $line = shift; 14 | $@ =~ s/\.$//; # difference between croak and die 15 | return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n"; 16 | } 17 | 18 | use vars qw/@a1 @a2/; 19 | my @ma1; 20 | 21 | # creation (3 tests) 22 | eval 'Readonly::Array @a1;'; 23 | is $@ =>'', 'Create empty global array'; 24 | eval 'Readonly::Array @ma1 => ();'; 25 | is $@ => '', 'Create empty lexical array'; 26 | eval 'Readonly::Array @a2 => (1,2,3,4,5);'; 27 | is $@ => '', 'Create global array'; 28 | 29 | # fetching (3 tests) 30 | ok !defined($a1[0]), 'Fetch global'; 31 | is $a2[0] => 1, 'Fetch global'; 32 | is $a2[-1] => 5, 'Fetch global'; 33 | 34 | # fetch size (3 tests) 35 | is scalar(@a1) => 0, 'Global size (zero)'; 36 | is scalar(@ma1) => 0, 'Lexical size (zero)'; 37 | is $#a2 => 4, 'Global last element (nonzero)'; 38 | 39 | # store (2 tests) 40 | eval {$ma1[0] = 5;}; 41 | is $@ => expected(__LINE__-1), 'Lexical store'; 42 | eval {$a2[3] = 4;}; 43 | is $@ => expected(__LINE__-1), 'Global store'; 44 | 45 | # storesize (1 test) 46 | eval {$#a1 = 15;}; 47 | is $@ => expected(__LINE__-1), 'Change size'; 48 | 49 | # extend (1 test) 50 | eval {$a1[77] = 88;}; 51 | is $@ => expected(__LINE__-1), 'Extend'; 52 | 53 | # exists (2 tests) 54 | SKIP: { 55 | skip "Can't do exists on array until Perl 5.6", 2 if $] < 5.006; 56 | 57 | eval 'ok(exists $a2[4], "Global exists")'; 58 | eval 'ok(!exists $ma1[4], "Lexical exists")'; 59 | } 60 | 61 | # clear (1 test) 62 | eval {@a1 = ();}; 63 | is $@ => expected(__LINE__-1), 'Clear'; 64 | 65 | # push (1 test) 66 | eval {push @ma1, -1;}; 67 | is $@ => expected(__LINE__-1), 'Push'; 68 | 69 | # unshift (1 test) 70 | eval {unshift @a2, -1;}; 71 | is $@ => expected(__LINE__-1), 'Unshift'; 72 | 73 | # pop (1 test) 74 | eval {pop (@a2);}; 75 | is $@ => expected(__LINE__-1), 'Pop'; 76 | 77 | # shift (1 test) 78 | eval {shift (@a2);}; 79 | is $@ => expected(__LINE__-1), 'shift'; 80 | 81 | # splice (1 test) 82 | eval {splice @a2, 0, 1;}; 83 | is $@ => expected(__LINE__-1), 'Splice'; 84 | 85 | # untie (1 test) 86 | SKIP: { 87 | skip "Can't catch untie until Perl 5.6", 1 if $] <= 5.006; 88 | eval {untie @a2;}; 89 | is $@ => expected(__LINE__-1), 'Untie'; 90 | } 91 | -------------------------------------------------------------------------------- /t/general/clone.t: -------------------------------------------------------------------------------- 1 | # Readonly clone tests 2 | use strict; 3 | use warnings; 4 | use Test::More; 5 | use lib '../../lib'; 6 | use Readonly; 7 | # 8 | Readonly::Scalar my $scalar => 13; 9 | Readonly::Array my @array => (1, 2, 3); 10 | Readonly::Hash my %hash => (foo => 'bar'); 11 | Readonly::Array my @deep_array => (1, \@array); 12 | Readonly::Hash my %deep_hash => (foo => \@array); 13 | # 14 | my $scalar_clone = Readonly::Clone $scalar; 15 | $scalar_clone++; 16 | is $scalar_clone, 14; 17 | # 18 | my @array_clone = Readonly::Clone @array; 19 | $array_clone[1] = 4; 20 | is $array_clone[1], 4; 21 | # 22 | my %hash_clone = Readonly::Clone %hash; 23 | $hash_clone{foo} = 'baz'; 24 | is $hash_clone{foo}, 'baz'; 25 | # 26 | my @deep_array_clone = Readonly::Clone @deep_array; 27 | $deep_array_clone[1]->[2] = 4; 28 | is $deep_array_clone[1]->[2], 4; 29 | # 30 | my %deep_hash_clone = Readonly::Clone %deep_hash; 31 | $deep_hash_clone{foo}->[1] = 4; 32 | is $deep_hash_clone{foo}->[1], 4; 33 | # 34 | { 35 | Readonly::Scalar my $scalar => ['string']; 36 | my $scalar_clone = Readonly::Clone $scalar; 37 | push @$scalar_clone, 'foo'; 38 | is_deeply $scalar_clone, [qw[string foo]]; 39 | } 40 | { 41 | Readonly::Scalar my $scalar => {qw[this that]}; 42 | my $scalar_clone = Readonly::Clone $scalar; 43 | $scalar_clone->{'eh'} = 'foo'; 44 | is_deeply $scalar_clone, {this => 'that', eh => 'foo'}; 45 | } 46 | { 47 | Readonly::Scalar my $scalar => {qw[this that]}; 48 | my %scalar_clone = Readonly::Clone $scalar; 49 | $scalar_clone{'eh'} = 'foo'; 50 | is_deeply [\%scalar_clone], [{this => 'that', eh => 'foo'}]; 51 | } 52 | # 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/general/deepa.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Test Array vs Array1 functionality 4 | 5 | use strict; 6 | use Test::More tests => 13; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | sub expected 12 | { 13 | my $line = shift; 14 | $@ =~ s/\.$//; # difference between croak and die 15 | return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n"; 16 | } 17 | 18 | use vars qw/@a1 @a2/; 19 | my $m1 = 17; 20 | 21 | # Create (2 tests) 22 | eval {Readonly::Array @a1 => (\$m1, {x => 5, z => [1, 2, 3]})}; 23 | is $@ => '', 'Create a deep reference array'; 24 | eval {Readonly::Array1 @a2 => (\$m1, {x => 5, z => [1, 2, 3]})}; 25 | is $@ => '', 'Create a shallow reference array'; 26 | 27 | # Modify (10 tests) 28 | eval {$a1[0] = 7;}; 29 | is $@ => expected(__LINE__-1), 'Modify a1'; 30 | eval {$a2[0] = 7;}; 31 | is $@ => expected(__LINE__-1), 'Modify a2'; 32 | 33 | eval {${$a1[0]} = "the";}; 34 | is $@ => expected(__LINE__-1), 'Deep-modify a1'; 35 | is $m1 => 17, 'a1 unchanged'; 36 | 37 | eval {${$a2[0]} = "the";}; 38 | is $@ => '', 'Deep-modify a2'; 39 | is $m1 => 'the', 'a2 modification successful'; 40 | 41 | eval {$a1[1]{z}[1] = 42;}; 42 | is $@ => expected(__LINE__-1), 'Deep-deep modify a1'; 43 | is $a1[1]{z}[1] => 2, 'a1 unchanged'; 44 | 45 | eval {$a2[1]{z}[2] = 42;}; 46 | is $@ => '', 'Deep-deep modify a2'; 47 | is $a2[1]{z}[2], 42, 'a2 mod successful'; 48 | -------------------------------------------------------------------------------- /t/general/deeph.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Test Hash vs Hash1 functionality 4 | 5 | use strict; 6 | use Test::More tests => 13; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | sub expected 12 | { 13 | my $line = shift; 14 | $@ =~ s/\.$//; # difference between croak and die 15 | return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n"; 16 | } 17 | 18 | use vars qw/%h1 %h2/; 19 | my $m1 = 17; 20 | 21 | # Create (2 tests) 22 | eval {Readonly::Hash %h1 => (key1 => \$m1, key2 => {x => 5, z => [1, 2, 3]})}; 23 | is $@ => '', 'Create a deep reference array'; 24 | eval {Readonly::Hash1 %h2 => (key1 => \$m1, key2 => {x => 5, z => [1, 2, 3]})}; 25 | is $@ => '', 'Create a shallow reference array'; 26 | 27 | # Modify (10 tests) 28 | eval {$h1{key1} = 7}; 29 | is $@ => expected(__LINE__-1), 'Modify h1'; 30 | eval {$h2{key1} = 7}; 31 | is $@ => expected(__LINE__-1), 'Modify h2'; 32 | 33 | eval {${$h1{key1}} = "the"}; 34 | is $@ => expected(__LINE__-1), 'Deep-modify h1'; 35 | is $m1 => 17, 'h1 unchanged'; 36 | 37 | eval {${$h2{key1}} = "the"}; 38 | is $@ => '', 'Deep-modify h2'; 39 | is $m1 => 'the', 'h2 modification successful'; 40 | 41 | eval {$h1{key2}{z}[1] = 42}; 42 | is $@ => expected(__LINE__-1), 'Deep-deep modify h1'; 43 | is $h1{key2}{z}[1] => 2, 'h1 unchanged'; 44 | 45 | eval {$h2{key2}{z}[2] = 42}; 46 | is $@ => '', 'Deep-deep modify h2'; 47 | is $h2{key2}{z}[2], 42, 'h2 mod successful'; 48 | -------------------------------------------------------------------------------- /t/general/deeps.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Test Scalar vs Scalar1 functionality 4 | 5 | use strict; 6 | use Test::More tests => 21; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | sub expected 12 | { 13 | my $line = shift; 14 | $@ =~ s/\.$//; # difference between croak and die 15 | return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n"; 16 | } 17 | 18 | use vars qw/$s1 $s2 $s3 $s4/; 19 | my $m1 = 17; 20 | my $m2 = \$m1; 21 | 22 | # Create (4 tests) 23 | eval {Readonly::Scalar1 $s1 => ["this", "is", "a", "test", {x => 5}]}; 24 | is $@ => '', 'Create a shallow reference scalar'; 25 | eval {Readonly::Scalar $s2 => ["this", "is", "a", "test", {x => 5}]}; 26 | is $@ => '', 'Create a deep reference scalar'; 27 | eval {Readonly::Scalar1 $s3 => $m2}; 28 | is $@ => '', 'Create a shallow scalar ref'; 29 | eval {Readonly::Scalar $s4 => $m2}; 30 | is $@ => '', 'Create a deep scalar ref'; 31 | 32 | # Modify (16 tests) 33 | eval {$s1 = 7}; 34 | is $@ => expected(__LINE__-1), 'Modify s1'; 35 | eval {$s2 = 7}; 36 | is $@ => expected(__LINE__-1), 'Modify s2'; 37 | eval {$s3 = 7}; 38 | is $@ => expected(__LINE__-1), 'Modify s3'; 39 | eval {$s4 = 7}; 40 | is $@ => expected(__LINE__-1), 'Modify s4'; 41 | 42 | eval {$s1->[2] = "the"}; 43 | is $@ => '', 'Deep-modify s1'; 44 | is $s1->[2] => 'the', 's1 modification successful'; 45 | 46 | eval {$s2->[2] = "the"}; 47 | is $@ => expected(__LINE__-1), 'Deep-modify s2'; 48 | is $s2->[2] => 'a', 's2 modification supposed to fail'; 49 | 50 | eval {$s1->[4]{z} = 42}; 51 | is $@ => '', 'Deep-deep modify s1'; 52 | is $s1->[4]{z} => 42, 's1 mod successful'; 53 | 54 | eval {$s2->[4]{z} = 42}; 55 | is $@ => expected(__LINE__-1), 'Deep-deep modify s2'; 56 | ok !exists($s2->[4]{z}), 's2 mod supposed to fail'; 57 | 58 | eval {$$s4 = 21}; 59 | is $@ => expected(__LINE__-1), 'Deep-modify s4 should fail'; 60 | is $m1 => 17, 's4 mod should fail'; 61 | 62 | eval {$$s3 = "bah"}; 63 | is $@ => '', 'deep s3 mod'; 64 | is $m1 => 'bah', 'deep s3 mod'; 65 | -------------------------------------------------------------------------------- /t/general/docs.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | # Examples from the docs -- make sure they work! 3 | use strict; 4 | use Test::More tests => 22; 5 | 6 | # Find the module (1 test) 7 | BEGIN { use_ok('Readonly'); } 8 | 9 | sub expected { 10 | my $line = shift; 11 | $@ =~ s/\.$//; # difference between croak and die 12 | return "Modification of a read-only value attempted at " . __FILE__ 13 | . " line $line\n"; 14 | } 15 | my ($a1, $a2, @a1, @a2, @a3, @a4, @a5, @a6, %a1, %a2, %a3, %a4, %a5); 16 | eval { Readonly::Scalar $a1 => "A string value"; }; 17 | is $@ => '', 'A string value'; 18 | my $computed_value = 5 + 5; 19 | eval { Readonly::Scalar $a2 => $computed_value; }; 20 | is $@ => '', 'Scalar computed value'; 21 | eval { Readonly::Array @a1 => (1, 2, 3, 4) }; 22 | is $@ => '', 'Array, with parens'; 23 | eval { Readonly::Array @a2 => 1, 2, 3, 4 }; 24 | is $@ => '', 'Array, without parens'; 25 | eval { Readonly::Array @a3 => qw/1 2 3 4/ }; 26 | is $@ => '', 'Array, with qw'; 27 | my @computed_values = qw/a b c d e f/; 28 | eval { Readonly::Array @a4 => @computed_values }; 29 | is $@ => '', 'Array, with computed values'; 30 | eval { Readonly::Array @a5 => () }; 31 | is $@ => '', 'Empty array 1'; 32 | eval { Readonly::Array @a6 }; 33 | is $@ => '', 'Empty array 2'; 34 | eval { Readonly::Hash %a1 => (key1 => "value1", key2 => "value2") }; 35 | is $@ => '', 'Hash constant'; 36 | my %computed_values = qw/a A b B c C d D/; 37 | eval { Readonly::Hash %a2 => %computed_values }; 38 | is $@ => '', 'Hash, computed values'; 39 | eval { Readonly::Hash %a3 => () }; 40 | is $@ => '', 'Empty hash 1'; 41 | eval { Readonly::Hash %a4 }; 42 | is $@ => '', 'Empty hash 2'; 43 | eval { Readonly::Hash %a5 => (key1 => "value1", "value2") }; 44 | like $@, qr/odd number of values/, 'Odd number of values'; 45 | 46 | # Shallow vs deep (8 tests) 47 | use vars qw/@shal @deep/; 48 | eval { 49 | Readonly::Array1 @shal => 50 | (1, 2, {perl => "Rules", java => "Bites"}, 4, 5); 51 | }; 52 | eval { 53 | Readonly::Array @deep => (1, 2, {perl => "Rules", java => "Bites"}, 4, 5); 54 | }; 55 | eval { $shal[1] = 7 }; 56 | is $@ => expected(__LINE__- 1), 'deep test 1'; 57 | is $shal[1] => 2, 'deep test 1 confirm'; 58 | eval { $shal[2]{APL} = "Weird" }; 59 | is $@ => '', 'deep test 2'; 60 | is $shal[2]{APL} => "Weird", 'deep test 2 confirm'; 61 | eval { $deep[1] = 7 }; 62 | is $@ => expected(__LINE__- 1), 'deep test 3'; 63 | is $deep[1] => 2, 'deep test 3 confirm'; 64 | eval { $deep[2]{APL} = "Weird" }; 65 | is $@ => expected(__LINE__- 1), 'deep test 4'; 66 | ok !exists($deep[2]{APL}), 'deep test 4 confirm'; 67 | -------------------------------------------------------------------------------- /t/general/export.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | # Readonly hash tests 3 | use strict; 4 | use Test::More tests => 1; 5 | 6 | # Find the module (1 test) 7 | BEGIN { use_ok('Readonly', qw/Scalar Scalar1 Array Array1 Hash Hash1/); } 8 | -------------------------------------------------------------------------------- /t/general/hash.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Readonly hash tests 4 | 5 | use strict; 6 | use Test::More tests => 20; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | sub expected 12 | { 13 | my $line = shift; 14 | $@ =~ s/\.$//; # difference between croak and die 15 | return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n"; 16 | } 17 | 18 | use vars qw/%h1/; 19 | my (%mh1, %mh2); 20 | 21 | # creation (3 tests) 22 | eval {Readonly::Hash %h1 => (a=>"A", b=>"B", c=>"C", d=>"D")}; 23 | is $@ => '', 'Create global hash'; 24 | eval {Readonly::Hash %mh1 => (one=>1, two=>2, three=>3, 4)}; 25 | like $@ => qr/odd number of values/, "Odd number of values"; 26 | eval {Readonly::Hash %mh1 => {one=>1, two=>2, three=>3, four=>4}}; 27 | is $@ => '', 'Create lexical hash'; 28 | 29 | # fetch (3 tests) 30 | is $h1{a} => 'A', 'Fetch global'; 31 | ok !defined $h1{'q'}, 'Nonexistent element undefined'; 32 | is $mh1{two} => 2, 'Fetch lexical'; 33 | 34 | # store (1 test) 35 | eval {$h1{a} = 'Z'}; 36 | is $@ => expected(__LINE__-1), 'Store'; 37 | 38 | # delete (1 test) 39 | eval {delete $h1{c}}; 40 | is $@ => expected(__LINE__-1), 'Delete'; 41 | 42 | # clear (1 test) 43 | eval {%h1 = ()}; 44 | is $@ => expected(__LINE__-1), 'Clear'; 45 | 46 | # exists (3 tests) 47 | ok exists $h1{a}, 'Exists'; 48 | eval {ok !exists $h1{x}, "Doesn't exist"}; 49 | is $@ => '', "Doesn't exist (no error)"; 50 | 51 | # keys, values (4 tests) 52 | my @a = sort keys %h1; 53 | is $a[0], 'a', 'Keys a'; 54 | is $a[1], 'b', 'Keys b'; 55 | @a = sort values %h1; 56 | is $a[0], 'A', 'Values A'; 57 | is $a[1], 'B', 'Values B'; 58 | 59 | # each (2 tests) 60 | my ($k,$v); 61 | while ( ($k,$v) = each %h1) 62 | { 63 | $mh2{$k} = $v; 64 | } 65 | is $mh2{c} => 'C', 'Each C'; 66 | is $mh2{d} => 'D', 'Each D'; 67 | 68 | # untie (1 test) 69 | SKIP: { 70 | skip "Can't catch untie until Perl 5.6", 1 if $] < 5.006; 71 | eval {untie %h1}; 72 | is $@ => expected(__LINE__-1), 'Untie'; 73 | } 74 | -------------------------------------------------------------------------------- /t/general/readonly.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Test the Readonly function 4 | 5 | use strict; 6 | use Test::More tests => 19; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | my $expected = qr/Modification of a read-only value attempted at \(eval \d+\),? line 1/; 12 | 13 | SKIP: 14 | { 15 | skip 'Readonly \\ syntax is for perls earlier than 5.8', 9 if $] >= 5.008; 16 | 17 | eval q{Readonly \my $ros => 45}; 18 | is $@ => '', 'Create scalar'; 19 | 20 | eval q{Readonly \my $ros2 => 45; $ros2 = 45}; 21 | like $@ => $expected, 'Modify scalar'; 22 | 23 | eval q{Readonly \my @roa => (1, 2, 3, 4)}; 24 | is $@ => '', 'Create array'; 25 | 26 | eval q{Readonly \my @roa2 => (1, 2, 3, 4); $roa2[2] = 3}; 27 | like $@ => $expected, 'Modify array'; 28 | 29 | eval q{Readonly \my %roh => (key1 => "value", key2 => "value2")}; 30 | is $@ => '', 'Create hash (list)'; 31 | 32 | eval q{Readonly \my %roh => (key1 => "value", "key2")}; 33 | like $@ => qr/odd number of values/, 'Odd number of values'; 34 | 35 | eval q{Readonly \my %roh2 => (key1 => "value", key2 => "value2"); $roh2{key1}="value"}; 36 | like $@ => $expected, 'Modify hash'; 37 | 38 | eval q{Readonly \my %roh => {key1 => "value", key2 => "value2"}}; 39 | is $@ => '', 'Create hash (hashref)'; 40 | 41 | eval q{Readonly \my %roh2 => {key1 => "value", key2 => "value2"}; $roh2{key1}="value"}; 42 | like $@ => $expected, 'Modify hash'; 43 | }; 44 | 45 | SKIP: 46 | { 47 | skip 'Readonly $@% syntax is for perl 5.8 or later', 9 unless $] >= 5.008; 48 | 49 | eval q{Readonly my $ros => 45}; 50 | is $@ => '', 'Create scalar'; 51 | 52 | eval q{Readonly my $ros2 => 45; $ros2 = 45}; 53 | like $@ => $expected, 'Modify scalar'; 54 | 55 | eval q{Readonly my @roa => (1, 2, 3, 4)}; 56 | is $@ => '', 'Create array'; 57 | 58 | eval q{Readonly my @roa2 => (1, 2, 3, 4); $roa2[2] = 3}; 59 | like $@ => $expected, 'Modify array'; 60 | 61 | eval q{Readonly my %roh => (key1 => "value", key2 => "value2")}; 62 | is $@ => '', 'Create hash (list)'; 63 | 64 | eval q{Readonly my %roh => (key1 => "value", "key2")}; 65 | like $@ => qr/odd number of values/, 'Odd number of values'; 66 | 67 | eval q{Readonly my %roh2 => (key1 => "value", key2 => "value2"); $roh2{key1}="value"}; 68 | like $@ => $expected, 'Modify hash'; 69 | 70 | eval q{Readonly my %roh => {key1 => "value", key2 => "value2"}}; 71 | is $@ => '', 'Create hash (hashref)'; 72 | 73 | eval q{Readonly my %roh2 => {key1 => "value", key2 => "value2"}; $roh2{key1}="value"}; 74 | like $@ => $expected, 'Modify hash'; 75 | }; 76 | -------------------------------------------------------------------------------- /t/general/reassign.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Readonly reassignment-prevention tests 4 | 5 | use strict; 6 | use Test::More tests => 22; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | use vars qw($s1 @a1 %h1 $s2 @a2 %h2); 12 | 13 | Readonly::Scalar $s1 => 'a scalar value'; 14 | Readonly::Array @a1 => 'an', 'array', 'value'; 15 | Readonly::Hash %h1 => {a => 'hash', of => 'things'}; 16 | 17 | my $err = qr/^Attempt to reassign/; 18 | 19 | # Reassign scalar 20 | eval {Readonly::Scalar $s1 => "a second scalar value"}; 21 | like $@ => $err, 'Readonly::Scalar reassign die'; 22 | is $s1 => 'a scalar value', 'Readonly::Scalar reassign no effect'; 23 | 24 | # Reassign array 25 | eval {Readonly::Array @a1 => "another", "array"}; 26 | like $@ => $err, 'Readonly::Array reassign die'; 27 | ok eq_array(\@a1, [qw[an array value]]) => 'Readonly::Array reassign no effect'; 28 | 29 | # Reassign hash 30 | eval {Readonly::Hash %h1 => "another", "hash"}; 31 | like $@ => $err, 'Readonly::Hash reassign die'; 32 | ok eq_hash(\%h1, {a => 'hash', of => 'things'}) => 'Readonly::Hash reassign no effect'; 33 | 34 | 35 | # Now use the naked Readonly function 36 | 37 | SKIP: 38 | { 39 | skip 'Readonly \\ syntax is for perls earlier than 5.8', 7 if $] >= 5.008; 40 | 41 | eval q{ 42 | Readonly \$s2 => 'another scalar value'; 43 | Readonly \@a2 => 'another', 'array', 'value'; 44 | Readonly \%h2 => {another => 'hash', of => 'things'}; 45 | }; 46 | 47 | # Reassign scalar 48 | eval q{Readonly \$s2 => "something bad!"}; 49 | like $@ => $err, 'Readonly Scalar reassign die'; 50 | is $s2 => 'another scalar value', 'Readonly Scalar reassign no effect'; 51 | 52 | # Reassign array 53 | eval q{Readonly \@a2 => "something", "bad", "!"}; 54 | like $@ => $err, 'Readonly Array reassign die'; 55 | ok eq_array(\@a2, [qw[another array value]]) => 'Readonly Array reassign no effect'; 56 | 57 | # Reassign hash 58 | eval q{Readonly \%h2 => {another => "bad", hash => "!"}}; 59 | like $@ => $err, 'Readonly Hash reassign die'; 60 | ok eq_hash(\%h2, {another => 'hash', of => 'things'}) => 'Readonly Hash reassign no effect'; 61 | 62 | # Reassign real constant 63 | eval q{Readonly \"scalar" => "vector"}; 64 | like $@ => qr/^Modification of a read-only value attempted at \(eval \d+\),? line 1/, 'Reassign indirect via ref'; 65 | }; 66 | 67 | SKIP: 68 | { 69 | skip 'Readonly $@% syntax is for perl 5.8 or later', 6 unless $] >= 5.008; 70 | 71 | eval q{ 72 | Readonly $s2 => 'another scalar value'; 73 | Readonly @a2 => 'another', 'array', 'value'; 74 | Readonly %h2 => {another => 'hash', of => 'things'}; 75 | }; 76 | 77 | # Reassign scalar 78 | eval q{Readonly $s2 => "something bad!"}; 79 | like $@ => $err, 'Readonly Scalar reassign die'; 80 | is $s2 => 'another scalar value', 'Readonly Scalar reassign no effect'; 81 | 82 | # Reassign array 83 | eval q{Readonly @a2 => "something", "bad", "!"}; 84 | like $@ => $err, 'Readonly Array reassign die'; 85 | ok eq_array(\@a2, [qw[another array value]]) => 'Readonly Array reassign no effect'; 86 | 87 | # Reassign hash 88 | eval q{Readonly %h2 => {another => "bad", hash => "!"}}; 89 | like $@ => $err, 'Readonly Hash reassign die'; 90 | ok eq_hash(\%h2, {another => 'hash', of => 'things'}) => 'Readonly Hash reassign no effect'; 91 | }; 92 | 93 | # Reassign real constants 94 | eval q{Readonly::Scalar "hello" => "goodbye"}; 95 | ok defined $@, 'Reassign real string'; 96 | eval q{Readonly::Scalar1 6 => 13}; 97 | ok defined $@, 'Reassign real number'; 98 | -------------------------------------------------------------------------------- /t/general/scalar.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | 3 | # Readonly scalar tests 4 | 5 | use strict; 6 | use Test::More tests => 12; 7 | 8 | # Find the module (1 test) 9 | BEGIN {use_ok('Readonly'); } 10 | 11 | sub expected 12 | { 13 | my $line = shift; 14 | $@ =~ s/\.$//; # difference between croak and die 15 | return "Modification of a read-only value attempted at " . __FILE__ . " line $line\n"; 16 | } 17 | 18 | use vars qw/$s1 $s2/; 19 | my ($ms1, $ms2); 20 | 21 | # creation (4 tests) 22 | eval {Readonly::Scalar $s1 => 13}; 23 | is $@ => '', 'Create a global scalar'; 24 | eval {Readonly::Scalar $ms1 => 31}; 25 | is $@ => '', 'Create a lexical scalar'; 26 | eval {Readonly::Scalar $s2 => undef}; 27 | is $@ => '', 'Create an undef global scalar'; 28 | eval 'Readonly::Scalar $ms2'; # must be eval string because it's a compile-time error 29 | like $@ => qr/^Not enough arguments for .*?Readonly::Scalar/, 'Try w/o args'; 30 | 31 | # fetching (4 tests) 32 | is $s1 => 13, 'Fetch global'; 33 | is $ms1 => 31, 'Fetch lexical'; 34 | ok !defined $s2, 'Fetch undef global'; 35 | ok !defined $ms2, 'Fetch undef lexical'; 36 | 37 | # storing (2 tests) 38 | eval {$s1 = 7}; 39 | is $@ => expected(__LINE__-1), 'Error setting global'; 40 | is $s1 => 13, 'Readonly global value unchanged'; 41 | 42 | # untie (1 test) 43 | SKIP:{ 44 | skip "Can't catch 'untie' until perl 5.6", 1 if $] < 5.006; 45 | skip "Scalars not tied: XS in use", 1 if $Readonly::XSokay; 46 | eval {untie $ms1}; 47 | is $@ => expected(__LINE__-1), 'Untie'; 48 | } 49 | -------------------------------------------------------------------------------- /t/general/tie.t: -------------------------------------------------------------------------------- 1 | #!perl -I../../lib 2 | # Test the Readonly function 3 | use strict; 4 | use Test::More tests => 4; 5 | 6 | sub expected { 7 | my $line = shift; 8 | $@ =~ s/\.$//; # difference between croak and die 9 | return "Invalid tie at " . __FILE__ . " line $line\n"; 10 | } 11 | 12 | # Find the module (1 test) 13 | BEGIN { use_ok('Readonly'); } 14 | eval { tie my $s, 'Readonly::Scalar', 1 }; 15 | is $@ => expected(__LINE__- 1), "Direct scalar tie"; 16 | eval { tie my @a, 'Readonly::Array', 2, 3, 4 }; 17 | is $@ => expected(__LINE__- 1), "Direct array tie"; 18 | eval { tie my %h, 'Readonly::Hash', five => 5, six => 6 }; 19 | is $@ => expected(__LINE__- 1), "Direct hash tie"; 20 | --------------------------------------------------------------------------------