Analyse de structure d'un source RPG

La commande CMTSRC analyse et commente en marge les structures DO, IF et autres d'un programme RPG.
Il ne fonctionne pas pour RPG IV (on ne peut pas tout avoir).

En pratique, définir une option PDM
CMTSRC &L/&F &N *STRUC /* Structures de programme RPG */

Pour trouver raidement des erreurs de structures dans le source, utiliser l'instruction de recherche
F ? 4

source de la commande de lancement CMTSRC
source du panneau d'aide CMTSRCH
source du CL de lancementCMTSRC1
source du programme pour commenter les structures, CMTSRC2
source du programme pour commenter les tags, CMTSRC3
source du programme pour nettoyer les marges, CMTSRC4

CMTSRC : commande de lancement

Cette commande est plus facile à utiliser comme option utilisateur PDM par
ST : CMTSRC SRCF(&L/&f) MBR(&N)

CMD PROMPT('Structures d''un Source') /* compiler avec PGM(CMTSRC1) HLPPNLGRP(*LIBL/CMTSRCH) HLPID(*CMD) */ /* Patrick LARREYA, 1990-2000 */ PARM KWD(SRCF) TYPE(FILE) PROMPT('Fichier') PARM KWD(MBR) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('Membre') PARM KWD(COMMENT) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*STRUC) VALUES(*STRUC *TAGS *BOTH *NONE) + PROMPT('Commentaires ajoutés') PARM KWD(CLEAR) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NUM) VALUES(*ALL *NUM *NOT) + PROMPT('Nettoyage des marges') FILE: QUAL TYPE(*NAME) LEN(10) DFT(QRPGSRC) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL) (*CURLIB)) + PROMPT('Bibliothèque')

CMTSRCH : panneau d'aide (type PNLGRP)

A compiler par option 14.

:PNLGRP.

:HELP NAME='CMTSRC'.
:p.Cette commande permet de commenter en marge les structures d'un programme
RPG ou RPG38 afin de repérer rapidement leurs imbrications.
:p.En général, elle ne doit pas être utilisée directement, et il est plus
simple d'ajouter dans le fichier d'option de PDM une option ST :
:pc.  CMTSRC &L/&F &N *STRUC  /* Structures de programme RPG */
:EHELP.

:HELP NAME='CMTSRC/SRCF'.Fichier source - Aide.
:XH2.Fichier source
:p.Entrer le nom du fichier source, et de sa bibliothèque.
:EHELP.

:HELP NAME='CMTSRC/MBR'.Membre - Aide.
:XH2.Membre
:p.Entrer le nom du membre à traiter.
:EHELP.

:HELP NAME='CMTSRC/COMMENT'.Type de commentaires - Aide.
:XH2.Type de commentaires
:p.Entrer :pk.*STRUC:epk. pour commenter seulement les ordres de
structuration, :pk.*TAGS:epk. pour commenter seulement les tags et
subroutines, :pk.*BOTH:epk. pour inclure des deux types de commentaires,
ou :pk.*NONE:epk. pour n'inclure aucun commentaire.
:EHELP.

:HELP NAME='CMTSRC/CLEAR'.Nettoyage des marges - Aide.
:XH2.Nettoyage des marges
:p.Entrer :pk.*ALL:epk. pour nettoyer complètement la marge avant tout autre
traitement, :pk.*NUM:epk. pour ne nettoyer la marge que si elle ne contient
que des chiffres, ou :pk.*NOT:epk. pour ne pas nettoyer la marge.
:EHELP.
:epnlgrp.

CMTSRC1 : programme CL de lancement

Définit le membre traité et enchaine l'appel des programmes de traitement.

PGM PARM(&FICL &MBR &COM &NET) /* Commentaire des structures d'un source (tags) */ /* Patrick LARREYA, 1990-2000 */ DCL &FICL *CHAR 20 DCL &LIB *CHAR 10 DCL &SRC *CHAR 10 DCL &MBR *CHAR 10 DCL &TYP *CHAR 10 DCL &COM *CHAR 6 DCL &NET *CHAR 4 DCL &ERR *CHAR 1 VALUE('0') DCL &MSGID *CHAR 7 DCL &MSGF *CHAR 10 DCL &MSGLIB *CHAR 10 DCL &MSGDTA *CHAR 256 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERREUR)) CHGVAR &SRC %SST(&FICL 1 10) CHGVAR &LIB %SST(&FICL 11 10) RTVMBRD FILE(&LIB/&SRC) MBR(&MBR) RTNLIB(&LIB) + SRCTYPE(&TYP) IF ((&TYP *NE 'RPG') *AND (&TYP *NE 'RPG38')) DO SNDPGMMSG MSG(&LIB !< '/' !< &SRC !< '/' !< &MBR !> + 'n''est pas de type RPG. Traitement + abandonné.') GOTO FINFIN ENDDO SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) + MSGDTA('Traitement en cours pour ' !! + &LIB !< '/' !< &SRC !< '/' !< &MBR !< + '...') TOPGMQ(*EXT) MSGTYPE(*STATUS) OVRDBF FILE(SRCF) TOFILE(&LIB/&SRC) MBR(&MBR) IF (&NET = *ALL *OR &NET = *NUM) CALL CMTSRC4 &NET IF (&COM = *STRUC *OR &COM = *BOTH) CALL CMTSRC2 IF (&COM = *TAGS *OR &COM = *BOTH) CALL CMTSRC3 SNDPGMMSG MSG('Traitement de' !> &LIB !< '/' !< &SRC + !< '/' !< &MBR !> 'effectué.') ERREUR: IF (&ERR = '1') GOTO FINFIN CHGVAR &ERR '1' RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) MSGFLIB(&MSGLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) FINFIN: ENDPGM

CMTSRC2 : traitement principal des structures

Ce programme s'est auto-analysé. Il ne traite pas les GOTO, car il ne devrait pas y en avoir.

H*------------------------------------------------------------------- H* Commentateur de structures auto-commenté. H* H* Ne modifie que les lignes concernées (pas de remise à blanc autres) H* Recherche rapide d'erreur, utiliser Find : F ? 4 H* Patrick LARREYA, 1990-2000 H*------------------------------------------------------------------- FSRCF UF F 92 DISK ISRCF NS 01 I 13 92 SRCDTA ISRCDTA DS I 1 2 DEBTAB I 6 7 CID I 28 32 OPER I 28 29 OP2 I 28 30 OP3 C* Rang est le compteur d'imbrications C Z-ADD0 RANG 30 C* Cartes C, en éliminant les commantaires CO/CA pour OR ou AND sur indics 1{ C DO *HIVAL C READ SRCF 97 C 97 LEAVE 2{ C CID IFNE 'C ' C CID ANDNE'CO' C CID ANDNE'CA' C ITER 2} C END 2{ C DEBTAB IFEQ '**' C LEAVE 2} C END C* Subroutine 2{ C OPER IFEQ 'ENDSR' C OPER OREQ 'BEGSR' 3{ C RANG IFNE 0 C MOVE '?' INFO 1 C EXCPT C Z-ADD0 RANG 3} C END C ITER 2} C END C* Fermeture de structure (identifiée par "}") 2{ C OP3 IFEQ 'END' C MOVE ' ' DERDEB 3 3{ C RANG IFEQ 0 C MOVE '?' INFO 3| C ELSE C MOVE '}' INFO 3} C END C EXCPT 3{ C RANG IFNE 0 C SUB 1 RANG 3} C ENDIF C ITER 2} C END C* Filtrage sur CAS suite 2{ C OP3 IFEQ 'CAS' C DERDEB ANDEQ'CAS' C ITER 2} C END C MOVE OP3 DERDEB C* Ouverture de structure (identifiée par "{") 2{ C OP2 IFEQ 'IF' C OP2 OREQ 'DO' C OPER OREQ 'SELEC' C OP3 OREQ 'CAS' C ADD 1 RANG C MOVE '{' INFO C EXCPT 2} C END C* Intermédiaire de structure (identifié par "=") 2{ C OP2 IFEQ 'WH' C OPER OREQ 'OTHER' C OPER OREQ 'ELSE ' 3{ C RANG IFEQ 0 C MOVE '?' INFO 3| C ELSE C MOVE '|' INFO 3} C END C EXCPT C ITER 2} C END C* Un controle sur les fins de end pourrait être ajouté 1} C ENDDO C SETON LR OSRCF E O RANG 15 ' 0' O INFO 16

CMTSRC3 : commentaire des GOTO

Ne devrait pas avoir à servir, car les GOTO doivent être absents d'un RPG.

H*------------------------------------------------------------------- H* Commentateur de structures TAGs et SR H* Recherche rapide d'erreur, utiliser Find : F ? 4 H* Patrick LARREYA, 1990-2000 H*------------------------------------------------------------------- FSRCF UF F 92 DISK E TAG 999 6 ISRCF NS 01 I 13 92 SRCDTA ISRCDTA DS I 1 2 DEBTAB I 6 7 CID I 18 23 NTAG I 28 32 OPER I 28 29 OP2 I 28 30 OP3 I 33 38 FAC2 I 43 48 RESUL C*----------------------------------------------------------------------- C* Cartes C, en éliminant les commantaires CO/CA pour OR ou AND sur indics C Z-ADD0 IT 30 N° Tag C MOVE '---' INFO 3 1{ C DO *HIVAL C READ SRCF 97 C 97 LEAVE 2{ C CID IFNE 'C ' C CID ANDNE'CO' Or C CID ANDNE'CA' And C CID ANDNE'CL' L1 ... Ln C ITER 2} C END 2{ C DEBTAB IFEQ '**' C LEAVE 2} C END C* Enregistrement des TAGS et subroutines 2{ C OPER IFEQ 'ENDSR' C OPER OREQ 'BEGSR' C OPER OREQ 'TAG ' C NTAG IFNE *BLANK C ADD 1 IT C MOVE NTAG TAG,IT C Z-ADDIT IT2 20 C EXCPTMAJTAG C ENDIF 3} C ENDIF C ENDDO C*----------------------------------------------------------------------- C* Second passage C CLOSESRCF C OPEN SRCF C* Cartes C, en éliminant les commantaires CO/CA pour OR ou AND sur indics C MOVE '<--' INFO 3 1{ C DO *HIVAL C READ SRCF 97 C 97 LEAVE 2{ C CID IFNE 'C ' C CID ANDNE'CO' C CID ANDNE'CA' C ITER 2} C END 2{ C DEBTAB IFEQ '**' C LEAVE 2} C END C* Enregistrement des TAGS et subroutines C MOVE *BLANK NTAG C OP3 IFEQ 'CAS' C OP3 OREQ 'CAB' C MOVE RESUL NTAG C END 2{ C OPER IFEQ 'EXSR ' C OPER OREQ 'GOTO ' C MOVE FAC2 NTAG C END C NTAG IFNE *BLANK C Z-ADD1 IT C NTAG LOKUPTAG,IT 90 C *IN90 IFEQ '1' C MOVE '<--' INFO C ELSE C MOVE ' ? ' INFO C Z-ADD0 IT C ENDIF C Z-ADDIT IT2 C EXCPTMAJTAG 3} C ENDIF C ENDDO C SETON LR OSRCF E MAJTAG O IT2 14 ' 0' O INFO 17

CMTSRC4 : nettoyage des marges

Teste pour éviter d'écraser quelque chose important.

FSRCF UF F 92 DISK I* Force à blanc la numérotation en marge ISRCF NS 01 I 13 16 NUMA I 13 14 TB C *ENTRY PLIST C PARM TYPNET 4 *ALL ou *NUM C SETON 98 C DO *HIVAL C READ SRCF 99 C 99 LEAVE C TB IFEQ '**' Postes Table C LEAVE C ENDIF C TYPNET IFNE '*ALL' C TESTN NUMA 98 Numéro. C END C 98 EXCPTMAJ C ENDDO C SETON LR OSRCF E MAJ O 17 ' '