H DFTNAME(TESTARY2) DATEDIT(*YMD/) BNDDIR('QC2LE')                                             
     F********** TESTARY2: 動的配列のテスト ********************************                        
     F*                                                                                             
     F**********************************************************************                        
                                                                                                    
      * CRTBNDRPG PGM(MYLIB/TESTARY2) SRCFILE(MYSRCLIB/QRPGLESRC) DFTACTGRP(*NO)                    
      *   ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)                                                   
                                                                                                    
      *-------------------------------------------------------------------*                         
      *  2021/10/27 : 作成                                                                          
      *-------------------------------------------------------------------*                         
      *( 作業変数 )                                                                                 
     D STR             S              7A   DIM(5000) BASED(ARYPTR)                                  
                                                                                                    
     D N               S              5P 0                                                          
     D SIZE            S              5P 0                                                          
     D ELEM            S              4S 0 INZ(1000)                                                
     D SAVLEN          S              4S 0 INZ(4500)                                                
     D NULL            C                   CONST(X'00')                                             
                                                                                                    
      /FREE                                                                                         
        //( 最初に 1000 個 (SIZE) の配列を %ALLOC でメモリ確保する )                                
        SIZE = %SIZE(STR) * ELEM;                                                                   
        ARYPTR = %ALLOC(SIZE);                                                                      
        FOR N = 1 TO ELEM;                                                                          
           CLEAR STR(N);                                                                            
        ENDFOR;                                                                                     
        //( 配列数 1000 を超える値として SAVLEN=4500 を配列要素数に設定する )                       
        DOW  SAVLEN > ELEM;                                                                         
          ELEM += 1000;                                                                             
          SIZE  = %SIZE(STR) * ELEM;                                                                
        ENDDO;                                                                                      
        //( REALLOC- メモリーを再割振りする。 )                                                     
        ARYPTR  = %REALLOC(ARYPTR: SIZE);                                                           
        //( 4500 番目に MOVE する )                                                                 
        STR(SAVLEN) = 'TESTDTA';                                                                    
        //( DEALLOC- メモリーを解放する )                                                           
        DEALLOC ARYPTR;                                                                             
      /END-FREE                                                                                     
     C                   SETON                                        LR                            
     C                   RETURN