このプロジェクトは pjcj さんの作った Perl モジュール Devel::Cover のプロジ

User

このプロジェクトは pjcj さんの作った Perl モジュール Devel::Cover のプロジェクトです。このプロジェクトで使われている実装技法について興味が有るので、これから色々質問させて下さい。まずは Claude さんの側で、ソースコードを一通り把握して下さい。

uuid: 0d59c195-b242-4099-8862-47afd461f9d0

このプロジェクトは pjcj さんの作った Perl モジュール Devel::Cover のプロジ

Tool Interactions

ユーザーは Devel::Cover という Perl モジュールのプロジェクトについて質問したいとのことです。まずはソースコードを一通り把握してほしいとのことなので、プロジェクトの構造を探索する必要があります。

Task ツールの Explore エージェントを使って、コードベースの構造を把握しましょう。

uuid: assistant: bd611400-cc21-4bb6-b39b-580950dec3b5

このプロジェクトは pjcj さんの作った Perl モジュール Devel::Cover のプロジ

Assistant

Devel::Cover のソースコードを探索して把握します。

uuid: 515c762b-3de1-4088-9f8e-c0bf9cf38bf6

このプロジェクトは pjcj さんの作った Perl モジュール Devel::Cover のプロジ

Tool Interactions

Tool: Task

{
  "subagent_type": "Explore",
  "prompt": "このプロジェクトは Perl モジュール Devel::Cover です。以下の点について徹底的に調査してください：\n\n1. プロジェクトの全体構造（ディレクトリ構成、主要ファイル）\n2. 主要な Perl モジュール (.pm ファイル) の役割\n3. XS/C コード（もしあれば）の役割\n4. テストの構成\n5. ビルドシステム（Makefile.PL など）\n6. 設定ファイルや依存関係\n\n特に Devel::Cover がどのようにコードカバレッジを計測しているかの仕組みに注目してください。",
  "model": "sonnet"
}

Results

Error:

<tool_use_error>InputValidationError: Task failed due to the following issue: The required parameter description is missing</tool_use_error>

description パラメータを追加して再試行します。

Tool: Task

{
  "subagent_type": "Explore",
  "description": "Explore Devel::Cover codebase",
  "prompt": "このプロジェクトは Perl モジュール Devel::Cover です。以下の点について徹底的に調査してください：\n\n1. プロジェクトの全体構造（ディレクトリ構成、主要ファイル）\n2. 主要な Perl モジュール (.pm ファイル) の役割\n3. XS/C コード（もしあれば）の役割\n4. テストの構成\n5. ビルドシステム（Makefile.PL など）\n6. 設定ファイルや依存関係\n\n特に Devel::Cover がどのようにコードカバレッジを計測しているかの仕組みに注目してください。",
  "model": "sonnet"
}

Results

完璧です。全体像が把握できました。詳細なレポートを作成します。

Devel::Cover プロジェクト調査レポート

Devel::Coverは、Perlのコードカバレッジ計測ツールで、非常に洗練されたアーキテクチャを持っています。以下、調査結果を報告します。

1. プロジェクト全体構造

ディレクトリ構成

/home/hkoba/db/monthly/202512/tmp/Devel--Cover/
├── Cover.xs                    # XSコア実装 (1600行)
├── Makefile.PL                 # ビルドシステム (415行)
├── bin/                        # 実行可能ファイル
│   ├── cover                   # メインコマンドラインツール
│   ├── cpancover              # CPAN全体のカバレッジ
│   ├── gcov2perl              # Cコードカバレッジ変換
│   └── queue
├── lib/Devel/
│   └── Cover/                 # Perlモジュール群
│       ├── Cover.pm           # メインモジュール (1891行)
│       ├── DB.pm              # データベース管理 (1037行)
│       ├── Collection.pm      # カバレッジデータ収集 (810行)
│       ├── Statement.pm       # 文カバレッジ
│       ├── Branch.pm          # 分岐カバレッジ
│       ├── Condition.pm       # 条件カバレッジ
│       ├── Subroutine.pm      # サブルーチンカバレッジ
│       ├── DB/                # データベースサブシステム
│       │   ├── IO.pm          # データ永続化
│       │   ├── IO/
│       │   │   ├── Storable.pm
│       │   │   ├── JSON.pm
│       │   │   └── Sereal.pm
│       │   ├── Structure.pm   # コード構造管理
│       │   └── Digests.pm     # ファイルダイジェスト
│       └── Report/            # レポート生成
│           ├── Html_basic.pm
│           ├── Html_minimal.pm
│           ├── Html_subtle.pm
│           ├── Text.pm
│           ├── Vim.pm
│           ├── Nvim.pm
│           └── Json.pm
├── t/                         # 内部テスト (6ファイル)
├── tests/                     # E2Eテスト (93ファイル)
├── docs/                      # ドキュメント
└── utils/                     # ユーティリティ

2. 主要なPerlモジュールの役割

コアモジュール

Devel::Cover.pm (1891行)

  • カバレッジ計測の中核エンジン
  • Perl OPツリーの走査とB::Deparseの活用
  • 条件分岐、文、サブルーチンの検出
  • XSコードとのインターフェース

主要機能:

  • import(): カバレッジ収集の初期化
  • get_cover(): CVからカバレッジ情報抽出
  • add_statement_cover(): 文カバレッジ記録
  • add_branch_cover(): 分岐カバレッジ記録
  • add_condition_cover(): 条件カバレッジ記録
  • walksymtable(): シンボルテーブル走査でサブルーチン発見

Devel::Cover::DB.pm (1037行)

  • カバレッジデータベースの管理
  • データの読み書き、マージ、削除
  • 複数実行結果の統合
  • サマリー計算

Devel::Cover::DB::Structure.pm

  • コード構造のメタデータ管理
  • ファイル、行、サブルーチンの関連付け
  • ダイジェストによる変更検出

Devel::Cover::DB::IO.pm

  • 複数フォーマット対応の永続化層
  • 優先順位: Sereal > JSON > Storable
  • 環境変数 DEVEL_COVER_DB_FORMAT で選択可能

カバレッジ基準クラス

Devel::Cover::Criterion - 基底クラス

  • covered(), total(), percentage(), error() の共通インターフェース

Devel::Cover::Statement - 文カバレッジ

  • 単純カウント: 実行されたか/されてないか

Devel::Cover::Branch - 分岐カバレッジ

  • if/elsif/else の各パスが実行されたか追跡

Devel::Cover::Condition - 条件カバレッジ

  • 論理演算子 (&&, ||, //, xor) の各条件組み合わせを追跡
  • and_2, and_3, or_2, or_3, xor_4 の特殊化サブクラス

Devel::Cover::Subroutine - サブルーチンカバレッジ

  • サブルーチンが呼び出されたか記録

Devel::Cover::Pod - PODドキュメントカバレッジ

  • Pod::Coverage統合

Devel::Cover::Time - 時間プロファイリング

  • オプション機能

3. XS/Cコードの役割 (Cover.xs - 1600行)

計測の仕組み: 2つの動作モード

モード1: runops関数置換 (レガシーモード)

static int runops_cover(pTHX) {
    for (;;) {
        // 各OPの実行前にカバレッジチェック
        if (PL_op->op_type == OP_NEXTSTATE)
            check_if_collecting(aTHX_ cCOP);
        else if (PL_op->op_type == OP_ENTERSUB)
            store_return(aTHX);
        
        // 文カバレッジ記録
        if (collecting_here(aTHX) && collecting(Statement))
            cover_current_statement(aTHX);
        
        // 論理演算カバレッジ
        if (collecting(Condition))
            switch (PL_op->op_type) {
                case OP_AND: case OP_OR: case OP_DOR:
                case OP_ANDASSIGN: case OP_ORASSIGN:
                    logop(aTHX);
                    break;
            }
        
        // 元のPP関数実行
        call_fptr:
            PL_op = CALLOP PL_op->op_ppaddr(aTHX);
        if (!PL_op) return 0;
    }
}

モード2: op_ppaddr置換 (デフォルト、高速)

static void replace_ops(pTHX) {
    // 元のppaddr保存
    for (i = 0; i < MAXO; i++)
        MY_CXT.ppaddr[i] = PL_ppaddr[i];
    
    // 重要なOP置き換え
    PL_ppaddr[OP_NEXTSTATE] = dc_nextstate;
    PL_ppaddr[OP_DBSTATE]   = dc_dbstate;
    PL_ppaddr[OP_ENTERSUB]  = dc_entersub;
    PL_ppaddr[OP_AND]       = dc_and;
    PL_ppaddr[OP_OR]        = dc_or;
    PL_ppaddr[OP_DOR]       = dc_dor;
    PL_ppaddr[OP_XOR]       = dc_xor;
    // ...
}

主要なC関数

データ構造

typedef struct {
    unsigned covering;              // カバレッジフラグ
    int collecting_here;            // 現在のファイルを収集中か
    HV *statements;                 // 文カバレッジ
    HV *branches;                   // 分岐カバレッジ
    HV *conditions;                 // 条件カバレッジ
    HV *times;                      // 時間プロファイル
    HV *modules;                    // モジュール情報
    HV *files;                      // ファイル情報
    Perl_ppaddr_t ppaddr[MAXO];     // 元のppaddr
} my_cxt_t;

キー関数

// OPを一意に識別するキー生成
static char *get_key(OP *o) {
    uniq.addr = o;
    uniq.op = *o;
    uniq.op.op_ppaddr = 0;
    if (o->op_type == OP_NEXTSTATE) {
        uniq.fileinfohash = fnv1a_hash(CopFILE, CopLINE);
    }
    return (char *)&uniq;
}

// 文カバレッジ記録
static void cover_statement(pTHX_ OP *op) {
    char *ch = get_key(op);
    SV **count = hv_fetch(MY_CXT.statements, ch, KEY_SZ, 1);
    IV c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
    sv_setiv(*count, c);
}

// 条件カバレッジ追加
static void add_conditional(pTHX_ OP *op, int cond) {
    SV **count = av_fetch(get_conditional_array(aTHX_ op), cond, 1);
    int c = SvTRUE(*count) ? SvIV(*count) + 1 : 1;
    sv_setiv(*count, c);
}

論理演算の追跡メカニズム

短絡評価を追跡するため、次のOPのop_ppaddrを一時的にget_condition()に置き換える:

static void logop(pTHX) {
    // 次のOPを保存
    next = right->op_next;
    
    // Pending_conditionalsハッシュに記録
    cref = hv_fetch(Pending_conditionals, get_key(next), KEY_SZ, 1);
    av_push(conds, newSViv(PTR2IV(PL_op)));
    
    // 次のOP実行時にget_condition()が呼ばれるよう設定
    next->op_ppaddr = get_condition;
}

static OP *get_condition(pTHX) {
    // 条件の各組み合わせを記録
    // 元のppaddr復元して実行
}

時間プロファイリング

#ifdef HAS_GETTIMEOFDAY
static void cover_time(pTHX) {
    if (collecting(Time)) {
        count = hv_fetch(MY_CXT.times, MY_CXT.profiling_key, KEY_SZ, 1);
        c = SvNV(*count) + elapsed();
        sv_setnv(*count, c);
    }
}
#endif

4. カバレッジ計測の仕組み

全体フロー

  1. 初期化 (import時)

    use Devel::Cover -db => 'cover_db', -coverage => 'all';
    • XS BOOT実行: replace_ops() または PL_runops = runops_cover
    • カバレッジデータ構造初期化
    • ファイルフィルタ設定 (@Inc, @Ignore, @Select)

  2. CHECK段階

    CHECK { check }
    • walksymtable(\%main::, "find_cv"): 全サブルーチン探索
    • B::main_cv->PADLIST: レキシカル変数からCV発見
    • ファイルフィルタリング

  3. 実行時 (Runtime)

    • OPごとにカバレッジデータ収集
    • check_if_collecting(): ファイルごとに収集ON/OFF
    • 文/分岐/条件/サブルーチン実行カウント

  4. END段階

    END { report() }
    • get_cover(@Cvs): 各CVのOPツリー走査
    • B::Deparse活用: ソースコード再構築
      • カスタムdeparse(): 条件分岐検出
      • logop(), logassignop(): 論理演算解析
    • カバレッジデータとコード構造のマッピング
    • データベース書き込み

  5. レポート生成 (cover コマンド)

    cover -report html
    • データベース読み込み
    • マージ・集計
    • HTMLやテキストレポート生成

B::Deparseのカスタマイズ

Devel::CoverはB::Deparseの内部関数をフックしてカバレッジ情報を収集:

# オリジナル関数保存
BEGIN {
    $Original{deparse}     = \&B::Deparse::deparse;
    $Original{logop}       = \&B::Deparse::logop;
    $Original{logassignop} = \&B::Deparse::logassignop;
}

# カスタム実装
sub logop {
    my ($op, $left, $right) = @_;
    
    # 左辺と右辺をdeparse
    $left  = $self->deparse($left, 1);
    $right = $self->deparse($right, 1);
    
    # カバレッジ情報記録
    add_condition_cover($op, $highop, $left, $right);
    
    # 分岐カバレッジ記録
    add_branch_cover($op, $lowop, "if ($left)", $File, $Line);
}

この手法により:

  • OPツリーから元のソースコード形式を復元
  • 条件式のテキスト表現を取得 (例: $a && $b)
  • 分岐の種類を判定 (if, elsif, unless, etc.)

5. テストの構成

テストディレクトリ構造

t/ (6ファイル)

  • 内部ユニットテスト
  • /home/hkoba/db/monthly/202512/tmp/Devel--Cover/t/00-report-prereqs.t
  • /home/hkoba/db/monthly/202512/tmp/Devel--Cover/t/internal/
  • /home/hkoba/db/monthly/202512/tmp/Devel--Cover/t/regexp/

tests/ (93ファイル)

  • E2Eテスト: 実際のコードスニペット
  • 各テストファイルに __COVER__ ディレクティブ: 
    # __COVER__ criteria statement branch condition
# __COVER__ test_parameters -merge 0
# __COVER__ cover_parameters -report text

Devel::Cover::Test.pm

  • テストフレームワーク
  • 期待値(gold)ファイルとの比較
  • Makefile.PL がtests/をt/e2e/に変換

テスト実行

# Makefile.PLがテスト生成
for my $t (readdir "tests") {
    # tests/foo -> t/e2e/afoo.t
    print $test <<EOT;
    use Devel::Cover::Test;
    my $test = Devel::Cover::Test->new("$t");
    $test->run_test;
    EOT
}

6. ビルドシステム (Makefile.PL)

主要機能

  1. 依存関係チェック

    check "Storable", $msg;
check "JSON::MaybeXS", $msg;
check "Sereal", $msg;
check "Digest::MD5", $msg;
check "Template", $msg, "2.00";
check "Pod::Coverage", $msg, "0.06";

  2. Inc.pm生成

    • ビルド時の@INCをキャプチャ
    • 実行時にPerl版が違う場合の警告機能

  3. テスト生成

    • tests/* から t/e2e/*.t を動的生成

  4. カスタムターゲット

    make t          # パラレルテスト実行
make self_cover # Devel::Cover自身のカバレッジ
make gold       # 期待値更新
make diff       # 差分確認

  5. XSコンパイル

    • Cover.xs をコンパイル
    • utils/typemap 使用

プリプロセッサフラグ

#define Statement  0x00000001
#define Branch     0x00000002
#define Condition  0x00000004
#define Subroutine 0x00000008
#define Pod        0x00000020
#define Time       0x00000040
#define All        0xffffffff

7. 設定ファイルと依存関係

必須依存関係

  • Digest::MD5: ファイル変更検出
  • Storable/JSON::MaybeXS/Sereal: データ永続化

オプション依存関係

  • Template Toolkit 2.00: HTML/cpancoverレポート
  • PPI::HTML または Perl::Tidy: シンタックスハイライト
  • Pod::Coverage 0.06: PODカバレッジ
  • Pod::Coverage::CountParents: PODカバレッジ改善
  • Browser::Open: -launch フラグ
  • HTML::Entities: HTMLレポート

環境変数

# ユーザー変数
DEVEL_COVER_OPTIONS="-db,mydb,-coverage,statement,branch"
HARNESS_PERL_SWITCHES=-MDevel::Cover
PERL5OPT=-MDevel::Cover

# 開発者変数
DEVEL_COVER_DEBUG=1
DEVEL_COVER_SELF=1        # Devel::Cover自身をカバー
DEVEL_COVER_NO_TESTS=1    # テスト無効化
DEVEL_COVER_DB_FORMAT=Sereal

設定ファイル

  • .perlcriticrc (60KB!): 厳格なコード品質チェック
  • .perltidyrc: コードフォーマット
  • .perlimports.toml: import最適化
  • dist.ini: Dist::Zilla設定

8. カバレッジ計測の重要な仕組みの詳細

OPキーの生成

各OPを一意に識別するために、以下の情報を組み合わせたハッシュキーを生成:

struct unique {
    OP *addr;                // OPアドレス
    OP op;                   // OP構造体コピー
    size_t fileinfohash;     // ファイル名:行番号のハッシュ
};

FNV-1aハッシュ使用でファイル位置情報を圧縮。

条件カバレッジの配列構造

各条件に対して6要素配列:

// 0 - XORの第1オペランドがtrueだったフラグ
// 1 - 短絡せず第2オペランドfalse
// 2 - 短絡せず第2オペランドtrue
// 3 - 短絡した、またはXORで第2オペランドfalse
// 4 - XORで第2オペランドtrue
// 5 - void context フラグ

これにより、and_2, and_3, or_2, or_3, xor_4 の全パターンを記録可能。

ファイルフィルタリング

3段階のフィルタ:

  1. @Inc_re: 標準ライブラリパスを除外
  2. @Ignore_re: 特定パターンを除外 (デフォルト: /Devel/Cover[./])
  3. @Select_re: 特定パターンのみ選択
sub use_file {
    my $file = shift;
    return 0 if grep $file =~ $_, @Inc_re;
    return 0 if @Select_re && !grep $file =~ $_, @Select_re;
    return 0 if @Ignore_re && grep $file =~ $_, @Ignore_re;
    return 1;
}

スレッド対応 (部分的)

#ifdef USE_ITHREADS
MUTEX_LOCK(&DC_mutex);
// クリティカルセクション
MUTEX_UNLOCK(&DC_mutex);
#endif

ただし、READMEに「スレッド未対応」と明記。基本的なミューテックスは実装済み。

結論: Devel::Coverの卓越した設計

Devel::Coverは以下の点で優れた設計を持っています:

  1. 2層アーキテクチャ

    • XS層: 高速なカバレッジデータ収集
    • Perl層: 柔軟なデータ処理とレポート生成

  2. 2つの計測モード

    • runops置換: 包括的だが遅い
    • ppaddr置換: 高速でデフォルト

  3. B::Deparseの巧妙な活用

    • OPツリーからソースコード復元
    • 条件分岐の詳細な解析

  4. 複数の永続化フォーマット

    • Sereal/JSON/Storableの自動選択
    • ポータビリティとパフォーマンスの両立

  5. 包括的なカバレッジ基準

    • Statement, Branch, Condition, Subroutine, Pod, Time
    • 各基準ごとに特殊化されたクラス

  6. 堅牢なテストフレームワーク

    • 93のE2Eテスト
    • gold ファイルによる期待値管理
    • 自己カバレッジ機能

このアーキテクチャにより、Devel::CoverはPerlのコードカバレッジツールのデファクトスタンダードとなっています。

agentId: aa5d2ac (for resuming to continue this agent's work if needed)

エージェントから非常に詳細なレポートが返ってきました。Devel::Cover の構造がよく把握できました。ユーザーに要約して伝えます。

uuid: assistant: 3b9039d8-fd48-4d83-a526-96803d1c5c34, assistant: 52e8432a-a7f3-428c-8825-05542ad81907, assistant: c32555ce-ab8c-458f-8124-2ed018aee297, assistant: be490636-7b71-4316-9254-863083e53550

このプロジェクトは pjcj さんの作った Perl モジュール Devel::Cover のプロジ

Assistant

Devel::Cover のソースコードを把握しました。以下が概要です：

プロジェクト構造

コアコンポーネント

  • Cover.xs (約1600行) - XS/C によるカバレッジ計測エンジン
  • lib/Devel/Cover.pm (約1900行) - メインモジュール、B::Deparse を活用
  • lib/Devel/Cover/DB.pm - カバレッジデータベース管理

カバレッジ計測の仕組み

2つの動作モード:

  1. ppaddr 置換モード (デフォルト、高速) - PL_ppaddr テーブルを置換
  2. runops 置換モード (レガシー) - PL_runops を独自実装に置換

計測対象:

  • Statement (文)
  • Branch (分岐)
  • Condition (条件 - &&, ||, //, xor)
  • Subroutine (サブルーチン)
  • Pod (ドキュメント)
  • Time (時間プロファイリング)

特徴的な実装技法

  • B::Deparse のカスタマイズ - OP ツリーからソースコード形式を復元
  • FNV-1a ハッシュ - OP の一意識別キー生成
  • 複数シリアライザ対応 - Sereal > JSON > Storable の優先順位
  • 3段階ファイルフィルタ - @Inc, @Ignore, @Select

その他

  • 93個の E2E テスト (tests/ ディレクトリ)
  • 複数のレポート形式 (HTML, Text, JSON, Vim/Nvim 統合)
  • cover コマンドによるレポート生成

どの部分について詳しく質問されますか？

uuid: bdc41882-c47f-4acb-b69e-0d7ded832330

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

User

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードから真理値表を生成することです。そのために、Devel::Cover がどのようにして Perl のコードを解析して真理値表を取り出しているのかに興味があります。ですので、この視点で、Devel::Cover の中のヒントになる箇所を挙げて、そのコードの動く仕組みを解説して下さい。

uuid: 1471f7c4-5668-4fff-9db2-16d9a05ff5e2

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Tool Interactions

ユーザーは Perl のソースコードから真理値表を生成したいと考えている。Devel::Cover がどのようにして条件式を解析し、真理値の組み合わせを追跡しているかに興味がある。

これは Devel::Cover の Condition カバレッジの部分が特に関連している。条件カバレッジでは、論理演算子 (&&, ||, //, xor) の各オペランドの真偽値の組み合わせを追跡している。

関連するコードを詳しく調べる必要がある：

  1. Cover.xs の条件カバレッジ関連部分（logop, get_condition など）
  2. lib/Devel/Cover.pm の条件解析部分（add_condition_cover, logop のフック）
  3. lib/Devel/Cover/Condition.pm や関連クラス

これらのファイルを読んで、真理値表生成に関連する部分を詳しく説明する。

uuid: assistant: 90083538-c0cf-4ff7-929e-e6d5b9f17398

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Assistant

真理値表生成の観点から、Devel::Cover の条件カバレッジ（Condition coverage）の実装を詳しく調べます。

uuid: d5e0161c-b93b-4582-82e4-a60a7157f487

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Tool Interactions

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover.pm"
}

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/Cover.xs"
}

Results

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover.pm (contents omitted)

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/Cover.xs (contents omitted)

ユーザーは真理値表を生成したいと考えており、Devel::Cover がどのように条件式を解析しているかに興味があります。

Devel::Cover のコードを読んで、真理値表生成に関連する重要な部分を見つけました。主に以下の部分が関連しています：

  1. Cover.xs の条件カバレッジ配列構造 (行 511-526)

    • 配列の各要素の意味が定義されている
    • 0: XOR で最初のオペランドが true だったフラグ
    • 1: 短絡せず第2オペランドが false
    • 2: 短絡せず第2オペランドが true
    • 3: 短絡した、または XOR で第2オペランドが false
    • 4: XOR で第2オペランドが true
    • 5: void context フラグ

  2. Cover.xs の cover_logop() 関数 (行 786-972)

    • 論理演算子の追跡方法
    • 短絡評価の検出
    • 次の OP の ppaddr を get_condition() に置き換えるトリック

  3. Devel::Cover.pm の add_condition_cover() (行 906-966)

    • 条件カバレッジの情報を構造化
    • type (and_2, and_3, or_2, or_3, xor_4) の決定
    • left, right オペランドのテキスト表現

  4. Devel::Cover.pm の logop() フック (行 1124-1170)

    • B::Deparse::logop をフックして条件式のテキスト表現を取得

さらに、真理値表生成に向けて、Devel::Cover/Condition.pm を詳細に調査する必要があります。条件のクラス（and_2, and_3, or_2, or_3, xor_4）の解析が重要になるでしょう。これらの情報から、条件式の論理構造を正確に理解できる可能性があります。

uuid: assistant: 9e91b455-edd1-449a-8b94-4577198eb889, assistant: fe5cd6a9-06a5-4fdb-a390-b18de546d7e3, assistant: 20a69dca-b295-4a65-9a8f-166055365300

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Assistant

関連するコードを見つけました。次に、条件カバレッジの真理値表を生成する部分を詳しく見てみます。

uuid: 52081bf8-e015-4e69-aeb9-922c8352a43d

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Tool Interactions

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition.pm"
}

Tool: Glob

{
  "pattern": "lib/Devel/Cover/Condition/*.pm"
}

Results

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition.pm (contents omitted)

Result:

No files found

条件のサブクラス（and_2, and_3, or_2, or_3, xor_4）を探す必要がある。Criterion ディレクトリを見てみよう。

Tool: Glob

{
  "pattern": "lib/Devel/Cover/*.pm"
}

Results

Result:

/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Branch.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Collection.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_and_2.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_and_3.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_or_2.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_or_3.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_xor_4.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Criterion.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/DB.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Dumper.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Html_Common.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Op.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Pod.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Statement.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Subroutine.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Test.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Time.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Truth_Table.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Util.pm
/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Web.pm

まさに探していたものがあります！Truth_Table.pm と条件のサブクラス（Condition_and_2.pm, Condition_and_3.pm, Condition_or_2.pm, Condition_or_3.pm, Condition_xor_4.pm）があります。これらを読んでみましょう。

uuid: assistant: 5b7f462d-a7a5-4a10-96cb-9a9bf44d2b4f, assistant: ebad7bf6-5e54-4b53-af5f-21ffb41b096e, assistant: a9a0b91e-6847-451d-8907-39d55360feb5, assistant: fa3b03eb-618d-4fbc-bae3-e57791fcd6fc, assistant: e7eeb40e-eb29-4de6-837e-0480b7b00283

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Assistant

真理値表に関連するファイルがあります！これらを読んでみます。

uuid: 0d8c69aa-52d6-4a5c-be5b-d833b71b178e

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Tool Interactions

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Truth_Table.pm"
}

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_and_3.pm"
}

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_or_3.pm"
}

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_xor_4.pm"
}

Results

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Truth_Table.pm (contents omitted)

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_and_3.pm (contents omitted)

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_or_3.pm (contents omitted)

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_xor_4.pm (contents omitted)

素晴らしい！今、真理値表生成に関連する全てのキーコードを把握しました。ユーザーに詳しく解説できます。

要約すると：

  1. 条件のタイプ:

    • and_3: $a && $b - 3つの条件パス (!l, l&&!r, l&&r)
    • or_3: $a || $b - 3つの条件パス (l, !l&&r, !l&&!r)
    • xor_4: $a xor $b - 4つの条件パス (l&&r, l&&!r, !l&&r, !l&&!r)
    • and_2, or_2: 右辺が定数の場合

  2. XS層での収集 (Cover.xs):

    • cover_logop() - 論理演算子を追跡
    • set_conditional(), add_conditional() - 条件配列にデータを格納
    • 配列の構造:
      • [0]: XOR で最初のオペランドが true
      • [1]: 短絡せず第2オペランドが false
      • [2]: 短絡せず第2オペランドが true
      • [4]: XOR 用
      • [5]: void context

  3. Perl層での解析 (Devel::Cover.pm):

    • add_condition_cover() - XS から収集したデータを整理
    • logop() - B::Deparse をフックして式のテキスト表現を取得
    • 条件式の左辺・右辺のテキストと演算子を取得

  4. 真理値表の生成 (Truth_Table.pm):

    • 基本的な真理値表作成メソッドを実装
    • 各論理演算子に特化した真理値表生成
    • 複合式の真理値表をマージする仕組み
    • X は「don't care」状態を表現し、短絡評価の特殊ケースを処理

uuid: assistant: 1ba7ee77-4689-44e0-9b3f-10c1cb9fa5a6, assistant: 6a9ab4d2-8115-4652-bdab-83c1ecae1861, assistant: a6b8ee4c-84a7-4d0e-b4e5-4cc70aceeea7, assistant: 6b3c862d-4c34-4a74-a9dc-e75e248b95d1, assistant: f204e133-6486-49f7-a949-d0dff6f144ae

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Assistant

素晴らしいファイルが見つかりました。残りの条件タイプも確認しておきます。

uuid: fc8df90f-6947-4870-97a9-225c515c4e5b

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Tool Interactions

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_and_2.pm"
}

Tool: Read

{
  "file_path": "/home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_or_2.pm"
}

Results

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_and_2.pm (contents omitted)

Read: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/lib/Devel/Cover/Condition_or_2.pm (contents omitted)

これで全ての関連ファイルを読みました。ユーザーに真理値表生成の仕組みを詳しく解説できます。

uuid: assistant: 01846727-84ba-4f29-9969-3e7f5a5c3ae0, assistant: a76028da-748f-4bb3-948d-32bb593b6abe, assistant: cb3fd050-8734-4a4b-bdf2-76a47e15917d

ありがとうございます。私の最終的な目的は、（カバレッジを取ることではなく）Perl のソースコードか

Assistant

全体像が把握できました。真理値表生成の観点から Devel::Cover の仕組みを解説します。

Devel::Cover が真理値表を生成する仕組み

1. 全体の流れ

[実行時] XS層 (Cover.xs)     [事後解析] Perl層 (Cover.pm)     [表示] Truth_Table.pm
        ↓                            ↓                              ↓
  OP 実行を監視              B::Deparse でコード復元          真理値表を構築
  条件の結果を収集           条件式のテキスト取得             複合式をマージ

2. XS層: 条件の実行結果を収集 (Cover.xs)

2.1 条件配列の構造 (行 511-526)

/*
 * 条件配列は6要素で構成:
 * 0 - XOR で最初のオペランドが true だったフラグ
 * 1 - 短絡せず、第2オペランドが false
 * 2 - 短絡せず、第2オペランドが true
 * 3 - 短絡した (または XOR で第2オペランドが false)
 * 4 - XOR で第2オペランドが true
 * 5 - void context フラグ
 */

2.2 論理演算の追跡 (cover_logop() 行 786-972)

核心となるトリック: 次のOPの op_ppaddr を一時的に get_condition() に置き換える

static void cover_logop(pTHX) {
    // スタックから左辺の値を取得
    int leftval_true_ish = SvTRUE(TOPs);
    
    if ((PL_op->op_type == OP_AND && leftval_true_ish) ||  // AND: 左が true → 右へ
        (PL_op->op_type == OP_OR && !leftval_true_ish)) {  // OR: 左が false → 右へ
        // 短絡しない場合
        
        OP *next = right->op_next;  // 右辺実行後の次のOP
        
        // 次のOPの実行関数を get_condition() に置き換え
        next->op_ppaddr = get_condition;
        
        // Pending_conditionals ハッシュに記録
        av_push(conds, newSViv(PTR2IV(PL_op)));
    } else {
        // 短絡した場合
        add_conditional(aTHX_ PL_op, 3);  // インデックス3に記録
    }
}

2.3 条件の結果を取得 (get_condition() 行 707-728)

static OP *get_condition(pTHX) {
    // スタックから第2オペランドの結果を取得
    int true_ish = SvTRUE(TOPs);
    
    // インデックス: 1=false, 2=true
    add_condition(aTHX_ *pc, true_ish ? 2 : 1);
    
    // 元の ppaddr を復元して実行
    return PL_op;
}

3. Perl層: 条件式のテキストを取得 (Devel::Cover.pm)

3.1 B::Deparse のフック (行 1124-1170)

# 元の関数を保存
BEGIN {
    $Original{logop} = \&B::Deparse::logop;
}

# カスタム版で置き換え
sub logop {
    my $self = shift;
    my ($op, $cx, $lowop, $lowprec, $highop, $highprec, $blockname) = @_;
    
    my $left  = $op->first;           # 左辺のOP
    my $right = $op->first->sibling;  # 右辺のOP
    
    # 左辺と右辺をテキストに変換
    $left  = $self->deparse_binop_left($op, $left, $highprec);
    $right = $self->deparse_binop_right($op, $right, $highprec);
    
    # 条件カバレッジを記録
    add_condition_cover($op, $highop, $left, $right);
    # 例: add_condition_cover($op, "&&", "$a", "$b")
}

3.2 条件の構造化 (add_condition_cover() 行 906-966)

sub add_condition_cover {
    my ($op, $strop, $left, $right) = @_;
    
    my $type = $op->name;  # "and", "or", "xor"
    my $c = $Coverage->{condition}{$key};  # XS から収集したデータ
    
    # 条件タイプを決定
    if ($type eq "or" || $type eq "and") {
        if ($c->[5] || $name =~ $Const_right) {
            # 右辺が定数 → 2パス
            $count = 2;
        } else {
            # 通常 → 3パス
            $count = 3;
            @$c = @{$c}[$type eq "or" ? (3, 2, 1) : (3, 1, 2)];
        }
    } elsif ($type eq "xor") {
        # XOR → 4パス
        @$c = @{$c}[3, 2, 4, 1];  # !l&&!r, l&&!r, l&&r, !l&&r
        $count = 4;
    }
    
    # 構造を保存
    my $structure = {
        type  => "${type}_${count}",  # "and_3", "or_3", "xor_4" など
        op    => $strop,              # "&&", "||", "xor"
        left  => $left,               # "$a"
        right => $right,              # "$b"
    };
}

4. 真理値表の生成 (Truth_Table.pm)

4.1 条件タイプと真理値表

タイプ演算子パス数ヘッダー
and_3&&3!l, l&&!r, l&&r
or_3``
and_2&& (右が定数)2l, !l
or_2`` (右が定数)
xor_4xor4l&&r, l&&!r, !l&&r, !l&&!r

4.2 基本真理値表の生成 (行 257-287)

# $a && $b の真理値表
sub and_tt {
    return (
        # inputs,   result, covered
        Row->new([ 0, 'X' ], 0, shift),  # $a=false → 短絡、結果=false
        Row->new([ 1, 0 ],   0, shift),  # $a=true, $b=false → 結果=false
        Row->new([ 1, 1 ],   1, shift),  # $a=true, $b=true → 結果=true
    );
}

# $a || $b の真理値表
sub or_tt {
    return (
        Row->new([ 0, 0 ],   0, shift),  # $a=false, $b=false → 結果=false
        Row->new([ 0, 1 ],   1, shift),  # $a=false, $b=true → 結果=true
        Row->new([ 1, 'X' ], 1, shift),  # $a=true → 短絡、結果=true
    );
}

# $a xor $b の真理値表 (短絡評価なし)
sub xor_tt {
    return (
        Row->new([ 0, 0 ], 0, shift),  # false xor false = false
        Row->new([ 0, 1 ], 1, shift),  # false xor true = true
        Row->new([ 1, 0 ], 1, shift),  # true xor false = true
        Row->new([ 1, 1 ], 0, shift),  # true xor true = false
    );
}

X は "don't care" = 短絡評価により右辺が評価されなかった

4.3 複合式のマージ (行 352-474)

例: ($a || $b) && $c を構築

# Step 1: 基本テーブル
#   A:  $a || $b          B:  b1 && $c (b1 = $a || $b)
#   a  b | a||b           b1  c | b1&&c
#   0  0 |  0              0  X |   0
#   0  1 |  1              1  0 |   0  
#   1  X |  1              1  1 |   1

# Step 2: B の b1 を A で展開
# b1=0 の行 → A から a||b=0 の行 (0,0) を代入
# b1=1 の行 → A から a||b=1 の行 (0,1), (1,X) を代入

# 結果:
#   a  b  c | (a||b)&&c
#   0  0  X |    0       # 短絡
#   0  1  0 |    0
#   1  X  0 |    0
#   0  1  1 |    1
#   1  X  1 |    1

5. 真理値表生成に参考になる箇所まとめ

ファイル行内容
Cover.xs511-526条件配列の構造定義
Cover.xs786-972cover_logop() - 論理演算の追跡
Cover.xs707-728get_condition() - ppaddr置換トリック
Cover.pm906-966add_condition_cover() - タイプ決定
Cover.pm1124-1170logop() - B::Deparse フック
Truth_Table.pm257-287and_tt(), or_tt(), xor_tt()
Truth_Table.pm409-474left_merge(), right_merge()
Condition_*.pm全体各条件タイプの定義

あなたの目的（真理値表生成）へのヒント

  1. B::Deparse の活用 - OP ツリーからソースコードのテキスト表現を復元
  2. OP の走査 - $op->first, $op->sibling で論理式の構造を把握
  3. 短絡評価の考慮 - X (don't care) で到達しないパスを表現
  4. マージアルゴリズム - 複合式を部分式から構築

何か特定の部分について詳しく知りたい点はありますか？

uuid: 3f86aa51-21d7-4eea-9828-89637dcca83c

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

User

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用しているのですね。私は出来ればコードを実行せずに、B::Deparse で出来る範囲でコードの論理構造を把握したいと考えています。ここまでの情報を元に、サンプルコードを提示していただけますか？

uuid: 08052453-6149-4ac6-987f-81e6026eb7eb

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Tool Interactions

ユーザーは実行時の情報ではなく、B::Deparse を使って静的にコードの論理構造を解析し、真理値表を生成したいと考えています。

Devel::Cover のコードから学んだことを活かして、以下のようなサンプルコードを作成できます：

  1. B::Deparse を使って OP ツリーを走査
  2. 論理演算子 (and, or, xor, cond_expr) を検出
  3. 左辺と右辺のテキスト表現を取得
  4. 論理構造を構築
  5. 真理値表を生成

Devel::Cover の手法を参考に、静的解析版を作ってみましょう。

ポイント：

  • B モジュールを使って OP ツリーにアクセス
  • B::Deparse を使ってテキスト表現を取得
  • logop のフックを参考に、論理演算子を検出
  • 再帰的に走査して論理式の構造を把握

サンプルコードを書いてみます。

uuid: assistant: 791ebcef-3d98-4481-8414-121b2449cbe2

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Assistant

はい、B::Deparse を使った静的解析で論理構造を把握するサンプルコードを作成します。

uuid: 4f2f030f-4d09-4aa9-96a4-05d54c6b27de

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Tool Interactions

Tool: Write /home/hkoba/db/monthly/202512/tmp/Devel--Cover/examples/static_logic_analyzer.pl

#!/usr/bin/env perl
use strict;
use warnings;
use v5.12;

#
# 静的にPerlコードの論理構造を解析し、真理値表を生成するサンプル
# Devel::Cover の手法を参考に、実行せずに B::Deparse で解析
#

package LogicAnalyzer;

use B qw(main_cv svref_2object OPf_KIDS);
use B::Deparse;

# 論理演算子の OP 名
my %LOGIC_OPS = map { $_ => 1 } qw(and or dor xor andassign orassign dorassign cond_expr);

sub new {
    my $class = shift;
    my $self = bless {
        deparse   => B::Deparse->new,
        conditions => [],  # 検出した条件式
    }, $class;
    return $self;
}

#------------------------------------------------------------------------------
# サブルーチンを解析
#------------------------------------------------------------------------------
sub analyze_sub {
    my ($self, $coderef) = @_;

    my $cv = svref_2object($coderef);
    return unless $cv->isa('B::CV');

    $self->{deparse}{curcv} = $cv;
    $self->{conditions} = [];

    my $root = $cv->ROOT;
    return unless $root && !$root->isa('B::NULL');

    $self->_walk_op($root);

    return $self->{conditions};
}

#------------------------------------------------------------------------------
# OP ツリーを再帰的に走査
#------------------------------------------------------------------------------
sub _walk_op {
    my ($self, $op) = @_;

    return unless $op && !$op->isa('B::NULL');

    my $name = $op->name;

    # 論理演算子を検出
    if ($LOGIC_OPS{$name}) {
        my $info = $self->_analyze_logop($op);
        push @{$self->{conditions}}, $info if $info;
    }

    # 子ノードを再帰的に走査
    if ($op->flags & OPf_KIDS) {
        for (my $kid = $op->first; $kid && !$kid->isa('B::NULL'); $kid = $kid->sibling) {
            $self->_walk_op($kid);
        }
    }
}

#------------------------------------------------------------------------------
# 論理演算子を解析
#------------------------------------------------------------------------------
sub _analyze_logop {
    my ($self, $op) = @_;

    my $name = $op->name;
    my $left_op = $op->first;

    return unless $left_op && !$left_op->isa('B::NULL');

    my $right_op;
    if ($name eq 'cond_expr') {
        # 三項演算子: cond ? true : false
        my $cond_op = $left_op;
        my $true_op = $cond_op->sibling;
        my $false_op = $true_op ? $true_op->sibling : undef;

        return {
            type      => 'cond_expr',
            op        => '?:',
            condition => $self->_deparse_op($cond_op),
            true_branch  => $self->_deparse_op($true_op),
            false_branch => $self->_deparse_op($false_op),
            line      => $self->_get_line($op),
        };
    }

    $right_op = $left_op->sibling;
    return unless $right_op && !$right_op->isa('B::NULL');

    my $op_symbol = $self->_op_to_symbol($name);
    my $left_text  = $self->_deparse_op($left_op);
    my $right_text = $self->_deparse_op($right_op);

    # 右辺が定数かどうか判定
    my $right_is_const = $self->_is_constant($right_op);

    return {
        type       => $name,
        op         => $op_symbol,
        left       => $left_text,
        right      => $right_text,
        right_const => $right_is_const,
        line       => $self->_get_line($op),
        # 真理値表のタイプを決定
        tt_type    => $self->_determine_tt_type($name, $right_is_const),
    };
}

#------------------------------------------------------------------------------
# OP をテキストに変換
#------------------------------------------------------------------------------
sub _deparse_op {
    my ($self, $op) = @_;

    return '' unless $op && !$op->isa('B::NULL');

    local $@;
    my $text = eval { $self->{deparse}->deparse($op, 0) };
    return '' if $@;

    # 前後の空白を除去
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;

    return $text;
}

#------------------------------------------------------------------------------
# OP 名からシンボルへ
#------------------------------------------------------------------------------
sub _op_to_symbol {
    my ($self, $name) = @_;

    my %symbols = (
        and       => '&&',
        andassign => '&&=',
        or        => '||',
        orassign  => '||=',
        dor       => '//',
        dorassign => '//=',
        xor       => 'xor',
    );

    return $symbols{$name} // $name;
}

#------------------------------------------------------------------------------
# 定数かどうか判定
#------------------------------------------------------------------------------
sub _is_constant {
    my ($self, $op) = @_;

    return 0 unless $op && !$op->isa('B::NULL');

    my $name = $op->name;

    # const, undef, refgen などは定数扱い
    return 1 if $name =~ /^(?:const|undef|s?refgen|null)$/;

    # die, return, last, next, redo, goto も「評価されない」扱い
    return 1 if $name =~ /^(?:die|return|last|next|redo|goto)$/;

    return 0;
}

#------------------------------------------------------------------------------
# 真理値表タイプを決定
#------------------------------------------------------------------------------
sub _determine_tt_type {
    my ($self, $op_name, $right_is_const) = @_;

    if ($op_name eq 'xor') {
        return 'xor_4';
    } elsif ($op_name =~ /^(?:and|andassign)$/) {
        return $right_is_const ? 'and_2' : 'and_3';
    } elsif ($op_name =~ /^(?:or|orassign|dor|dorassign)$/) {
        return $right_is_const ? 'or_2' : 'or_3';
    }

    return 'unknown';
}

#------------------------------------------------------------------------------
# 行番号を取得
#------------------------------------------------------------------------------
sub _get_line {
    my ($self, $op) = @_;

    # COP (statement) から行番号を取得するのは複雑なので、簡易版
    return 0;  # 実際にはより複雑な処理が必要
}

#==============================================================================
# 真理値表生成
#==============================================================================
package TruthTable;

sub new {
    my ($class, $condition) = @_;
    return bless { condition => $condition }, $class;
}

sub generate {
    my ($self) = @_;

    my $cond = $self->{condition};
    my $type = $cond->{tt_type} // '';

    if ($type eq 'and_3') {
        return $self->_and_3_table($cond);
    } elsif ($type eq 'and_2') {
        return $self->_and_2_table($cond);
    } elsif ($type eq 'or_3') {
        return $self->_or_3_table($cond);
    } elsif ($type eq 'or_2') {
        return $self->_or_2_table($cond);
    } elsif ($type eq 'xor_4') {
        return $self->_xor_4_table($cond);
    } elsif ($cond->{type} eq 'cond_expr') {
        return $self->_cond_expr_table($cond);
    }

    return [];
}

sub _and_3_table {
    my ($self, $cond) = @_;
    my ($l, $r, $op) = @{$cond}{qw(left right op)};

    return [
        { inputs => [0, 'X'], result => 0, desc => "!($l)" },
        { inputs => [1, 0],   result => 0, desc => "($l) $op !($r)" },
        { inputs => [1, 1],   result => 1, desc => "($l) $op ($r)" },
    ];
}

sub _and_2_table {
    my ($self, $cond) = @_;
    my ($l, $op) = @{$cond}{qw(left op)};

    return [
        { inputs => [0], result => 0, desc => "!($l)" },
        { inputs => [1], result => 1, desc => "($l)" },
    ];
}

sub _or_3_table {
    my ($self, $cond) = @_;
    my ($l, $r, $op) = @{$cond}{qw(left right op)};

    return [
        { inputs => [1, 'X'], result => 1, desc => "($l)" },
        { inputs => [0, 1],   result => 1, desc => "!($l) $op ($r)" },
        { inputs => [0, 0],   result => 0, desc => "!($l) $op !($r)" },
    ];
}

sub _or_2_table {
    my ($self, $cond) = @_;
    my ($l, $op) = @{$cond}{qw(left op)};

    return [
        { inputs => [1], result => 1, desc => "($l)" },
        { inputs => [0], result => 0, desc => "!($l)" },
    ];
}

sub _xor_4_table {
    my ($self, $cond) = @_;
    my ($l, $r) = @{$cond}{qw(left right)};

    return [
        { inputs => [0, 0], result => 0, desc => "!($l) xor !($r)" },
        { inputs => [0, 1], result => 1, desc => "!($l) xor ($r)" },
        { inputs => [1, 0], result => 1, desc => "($l) xor !($r)" },
        { inputs => [1, 1], result => 0, desc => "($l) xor ($r)" },
    ];
}

sub _cond_expr_table {
    my ($self, $cond) = @_;
    my ($c, $t, $f) = @{$cond}{qw(condition true_branch false_branch)};

    return [
        { inputs => [1], result => $t, desc => "($c) ? $t : ..." },
        { inputs => [0], result => $f, desc => "!($c) ? ... : $f" },
    ];
}

sub format_text {
    my ($self) = @_;

    my $table = $self->generate;
    return '' unless @$table;

    my $cond = $self->{condition};
    my @lines;

    # ヘッダー
    my $expr = $cond->{type} eq 'cond_expr'
        ? "$cond->{condition} ? $cond->{true_branch} : $cond->{false_branch}"
        : "$cond->{left} $cond->{op} $cond->{right}";

    push @lines, "Expression: $expr";
    push @lines, "Type: $cond->{tt_type}" if $cond->{tt_type};
    push @lines, "-" x 60;

    # 入力ヘッダー
    my $n_inputs = @{$table->[0]{inputs}};
    my @headers = map { chr(ord('A') + $_) } 0 .. $n_inputs - 1;
    push @lines, sprintf("| %s | Result | Description", join(" | ", @headers));
    push @lines, "-" x 60;

    # 各行
    for my $row (@$table) {
        my $inputs = join(" | ", map { $_ eq 'X' ? 'X' : $_ } @{$row->{inputs}});
        push @lines, sprintf("| %s |   %s    | %s", $inputs, $row->{result}, $row->{desc});
    }

    push @lines, "-" x 60;

    return join("\n", @lines);
}

#==============================================================================
# メイン
#==============================================================================
package main;

# テスト用サブルーチン
sub test_simple_and {
    my ($a, $b) = @_;
    return $a && $b;
}

sub test_simple_or {
    my ($a, $b) = @_;
    return $a || $b;
}

sub test_or_with_const {
    my ($a) = @_;
    return $a || die "error";
}

sub test_complex {
    my ($a, $b, $c) = @_;
    return ($a || $b) && $c;
}

sub test_ternary {
    my ($x) = @_;
    return $x ? "yes" : "no";
}

sub test_xor {
    my ($a, $b) = @_;
    return $a xor $b;
}

sub test_dor {
    my ($a, $b) = @_;
    return $a // $b;
}

# 解析実行
my $analyzer = LogicAnalyzer->new;

print "=" x 60, "\n";
print "Static Logic Structure Analyzer\n";
print "=" x 60, "\n\n";

my @test_subs = (
    [\&test_simple_and,    'test_simple_and:    $a && $b'],
    [\&test_simple_or,     'test_simple_or:     $a || $b'],
    [\&test_or_with_const, 'test_or_with_const: $a || die'],
    [\&test_complex,       'test_complex:       ($a || $b) && $c'],
    [\&test_ternary,       'test_ternary:       $x ? "yes" : "no"'],
    [\&test_xor,           'test_xor:           $a xor $b'],
    [\&test_dor,           'test_dor:           $a // $b'],
);

for my $test (@test_subs) {
    my ($coderef, $name) = @$test;

    print "### $name\n\n";

    my $conditions = $analyzer->analyze_sub($coderef);

    if (@$conditions) {
        for my $cond (@$conditions) {
            my $tt = TruthTable->new($cond);
            print $tt->format_text, "\n\n";
        }
    } else {
        print "(No logical conditions found)\n\n";
    }
}

# 文字列からコードを解析するデモ
print "=" x 60, "\n";
print "Analyzing code from string\n";
print "=" x 60, "\n\n";

my $code = q{
    sub complex_logic {
        my ($x, $y, $z) = @_;
        if ($x && $y || $z) {
            return 1;
        }
        return 0;
    }
};

print "Source code:\n$code\n";

# eval でコードをコンパイル (実行はしない)
eval $code;
if ($@) {
    die "Compile error: $@";
}

my $conditions = $analyzer->analyze_sub(\&complex_logic);
for my $cond (@$conditions) {
    my $tt = TruthTable->new($cond);
    print $tt->format_text, "\n\n";
}

Results

Result:

File created successfully at: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/examples/static_logic_analyzer.pl

サンプルコードを書きました。実行して結果を確認してみましょう。

uuid: assistant: f0d2a0ce-018f-4539-8449-18d2c54af0c0, assistant: af324036-ebe7-467e-8151-8f6ec15feccd

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Assistant

実行して動作を確認してみます。

uuid: 47a357ea-e053-4eae-902e-d036ae3af991

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Tool Interactions

Tool: Bash

{
  "command": "perl examples/static_logic_analyzer.pl 2>&1",
  "description": "Run static logic analyzer"
}

Results

Result:

Possible precedence issue with control flow operator (return) at examples/static_logic_analyzer.pl line 371.
============================================================
Static Logic Structure Analyzer
============================================================

### test_simple_and:    $a && $b

Expression: $a && $b
Type: and_3
------------------------------------------------------------
| A | B | Result | Description
------------------------------------------------------------
| 0 | X |   0    | !($a)
| 1 | 0 |   0    | ($a) && !($b)
| 1 | 1 |   1    | ($a) && ($b)
------------------------------------------------------------

### test_simple_or:     $a || $b

Expression: $a || $b
Type: or_3
------------------------------------------------------------
| A | B | Result | Description
------------------------------------------------------------
| 1 | X |   1    | ($a)
| 0 | 1 |   1    | !($a) || ($b)
| 0 | 0 |   0    | !($a) || !($b)
------------------------------------------------------------

### test_or_with_const: $a || die

Expression: $a || die 'error'
Type: or_2
------------------------------------------------------------
| A | Result | Description
------------------------------------------------------------
| 1 |   1    | ($a)
| 0 |   0    | !($a)
------------------------------------------------------------

### test_complex:       ($a || $b) && $c

Expression: $b unless $a && $c
Type: and_3
------------------------------------------------------------
| A | B | Result | Description
------------------------------------------------------------
| 0 | X |   0    | !($b unless $a)
| 1 | 0 |   0    | ($b unless $a) && !($c)
| 1 | 1 |   1    | ($b unless $a) && ($c)
------------------------------------------------------------

Expression: $a || $b
Type: or_3
------------------------------------------------------------
| A | B | Result | Description
------------------------------------------------------------
| 1 | X |   1    | ($a)
| 0 | 1 |   1    | !($a) || ($b)
| 
... (truncated)

動作しました！いくつかの問題があります：

  1. xor が検出されていない - Perl 5.41.12 以降で xor が binop になった可能性
  2. B::Deparse の出力がそのまま使われているので、$b unless $a のような形式になっている
  3. 文字列からのコードでは、スコープ全体が deparse されてしまっている

これらを改善したバージョンを作成しましょう。また、より実用的なサンプルとして、論理構造の木を構築するバージョンも追加します。

uuid: assistant: 07d94729-01cc-46a5-b25a-7d9d81e1734b, assistant: 52689de9-bd19-4033-ae23-bfb6986034c3

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Assistant

動作しました。いくつか改善点があるので、より実用的なバージョンを作成します。

uuid: 74cbe301-0dc0-403f-9db3-cbe6637a3ee7

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Tool Interactions

Tool: Write /home/hkoba/db/monthly/202512/tmp/Devel--Cover/examples/logic_tree_builder.pl

#!/usr/bin/env perl
use strict;
use warnings;
use v5.12;

#
# 論理式の木構造を静的に構築するサンプル
# Devel::Cover の手法を参考に、B モジュールで OP ツリーを解析
#

package LogicNode;

# 論理式の木構造を表現するノード

sub new {
    my ($class, %args) = @_;
    return bless \%args, $class;
}

sub type     { $_[0]->{type} }
sub op       { $_[0]->{op} }
sub left     { $_[0]->{left} }
sub right    { $_[0]->{right} }
sub text     { $_[0]->{text} }
sub children { @{$_[0]->{children} // []} }

sub is_leaf {
    my $self = shift;
    return $self->{type} eq 'leaf';
}

sub to_string {
    my ($self, $indent) = @_;
    $indent //= 0;
    my $pad = "  " x $indent;

    if ($self->is_leaf) {
        return "${pad}LEAF: $self->{text}";
    }

    my @lines = ("${pad}$self->{type} [$self->{op}]");

    if ($self->{left}) {
        push @lines, "${pad}  LEFT:";
        if (ref $self->{left}) {
            push @lines, $self->{left}->to_string($indent + 2);
        } else {
            push @lines, "${pad}    $self->{left}";
        }
    }

    if ($self->{right}) {
        push @lines, "${pad}  RIGHT:";
        if (ref $self->{right}) {
            push @lines, $self->{right}->to_string($indent + 2);
        } else {
            push @lines, "${pad}    $self->{right}";
        }
    }

    return join("\n", @lines);
}

#==============================================================================
package LogicTreeBuilder;

use B qw(svref_2object OPf_KIDS);
use B::Deparse;

my %LOGIC_OPS = (
    and       => { symbol => '&&',  short_circuit => 'left_false' },
    andassign => { symbol => '&&=', short_circuit => 'left_false' },
    or        => { symbol => '||',  short_circuit => 'left_true' },
    orassign  => { symbol => '||=', short_circuit => 'left_true' },
    dor       => { symbol => '//',  short_circuit => 'left_defined' },
    dorassign => { symbol => '//=', short_circuit => 'left_defined' },
    xor       => { symbol => 'xor', short_circuit => 'none' },
);

sub new {
    my $class = shift;
    my $self = bless {
        deparse => B::Deparse->new('-x7'),  # -x7: 最小限の変形
    }, $class;
    return $self;
}

#------------------------------------------------------------------------------
# コードリファレンスから論理式の木を構築
#------------------------------------------------------------------------------
sub build_from_coderef {
    my ($self, $coderef) = @_;

    my $cv = svref_2object($coderef);
    return unless $cv->isa('B::CV');

    $self->{deparse}{curcv} = $cv;
    $self->{trees} = [];

    my $root = $cv->ROOT;
    return [] unless $root && !$root->isa('B::NULL');

    $self->_scan_for_logic($root);

    return $self->{trees};
}

#------------------------------------------------------------------------------
# 論理演算を探して木を構築
#------------------------------------------------------------------------------
sub _scan_for_logic {
    my ($self, $op) = @_;

    return unless $op && !$op->isa('B::NULL');

    my $name = $op->name;

    if (exists $LOGIC_OPS{$name}) {
        my $tree = $self->_build_logic_tree($op);
        push @{$self->{trees}}, $tree if $tree;
    } elsif ($name eq 'cond_expr') {
        my $tree = $self->_build_cond_tree($op);
        push @{$self->{trees}}, $tree if $tree;
    }

    # 子ノードを再帰的に走査
    if ($op->flags & OPf_KIDS) {
        for (my $kid = $op->first; $kid && !$kid->isa('B::NULL'); $kid = $kid->sibling) {
            $self->_scan_for_logic($kid);
        }
    }
}

#------------------------------------------------------------------------------
# 論理演算の木を構築 (再帰的に部分式も解析)
#------------------------------------------------------------------------------
sub _build_logic_tree {
    my ($self, $op) = @_;

    my $name = $op->name;
    my $info = $LOGIC_OPS{$name} or return;

    my $left_op = $op->first;
    return unless $left_op && !$left_op->isa('B::NULL');

    my $right_op = $left_op->sibling;
    return unless $right_op && !$right_op->isa('B::NULL');

    # 左辺と右辺を再帰的に解析
    my $left  = $self->_analyze_operand($left_op);
    my $right = $self->_analyze_operand($right_op);

    return LogicNode->new(
        type          => $name,
        op            => $info->{symbol},
        short_circuit => $info->{short_circuit},
        left          => $left,
        right         => $right,
        right_const   => $self->_is_constant($right_op),
    );
}

#------------------------------------------------------------------------------
# 三項演算子の木を構築
#------------------------------------------------------------------------------
sub _build_cond_tree {
    my ($self, $op) = @_;

    my $cond_op = $op->first;
    return unless $cond_op && !$cond_op->isa('B::NULL');

    my $true_op = $cond_op->sibling;
    my $false_op = $true_op ? $true_op->sibling : undef;

    return LogicNode->new(
        type      => 'cond_expr',
        op        => '?:',
        condition => $self->_analyze_operand($cond_op),
        left      => $self->_analyze_operand($true_op),
        right     => $self->_analyze_operand($false_op),
    );
}

#------------------------------------------------------------------------------
# オペランドを解析 (論理演算なら再帰、そうでなければ葉ノード)
#------------------------------------------------------------------------------
sub _analyze_operand {
    my ($self, $op) = @_;

    return '' unless $op && !$op->isa('B::NULL');

    my $name = $op->name;

    # 論理演算子なら再帰的に木を構築
    if (exists $LOGIC_OPS{$name}) {
        return $self->_build_logic_tree($op);
    }

    # null OP の場合は中身を見る
    if ($name eq 'null') {
        my $first = $op->first;
        if ($first && !$first->isa('B::NULL')) {
            my $inner_name = $first->name;
            if (exists $LOGIC_OPS{$inner_name}) {
                return $self->_build_logic_tree($first);
            }
        }
    }

    # 葉ノード: deparse してテキストを取得
    return LogicNode->new(
        type => 'leaf',
        text => $self->_deparse_simple($op),
    );
}

#------------------------------------------------------------------------------
# シンプルな deparse (論理演算子は展開しない)
#------------------------------------------------------------------------------
sub _deparse_simple {
    my ($self, $op) = @_;

    return '' unless $op && !$op->isa('B::NULL');

    local $@;
    my $text = eval { $self->{deparse}->deparse($op, 0) };
    return $text // '' if $@;

    # 後処理
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;

    return $text;
}

#------------------------------------------------------------------------------
# 定数判定
#------------------------------------------------------------------------------
sub _is_constant {
    my ($self, $op) = @_;

    return 0 unless $op && !$op->isa('B::NULL');

    my $name = $op->name;
    return 1 if $name =~ /^(?:const|undef|s?refgen|null)$/;
    return 1 if $name =~ /^(?:die|return|last|next|redo|goto)$/;
    return 0;
}

#==============================================================================
package TruthTableGenerator;

#------------------------------------------------------------------------------
# LogicNode から真理値表を生成
#------------------------------------------------------------------------------
sub generate {
    my ($class, $node) = @_;

    return [] unless $node;

    if ($node->is_leaf) {
        return $class->_leaf_table($node);
    }

    my $type = $node->type;

    if ($type eq 'cond_expr') {
        return $class->_cond_table($node);
    }

    # 左右のオペランドの変数を収集
    my @vars = $class->_collect_variables($node);

    # 左右が複合式かどうかで分岐
    my $left_complex  = ref($node->left)  && !$node->left->is_leaf;
    my $right_complex = ref($node->right) && !$node->right->is_leaf;

    if ($left_complex || $right_complex) {
        return $class->_complex_table($node, \@vars);
    }

    return $class->_simple_table($node);
}

#------------------------------------------------------------------------------
# 変数を収集
#------------------------------------------------------------------------------
sub _collect_variables {
    my ($class, $node) = @_;

    return () unless $node;

    if ($node->is_leaf) {
        my $text = $node->text;
        # $var 形式の変数を抽出
        my @vars = $text =~ /(\$\w+)/g;
        return @vars;
    }

    my @vars;
    push @vars, $class->_collect_variables($node->left)  if ref $node->left;
    push @vars, $class->_collect_variables($node->right) if ref $node->right;

    # 重複を除去しつつ順序を保持
    my %seen;
    return grep { !$seen{$_}++ } @vars;
}

#------------------------------------------------------------------------------
# 単純な真理値表 (and_3, or_3 など)
#------------------------------------------------------------------------------
sub _simple_table {
    my ($class, $node) = @_;

    my $type = $node->type;
    my $op   = $node->op;

    my $left_text  = ref($node->left)  ? $node->left->text  : $node->left;
    my $right_text = ref($node->right) ? $node->right->text : $node->right;

    my $right_const = $node->{right_const};

    my @table;

    if ($type =~ /^(?:and|andassign)$/) {
        if ($right_const) {
            # and_2
            @table = (
                { A => 0, result => 0, path => "!$left_text (short-circuit)" },
                { A => 1, result => 1, path => "$left_text" },
            );
        } else {
            # and_3
            @table = (
                { A => 0, B => 'X', result => 0, path => "!$left_text (short-circuit)" },
                { A => 1, B => 0,   result => 0, path => "$left_text $op !$right_text" },
                { A => 1, B => 1,   result => 1, path => "$left_text $op $right_text" },
            );
        }
    } elsif ($type =~ /^(?:or|orassign|dor|dorassign)$/) {
        if ($right_const) {
            # or_2
            @table = (
                { A => 1, result => 1, path => "$left_text (short-circuit)" },
                { A => 0, result => 0, path => "!$left_text" },
            );
        } else {
            # or_3
            @table = (
                { A => 1, B => 'X', result => 1, path => "$left_text (short-circuit)" },
                { A => 0, B => 1,   result => 1, path => "!$left_text $op $right_text" },
                { A => 0, B => 0,   result => 0, path => "!$left_text $op !$right_text" },
            );
        }
    } elsif ($type eq 'xor') {
        # xor_4 (短絡評価なし)
        @table = (
            { A => 0, B => 0, result => 0, path => "!$left_text xor !$right_text" },
            { A => 0, B => 1, result => 1, path => "!$left_text xor $right_text" },
            { A => 1, B => 0, result => 1, path => "$left_text xor !$right_text" },
            { A => 1, B => 1, result => 0, path => "$left_text xor $right_text" },
        );
    }

    return {
        expression => "$left_text $op $right_text",
        type       => $type,
        headers    => $right_const ? ['A'] : ['A', 'B'],
        rows       => \@table,
    };
}

#------------------------------------------------------------------------------
# 複合式の真理値表
#------------------------------------------------------------------------------
sub _complex_table {
    my ($class, $node, $vars) = @_;

    # 全変数の組み合わせを生成
    my $n = @$vars;
    my @table;

    for my $i (0 .. (2**$n - 1)) {
        my %vals;
        for my $j (0 .. $n-1) {
            $vals{$vars->[$j]} = ($i >> ($n - 1 - $j)) & 1;
        }

        my $result = $class->_evaluate($node, \%vals);
        my @inputs = map { $vals{$_} } @$vars;

        push @table, {
            inputs => \@inputs,
            result => $result,
            vals   => \%vals,
        };
    }

    return {
        expression => $class->_node_to_expr($node),
        variables  => $vars,
        headers    => [map { s/^\$//r } @$vars],
        rows       => \@table,
    };
}

#------------------------------------------------------------------------------
# 論理式を評価
#------------------------------------------------------------------------------
sub _evaluate {
    my ($class, $node, $vals) = @_;

    return 0 unless $node;

    if ($node->is_leaf) {
        my $text = $node->text;
        # $var 形式を探して値を返す
        if ($text =~ /^\$(\w+)$/) {
            return $vals->{$text} // 0;
        }
        # 定数として評価
        return $text ? 1 : 0;
    }

    my $type = $node->type;
    my $left_val  = $class->_evaluate($node->left, $vals);
    my $right_val = $class->_evaluate($node->right, $vals);

    if ($type =~ /^(?:and|andassign)$/) {
        return $left_val && $right_val ? 1 : 0;
    } elsif ($type =~ /^(?:or|orassign|dor|dorassign)$/) {
        return $left_val || $right_val ? 1 : 0;
    } elsif ($type eq 'xor') {
        return ($left_val xor $right_val) ? 1 : 0;
    } elsif ($type eq 'cond_expr') {
        my $cond_val = $class->_evaluate($node->{condition}, $vals);
        return $cond_val ? $left_val : $right_val;
    }

    return 0;
}

#------------------------------------------------------------------------------
# ノードを式文字列に変換
#------------------------------------------------------------------------------
sub _node_to_expr {
    my ($class, $node) = @_;

    return '' unless $node;

    if ($node->is_leaf) {
        return $node->text;
    }

    my $left  = $class->_node_to_expr($node->left);
    my $right = $class->_node_to_expr($node->right);
    my $op    = $node->op;

    return "($left $op $right)";
}

#------------------------------------------------------------------------------
# 葉ノード用
#------------------------------------------------------------------------------
sub _leaf_table {
    my ($class, $node) = @_;
    return { expression => $node->text, type => 'leaf', rows => [] };
}

#------------------------------------------------------------------------------
# 三項演算子用
#------------------------------------------------------------------------------
sub _cond_table {
    my ($class, $node) = @_;

    my $cond_text = ref($node->{condition}) ? $class->_node_to_expr($node->{condition}) : $node->{condition};
    my $true_text = ref($node->left) ? $class->_node_to_expr($node->left) : $node->left;
    my $false_text = ref($node->right) ? $class->_node_to_expr($node->right) : $node->right;

    return {
        expression => "$cond_text ? $true_text : $false_text",
        type       => 'cond_expr',
        headers    => ['cond'],
        rows       => [
            { cond => 1, result => $true_text,  path => "condition is true" },
            { cond => 0, result => $false_text, path => "condition is false" },
        ],
    };
}

#------------------------------------------------------------------------------
# テキスト形式で出力
#------------------------------------------------------------------------------
sub format_text {
    my ($class, $table) = @_;

    return '' unless $table && $table->{rows} && @{$table->{rows}};

    my @lines;
    push @lines, "Expression: $table->{expression}";
    push @lines, "Type: $table->{type}" if $table->{type};
    push @lines, "-" x 70;

    my @headers = @{$table->{headers} // []};

    if ($table->{variables}) {
        # 複合式
        push @lines, sprintf("| %s | result |", join(" | ", @headers));
        push @lines, "-" x 70;

        for my $row (@{$table->{rows}}) {
            my $inputs = join(" | ", @{$row->{inputs}});
            push @lines, sprintf("| %s |   %d    |", $inputs, $row->{result});
        }
    } else {
        # 単純式
        push @lines, sprintf("| %s | result | path", join(" | ", @headers));
        push @lines, "-" x 70;

        for my $row (@{$table->{rows}}) {
            my @vals = map { $row->{$_} // 'X' } @headers;
            my $inputs = join(" | ", @vals);
            push @lines, sprintf("| %s |   %s    | %s",
                $inputs, $row->{result}, $row->{path} // '');
        }
    }

    push @lines, "-" x 70;
    return join("\n", @lines);
}

#==============================================================================
package main;

# テスト用サブルーチン
sub test1 { my ($a, $b) = @_; $a && $b }
sub test2 { my ($a, $b) = @_; $a || $b }
sub test3 { my ($a, $b, $c) = @_; ($a && $b) || $c }
sub test4 { my ($a, $b, $c) = @_; $a && ($b || $c) }
sub test5 { my ($a, $b, $c, $d) = @_; ($a || $b) && ($c || $d) }
sub test6 { my ($x) = @_; $x ? 1 : 0 }

my $builder = LogicTreeBuilder->new;

print "=" x 70, "\n";
print "Logic Tree Builder - Static Analysis Demo\n";
print "=" x 70, "\n\n";

my @tests = (
    [\&test1, '$a && $b'],
    [\&test2, '$a || $b'],
    [\&test3, '($a && $b) || $c'],
    [\&test4, '$a && ($b || $c)'],
    [\&test5, '($a || $b) && ($c || $d)'],
    [\&test6, '$x ? 1 : 0'],
);

for my $test (@tests) {
    my ($coderef, $desc) = @$test;

    print "### $desc\n\n";

    my $trees = $builder->build_from_coderef($coderef);

    for my $tree (@$trees) {
        print "Logic Tree:\n";
        print $tree->to_string(1), "\n\n";

        my $table = TruthTableGenerator->generate($tree);
        print TruthTableGenerator->format_text($table), "\n\n";
    }

    print "-" x 70, "\n\n";
}

Results

Result:

File created successfully at: /home/hkoba/db/monthly/202512/tmp/Devel--Cover/examples/logic_tree_builder.pl

より完成度の高いバージョンを作成しました。実行して結果を確認してみましょう。

Tool: Bash

{
  "command": "perl examples/logic_tree_builder.pl 2>&1",
  "description": "Run logic tree builder"
}

Results

Result:

======================================================================
Logic Tree Builder - Static Analysis Demo
======================================================================

### $a && $b

Logic Tree:
  and [&&]
    LEFT:
      LEAF: $a
    RIGHT:
      LEAF: $b

Expression: $a && $b
Type: and
----------------------------------------------------------------------
| A | B | result | path
----------------------------------------------------------------------
| 0 | X |   0    | !$a (short-circuit)
| 1 | 0 |   0    | $a && !$b
| 1 | 1 |   1    | $a && $b
----------------------------------------------------------------------

----------------------------------------------------------------------

### $a || $b

Logic Tree:
  or [||]
    LEFT:
      LEAF: $a
    RIGHT:
      LEAF: $b

Expression: $a || $b
Type: or
----------------------------------------------------------------------
| A | B | result | path
----------------------------------------------------------------------
| 1 | X |   1    | $a (short-circuit)
| 0 | 1 |   1    | !$a || $b
| 0 | 0 |   0    | !$a || !$b
----------------------------------------------------------------------

----------------------------------------------------------------------

### ($a && $b) || $c

Logic Tree:
  or [||]
    LEFT:
      and [&&]
        LEFT:
          LEAF: $a
        RIGHT:
          LEAF: $b
    RIGHT:
      LEAF: $c

Expression: (($a && $b) || $c)
----------------------------------------------------------------------
| a | b | c | result |
----------------------------------------------------------------------
| 0 | 0 | 0 |   0    |
| 0 | 0 | 1 |   1    |
| 0 | 1 | 0 |   0    |
| 0 | 1 | 1 |   1    |
| 1 | 0 | 0 |   0    |
| 1 | 0 | 1 |   1    |
| 1 | 1 | 0 |   1    |
| 1 | 1 | 1 |   1    |
----------------------------------------------------------------------

Logic Tree:
  and [&&]
    LEFT:
      LEAF: $a
    RIGHT:
      LEAF: $b

Expression: $a && $b
Type: and
-------------------------------------------
... (truncated)

素晴らしい！うまく動作しています。論理式の木構造が正しく解析され、真理値表も生成されています。

ユーザーにサンプルコードの概要と、Devel::Cover との違いを説明しましょう。

uuid: assistant: 8f0c2413-893b-437f-85cc-244f015da68c, assistant: 517abd0d-5fd9-40df-8d2e-fc30b432c361, assistant: f4b1e88e-30af-4963-8c7c-ea1a9adb7729, assistant: df1427ae-14f2-423a-a66d-90baea54990f

ありがとうございます。やはり Devel::Cover は実行時の情報をキャプチャーして活用している

Assistant

うまく動作しました！サンプルコードの概要をまとめます。

サンプルコードの解説

作成した2つのファイル

ファイル目的
examples/static_logic_analyzer.pl基本版：単純な条件式を解析
examples/logic_tree_builder.pl発展版：論理式の木構造を構築

核心となる技法

1. B モジュールで OP ツリーにアクセス

use B qw(svref_2object OPf_KIDS);

my $cv = svref_2object($coderef);  # コードリファレンス → B::CV
my $root = $cv->ROOT;               # ルート OP を取得

2. OP ツリーの走査

sub _walk_op {
    my ($self, $op) = @_;
    
    my $name = $op->name;  # "and", "or", "cond_expr" など
    
    # 子ノードを走査
    if ($op->flags & OPf_KIDS) {
        for (my $kid = $op->first; $kid; $kid = $kid->sibling) {
            $self->_walk_op($kid);
        }
    }
}

3. 論理演算子の構造

# $a && $b の OP 構造
#
#   and
#    ├── first: $a を評価する OP
#    └── sibling: $b を評価する OP

my $left_op  = $op->first;
my $right_op = $left_op->sibling;

4. B::Deparse でテキスト化

my $deparse = B::Deparse->new;
$deparse->{curcv} = $cv;  # 対象の CV を設定

my $text = $deparse->deparse($op, 0);  # OP → Perl コード文字列

Devel::Cover との違い

観点Devel::Cover今回のサンプル
解析タイミング実行時 + 事後コンパイル時のみ（静的）
短絡評価実際の実行結果を記録構造から推論
カバレッジどのパスが実行されたか全パスを列挙
用途テストのカバレッジ計測論理構造の可視化

拡張のアイデア

  1. if/unless/while の解析 - cond_expr 以外の制御構造
  2. 複数文の解析 - サブルーチン全体ではなく特定の式
  3. 短絡評価の視覚化 - 到達しないパスを X で表示
  4. CNF/DNF への変換 - 論理式の正規化

何か特定の部分を深掘りしたい、あるいは別の形式の出力が欲しいなどあれば、お知らせください。

uuid: 39b6198a-b47f-4e26-ab50-35a7411204b4